R блестящее приложение: Как обратиться к конкретным кнопкам SharpBS на нескольких вкладках?

Question

Я начал писать блестящее приложение.

Чего я хочу добиться - это загрузить текстовый файл со строкой в ​​одну строку - вот так:

$ cat testdata.txt
hello world 

Если текст загружается, гласные устанавливаются в значение 1 во фрейме данных и выделяются shinyBS пакет.

Чего я хочу добиться, так это иметь возможность изменять значения во фрейме данных, нажимая переключаемые кнопки. Кнопки можно переключать, но измененные значения не переносятся во фрейм данных или на график.

Как этого достичь? Я надеюсь, что вопрос ясен, если не спросите, я постараюсь перефразировать вопрос и сделать его более понятным.

Вот код для ui.R а также 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)
  })    
})

Answer 1

Возможно, это не лучшее решение, но оно работает! Помимо реактивного выражения, которое уже было там, я добавил дополнительное реактивное значение, чтобы изменения в этом значении отражались как в таблице, так и на графике. Ui.R такой же, как в вашем коде. Вот модифицированный сервер.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)
  })


}) 

[РЕДАКТИРОВАТЬ]:

Я изменил код так, чтобы переключение относилось к 1, а непереключенное - к 0. Вот модифицированный код сервера:

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)
  })


}) 

Надеюсь, поможет!