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)
Related
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)
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.
When using filtering and the verbatimTextOutput function in R Shiny, rows go seemingly go missing when I select more than one of the input choices in my checkboxGroupInput.
Below is my code. Any advice?
Thanks in advance.
infantmort <- read.csv("infantmort.csv", header = TRUE)
ui <- fluidPage(
checkboxGroupInput("regioninputID",
"Select Region(s)",
choices = unique(infantmort$whoregion)
),
mainPanel(
verbatimTextOutput("regionoutputID"), width = "auto", height = "auto"
)
)
server <- function(input, output) {
dataset <- reactive({
as.data.frame(infantmort %>% select(whoregion, year, deathsinthousands) %>%
filter(whoregion == input$regioninputID) )
})
output$regionoutputID <- renderPrint({ dataset()
})
}
shinyApp(ui = ui, server = server)
You need to change your filter from == to %in%
The following should do the trick
server <- function(input, output) {
dataset <- reactive({
as.data.frame(infantmort %>% select(whoregion, year, deathsinthousands) %>%
filter(whoregion %in% input$regioninputID) )
})
I know this is a basic question, but I'm really new at Shiny...
How can I combine plotlyOutput with an if loop from a SelectInput box?
I mean something like this:
vars <- data.frame(location = c("AP LIGUA",
"ESCUELA CHALACO"),
lat = c(-32.45,
-32.183333),
lon = c(-71.216667,
-70.802222)
)
selectInput(inputId = "myLocations", label = "Estación",
choices = vars$location),
if (vars$location=="AP LIGUA") {
plotlyOutput("apligua", height = "100%")
fluidRow(
DT::dataTableOutput("table")
)
}
But it does not work.
I suppose you truncated your code? It doesn't look very much like a shiny app. This is what a shiny app should look like.
vars <- data.frame(location = c("AP LIGUA",
"ESCUELA CHALACO"),
lat = c(-32.45,
-32.183333),
lon = c(-71.216667,
-70.802222)
)
ui <- fluidPage(
selectInput(inputId = "myLocations", label = "Estación",
choices = vars$location),
plotlyOutput("apligua", height = "100%"),
dataTableOutput("table")
)
server <- function(input, output,session) {
output$apligua <- renderPlotly({
if(is.null(input$myLocations)) return() #react to the user's choice if there's one
plot_ly(...)
})
output$table <- renderDataTable({
if(is.null(input$myLocations)) return() #same thing, react to the user's choice
data.table(...)
})
}
shinyApp(ui, server)
I've have tried lots of combinations of this to no avail and am all out of ideas.
I have a data.table, DT, and a shiny app with two selectInputs both based off of the same shiny module.
The first inputSelect should subset my data.table based on the first column and the second takes the remaining subset and subsets DT further based on the values of the second column.
I am finding it impossible to make the choices for the second selectInput to be the values from the second column after the subset where the 1st selectInput == col1.
I have included example code for the app below. The actual app I am making is more complicated than this. Everything works up until the second selectInput. I am having problems making this second renderUI reactive.
Would very much appreciate some tips in the right direction.
library(data.table)
library(shiny)
myUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('myFinalText'))
)
}
ui <- pageWithSidebar(headerPanel = headerPanel(title = "title"),
sidebarPanel = sidebarPanel(
myUI('menu1')
,
myUI('menu2')
),
mainPanel = mainPanel(actionButton("debug","INSPECT"))
)
set.seed(1)
DT <- data.table(col1 = LETTERS[rep(1:2, each = 3)] ,
col2 = LETTERS[sample(1:4, 6, replace = TRUE)],
num = 1:6,
key = c("col1", "col2"))
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderUI({
if(text == "textArg1"){
selectInput(paste0(text,"Val"),"choose",choices = DT[,col1])
}else{
selectInput(paste0(text,"Val"),"choose",choices = DT[col1 == input$textArg1Val,col2])
}
})
}
server <- function(input, output, session) {
callModule(myTextFunc, 'menu1', session = session, 'textArg1')
callModule(myTextFunc, 'menu2', session = session, 'textArg2')
observeEvent(input$debug,
browser()
)
}
shinyApp(ui = ui, server = server)
You can add some reactive data manualy
like
myTextFunc <- function(input, output, session, text,data) {
output$myFinalText <- renderUI({
if(text == "textArg1"){
selectInput(paste0(text,"Val"),"choose",choices = DT[,col1])
}else{
selectInput(paste0(text,"Val"),"choose",choices = DT[col1 == data(),col2])
}
})
}
server <- function(input, output, session) {
reactive_choose=reactive({
input$textArg1Val
})
callModule(myTextFunc, 'menu1', 'textArg1')
callModule(myTextFunc, 'menu2', 'textArg2',reactive_choose)
}