R Shiny reset input values for mychooser function of the Shiny gallery

Question

I am still learning about Shiny and developing my own application.

The following widget allows to select columns however the user wants (with live example):

https://shiny.rstudio.com/gallery/custom-input-control.html

UI.R

source("chooser.R")

fluidPage(
  chooserInput("mychooser", "Available frobs", "Selected frobs",
    row.names(USArrests), c(), size = 10, multiple = TRUE
  ),
  verbatimTextOutput("selection")
)

server.R

function(input, output, session) {

  output$selection <- renderPrint(
    input$mychooser
  )

}

chooser.R

chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
  size = 5, multiple = FALSE) {

  leftChoices <- lapply(leftChoices, tags$option)
  rightChoices <- lapply(rightChoices, tags$option)

  if (multiple)
    multiple <- "multiple"
  else
    multiple <- NULL

  tagList(
    singleton(tags$head(
      tags$script(src="chooser-binding.js"),
      tags$style(type="text/css",
        HTML(".chooser-container { display: inline-block; }")
      )
    )),
    div(id=inputId, class="chooser",
      div(class="chooser-container chooser-left-container",
        tags$select(class="left", size=size, multiple=multiple, leftChoices)
      ),
      div(class="chooser-container chooser-center-container",
        icon("arrow-circle-o-right", "right-arrow fa-3x"),
        tags$br(),
        icon("arrow-circle-o-left", "left-arrow fa-3x")
      ),
      div(class="chooser-container chooser-right-container",
        tags$select(class="right", size=size, multiple=multiple, rightChoices)
      )
    )
  )
}

registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
  if (is.null(data))
    NULL
  else
    list(left=as.character(data$left), right=as.character(data$right))
}, force = TRUE)

www/chooser-binding.js

(function() {

function updateChooser(chooser) {
    chooser = $(chooser);
    var left = chooser.find("select.left");
    var right = chooser.find("select.right");
    var leftArrow = chooser.find(".left-arrow");
    var rightArrow = chooser.find(".right-arrow");

    var canMoveTo = (left.val() || []).length > 0;
    var canMoveFrom = (right.val() || []).length > 0;

    leftArrow.toggleClass("muted", !canMoveFrom);
    rightArrow.toggleClass("muted", !canMoveTo);
}

function move(chooser, source, dest) {
    chooser = $(chooser);
    var selected = chooser.find(source).children("option:selected");
    var dest = chooser.find(dest);
    dest.children("option:selected").each(function(i, e) {e.selected = false;});
    dest.append(selected);
    updateChooser(chooser);
    chooser.trigger("change");
}

$(document).on("change", ".chooser select", function() {
    updateChooser($(this).parents(".chooser"));
});

$(document).on("click", ".chooser .right-arrow", function() {
    move($(this).parents(".chooser"), ".left", ".right");
});

$(document).on("click", ".chooser .left-arrow", function() {
    move($(this).parents(".chooser"), ".right", ".left");
});

$(document).on("dblclick", ".chooser select.left", function() {
    move($(this).parents(".chooser"), ".left", ".right");
});

$(document).on("dblclick", ".chooser select.right", function() {
    move($(this).parents(".chooser"), ".right", ".left");
});

var binding = new Shiny.InputBinding();

binding.find = function(scope) {
  return $(scope).find(".chooser");
};

binding.initialize = function(el) {
  updateChooser(el);
};

binding.getValue = function(el) {
  return {
    left: $.makeArray($(el).find("select.left option").map(function(i, e) { return e.value; })),
    right: $.makeArray($(el).find("select.right option").map(function(i, e) { return e.value; }))
  }
};

binding.setValue = function(el, value) {
  // TODO: implement
};

binding.subscribe = function(el, callback) {
  $(el).on("change.chooserBinding", function(e) {
    callback();
  });
};

binding.unsubscribe = function(el) {
  $(el).off(".chooserBinding");
};

binding.getType = function() {
  return "shinyjsexamples.chooser";
};

Shiny.inputBindings.register(binding, "shinyjsexamples.chooser");

})();

Once the columns have been scrambled, we can't go back to the original order except reloading the application. I'd like to have an actionButton that resets all the columns of mychooser to their default values.

What I tried so far

UI.R

source("chooser.R")

fluidPage(
    chooserInput("mychooser", "Available frobs", "Selected frobs",
                 row.names(USArrests), c(), size = 10, multiple = TRUE
    ),
    actionButton(inputId = "resetcols", label = "Reset"),
    verbatimTextOutput("selection")
)

server.R

function(input, output, session) {

    colvalues <- row.names(USArrests)

    output$selection <- renderPrint(
        input$mychooser
    )

    eventReactive(input$resetcols, {
        output$mychooser <- row.names(USArrests)
    })

}

However, there's nothing happened and I don't know what can I do.

Thanks in advance

Answer 1

Here is the way.

Add this JS code in chooser-binding.js , eg after binding.setValue :

binding.receiveMessage = function (el, data) {
  $(".chooser select.left").empty();
  $(".chooser select.right").empty();
  if(data.left !== null){
    for(var i = 0; i < data.left.length; ++i){
      $(".chooser select.left")
        .append($("<option>" + data.left[i] + "</option>"));
    }
  }
  if(data.right !== null){
    for(var i = 0; i < data.right.length; ++i){
      $(".chooser select.right")
        .append($("<option>" + data.right[i] + "</option>"));
    }
  }
  var chooser = $(el);
  updateChooser(chooser);
  chooser.trigger("change");
};

Define the updater for chooserInput :

updateChooserInput <- function(session, inputId, left, right){
  session$sendInputMessage(inputId, list(right = right, left = left))
}

Now, here is an example:

# ui ####
ui <- fluidPage(
  br(),
  chooserInput("mychooser", "Available frobs", "Selected frobs",
               row.names(USArrests), c(), size = 10, multiple = TRUE
  ),
  verbatimTextOutput("selection"),
  br(),
  actionButton("update", "Update"),
  actionButton("reset", "Reset")
)

# server ####
server <- function(input, output, session) {

  output$selection <- renderPrint(
    input$mychooser
  )

  observeEvent(input$update, {
    updateChooserInput(session, "mychooser", 
                       left = c("aaa", "bbb", "ccc"), 
                       right = c("xxx", "yyy", "zzz"))
  })

  observeEvent(input$reset, {
    updateChooserInput(session, "mychooser", 
                       left = row.names(USArrests), 
                       right = c())
  })

}

shinyApp(ui, server)