0

これは私の元のコードです:

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ですか?必要に応じて、メールでお送りします。どうもありがとうございました。

4

1 に答える 1

1

私はあなたのデータを持っていませんし、反応性を制御する方法を示すためにニューラル ネットワークを導出する必要もありません。ただし、光沢のあるアプリの設計に関する考慮事項がいくつかあります。

  1. データ導出とテーブル/プロット出力を混在させないでください。別のリアクティブ ブロックのデータの一部を確認する必要がある場合は、プロットの最後で結果を破棄するため、うまくいきません。ここでは、少なくとも 3 つの異なるリアクティブ チャンク (使用中のデータ、トレーニング済みニューラル ネットワーク、プロット出力) を用意することをお勧めします。

  2. render*reactive、および(およびその他のブロック) のすべてのブロックでobserve、あらゆる種類のリアクティブ データまたはオブジェクトがブロックの変更をトリガーできます。私の最初の推奨事項に基づいて、dat <- reactive(...)ブロックがある場合、変更すると、dat()それを含むすべてのブロックも更新されます (したがって、光沢のある反応性)。何か他のことが起こったときだけブロックを使用 したい場合(つまり、変更時に更新しない場合) は、リアクティブ コンポーネントを定義せずにデータを取得するために使用します。dat()dat()isolate(dat())

    2 つの特別なリアクティブ ブロックはobserveEventeventReactiveで、最初の引数には反応しますが、2 番目の式/引数には反応しません。

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

光沢のあるサンプル

于 2020-04-14T16:07:39.843 に答える