R блестящее приложение: как обратиться к определенным кнопкам shinyBS через несколько вкладок?

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


}) 

[EDIT]:

Я изменил код таким образом, что переключение относится к 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) 
    }) 


}) 

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