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与代码中的相同。这是修改后的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)
  })


})

<强> [编辑]：

我修改了代码，以便切换引用1而untoggled引用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)
  })


})

希望它有所帮助！

R闪亮的应用程序：如何跨几个选项卡处理特定的闪亮BS按钮？

1 个答案: