R闪亮的应用程序:如何解决跨多个选项卡的特定闪亮BS按钮



我已经开始编写一个闪亮的应用程序。

我想要实现的是加载一个在一行中带有字符串的文本文件 - 如下所示:

$ cat testdata.txt
hello world 

如果加载文本,则元音在数据框中设置为值 1,并使用shinyBS包高亮显示。

我想要实现的是能够通过单击切换按钮来更改数据框中的值。可以切换按钮,但更改的值不会传输到数据框或绘图。

如何实现这一点?我希望这个问题是清楚的,如果没有,请问,我会尝试改写这个问题并使其更清楚。

这是ui.Rserver.R的代码。

用户界面。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"))
    )
  )
))

服务器。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)
  })    
})

这可能不是最好的解决方案,但它有效!除了已经存在的反应表达式之外,我还添加了一个额外的反应值,以便该值的变化反映在表格和图中。用户界面。R 与代码中的 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)
  })

}) 

希望对您有所帮助!

最新更新