闪亮更新数字输入数据框和图形输出

Question

我一直在寻找一个模拟工具的解决方案，该解决方案应该连接图形部分（最后一部分应该在按下“添加”操作按钮之前显示为反应性）。完成图的数据框（所有连接部分）应可下载为 csv。

基本上，我想结合此处描述的功能Add (multiple) values to a data frame with R shiny（向数据框添加行）和此处http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html（反应性滑块），而不会陷入无限循环。

我可以使用操作按钮使我的输出 .csv 文件更长，但并非所有添加的模拟都正确存储，我也没有成功更新我的 x 输入值（图表的下一部分应该从哪里开始）。

这是我的代码。任何帮助深表感谢。 汤姆

server.R

shinyServer(function(input, output, clientData, session){
#set up model input parameters
  observe({
  #Define input variables
   x <- input$xc
   a <- input$ac
   b <- input$bc
   l <- input$lc
#Control  value, min, max, and step
   updateSliderInput(session, "xr", value = x, min = x-10, max = x+10, step = 0.1)
   updateSliderInput(session, "ar", value = a, min = a-10, max = x+10, step = 0.1)
   updateSliderInput(session, "br", value = b, min = b-10, max = x+10, step = 0.1)
   updateSliderInput(session, "lr", value = l, min = l-10, max = l+10, step = 0.1)
})

#Calculate additional variables
observe({
   xs <- input$xr
   xe <-xs+input$lr
   al <-input$ar
   bl <-input$br
   xl <-xs:xe
   yl<-xl*al+bl

#create the continiously updated data from the inputs
dataset0<-reactive({
  df<-as.data.frame(cbind(xl,yl))
  return(df)
})

#set the data to be added aside
addData <- reactiveValues()
addData$dataset0 <- dataset0()  

#when the action button is pressed, freeze the data from the model and store them
observe(if (input$addDataset>0) {
  newFrame <- isolate(addData$dataset0)
  #THIS IS NOT WORKING: SAVE LAST X VALUE AS NEW MODEL START
  newx0 <- isolate(addData$dataset0[length(addData$dataset0[,1]),1])
  #update data
  isolate(addData$dataset0 <- rbind(addData$dataset0, newFrame))
  #THIS IS NOT WORKING: CHANGING THE INPUT CAUSES INFINITE LOOP
  #updateNumericInput(session,"xc",value=newx0)
})

#set the freezed data aside
dataset<-reactive({
  df<-as.data.frame(addData$dataset0)
  return(df)
})  

#show some output
output$newx<-renderText(addData$newx0())
output$plot<-renderPlot({plot(dataset()$y~dataset()$x)})
output$table1 <- renderTable(head({addData$dataset0},3), include.rownames=FALSE)
output$table2 <- renderTable(tail({addData$dataset0},3), include.rownames=FALSE)

#download the dataset
output$downloadDataset <- downloadHandler(
  filename = function() {paste('dataset','.csv', sep='')},
  content = function(file) {write.table(dataset(), dec = ",", sep = ";", row.names = FALSE, file)}
) 
})
})

ui.R

shinyUI(fluidPage(
titlePanel("Simulator input"),
fluidRow(
column(2, wellPanel(
#numeric default inputs, changing them updates the sliders
  numericInput("xc", "choose x:", min=0, max=100, value=1, step=0.1),
  numericInput("ac", "choose a:", min=0, max=100, value=1, step=0.1),
  numericInput("bc", "choose b:", min=0, max=100, value=1, step=0.1),
  numericInput("lc", "choose l:", min=0, max=100, value=50, step=0.1)
)),

column(2, wellPanel(
#sliders updated through the numeric inputs, their value are used in the graph
  sliderInput("xr", "choose x:", min=0, max=100, value=1, step=0.1),
  sliderInput("ar", "choose a:", min=0, max=100, value=1, step=0.1),
  sliderInput("br", "choose b:", min=0, max=100, value=1, step=0.1),
  sliderInput("lr", "choose l:", min=0, max=100, value=50, step=0.1)
)),

#the actionButton serves to add a graph part and lines to the data frame
actionButton("addDataset", "Add to Dataset"),
downloadButton('downloadDataset', 'Download'),

# Show a table summarizing the values entered
mainPanel(
  plotOutput("plot"),
  textOutput("newx"),
  tableOutput("table1"),
  tableOutput("table2")
)
)
))

here are two subsequent graph parts, separately downloaded and merged in excel, this should be done in the app itself...

Answer 1

我对您的服务器文件中使用的反应性进行了一些编辑，我认为它实现了您在问题中描述的功能。您用于定义xs、xe 等的observe 语句是不必要的，因为您仅在单击addDataset 按钮后才使用这些值。看起来好像您用来更新数据集的 observe 语句是在尝试模仿 observeEvent 函数的功能（它将事件作为响应的第一个参数）。

您对addData$dataset0 <- dataset0() 的定义不在“侦听”dataset0() 更改的环境中（侦听器可以是诸如渲染函数、reactive、eventReactive、@987654330 之类的函数@，或observeEvent)。

其他修改：

as.data.frame(cbind(xl,yl)) 可以简单地用data.frame(xl,yl) 完成

req 在这里用于等待 addData$dataset0 不为 NULL。使用?shiny::req 获取更多信息，但基本上如果req 的参数是NULL、FALSE 或其他“错误”值，则该语句会停止执行。

注意事项：

作为一般规则，我认为如果可能，最好避免使用observe。它有可能大大减慢闪亮的应用程序。

我没有测试downloadHandler 功能。`

server.R:

shinyServer(function(input, output, clientData, session){
  #set up model input parameters
  observe({
    #Define input variables
    x <- input$xc
    a <- input$ac
    b <- input$bc
    l <- input$lc
    #Control  value, min, max, and step
    updateSliderInput(session, "xr", value = x, min = x-10, max = x+10, step = 0.1)
    updateSliderInput(session, "ar", value = a, min = a-10, max = x+10, step = 0.1)
    updateSliderInput(session, "br", value = b, min = b-10, max = x+10, step = 0.1)
    updateSliderInput(session, "lr", value = l, min = l-10, max = l+10, step = 0.1)
  })
  
  
  addData <- reactiveValues()
  addData$dataset0 <- NULL 
  
    observeEvent(input$addDataset,{

      xs <- input$xr
      xe <- xs+input$lr
      al <- input$ar
      bl <- input$br
      xl <- xs:xe
      yl <- xl*al+bl
      
      newRow <- data.frame(x=xl,y=yl)
      addData$dataset0 <- rbind(addData$dataset0, newRow)
    })
    
    #show some output
    output$newx <- renderText({
      req(addData$dataset0)
      addData$dataset0$x[nrow(addData$dataset0)]
      })
    output$plot <- renderPlot({
      req(addData$dataset0)
      plot(addData$dataset0$y~addData$dataset0$x)
      })
    output$table1 <- renderTable({
      req(addData$dataset0)
      head(addData$dataset0,3) 
      }, include.rownames=FALSE)
    output$table2 <- renderTable({
      req(addData$dataset0)
      tail(addData$dataset0,3)
      }, include.rownames=FALSE)
    
    #download the dataset
    output$downloadDataset <- downloadHandler(
      filename = function() {paste('dataset','.csv', sep='')},
      content = function(file) {write.table(addData$dataset0, dec = ",", sep = ";", row.names = FALSE, file)}
    ) 
})