Display multiple strings in a cell of a datatable that can be removed by clicking on them

I have the shiny app below in which I convert the d dataframe to a dataframe in which the unique items will be summarized based on the name and a new column will be added with their count. Then I use DT package to display this dataframe. I wonder if DT or shinywidgets or maybe another method can be used in order to display the table like in the screenshot below in which the user will be able to display the different strings in the items column as separated words that he will be able to remove. Here is an example in the second column.

library(shiny)
library(DT)
library(jsonlite)

selector <- function(id, values, items = values){
  options <- HTML(paste0(mapply(
    function(value, item){
      as.character(tags$option(value = value, item))
    }, c("", values), c("", items)
  ), collapse = ""))
  as.character(
    tags$select(
      id = id, class = "form-control", multiple = "multiple", options
    )
  )
}

name<-c("Jack","Bob","Jack","Bob")
item<-c("apple","olive","banana","tomato")
d<-data.frame(name,item)

words<-tapply(d$item, d$name, I)


nrows <- length(words)

js <- c(
  "function(settings) {",
  sprintf("var nrows = %d;", nrows),
  sprintf("var words = %s;", toJSON(words)),
  "  var table = this.api().table();",
  "  function selectize(i) {",
  "    $('#slct' + i).selectize({",
  "      items: words[i-1],",
  "      onChange: function(value) {",
  "        table.cell(i-1, 2).data(value.length);",
  "      }",
  "    });",
  "  }",
  "  for(var i = 1; i <= nrows; i++) {",
  "    selectize(i);",
  "    Shiny.setInputValue('slct' + i, words[i-1]);",
  "  }",
  "}"
)

ui <- fluidPage(
  br(),
  DTOutput("table"),
  div( # this is a hidden selectize input whose role is to make
    # available 'selectize.js'
    style = "display: none;",
    selectInput("id", "label", c("x", "y"))
  )
)

server <- function(input, output, session) {
  
  output[["table"]] <- renderDT({
    dat <- data.frame(
      FOO = c(unique(d$name)),
      Words = vapply(
        1:nrows,
        function(i){
          selector(paste0("slct", i), words[[i]])
        },
        character(1)
      ),
      Count = lengths(words),
      stringsAsFactors = FALSE
    )
    
    datatable(
      data = dat,
      selection = "none",
      escape = FALSE,
      rownames = FALSE,
      options = list(
        initComplete = JS(js),
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); }'
        )
      )
    )
  }, server = FALSE)
  
  
}

shinyApp(ui, server)

Solution

We can do that with a selectizeInput:

library(shiny)
library(DT)

js <- c(
  "function(settings){",
  "  $('#mselect').selectize();",
  "}"
)

ui <- fluidPage(
  br(),
  DTOutput("table"),
  div(
    style = "display: none;",
    selectInput("id", "label", c("x", "y"))
  )
)

server <- function(input, output, session) {
  
  output[["table"]] <- renderDT({
    dat <- data.frame(
      FOO = "bar",
      BAZ = '<select id="mselect" class="form-control" multiple="multiple">
                       <option value=""></option>
                       <option value="A">Apple</option>
                       <option value="B">Banana</option>
                       <option value="C">Lemon</option>
                       </select>',
      stringsAsFactors = FALSE)
    
    datatable(
      data = dat,
      selection = "none",
      escape = FALSE,
      rownames = FALSE, 
      options = list(
        initComplete = JS(js)
      )
    )
  })
  
}

shinyApp(ui, server)

EDIT

library(shiny)
library(DT)

selector <- function(id, values, items = values){
  options <- HTML(paste0(mapply(
    function(value, item){
      as.character(tags$option(value = value, item))
    }, c("",values), c("",items)
  ), collapse = ""))
  as.character(
    tags$select(
      id = id, class = "form-control", multiple = "multiple", options
    )
  )
}

words1 <- c("apple", "banana")
words2 <- c("olive", "tomato")

js <- c(
  "function(settings) {",
  sprintf("var words1 = [%s];", toString(shQuote(words1))),
  sprintf("var words2 = [%s];", toString(shQuote(words2))),
  "  $('#slct1').selectize({items: words1});",
  "  $('#slct2').selectize({items: words2});",
  "  Shiny.setInputValue('slct1', words1);",
  "  Shiny.setInputValue('slct2', words2);",
  "}"
)

ui <- fluidPage(
  br(),
  verbatimTextOutput("words1"),
  DTOutput("table"),
  div( # this is a hidden selectize input whose role is to make
       # available 'selectize.js'
    style = "display: none;",
    selectInput("id", "label", c("x", "y"))
  )
)

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

  output[["table"]] <- renderDT({
    dat <- data.frame(
      FOO = c("bar", "baz"),
      Words = c(
        selector("slct1", words1),
        selector("slct2", words2)
      ),
      stringsAsFactors = FALSE
    )

    datatable(
      data = dat,
      selection = "none",
      escape = FALSE,
      rownames = FALSE,
      options = list(
        initComplete = JS(js),
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); }'
        )
      )
    )
  }, server = FALSE)

  output[["words1"]] <- renderPrint({
    input[["slct1"]]
  })
}

shinyApp(ui, server)

EDIT

With the counts:

library(shiny)
library(DT)

selector <- function(id, values, items = values){
  options <- HTML(paste0(mapply(
    function(value, item){
      as.character(tags$option(value = value, item))
    }, c("",values), c("",items)
  ), collapse = ""))
  as.character(
    tags$select(
      id = id, class = "form-control", multiple = "multiple", options
    )
  )
}

words1 <- c("apple", "banana")
words2 <- c("olive", "tomato")

js <- c(
  "function(settings) {",
  sprintf("var words1 = [%s];", toString(shQuote(words1))),
  sprintf("var words2 = [%s];", toString(shQuote(words2))),
  "  var table = this.api().table();",
  "  $('#slct1').selectize({",
  "    items: words1,",
  "    onChange: function(value) {",
  "      var count = value.length;",
  "      table.cell(0,2).data(count);",
  "    }",
  "  });",
  "  $('#slct2').selectize({",
  "    items: words2,",
  "    onChange: function(value) {",
  "      var count = value.length;",
  "      table.cell(1,2).data(count);",
  "    }",
  "  });",
  "  Shiny.setInputValue('slct1', words1);",
  "  Shiny.setInputValue('slct2', words2);",
  "}"
)

ui <- fluidPage(
  br(),
  verbatimTextOutput("words1"),
  DTOutput("table"),
  div( # this is a hidden selectize input whose role is to make
       # available 'selectize.js'
    style = "display: none;",
    selectInput("id", "label", c("x", "y"))
  )
)

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

  output[["table"]] <- renderDT({
    dat <- data.frame(
      FOO = c("bar", "baz"),
      Words = c(
        selector("slct1", words1),
        selector("slct2", words2)
      ),
      Count = c(length(words1), length(words2)),
      stringsAsFactors = FALSE
    )

    datatable(
      data = dat,
      selection = "none",
      escape = FALSE,
      rownames = FALSE,
      options = list(
        initComplete = JS(js),
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); }'
        )
      )
    )
  }, server = FALSE)

  output[["words1"]] <- renderPrint({
    input[["slct1"]]
  })
}

shinyApp(ui, server)

EDIT

For an arbitrary number of rows:

library(shiny)
library(DT)
library(jsonlite)

selector <- function(id, values, items = values){
  options <- HTML(paste0(mapply(
    function(value, item){
      as.character(tags$option(value = value, item))
    }, c("", values), c("", items)
  ), collapse = ""))
  as.character(
    tags$select(
      id = id, class = "form-control", multiple = "multiple", options
    )
  )
}

words <- list(
  c("apple", "banana"),
  c("olive", "tomato")
)

nrows <- length(words)

js <- c(
  "function(settings) {",
  sprintf("var nrows = %d;", nrows),
  sprintf("var words = %s;", toJSON(words)),
  "  var table = this.api().table();",
  "  function selectize(i) {",
  "    $('#slct' + i).selectize({",
  "      items: words[i-1],",
  "      onChange: function(value) {",
  "        table.cell(i-1, 2).data(value.length);",
  "      }",
  "    });",
  "  }",
  "  for(var i = 1; i <= nrows; i++) {",
  "    selectize(i);",
  "    Shiny.setInputValue('slct' + i, words[i-1]);",
  "  }",
  "}"
)

ui <- fluidPage(
  br(),
  verbatimTextOutput("words1"),
  DTOutput("table"),
  div( # this is a hidden selectize input whose role is to make
       # available 'selectize.js'
    style = "display: none;",
    selectInput("id", "label", c("x", "y"))
  )
)

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

  output[["table"]] <- renderDT({
    dat <- data.frame(
      FOO = c("bar", "baz"),
      Words = vapply(
        1:nrows,
        function(i){
          selector(paste0("slct", i), words[[i]])
        },
        character(1)
      ),
      Count = lengths(words),
      stringsAsFactors = FALSE
    )

    datatable(
      data = dat,
      selection = "none",
      escape = FALSE,
      rownames = FALSE,
      options = list(
        initComplete = JS(js),
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); }'
        )
      )
    )
  }, server = FALSE)

  output[["words1"]] <- renderPrint({
    input[["slct1"]]
  })
}

shinyApp(ui, server)