如何使它成为 R 中 Shiny 的用户界面？

Question

我在下面有一个程序，但我希望将它变成 R 中闪亮的图形用户界面。但我真的是闪亮的新手。这是代码：

#Optimization to find w for a sigmoid with given  
#multiple samples for one input and one output
#x1, x2... are different observation for one x input

require(ggplot2)
generate_data<- function(n){
  x_neg<- -3L
  x_pos<- 3L
  scale<- 1.5
  n_samples<- n
  x_train<- matrix(c(rnorm(n_samples) + x_pos
                     , rnorm(n_samples) + x_neg)*scale, byrow = T)
  y_train<- matrix(c(rep(1, n_samples), rep(0, n_samples)), byrow = T)
  list(x_train, y_train)
}

n <- 10
data_train<- generate_data(n)
x_train<- as.matrix(data_train[[1]])
y_train<- as.matrix(data_train[[2]])
plot(x_train, y_train, col='green', pch= 3
     , ylim= c((min(y_train)-0.2), (max(y_train)+0.2)))

#create tensor:
unity_matrix<- matrix(rep(1, nrow(x_train))) 
x_tensor<- cbind(unity_matrix, x_train)
sigmoid_neuron<- function(x, w) {
  output<- 1/(1 + exp(-(x_tensor%*%w)))
}

w<- matrix(rnorm(2), byrow = T)#initialize
(sigmoid_output<- sigmoid_neuron(x= x_tensor, w= w))
points(x_train, sigmoid_neuron(x_tensor, w), col='blue', pch= 19)

Grad<- matrix(rep(0, 2), byrow = T)
compute_gradients<- function(x, y, h) {
  Grad[1]<- mean(h- y)
  Grad[2]<- mean((h-y)*x)
  error<<- (h-y)
  return(Grad)
}
compute_gradients(x= x_train, y= y_train, h= sigmoid_output)

##manually cycle through the code chunk to check if the algo works
learningRate<- 0.2
w<- matrix(rnorm(2), byrow = T)#initialize
(sigmoid_output<- sigmoid_neuron(x= x_tensor, w= w))   
(grad<- compute_gradients(x_train, y_train, sigmoid_output)) 
w<- w  - learningRate*grad
y_train

##tune sigmoid
learningRate<- 0.2
Grad<- matrix(rep(0, 2), byrow = T)
w<- matrix(rnorm(2), byrow = T)#initialize
idx_end<- 1000
error_history<- list()
for (i in 1:idx_end) {
  sigmoid_output<- sigmoid_neuron(x= x_tensor, w= w)   
  grad<- compute_gradients(x_train, y_train, sigmoid_output)
  error_history[[i]]<- error
  w<- w  - learningRate*grad
}

grad; sigmoid_output; y_train; w
points(x_train, sigmoid_neuron(x_tensor, w), col='red', pch= 4)

error_history_rmse<- sapply(1:length(error_history), function(x) sqrt(mean(error_history[[x]]^2)))
qplot(seq_along(error_history_rmse), error_history_rmse
      , ylim = c(0, 0.1)
      )
#dev.off()

我的问题是，如何创建一个 Sigmoid 曲线（mainPanel），我使用sliderInput 来调整 x 轴上idx_end（在 56 行）的值？

这是我的代码，我应该修改或添加什么到我的服务器？

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(

      sliderInput("x_range", "idx_end",
                  min = 0, max = 10000, value = c(0, 1000), step = 100)
    ),
    mainPanel(
      plotOutput("distPlot"))))

server <- function(input, output, session) {
  output$distPlot <- renderPlot({

    plot(seq_along(error_history_rmse), error_history_rmse, 
         xlim = c(0, input$x_range[2]),
         #ylim = c(0,0.1),
         col = 'darkgray', 
         border = 'white')})}

shinyApp(ui, server)

谁能帮帮我？真的会很感激..

Answer 1

您几乎可以将代码插入renderPlot 函数。然后将input$x_range[2] 分配给idx_end。但是，没有必要在renderPlot 中包含您的所有代码，只需对用户输入做出反应并制作绘图的代码即可。因此，我将您的大部分代码放在一个名为“plot_data.R”的源 R 文件中，然后使用 source 用静态变量填充全局环境。

library(shiny)

source("plot_data.R")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(

      sliderInput("x_range", "idx_end",
                  min = 0, max = 10000, value = c(0, 1000), step = 100)
    ),
    mainPanel(
      plotOutput("distPlot"))))

server <- function(input, output, session) {

  output$distPlot <- renderPlot({

    learningRate<- 0.2
    Grad<- matrix(rep(0, 2), byrow = T)
    w<- matrix(rnorm(2), byrow = T)#initialize
    idx_end <- input$x_range[2]
    error_history<- list()
    for (i in 1:idx_end) {
      sigmoid_output<- sigmoid_neuron(x= x_tensor, w= w)   
      grad<- compute_gradients(x_train, y_train, sigmoid_output)
      error_history[[i]]<- error
      w<- w  - learningRate*grad
    }

    error_history_rmse<- sapply(1:length(error_history), function(x) sqrt(mean(error_history[[x]]^2)))

    plot(seq_along(error_history_rmse), error_history_rmse, 
         xlim = c(0, input$x_range[2]),
         #ylim = c(0,0.1),
         col = 'darkgray', 
         border = 'white')})}

shinyApp(ui, server)