Как применить actionButton для обновления моего ggplot в Shiny in R?

Question

Это мой воспроизводимый пример:

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

И это код, который я пробовал в 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 sh, чтобы добавить actionButton это действительно работает, так что я могу обновить свое представление вместо автоматического обновления. Что я должен поместить внутрь моего server.R?

В строке 20 воспроизводимого примера переменная w и b - это значения, которые я буду sh контролировать в блестящем server .

Я пытался использовать sliderInput, но здесь у меня есть 2 переменные (w an b)?

И есть ли лучший способ представить мой сценарий? Так как я новичок в блеске, я надеюсь, что смогу получить несколько небольших советов / подсказок от кого-либо из вас ..

Answer 1

Пожалуйста, проверьте ниже. Я поместил генерацию данных в начале под #global, так как это нужно запустить только один раз. Затем я добавил reactiveValues и observeEvent, и это главное, что вам нужно для использования actionButton. См. Использование кнопок действий . reactiveValues используется для того, чтобы график появлялся при запуске и изначально не нуждается в actionButton. Он также перезапускает код, только если w или b изменился, даже если вы нажмете actionButton. Я закомментировал весь ненужный код для собственного тестирования.

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)