R shiny app: How to address specific shinyBS buttons across several tabs?

Question

I have started writing a shiny app.

What I want to achieve is loading a text file with a string in one line - like this:

$ cat testdata.txt
hello world

If the text gets loaded, the vowels are set to value 1 in the data frame and are highlighted with the shinyBS package.

What I want to achieve is to be able to change the values in the data frame by clicking the toggled buttons. The buttons can be toggled, but the changed values are not transferred to the data frame or the plot.

How can this be achieved? I hope the question is clear, if not please ask and I will try to rephrase the question and make it clearer.

Here is the code for ui.R and server.R.

ui.R

library(shiny)

shinyUI(pageWithSidebar(
  headerPanel("Test buttons"),
  sidebarPanel(
    fileInput('file1', 'Choose text file',
              accept=c('text',
                       'text/plain',
                       '.txt')),
    tags$hr()
    ),
  mainPanel(
    tabsetPanel(
      tabPanel("Home"),
      tabPanel("Loaded Text",
               br(),
               tableOutput("showOverview")),
      tabPanel("Text fields",
               br(),
               uiOutput("createButtons")),
      tabPanel("Plots",
               br(),
               plotOutput("showDistribution"))
    )
  )
))

server.R

library(shiny)
library(shinyBS)

shinyServer(function(input, output) {
  fileReadText <- reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    uploadReadText <- read.table(inFile$datapath, sep = "|",
                                 stringsAsFactors = FALSE)
    df <- data.frame(V1 = unlist(strsplit(uploadReadText[1,], "")))
    df$V2 <- as.integer(grepl("[aeiou]", df$V1))
    df$V2 <- ifelse(df$V1 == " ", NA, df$V2)
    names(df) <- c("letter", "value")
    df
  })

  output$showOverview <- renderTable({
    data1 <- fileReadText()
    data1[c(1:10),]
  })

  output$createButtons <- renderUI({
    data1 <- fileReadText()
    listOfButtons = list()
    for (i in 1:length(data1$letter)) {
      buttonValue <- as.logical(data1$value[i])
      buttonDisabled = FALSE
      if (is.na(buttonValue)) {
        buttonValue = 0
        buttonDisabled = TRUE
      }
      listOfButtons <- list(listOfButtons,
                            bsButton(paste("button_", i, sep = ""),
                                     data1$letter[i],
                                     type = "toggle",
                                     value = as.logical(buttonValue),
                                     disabled = buttonDisabled))
    }
    listOfButtons

  })

  output$showDistribution <- renderPlot({
    data1 <- fileReadText()
    plot(data1$value)
  })    
})

If I click a button (and if it is toggled), it should set the respective value in the data frame to 1 and update the plot at this position as well. If it is untoggled again, it should be set to 0 (in data frame and plot). — Revan, Feb 02 '17 at 12:05

SBista · Accepted Answer · 2017-02-03T15:06:17.017

This might not be the best solution but it works! Apart from the reactive expression that was already there I have added an additional reactive value so that the changes in that value gets reflected in the table as well as the plot. The ui.R is same as in your code. Here is the modified server.R

library(shiny)
library(shinyBS)

shinyServer(function(input, output) {
  values <- reactiveValues()

  fileReadText <- reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    uploadReadText <- read.table(inFile$datapath, sep = "|",
                                 stringsAsFactors = FALSE)
    df <- data.frame(V1 = unlist(strsplit(uploadReadText[1,], "")))
    df$V2 <- as.integer(grepl("[aeiou]", df$V1))
    df$V2 <- ifelse(df$V1 == " ", NA, df$V2)
    names(df) <- c("letter", "value")
    values$df <- df
    df
  })


  output$showOverview <- renderTable({
    fileReadText()
    data1 <-  values$df
    data1
  })

  makeObservers <- reactive({
    data1 <- fileReadText()
    lapply(1:(length(data1$letter)), function (x) {

      observeEvent(input[[paste0("button_", x)]], {
         values$df[x,2] <- as.integer(!values$df[x,2])
      })

    }) 
  })

  output$createButtons <- renderUI({
    data1 <-  fileReadText()
    listOfButtons <-list()
    for (i in 1:length(data1$letter)) {
      buttonValue <- as.logical(data1$value[i])
      buttonDisabled = FALSE
      if (is.na(buttonValue)) {
        buttonValue = 0
        buttonDisabled = TRUE
      }
      listOfButtons <- list(listOfButtons,
                            bsButton(paste("button_", i, sep = ""),
                                     data1$letter[i],
                                     type = "toggle",
                                     value = as.logical(buttonValue),
                                     disabled = buttonDisabled))
    }

    makeObservers()
    listOfButtons

  })

  output$showDistribution <- renderPlot({
    data1 <- values$df
    plot(data1$value)
  })


})

[EDIT]:

I have modified the code so that toggle refers to 1 and untoggled refers to 0. Here is the modified server code:

library(shiny)
library(shinyBS)

shinyServer(function(input, output) {
  values <- reactiveValues()

  fileReadText <- reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    uploadReadText <- read.table(inFile$datapath, sep = "|",
                                 stringsAsFactors = FALSE)
    df <- data.frame(V1 = unlist(strsplit(uploadReadText[1,], "")))
    df$V2 <- as.integer(grepl("[aeiou]", df$V1))
    df$V2 <- ifelse(df$V1 == " ", NA, df$V2)
    names(df) <- c("letter", "value")
    values$df <- df1
    df
  })


  output$showOverview <- renderTable({
    fileReadText()
    data1 <-  values$df
    data1
  })

  makeObservers <- reactive({
    data1 <- fileReadText()
    lapply(1:(length(data1$letter)), function (x) {

      observeEvent(input[[paste0("button_", x)]], {
    #I have modified the code here. So that the table shows the value of the button
        if(!is.na(values$df[x,2]))
        values$df[x,2] <- as.integer(input[[paste0("button_", x)]])
      })

    }) 
  })

  output$createButtons <- renderUI({
    data1 <-  fileReadText()
    listOfButtons <-list()
    for (i in 1:length(data1$letter)) {
      buttonValue <- as.logical(data1$value[i])
      buttonDisabled = FALSE
      if (is.na(buttonValue)) {
        buttonValue = 0
        buttonDisabled = TRUE
      }
      listOfButtons <- list(listOfButtons,
                            bsButton(paste("button_", i, sep = ""),
                                     data1$letter[i],
                                     type = "toggle",
                                     value = as.logical(buttonValue),
                                     disabled = buttonDisabled))
    }

    makeObservers()
    listOfButtons

  })

  output$showDistribution <- renderPlot({
    data1 <- values$df
    plot(data1$value)
  })


})

Hope it helps!

Thank you, that helped a lot. Only one minor thing: the toggled button should set to 1, not to 0. What do I have to change? Removing the `!` from the line `values$df[x,2] <- as.integer(!values$df[x,2])` does not do the trick. — Revan, Feb 03 '17 at 13:07
@ raven The value in the button is based on the initial value in the data frame. For example,for "h" which is initially not toggled, the value is 1 and when we toggle it the value changes to 0. Similarly, for "e" which is initially toggled, the value is 0 so when we click on it the value changes to "1". If I understand you correctly, what you want is the condition to be exactly opposite. Is my understanding correct? — SBista, Feb 03 '17 at 13:16
Yes, globally toggled should refer to 1, untoggled should refer to 0. — Revan, Feb 03 '17 at 13:21
I have edited the answer so that toggled is refered as 1 and untoggled as 0. — SBista, Feb 03 '17 at 15:07
Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/134789/discussion-between-raven-and-sbista). — Revan, Feb 03 '17 at 15:46

R shiny app: How to address specific shinyBS buttons across several tabs?

1 Answers1