I've this problem. I'm starting to learn shiny and I can't figure out how to use a filter on a dataset derived from another shiny selector.
In this particular case I would like to have one filter that works for any dataset that is selected at the first step.
I want to filter the dataset according to the column C, in particular I want to visualize only the rows with C > 1.
I'll report the code:
library(shiny)
set.seed(1)
rock <- data.frame(unif = runif(100, -1, 1),
norm = rnorm(100, 0, 2),
pois = rpois(100, 1))
paper <- data.frame(unif = runif(100, -2, 2),
norm = rnorm(100, 0, 4),
pois = rpois(100, 2))
scissor <- data.frame(unif = runif(100, -3, 3),
norm = rnorm(100, 0, 6),
pois = rpois(100, 3))
# Define UI for dataset viewer application
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "paper", "scissor")),
sliderInput("range", "Range:",
min = 0, max = 10,
value = c(0.5,5)),
numericInput("obs", "Number of observations to view:", 20)
),
# Show an HTML table with the requested
# number of observations
mainPanel(
tableOutput("view")
)
))
# Define server logic required to summarize and view the selected dataset
server <- shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"paper" = paper,
"scissor" = scissor)
})
#Creating a data frame based on inputs
####?????####
# Show the first "n" observations
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
})
shinyApp(ui = ui, server = server)
My problem is what to put instead of ####?????#### in the server part.
I hope you can help me.
Something like this?
library(shiny)
set.seed(1)
rock <- data.frame(unif = runif(100, -1, 1),
norm = rnorm(100, 0, 2),
pois = rpois(100, 1))
paper <- data.frame(unif = runif(100, -2, 2),
norm = rnorm(100, 0, 4),
pois = rpois(100, 2))
scissor <- data.frame(unif = runif(100, -3, 3),
norm = rnorm(100, 0, 6),
pois = rpois(100, 3))
# Define UI for dataset viewer application
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "paper", "scissor")),
sliderInput("range", "Range:",
min = 0, max = 10,
value = c(0.5,5)),
numericInput("obs", "Number of observations to view:", 20)
),
# Show an HTML table with the requested
# number of observations
mainPanel(
tableOutput("view")
)
))
# Define server logic required to summarize and view the selected dataset
server <- shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"paper" = paper,
"scissor" = scissor)
})
#Creating a data frame based on inputs
seconddata <- reactive({
d <- datasetInput()
d[d[,3] >= input$range[1] & d[,3] <= input$range[2],]
})
####?????####
# Show the first "n" observations
output$view <- renderTable({
head(seconddata(), n = input$obs)
})
})
shinyApp(ui = ui, server = server)
Related
I have made a simple shiny app that generates a plot of the x and y data from an individual group within the data which the users can choose from. The app subsets the larger dataframe and produces the graph for only the chosen individual. I would also like to include and actionButton which chooses an individual from within the dataset at random and plots that every time the button is pushed.
library(shiny)
library(tidyverse)
# Create example data frame
Data <- data.frame(Indiv = c(rep(1,10),
rep(2,10),
rep(3,10),
rep(4,10),
rep(5,10),
rep(6,10)),
varX = c(runif(10, min = 1, max = 10),
runif(10, min = 1, max = 10),
runif(10, min = 1, max = 10),
runif(10, min = 1, max = 10),
runif(10, min = 1, max = 10),
runif(10, min = 1, max = 10)),
varY = c(runif(10, min = 1, max = 1),
runif(10, min = 1, max = 5),
runif(10, min = 1, max = 10),
runif(10, min = 1, max = 15),
runif(10, min = 1, max = 20),
runif(10, min = 1, max = 25))
)
###### Shiny App #######
# User interface for shiny app
ui <- fluidPage(
titlePanel("Random Select Button"), # page title
sidebarLayout(
# Sidebar panel
sidebarPanel(
# input for which TagID to display in plot
actionButton("do", "Plot Random Indiv"),
selectInput(inputId = "ID",
label = "Individual ID",
choices = levels(factor(Data$Indiv)),
selected = NULL, # choose no individuals by default
multiple = FALSE # allow for multiple options
),
p("Choose an invidual, or push the button to randomly choose an individual."),
),
# Main Panel
mainPanel(
plotOutput("IndivPlot"), # name of plot object
),
)
)
# Server
server <- function(input, output) {
# Plot
output$IndivPlot <- renderPlot({ # make a live adjustable plot
### Filter to only include selected Individual
Data <- Data[Data$Indiv %in% input$ID,]
# Create plot
p = ggplot(data=Data, aes(x=varX, y=varY))+
geom_line()+
expand_limits(y=c(1,30), x = c(1,10))+
scale_y_continuous(breaks=seq(1,30,5), labels=seq(1,30,5))+
scale_x_continuous(breaks = seq(1,10,1), labels = seq(1,10,1))+
labs(x = "My X", y = "My Y")
print(p)
})
}
shinyApp(ui = ui, server = server)
I can't figure out how to get the action button to randomly choose and individual ID number and cause the plot to render. Right now, the button exists on the UI but doesn't do anything.
You may create a reactive ID which will be dynamic. It will be updated when the ID is selected from the dropdown as well as when the action button is pressed to generate random ID.
The plot will be updated based on the ID.
library(shiny)
library(tidyverse)
###### Shiny App #######
# User interface for shiny app
ui <- fluidPage(
titlePanel("Random Select Button"), # page title
sidebarLayout(
# Sidebar panel
sidebarPanel(
# input for which TagID to display in plot
actionButton("do", "Plot Random Indiv"),
selectInput(inputId = "ID",
label = "Individual ID",
choices = levels(factor(Data$Indiv)),
selected = NULL, # choose no individuals by default
multiple = FALSE # allow for multiple options
),
p("Choose an invidual, or push the button to randomly choose an individual."),
),
# Main Panel
mainPanel(
plotOutput("IndivPlot"), # name of plot object
),
)
)
# Server
server <- function(input, output, session) {
#To save dynamic ID
rv <- reactiveValues()
observe({
#ID selected from the dropdown manually
rv$ID <- input$ID
})
# Plot
output$IndivPlot <- renderPlot({ # make a live adjustable plot
### Filter to only include selected Individual
Data <- Data[Data$Indiv %in% rv$ID,]
# Create plot
p = ggplot(data=Data, aes(x=varX, y=varY))+
geom_line()+
expand_limits(y=c(1,30), x = c(1,10))+
scale_y_continuous(breaks=seq(1,30,5), labels=seq(1,30,5))+
scale_x_continuous(breaks = seq(1,10,1), labels = seq(1,10,1))+
labs(x = "My X", y = "My Y")
print(p)
})
#On action button click
observeEvent(input$do, {
#Select a random ID
rv$ID <- sample(unique(Data$Indiv), 1)
#Update the value of dropdown with random ID selected
updateSelectInput(session, inputId = "ID",
label = "Individual ID",
choices = levels(factor(Data$Indiv)),
selected = rv$ID)
})
}
shinyApp(ui = ui, server = server)
Can I get help on how to get the below code to work? I am looking to update the numbers in
dataExample <- getDataset(n1 = c(20),n2 = c(20), means1 = c(18), means2 = c(9),stds1 = c(14), stds2 = c(14))
based on input values and then generate the plot whenever I apply changes but not sure how to do it. I read it somewhere it says need to use reactive or observe but I am not sure how to modify the code?
library(shiny)
library(plyr)
library(rmarkdown)
library(rpact)
design <- getDesignGroupSequential(kMax = 2, alpha = 0.05, informationRates = c(0.5, 1), typeOfDesign = "WT", deltaWT = 0.5)
ui <- fluidPage(
titlePanel("Efficacy Monitoring Using Conditional Power"),
sidebarLayout(
sidebarPanel(
numericInput('nn1', 'Number of Subjects at Current stage (Active)', 20, min = 1, max = 100),
numericInput('nn2', 'Number of Subjects at Current stage (Control)', 20, min = 1, max = 100),
textInput('Mean1', 'Mean1',"18"),
textInput('Mean2', 'Mean2',"9"),
textInput('SD1', 'SD1',"14"),
textInput('SD2', 'SD2',"14"),
textInput('nPlanned', 'Additional Numbers Planned',"40"),
submitButton(text = 'Apply Changes')
),
# Main panel for displaying outputs ----
mainPanel(plotOutput("plot2")
)
)
)
server <- function(input,output){
dataExample <- getDataset(
n1 = c(20),
n2 = c(20),
means1 = c(18),
means2 = c(9),
stds1 = c(14),
stds2 = c(14)
)
stageResults <- getStageResults(design, dataExample,thetaH0 = 0)
output$plot2<-renderPlot(
plot(stageResults, nPlanned = c(as.numeric(input$nPlanned)), thetaRange = c(0, 20))
)
}
# Run the app ----
shinyApp(ui, server)
Use a reactive function and put the input values
library(shiny)
library(plyr)
library(rmarkdown)
library(rpact)
design <- getDesignGroupSequential(kMax = 2, alpha = 0.05, informationRates = c(0.5, 1), typeOfDesign = "WT", deltaWT = 0.5)
ui <- fluidPage(
titlePanel("Efficacy Monitoring Using Conditional Power"),
sidebarLayout(
sidebarPanel(
numericInput('nn1', 'Number of Subjects at Current stage (Active)', 20, min = 1, max = 100),
numericInput('nn2', 'Number of Subjects at Current stage (Control)', 20, min = 1, max = 100),
# WHY THE CHOICE OF textInput instead of numericInput ?
textInput('Mean1', 'Mean1',"18"),
textInput('Mean2', 'Mean2',"9"),
textInput('SD1', 'SD1',"14"),
textInput('SD2', 'SD2',"14"),
textInput('nPlanned', 'Additional Numbers Planned',"40"),
submitButton(text = 'Apply Changes')
),
# Main panel for displaying outputs ----
mainPanel(plotOutput("plot2")
)
)
)
server <- function(input,output){
# Use the input values in a reactive function
dataExample <- reactive({
getDataset(
n1 = input$nn1,
n2 = input$nn2,
means1 = as.numeric(input$Mean1),
means2 = as.numeric(input$Mean2),
stds1 = as.numeric(input$SD1),
stds2 = as.numeric(input$SD2)
)
})
output$plot2<-renderPlot({
stageResults <- getStageResults(design, dataExample(), thetaH0 = 0)
plot(stageResults, nPlanned = c(as.numeric(input$nPlanned)), thetaRange = c(0, 20))
})
}
# Run the app ----
shinyApp(ui, server)
I'm building a basic R Shiny app, and have a list that contains individual lists, each storing a dataframe and a value. I've included sample data to demonstrate my list of lists. Within my app I am trying to have one select option (a dropdown menu that says "List 1", List 2", etc) and then have the main panel in the app display a boxplot of the dataframe (x and y) and a text output of the value stored in the list that was selected.
I'm having trouble with the ability to make the outputs (both plot and text) reactive to the input and display data from the selected list.
I've put my code of what I have so far below.
## Example Data
list_a <- list(df = data.frame(x = rnorm(n = 10, mean = 5, sd = 2),
y = rnorm(n = 10, mean = 7, sd = 3)),
value = "a")
list_b <- list(df = data.frame(x = rnorm(n = 10, mean = 20, sd = 5),
y = rnorm(n = 10, mean = 13, sd = 7)),
value = "b")
list_c <- list(df = data.frame(x = rnorm(n = 10, mean = 12, sd = 4),
y = rnorm(n = 10, mean = 10, sd = 4)),
value = "c")
mylist <- list(list_a, list_b, list_c)
## Packages
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel('Data'),
sidebarPanel(
selectInput('data', 'Dataset',
choices = c("1" = list_a, "2" = list_b, "3" = list_c)),
),
mainPanel(
plotOutput('plot1'),
textOutput('text1')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
reactivedata <- boxplot(input$data)
boxplot(reactivedata$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
reactivetext <- print(input$data)
print(reactivetext$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Main issue with your code that you used your raw lists for the choices argument. Additionally I added a reactive to pick the right list according to the user's input:
set.seed(123)
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
selectInput("data", "Dataset",
choices = c("list_a" = 1, "list_b" = 2, "list_c" = 3)
),
),
mainPanel(
plotOutput("plot1"),
textOutput("text1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
reactivedata <- reactive({
mylist[[as.integer(input$data)]]
})
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
boxplot(reactivedata()$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
print(reactivedata()$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4502
#> [1] "a"
I am running the current version of RStudio, R, and all R packages.
In the sample code below, my goal is to set the maximum value for the xcol and ycol so they are limited to the number of columns in the dataframe that is being plotted. The code below results in the error "object 'input' not found." I suspect the problem may be that I am making the widgets in the ui dependent, but that is a guess on my part. Is that the problem, and is there a strategy that I can use to get around it.
I reviewed posts that contained the same error, but couldn't find anything that answered my question (or didn't recognize when it was answered.) The closest posts to my issue were: R Shiny error: object input not found; R Shiny renderImage() does not recognize object 'input'; Error in eval: object 'input' not found in R Shiny app; Conditional initial values in shiny UI?
Here is some reproducible code with random data.
library(tidyverse)
library(cluster)
library(vegan)
library(shiny)
dta <- rnorm(100, mean = 0, sd = 1)
mat <- matrix(dta, nrow = 10)
dm <- daisy(mat, metric = "euclidean") %>% as.matrix()
server <- function(input, output) {
output$plot <- renderPlot({
nmds <- metaMDS(dm, distance = "euclidean", k = input$dim, trymax = 2000, autotransform = FALSE, noshare = FALSE, wascores = FALSE)
df <- nmds$points %>% as.data.frame()
plot(df[,input$xcol], df[,input$ycol])
}, height = 500, width = 500)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("dim", "Number of dimensions", value = 2, min = 2, max = 12),
numericInput("xcol", "X column", value = 1, min = 1, max = input$dim),
numericInput("ycol", "Y column", value = 2, min = 1, max = input$dim)
),
mainPanel(
plotOutput("plot")
)
)
)
You can use updateNumericInput to modify the UI from the server:
# Modify ui to use initial max
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput("dim", "Number of dimensions", value = 2, min = 2, max = 12),
numericInput("xcol", "X column", value = 1, min = 1, max = 2),
numericInput("ycol", "Y column", value = 2, min = 1, max = 2)
),
mainPanel(
plotOutput("plot")
)
)
)
# Modify server to update max when dim changes
# (notice the session parameter needed for updateNumericInput)
server <- function(input, output, session) {
output$plot <- renderPlot({
if(input$xcol>input$dim)
updateNumericInput(session, "xcol", value=input$dim, max=input$dim)
else
updateNumericInput(session, "xcol", max=input$dim)
if(input$ycol>input$dim)
updateNumericInput(session, "ycol", value=input$dim, max=input$dim)
else
updateNumericInput(session, "ycol", max=input$dim)
nmds <- metaMDS(dm, distance = "euclidean", k = input$dim, trymax = 2000, autotransform = FALSE, noshare = FALSE, wascores = FALSE)
df <- nmds$points %>% as.data.frame()
plot(df[,min(input$dim,input$xcol)], df[,min(input$dim,input$ycol)])
}, height = 500, width = 500)
}
The community helped me in developing this code
library(shiny)
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
gr <- 10 + input$n
newLine <- isolate(c(input$n, input$nr1, gr))
values$df[nrow(values$df) + 1,] <- c(input$n, input$nr1, gr)
})
output$table1 <- renderTable({values$df})
})
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number: ", min = 0, max = 100, value = 0, step = 2),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
shinyApp(ui, server)
And I come to a new problem with that.
Now, I'd like that the app do like this: on click on the update, the variable A should always add a 5 i.e. if I have starting value of 5 than on the next click it should be 10 than 15, 20 etc?
Now when I click update the same number appears continously
Is this what you want? Also you dont need the isolate in there.
rm(list = ls())
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number:", min = 1, max = 100, value = 1, step = 1),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
if(!is.null(input$nr1) & is.null(values$A)){
values$A <- input$nr1
}
if(nrow(values$df) > 0){
values$A <- values$A + 5
}
gr <- 10 + input$n
values$df[nrow(values$df) + 1,] <- c(input$n, values$A, gr)
})
output$table1 <- renderTable({values$df})
})
shinyApp(ui, server)