I am working on a shiny aplication to explore sums of squares in linear regression (link). This application has three sliderInput, so the user can choose: (i) the regression slope; (ii) the sample size and (iii) the standard deviation. With this inputs, the app generate a raw dataset to plot some graphs. This is working fine with the reactive function. Any change in one parameter will generate new data. My problem is that I want to include a buttom to "refresh" all values, actually to re-run the functions that generate these parameters.
So my question is how do I include this in the server?
I know I have to include the buttom in the ui:
actionButton(inputId = "refresh", label = "Refresh" ,
icon = icon("fa fa-refresh"))
)
But I dont know how to use this buttom to rerun the reactive functions that generate the data. This is the code that generates the data in the server:
### Saving data:
Rawdata <- reactive({
slope <- input$slope
SD <- input$SD
sample <- input$sample
x <- round(1:sample + rnorm(n = sample, mean = 1, sd = 1), digits = 2)
y <- round(slope * (x) + rnorm(n = sample, mean = 3, sd = SD ), digits = 2)
mod <- lm(y ~ x, data.frame(y,x))
ypred <- predict(mod)
Rawdata <- data.frame(y, x, ypred)
})
The full source code is available in github:
ui
| server
I appreciate any suggestion.
Best wishes,
Gustavo
You can isolate other input variables and make actionButton only dependency for reactive expression:
library(shiny)
shinyApp(
server = function(input, output, session) {
rawdata <- reactive({
# Make action button dependency
input$refresh
# but isolate input$sample
isolate(rnorm(input$sample))
})
output$mean <- renderText({ mean(rawdata()) })
},
ui = fluidPage(
actionButton(inputId = "refresh",
label = "Refresh", icon = icon("fa fa-refresh")),
sliderInput(inputId = "sample",
label = "Sample size",
value = 50, min = 10, max = 100),
textOutput("mean")
)
)
Related
I am attempting to create a shiny app with editable cells where the underlying data frame updates depending on user input. I asked a similar question earlier and was pointed to this link.
My app:
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
# Application title
titlePanel("blah"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
DT::DTOutput('ex_table'),
)
)
)
server <- function(input, output,session) {
example_data <- data.frame(x = rnorm(10, 0, 1) %>% round) %>% mutate(y = x + 1)
output$ex_table <- DT::renderDT(example_data, selection = 'none', editable = TRUE)
# from https://yihui.shinyapps.io/DT-edit/
observeEvent(input$ex_table_cell_edit, {
example_data <<- editData(example_data, input$ex_table, 'ex_table', rownames = FALSE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This app loads when you press run in rstudio. But when trying to edit a cell in column x, the app crashes with error message 'Warning: Error in split.default: first argument must be a vector'.
This is the problem code block:
# from https://yihui.shinyapps.io/DT-edit/
observeEvent(input$ex_table_cell_edit, {
example_data <<- editData(example_data, input$ex_table, 'ex_table', rownames = FALSE)
})
Screens:
The app loads up fine. Y is always x + 1 due to the data frame definition:
example_data <- data.frame(x = rnorm(10, 0, 1) %>% round) %>% mutate(y = x + 1)
When a user edits the x column, I wouldlike the y column to update to be whatever x is plus one:
When I press enter, desired behavior is to have y = 101.
Per the link suggested, https://yihui.shinyapps.io/DT-edit/, I'd prefer to use editData() as opposed to what was provided in my previous post, because editData() approach looks simpler and more readable.
But when I try it my shiny app always crashes?
Your existing program works fine if you put rownames=FALSE in output$ex_table. However, it only allows you to edit table cells. If you still want to maintain the dependency y=x+1, you need to define like #Waldi did in his answer earlier. Also, once you modify, you need to feed it back to the output via replaceData() of Proxy or define a reactiveValues object as shown below.
ui <- fluidPage(
# Application title
titlePanel("blah"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
DTOutput('ex_table'),
)
)
)
server <- function(input, output,session) {
DF1 <- reactiveValues(data=NULL)
example_data <- data.frame(x = rnorm(10, 0, 1) %>% round) %>% mutate(y = x + 1)
DF1$data <- example_data
output$ex_table <- renderDT(DF1$data, selection = 'none', editable = TRUE, rownames = FALSE)
observeEvent(input$ex_table_cell_edit, {
info = input$ex_table_cell_edit
str(info)
i = info$row
j = info$col + 1 ## offset by 1
example_data <<- editData(example_data, input$ex_table_cell_edit, 'ex_table', rownames = FALSE)
if(j==1){example_data[i,j+1]<<-as.numeric(example_data[i,j])+1} ### y = x + 1 dependency
DF1$data <- example_data
})
}
# Run the application
shinyApp(ui = ui, server = server)
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 bis the values I wish to control in the shiny server.
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..
See the documentation example for the actionButton, specifically how isolate is being used there. This is the code from the example for posterity:
ui <- fluidPage(
sliderInput("obs", "Number of observations", 0, 1000, 500),
actionButton("goButton", "Go!"),
plotOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# Take a dependency on input$goButton. This will run once initially,
# because the value changes from NULL to 0.
input$goButton
# Use isolate() to avoid dependency on input$obs
dist <- isolate(rnorm(input$obs))
hist(dist)
})
}
Normally when you would move slider, shiny would update the histogram "continuously". As you isolate this variable, it waits on a button press.
I want to create a small shiny app to explore a scoring function that I am writing for a set of data observations. This is my first shiny app so bear with me.
What I want to show is the data table where one column is computed by a function (let's say f(x) = x^2 + y) where x is another (numeric) column in the table and y should be adjustable with a slider in the sidebar.
I want to make the table reactive, so that as soon as the slider is adjusted, the content that is displayed will be updated. Does anyone have a link to a tutorial (I could not find a similar problem) or a suggestion how to handle this. If so, please let me know!
This is the code I have so far:
library(shiny)
#### INIT ####
x <- 1
y <- 0.5
z <- 2
df <- data.frame(
a=1:10,
b=10:1
)
df['score'] <- df[,x]^y + z
#### UI ####
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
sliderInput("x", "x:",
min = 0, max = ncol(df),
value = 1),
sliderInput("y", "y:",
min = 1, max = 10,
value = 1),
sliderInput("z", "z:",
min = 1, max = 100,
value = 20)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("df", dataTableOutput("df"))
)
)
)
)
#### SERVER ####
server <- function(input, output) {
sliderValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
})
sliderValues()
output$df<- renderDataTable(df)
}
#### RUN ####
shinyApp(ui = ui, server = server)
Just make the data.frame you actually plot reactive. For example
server <- function(input, output) {
calcualtedValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
df
})
output$df<- renderDataTable(calcualtedValues())
}
Here the calcualtedValues reactive element returns a new data.frame when the input is updated, and then you actually render that updated data.frame rather than the original data.frame each time.
I have been working on a side project that involves a simple shiny app that allows users to input the parameters of a dice roll for a board game then have the code preform 10,000 rolls with those parameters and present the average of the rolls. I have a basic code that successfully makes this happen but I am struggling how to make it into a shiny app to make accessible to others.
The issue I face is that in the server part of the shiny code I do not know how to store the intermediate results within a single reactive() function. Is there a local storage option that works with a repeating function?
The code I am using is:
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("10,000 Roll Simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput(inputId = "num_tac", label = "TAC",
value =1 , min = 1, max = 20),
numericInput(inputId = "num_def", label = "DEF",
value =1 , min = 1, max = 10),
numericInput(inputId = "num_arm", label = "ARM",
value =0 , min = 0, max = 10)
)
)
)
server <- function(input, output){
data()<- reactive({
One_roll<- function(){dice <- sample(1:6, size = input$num_tac, replace = TRUE)
return(sum((dice >= input$num_def)-input$num_arm))
sims<-replicate(10000, One_roll()}
output$stats <- renderPrint({mean(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help would be greatly appreciated, thank you!
A few issues with your code :
data()<- is not allowed. Use data<- instead then call it with data()
Using input$ inside a function is definitely not the right way to pass parameters
This is a modified server function where the One_roll function is defined outside the reactive, but called inside, with input passed as parameters:
server <- function(input, output){
One_roll<- function(num_tac,num_def,num_arm){
dice <- sample(1:6, size = num_tac, replace = TRUE)
sum((dice >= num_def)-num_arm)
}
data<- reactive(replicate(10000, One_roll(input$num_tac,input$num_def, input$num_arm )))
output$stats <- renderPrint(mean(data()))
}
And also you need a textOutput in the ui function to call the renderText for example:
ui <- fluidPage(
# Application title
titlePanel("10,000 Roll Simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput(inputId = "num_tac", label = "TAC",
value =1 , min = 1, max = 20),
numericInput(inputId = "num_def", label = "DEF",
value =1 , min = 1, max = 10),
numericInput(inputId = "num_arm", label = "ARM",
value =0 , min = 0, max = 10)
), mainPanel = textOutput("stats")
)
)
You could also save all the user entered data into a static variable first and then use them as normal variables.
server <- function(input, output) {
temp <- reactive({
tac <- input$num_tac
def <- input$num_def
arm <- input$num_arm
One_roll <- function(tac, def, arm) {
dice <- sample(1:6, size = tac, replace = TRUE)
sum((dice >= def) - arm)
}
data <- replicate(10000, One_roll(tac, def, arm))
#remember to print the data again so the results will be saved to temp
data
})
output$stats <- renderPrint({
mean(temp())
})
}
I have a randomly generated data.frame. The user can modify a slider to choose the number of points. Then I plot this data.frame.
I want to add a button than when clicked, it performs a modification in the previous randomly generated data.frame (but without regenerating the data.frame). The modification is a voronoid relaxation, and it should be performed once per each time the button is clicked and the graph generated.
Until now, I have not achieved anything similar...
ui.R
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Map Generator:"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
p("Select the power p to generate 2^p points."),
sliderInput("NumPoints",
"Number of points:",
min = 1,
max = 10,
value = 9),
actionButton("GenPoints", "Generate"),
actionButton("LloydAlg", "Relaxe")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot",height = 700, width = "auto")
)
)
))
server.R
library(shiny)
library(deldir)
shinyServer(function(input, output) {
observeEvent(input$NumPoints,{
x = data.frame(X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6))
observeEvent(input$LloydAlg, {
x = tile.centroids(tile.list(deldir(x)))
})
output$distPlot <- renderPlot({
plot(x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
})
Of course there is something that I must be doing wrong, but I am quite new into shiny I can't figure it out what I am doing wrong...
This should work (even though I am pretty sure this could be improved):
shinyServer(function(input, output) {
library(deldir)
data = data.frame(
X = runif(2^9, 1, 1E6),
Y = runif(2^9, 1, 1E6)
)
rv <- reactiveValues(x = data)
observeEvent(input$GenPoints, {
rv$x <- data.frame(
X = runif(2^input$NumPoints,1,1E6),
Y = runif(2^input$NumPoints,1,1E6)
)
})
observeEvent(input$LloydAlg, {
rv$x = tile.centroids(tile.list(deldir(rv$x)))
})
output$distPlot <- renderPlot({
plot(rv$x,pch = 20,asp=1,xlim=c(0,1E6),ylim = c(0,1E6))
})
})
So first I initialize the points to plot. I use runif(2^9, 1, 1E6) because the starting value of the sliderInput is 9 all the time.
I also removed the observeEvent from the sliderInput and moved it to the GenPoints actionButton.