How to apply the actionButton to update my ggplot in Shiny in R?

Question

This is my reproducible example :

#http://gekkoquant.com/2012/05/26/neural-networks-with-r-simple-example/

library("neuralnet")
require(ggplot2)
setwd(dirname(rstudioapi::getSourceEditorContext()$path))

#Going to create a neural network to perform sqare rooting
#Type ?neuralnet for more information on the neuralnet library

#Generate 50 random numbers uniformly distributed between 0 and 100
#And store them as a dataframe
traininginput <-  as.data.frame(runif(50, min=0, max=100))
trainingoutput <- sqrt(traininginput)

#Column bind the data into one variable
trainingdata <- cbind(traininginput,trainingoutput)
colnames(trainingdata) <- c("Input","Output")

#Train the neural network
net.sqrt <- neuralnet(Output~Input,trainingdata, hidden=c(input$w, input$b), threshold=0.01)
print(net.sqrt)

#Plot the neural network
plot(net.sqrt)

#Test the neural network on some test data
testdata <- as.data.frame((1:13)^2)  #Generate some squared numbers
net.results <- predict(net.sqrt, testdata) #Run them through the neural network

#Lets see what properties net.sqrt has
class(net.results)

#Lets see the results
print(net.results)

#Lets display a better version of the 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)

And this is the code I tried in shiny :

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

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 ?

In the line 20 of the reproducible example, the variable w and b is the values I wish to control in the shiny server.

I have tried by using sliderInput but at here I have 2 variables (w an b)?

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..

score 1 · Accepted Answer · answered Apr 20 '20 at 19:44

Please check below. I have put the data generation at the beginning under #global as this only needs to be run once. I have then added reactiveValues and an observeEvent which is the main thing you need to use the actionButton. See Using Action Buttons. The reactiveValues is used so that the plot shows up on start-up and doesn't need the actionButton initially. It also only reruns the code if either w or b has changed even if you click the actionButton. I have commented out all unnecessary code for my own testing.

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

# global
traininginput <-  as.data.frame(runif(50, min=0, max=100))
trainingoutput <- sqrt(traininginput)
trainingdata <- cbind(traininginput,trainingoutput)
colnames(trainingdata) <- c("Input","Output")

testdata <- as.data.frame((1:13)^2)  #Generate some squared numbers

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, session) {

    values <- reactiveValues(
        w = 5,
        b = 5
    )

    observeEvent(input$update, {
        values$w <- input$w
        values$b <- input$b
    })

    output$main_plot <- renderPlot({
        net.sqrt <- neuralnet(Output~Input,trainingdata, hidden=c(values$w, values$b), threshold=0.01)
        #print(net.sqrt)
        #plot(net.sqrt)

        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)

yeahhh this is what I want, thank you very much! Really very appreciate it, very helpful. Have a nice day ya :D — Gambit, Apr 21 '20 at 01:02

How to apply the actionButton to update my ggplot in Shiny in R?

1 Answers1