首页 > 解决方案 > 如何在 RShiny 应用程序中更新数据框

问题描述

我正在尝试创建一个分层选项工具;其中选项相互比较,用户通过单击相应的按钮来选择他们的偏好。我试图让按钮也用 1 为选项评分(默认设置为 0)。我已经嵌入了一个情节,以查看正在发生的事情,但没有喜悦。

library(shiny)

################################
#                              #
#      Data Manipulation       #
#                              #
################################

# The following section of code creates a dataframe
# where each row is a unique combination of the options

dummy_options <- c("Apples", "Oranges", "Pears", "Bananas", "Grapes")

options <- dummy_options

tradeOffs <- data.frame(option1 = sort(rep(options, sum(table(options)))),
                        option2 = rep(options, sum(table(options))))
tradeOffs$duplicates <- ifelse(tradeOffs$option1 == tradeOffs$option2, "TRUE", "FALSE")
tradeOffs <- tradeOffs[tradeOffs$duplicates == "FALSE",]
tradeOffs$duplicates <- NULL

tradeOffs$random_order = runif(length(tradeOffs$option1))
tradeOffs <- tradeOffs[order(tradeOffs$random_order),]
tradeOffs$random_order <- NULL

tradeOffs$option1_score <- rep(0, length(tradeOffs$option1))
tradeOffs$option2_score <- tradeOffs$option1_score




################################
#                              #
#         User Interface       #
#                              #
################################


ui <- shinyUI(
    fluidPage(
        tags$b("Simple counter using reactiveValues() - An example"),
        uiOutput("button_option1"),
        uiOutput("button_option2"),
        plotOutput("test")
    )
)

################################
#                              #
#            Server            #
#                              #
################################

server <-  function(input, output, session) {
    
    row <- reactiveValues(value = 1) # Creates the reactiveValues object to tally the number of clicks
    
    output$test <- renderPlot({   # a test function to see the tradeOff dataframe updating
         plot(x = tradeOffs$option1, y = tradeOffs$option1_score, ylim = c(0, 25))
        })
    
    ##########    
    
    output$button_option1 <- renderUI({  # this generates a reactive button with the appropriate option as its text
        actionButton("button_option1_1", if(is.na(tradeOffs[row$value, 1])){""}   
                                            else { tradeOffs[row$value, 1] })
    })
    
    observeEvent(input$button_option1_1, {
        tradeOffs[row$value, 3] <- tradeOffs[row$value, 3] + 1 # updates the score column
        row$value <- row$value + 1     # if the button is clicked, increment the row value by 1 and update it
        
    })
    
    
    #########
    


    
    output$button_option2 <- renderUI({
        actionButton("button_option2_1", if(is.na(tradeOffs[row$value, 2])){""} 
                                            else {tradeOffs[row$value, 2]})
        })
    
    observeEvent(input$button_option2_1, {
        tradeOffs[row$value, 4] <- tradeOffs[row$value, 4] + 1
        row$value <- row$value + 1     
        })
    
    
}


shinyApp(ui, server)

标签: rdataframeshinyshiny-reactivity

解决方案


推荐阅读