如何在 R 中的 Shiny 中应用 actionButton“Upate View”？

Question

这是我的原始代码：

library(shiny)
library("neuralnet")
require(ggplot2)

load("C:/gambit/NeuralNetwork.Rdata")

ui <- fluidPage(
  fluidRow(
    column(width = 12, class = "well",
           h4("Neural Network Plot"),

           plotOutput("main_plot"),

           hr(),

           numericInput(inputId = "w",
                       label = "Weight(w):",
                       value = 5),

           numericInput(inputId = "b",
                       label = "Biased(b):",
                       value = 5))))
#--------------------------------------------------------------------------------------------
server <- function(input, output) {

  output$main_plot <- renderPlot({
    traininginput <-  as.data.frame(runif(50, min=0, max=100))
    trainingoutput <- sqrt(traininginput)
    trainingdata <- cbind(traininginput,trainingoutput)
    colnames(trainingdata) <- c("Input","Output")
    net.sqrt <- neuralnet(Output~Input,trainingdata, hidden=c(input$w, input$b), threshold=0.01)
    print(net.sqrt)
    plot(net.sqrt)
    testdata <- as.data.frame((1:13)^2)  #Generate some squared numbers
    net.results <- predict(net.sqrt, testdata) #Run them through the neural network
    class(net.results)
    print(net.results)
    cleanoutput <- cbind(testdata,sqrt(testdata),
                         as.data.frame(net.results))
    colnames(cleanoutput) <- c("Input","ExpectedOutput","NeuralNetOutput")
    head(cleanoutput)
    lm1<- lm(NeuralNetOutput~ ExpectedOutput, data = cleanoutput)

    ggplot(data = cleanoutput, aes(x= ExpectedOutput, y= NeuralNetOutput)) + geom_point() +
      geom_abline(intercept = 0, slope = 1
                  , color="brown", size=0.5)})}

shinyApp(ui,server)

我尝试过的代码：

library(shiny)
library("neuralnet")
require(ggplot2)

load("C:/gambit/NeuralNetwork.Rdata")

ui <- fluidPage(
  fluidRow(
    column(width = 12, class = "well",
           h4("Neural Network Plot"),

           plotOutput("main_plot"),

           hr(),

           numericInput(inputId = "w",
                       label = "Weight(w):",
                       value = 5),

           numericInput(inputId = "b",
                       label = "Biased(b):",
                       value = 5), 

           actionButton("update", "Update View"))))
#--------------------------------------------------------------------------------------------
server <- function(input, output) {

  output$main_plot <- renderPlot({
    traininginput <-  as.data.frame(runif(50, min=0, max=100))
    trainingoutput <- sqrt(traininginput)
    trainingdata <- cbind(traininginput,trainingoutput)
    colnames(trainingdata) <- c("Input","Output")
    net.sqrt <- neuralnet(Output~Input,trainingdata, hidden=c(input$w, input$b), threshold=0.01)
    print(net.sqrt)
    plot(net.sqrt)
    testdata <- as.data.frame((1:13)^2)  #Generate some squared numbers
    net.results <- predict(net.sqrt, testdata) #Run them through the neural network
    class(net.results)
    print(net.results)
    cleanoutput <- cbind(testdata,sqrt(testdata),
                         as.data.frame(net.results))
    colnames(cleanoutput) <- c("Input","ExpectedOutput","NeuralNetOutput")
    head(cleanoutput)
    lm1<- lm(NeuralNetOutput~ ExpectedOutput, data = cleanoutput)

    ggplot(data = cleanoutput, aes(x= ExpectedOutput, y= NeuralNetOutput)) + geom_point() +
      geom_abline(intercept = 0, slope = 1
                  , color="brown", size=0.5)})}

shinyApp(ui,server)

我希望添加一个真正有效的actionButton，以便我可以更新我的视图而不是让它自动更新。我应该在我的 server.R 里面放什么？

还有没有更好的方法来展示我的脚本？由于我对shiny 很陌生，我希望我能从你们中的任何人那里得到一些小指南/提示..

你们需要R.data 吗？如果需要，我可以通过电子邮件发送给你们。非常感谢。

Answer 1

我没有您的数据，也不需要派生神经网络来演示如何控制反应性。但是对于闪亮应用的一些设计注意事项：

1. 不要混合数据推导和表格/绘图输出。如果您需要查看另一个反应块中的部分数据，那么您很不走运，因为您在绘图结束时丢弃了结果。我建议你在这里至少有三个不同的反应块：正在使用的数据、训练的神经网络和绘图输出。

2. 在render*、reactive和observe（以及其他一些）的所有块中，任何类型的反应性数据或对象都可以触发块的更改。根据我的第一个建议，如果您有 dat <- reactive(...) 块，那么 dat() 的更改将导致包含它的所有块也更新（ergo shiny 的反应性）。如果您希望一个块使用 dat() 但仅在发生其他事情时（即，当dat() 更改时不更新），然后使用isolate(dat()) 获取数据而不定义反应组件.

   两个特殊的反应块是observeEvent 和eventReactive，它们对第一个参数作出反应，但在第二个表达式/参数中没有任何反应。

3. 插件：我使用req 来确保在数据或触发器首次有效之前不会触发任何事件。

这是一个小应用程序。意图是这样的：虽然绘图基于随机数据，但它仅在您明确单击 Plot Now 按钮时更新绘图。单击Random 按钮并查看每次按下时数据都会发生变化，但绘图不会发生变化。点击Plot Now，绘图会更新（基于数据的当前状态）。

library(shiny)
shinyApp(
  ui = fluidPage(
    fluidRow(
      actionButton("rand", "Random"),
      actionButton("btn", "Plot Now")
    ),
    fluidRow(
      textInput("dat", NULL, placeholder = "Random data not ready yet"),
      plotOutput("plt")
    )
  ),
  server = function(input, output, session) {
    dat <- reactive({
      input$rand
      sample(1e4, size = 10)
    })
    observeEvent(input$rand, {
      # automatically isolated, only input$rand causes updates
      req(dat()) # ensure there is data before trying to update the field
      updateTextInput(session, "dat", value = paste(dat(), collapse = ", "))
    })
    output$plt <- renderPlot({
      thisdat <- req(isolate(dat()))               # both require-valid and not-update
      req(input$btn)                               # just require-valid
      # at this point, we should always have "valid" data
      plot(seq_along(thisdat), thisdat, pch = 16)
    })
  }
)