How to make it into User Interface in Shiny in R? - r

Question

I have a program at below here, but I wish to make it into a Graphic User Interface in shiny in R. But I am really new to shiny. Here is the code :
#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()
My problem is, how can I create a Sigmoid Curve (at mainPanel) which I use the sliderInput to adjust the value of idx_end (at the line of 56) on the x-axis?
Here is my code, what should I modify or add to my Server?
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)
Can anyone help me? Really will appreciate it..

Answer 1

You can pretty much just slot in your code into the renderPlot function. Then assign input$x_range[2] to idx_end. However, there's no need to include all of your code in renderPlot, just the code that reacts to user input and makes the plot. Hence, I've placed most of your code in a source R file called 'plot_data.R' then used source to populate the global environment with variables that are static.
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)