How to apply the actionButton "Upate View" in Shiny in R?

Question

This is my original code :

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)

The code that I tried :

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)

I wish to add an actionButton that really works so that I can Update my view instead of let it update automatically. What should I put inside my server.R ?

And is there a better to present my script? As I am quite new to shiny, I hope I can get some little guide/hints from anyone of you..

Do you guys need the R.data? If need it I can email it to you guys.. thanks a lot.

Answer 1

I don't have your data nor do I need to derive a neural network to demonstrate how to control reactivity. But some design considerations for your shiny app:

1. Don't mix data derivation and table/plot output. If you ever need to look at a portion of the data in another reactive block, you're out of luck, since you discard the results at the end of the plot. I suggest you have at least three different reactive chunks here: data being used, trained neural net, and plot output.

2. In all blocks of render*, reactive, and observe (and some others), any kind of reactive data or object can trigger change of the block. Based on my first recommendation, if you have a dat <- reactive(...) block, then a change in dat() will cause all blocks containing it to also update (ergo shiny's reactivity). If you want a block to use dat() but only when something else happens (i.e., not update when dat() changes), then use isolate(dat()) to get to the data without defining a reactive component.

   Two special reactive blocks are observeEvent and eventReactive, which react to the first argument but nothing in the second expression/argument.

3. Add-on: I use req to make sure nothing fires before data or triggers are first valid.

Here's a small app. The intent is this: while the plot is based on the random data, it only updates the plot when you explicitly click the Plot Now button. Click on Random button and see that the data changes with each press, but the plot does not. Click on Plot Now and the plot updates (based on the current state of the data).

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