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.
Related
I want to make a shiny app that can make successive calculations based on user input. Something like this:
a <- input$inputa
b <- a+2
c <- b-3
d <- c*4
e <- d/5
So the user would choose input a, and the shiny app would do the rest and show values a, b, c, d, e.
I managed to do it if the app always makes the entire calculations based on a. But if I try to create value b and call it, it breaks.
The following code works and shows the final result as it should, but I'm sure it can be improved upon, removing repetitions:
# UI
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
output$output1 <- renderText({ input$inputa })
output$output2 <- renderText({ input$inputa+2 })
output$output3 <- renderText({ ( input$inputa+2)-3 })
output$output4 <- renderText({ (( input$inputa+2)-3)*4 })
output$output5 <- renderText({ ((( input$inputa+2)-3)*4)/5 })
}
shinyApp(ui, server)
The last bit, (((input$inputa+2)-3)*4)/5, looks terrible and is terrible. Can I make a shiny app that creates a value in one equation and uses that value in the next equation?
Thanks!
You can store the data in a reactive expression.
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
rv <- reactive({
tibble::tibble(a = input$inputa, b = a + 2, c = b-3, d = c*4, e = d/5)
})
output$output1 <- renderText({rv()$a})
output$output2 <- renderText({rv()$b})
output$output3 <- renderText({rv()$c})
output$output4 <- renderText({rv()$d})
output$output5 <- renderText({rv()$e})
}
shinyApp(ui, server)
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)
I've looked through R Shiny tutorials and stackoverflow for answers related to my query. I usually wait for 3-4 days to solve a coding problem before I attempt to post.
I have an animated slider in my UI that loops through time interval in a column (column a) . I'm trying to produce an animated line plot that plots y values of another column (column b), corresponding to the nrow() of that time interval. The slider works perfectly, but I haven't been able to plot the output.
I mightve missed some concepts related to reactivity in Shiny app. Appreciate any guidance I can get related to my query. I'll be happy to post more info if needed.
a <- c(0,1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata())
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = 0,
max = nrow(mydata()),
value = 1, step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotlyOutput("plot")
)
)
server <- function(input, output) {
sliderValues <- reactive({
data.frame(
Name = "slider",
Value = input$slider)
})
output$plot <- renderPlot({
x<- as.numeric(input$slider)
y <- as.numeric(b[x])
ggplot(mydata,aes_string(x,y))+ geom_line()
})
}
Just as a demo, I wanted the animated plot to come out like this, but in correspondance to UI slider values :
library(gganimate)
library(ggplot2)
fake <- c(1,10)
goods <- c(11,20)
fakegoods <- cbind(fake,goods)
fakegoods <- data.frame(fakegoods)
ggplot(fakegoods, aes(fake, goods)) + geom_line() + transition_reveal(1, fake)
Does this accomplish what you are looking for? Note that I removed the first element, 0, from vector a as your original example had more elements in a than b, and in order for them to be cbind together they must be the same length.
library(ggplot2)
library(shiny)
a <- c(1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata)
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = min(mydata$a),
max = max(mydata$a),
value = min(mydata$a), step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotOutput("plot")
)
)
server <- function(input, output) {
output$plot <- renderPlot({
plotdata <- mydata[1:which(input$slider==mydata$a),]
p <- ggplot(plotdata,aes(x = a,y = b))
if(nrow(plotdata)==1) {
p + geom_point()
} else {
p + geom_line()
}
})
}
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.