I have a shiny app which is used to sample 10 rows of iris data.
When I start this shiny app for the first time, I need to click the sampling action button to display the sampled iris rows.
Is it possible to pre-assign a value that could allow shiny to display the sampled iris data when I first open the app?
Below is the original code.
library(shiny)
ui = fluidPage(
actionButton(inputId = "sampling", label = "Sample rows"),
tableOutput("DFTable")
)
server = function(input, output, session){
n <- eventReactive(input$sampling, {
getrows <- dim(iris)[1]
return(sample(1:getrows, 10))
})
output$DFTable <- renderTable(iris[n(), ])
}
shinyApp(ui, server)
I tried two ways, both didn't work.
to initiate a default value for n
n <- reactiveVal(value = 1:10)
use if() function
output$DFTable <- renderTable(
if(is.null(n())){n() = 1:10}
iris[n(), ]
)
Thanks a lot for your help.
Would the following work for you?
library(shiny)
ui = fluidPage(
actionButton(inputId = "sampling", label = "Sample rows"),
tableOutput("DFTable")
)
server = function(input, output, session){
values <- reactiveValues()
values$n <- sample(1:nrow(iris), 10)
observeEvent(input$sampling, {
values$n <- sample(1:nrow(iris), 10)
})
output$DFTable <- renderTable(iris[values$n, ])
}
shinyApp(ui, server)
Related
Some days ago I was answered in this post. The solution was perfect in that moment, but I realised that I forgot to ask how I can do that with more than 1 checkboxInput. Since... I have tried a lot of things and that solution doesn't fit me with 2 checkboxInput. Maybe it can be done with the same solution changing some things, but, as I am new using shiny, I cannot find a way to do it.
The difference between the code from the previous post and this one, is that I have added a conditionalPanel and two checkboxInputs instead of 1.
Since the condition here is that if the user selects the condition (play), I thought that the solution was writing eventReactive(input$play,{}). However, none of the checkboxInputs work.
On the other hand, if you write eventReactive(input$change_log2,{}) one of the checkboxInputs (the logaritm) works. But if you select the other (srqt) it won't do nothing.
I have seen that an alternative way could be using observe or observeEvent but I cannot save the results in a variable, so... I need eventReactive...
I am a bit lost.
Someone could help me? Eventually I will add more checkboxInputs... so I need a way which I could use more than 2 checkboxInputs.
Here it is the code:
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
uiOutput("selected_sample_one"),
uiOutput("selected_sample_two"),
checkboxInput("play", strong("I want to play my data"), value = FALSE),
conditionalPanel(
condition = "input.play == 1",
checkboxInput("change_log2", "Log2 transformation", value = FALSE),
checkboxInput("run_sqrt", "sqrt option", value = FALSE))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot")
)
)
)
# Define server
server <- function(input, output,session) {
data <- reactive({
numbers <- c(5,345,55,10)
df<-data.frame(t(numbers))
names(df) <- c("S1", "S2", "S3", "S4")
return(df)
})
data1 <- eventReactive(input$play,{
df <- data()
if(input$change_log2 == TRUE){
df <- log2(df)
}
if(input$run_sqrt == TRUE){
df <- sqrt(df)
}
return(df)
})
samples_names <- reactive({
req(data())
samples <- colnames(data())
return(samples)
})
output$selected_sample_one <- renderUI({
selectizeInput(inputId = "sample_one_axis", "Select the 1st sample", choices=samples_names(), options=list(maxOptions = length(samples_names())))
})
# With this function you can select which sample do you want to plot in the y-axis.
output$selected_sample_two <- renderUI({
selectizeInput(inputId = "sample_two_axis", "Select the 2nd sample", choices=samples_names(), selected=samples_names()[2], options=list(maxOptions = length(samples_names())))
})
output$plot <- renderPlot({
req(input$sample_one_axis,input$sample_two_axis,data1())
barplot(c(data1()[,input$sample_one_axis], data1()[,input$sample_two_axis]))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks very much in advance,
Regards
You can simply wrap the relvant inputs in c().
Here's a MWE:
library(shiny)
ui <- fluidPage(
checkboxInput("check1", "Checkbox 1"),
checkboxInput("check2", "Checkbox 2"),
textOutput("text")
)
server <- function(input, output, session) {
v <- reactiveValues(text="Waiting...")
observeEvent(c(input$check1, input$check2), {
s <- "Checked: "
if (input$check1) {
s <- paste(s, "1")
}
if (input$check2) {
s <- paste(s, "2")
}
v$text <- s
},
ignoreInit=TRUE
)
output$text <- renderText({
v$text
})
}
shinyApp(ui, server)
Alternatively, you could perhaps wrap what you need to do in a function and then just call the function in a series of observeEvents, one for each relevant input.
[I started writing before you updated your post.]
Thanks to #Limey, the solution for my problem was to replace data1 <- eventReactive with data1 <- reactive.
Thanks very much.
I need a dataset to be continuously updated once the user clicks on a button. I was hoping the below code to achieve that but it simply ignores the updating part in my code. Here is the code:
library(shiny)
rm(list = ls())
x = 0.1
y = 0.1
df = data.frame(x,y) #Just define a simple dataset
ui <- shinyUI(fluidPage(
actionButton("run", "Run"),
tableOutput('table')
))
server <- shinyServer(function(input, output, session) {
df_new = eventReactive(input$run, {
z = runif(2)
if(isFALSE(exists("df_new()"))){ #Check if there is new data
return(rbind(df,z)) #1st update
}
else{
return(rbind(df_new(),z)) #Update the dataset
}
})
output$table = renderTable({
df_new()
})
})
shiny::shinyApp(ui, server)
I want the app to add a new row to the previous ones each time we run it, and so the number of rows should be always #of clicks + 1. Any idea if that's possible?
You could use a reactiveVal with observeEvent:
library(shiny)
x = 0.1
y = 0.1
df = data.frame(x,y) #Just define a simple dataset
ui <- shinyUI(fluidPage(
actionButton("run", "Run"),
tableOutput('table')
))
server <- shinyServer(function(input, output, session) {
df_new = reactiveVal(df)
observeEvent(input$run, {
z = runif(2)
df_new(rbind(df_new(),z))
})
output$table = renderTable({
df_new()
})
})
shiny::shinyApp(ui, server)
I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)
How can I extract selected option from r markdown selectInput drop down menu? I have reactive input on my web page something like the following:
aggdata <- data.frame(
"Experiment" = c("One","Two","Three"),
"AnythingElse" = c(1,2,3)
)
selectInput("Experiment1","Choose the first experiment",
choices = unique(aggdata$Experiment),
selected = unique(aggdata$Experiment)[1])
reactiveData <- reactive(as.data.frame(subset(aggdata, Experiment == input$Experiment1)))
firstExperiment_aggData <- reactive(reactiveData())
And I'd like to write somewhere to the text reactively, what was user's selection. Do you happen to know, how can I do that. Many thanks in advance.
As far as Shiny is concerned, you could start with this. Does that help you?
library(shiny)
aggdata <- data.frame(
"Experiment" = c("One","Two","Three"),
"AnythingElse" = c(1,2,3)
)
ui <- shinyUI(
fluidPage(
selectInput("Experiment1","Choose the first experiment",
choices = unique(aggdata$Experiment),
selected = unique(aggdata$Experiment)[1]),
tableOutput("table1")
)
)
server <- shinyServer(function(input, output, session) {
reactiveData <- reactive({
return(as.data.frame(subset(aggdata, Experiment == input$Experiment1)))
})
output$table1 <- renderTable({
return( reactiveData() )
})
})
shinyApp(ui = ui, server = server)
I'm creating Shiny app and I want to use checkboxGroupInput in order to print out multiple plots. However, I want to print out plots only for the elements of checkboxGroupInput that were checked. There is a similar example in Shiny gallery to create UI elements in a loop that uses lapply. Here is a simplified version of that example to show what I want to do:
#server.R
library(shiny)
library(ggplot2)
shinyServer(function(input, output, session) {
numberInput <- reactive({
input$checkbox
})
lapply(1:10, function(i) {
output[[paste0('b', i)]] <- renderPlot({
qplot(x = rnorm(100, mean = as.numeric(numberInput()[i]))) +
ggtitle(paste("This plot was plotted with", numberInput()[i], "option"))
})
})
})
#ui.R
library(shiny)
shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
lapply(1:10, function(i) {
plotOutput(paste0('b', i))
})
)
)
))
This works, but obviously when Shiny tries to extract numberInput()[i] where i is bigger than number of currently checked elements, there is nothing to extract and instead of a plot there is an error. Therefore I need to somehow tell lapply to iterate only n number of times where n is length(input$checkbox).
I tried to use length(input$checkbox) directly, tried putting that element in the numberInput() reactive statement and returning it as the list, I tried to use reactiveValues() in a following way:
v <- reactiveValues(n = length(input$checkbox))
lapply(1:isolate(v$n), function(i) {
However, in all of those instances Shiny complains about lack of active reactive context.
So, what am I missing? How can I use length of input in lapply outside of reactive context?
I've generally had more luck using this approach (only because it's easier for me to wrap my head around it), but the idea is to render your plots into a UI on the server and then render the UI in ui.R
#server.R
library(shiny)
library(ggplot2)
server <- shinyServer(function(input, output, session) {
output$checks <- renderText(input$checkbox)
output$plots <- renderUI({
plot_output_list <-
lapply(input$checkbox,
function(i){
plotOutput(paste0("plot", i))
})
do.call(tagList, plot_output_list)
})
observe({
for (i in input$checkbox) {
local({
local_i <- i
output[[paste0("plot", local_i)]] <-
renderPlot({
qplot(x = rnorm(100, mean = as.numeric(local_i))) +
ggtitle(paste("This plot was plotted with", local_i, "option"))
})
})
}
})
})
#ui.R
library(shiny)
ui <- shinyUI(fluidPage(
title = 'lapply example',
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Checkbox",
choices = sample(1:10, 5))
),
mainPanel(
verbatimTextOutput("checks"),
uiOutput('plots')
)
)
))
shinyApp(ui = ui, server = server)