Thank you all in advance for your help.
I'm still relatively new to R-Shiny and I'm trying to explore dynamic UI. I've done some research into renderUI, reactive, and observe functions but I'm still not sure of the right way to go about doing what I'm trying to accomplish which is:
User selects Y - dynamically populates choices based on loaded data in global.r
User selects X - dynamically populates choices based on loaded data in global.r
R plots the two
My problem is that the select inputs do not display - that makes sense to me given they are reactive. How do I show those select inputs when the page loads?
ui.R
require(shiny)
shinyUI(fluidPage(
tabPanel("Pineapple",
tabPanel("",
sidebarLayout(
sidebarPanel(
helpText("Choose X and Y"),
uiOutput("pineapple.pick_Y"),
uiOutput("pineapple.pick_X"),
),
mainPanel(
plotOutput("pineapple.plot")
)
)
)
)
))
server.R
shinyServer(function(input, output, session){
output$pineapple.plot <- renderPlot({
df <- data.frame(blue = c(1,2,3),
red = c(4,5,6),
boy = c("steve","steve","bill"),
girl = c("stacey","lauren","stacey")
plot(input$pineapple.pick_X,input$pineapple.pick_Y,data=df)
})
output$pineapple.pick_X <- renderUI({
selectInput("pineapple.x", label = h6("Select X"),
choices = c("blue","red"),
selected = "blue")
})
output$pineapple.pick_Y <- renderUI({
selectInput("pineapple.y", label = h6("Select Y"),
choices = c("boy","girl"),
selected = "boy")
})
})
Found a way around it - There wasn't a need to a dynamic UI really, just used variables I stored in global.R to pull the choices.
Thanks!
Related
[picture of my code and shiny app][1]I am trying to write a shiny app where I have two drop down menus and I create two histograms from those dropdowns and a salary variable I have stored in a dataframe. I can create the drop downs but I am lost on how to save the selection and use the selection as a independent variable for my model. any help at all would be huge.
I tried using a save button to save the selection from the drop down but I couldn't get that to store the variable in a way that I could verify with my dataframe.
code below
library(dplyr)
library(ggplot2)
library(shiny)
data <- read.csv("C:/Users/lewis/OneDrive/Desktop/STA 580( R
programming)/Final_Project/salaries_entry.csv")
data
wxdata <- data.frame(
Remote = c("0%", "50%", "100%"),
Size = c("Small","Medium","Large")
)
remotelist <- unique(wxdata$Remote)
sizelist <- unique(wxdata$Size)
ui <- fluidPage(
titlePanel("Data Science / Data Engineer Salaries"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h4("The purpose of this app is to give you an idea"),
h4("about the potential money you could be making as an"),
h4("entry level employee in the Data Science field based "),
h4("on a few key factors. Test it out and Get that BAG!")
)
),
inputPanel(
selectInput(
"RemoteWork",
label = "Select Amount of Remote Work",
choices = remotelist
)
),
inputPanel(
selectInput(
"CompanySize",
label = "Select the Size of the Company",
choices = sizelist
)
),
)
server <- function(input, output) {
output$minplot <- renderPlot(draw_plot(input$PlotCity))
}
shinyApp(ui = ui, server = server)
I have two datasets, one with a list of two hundred cities and their corresponding state and another much larger dataset that I'd like to make an app to sort through. I need help making two drop down boxes in my shiny app where the first is the state variable and the second is the list of cities within that chosen state. I then want those selections to filter the much larger, second dataset in the output. I've tried solutions from several similar but slightly different examples online, but I'm having trouble translating it to what I'm doing.
So far I have this:
ui <- fluidPage(
headerPanel(''),
sidebarPanel(
#add selectinput boxs
htmlOutput("state_selector"),
htmlOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$State == input$state, "state"]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available), #calls list of available cities
selected = unique(data_available)[1])
})
shinyApp(ui = ui, server = server)
I tried to take out the portions of the code that weren't specifically related to the drop down boxes, since that's what I was more specifically asking about. So I'm sorry if I've left anything out! Let me know if I need to include anything else
Using available gapminder data, you can try this.
df <- gapminder
df$state <- gapminder$continent
df$city <- gapminder$country
citystatedata <- df
ui <- fluidPage(
headerPanel('Test'),
sidebarPanel(
#add selectinput boxs
uiOutput("state_selector"),
uiOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DTOutput("table")
)
)
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$state == req(input$state),]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available$city), #calls list of available cities
selected = 1)
})
mydt <- reactive({
citystatedata %>% filter(citystatedata$state == req(input$state) & citystatedata$city %in% req(input$city))
})
output$table <- renderDT(mydt())
}
shinyApp(ui = ui, server = server)
Probably very basic question - but can't translate similar posts I've found to my exact issue.
Within an R Shiny app, I have a first drop-down menu that is populated by a vector produced on the server - this allows me to make one set of choices.
I want to have a tick box that then introduces a second drop down - but I want that drop down to disappear if I un-tick the tick box.
I've had a go - see MWE below - the graph is just there to keep to the structure of my original code (obviously I'm aware my drop-downs do nothing but that's not the case in the original but wanted the MWE to be as 'M' as possible).
If I remove the removeUI() line then ticking the tick-box does create a new drop down as required - but then un-ticking the tick box fails to remove it.
I'm obviously missing something; any help much appreciated as I totally suck at R Shiny but really want to get better!
library(shiny)
library(shinyMobile)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
htmlOutput("reactive_drop_down") #second drop down
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
library(ggplot2)
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
observeEvent(input$initial_choice, {
# trying to add second drop down based on action in switch - not convinced my use of observeEvent is quite right - issue likely sits in here.
observeEvent(input$switch, {
if(input$switch == T){
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
}else{
removeUI(selector ="#reactive_drop_down")
}
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Could you use conditionalPanel? Put your htmlOutput for your second input there in your ui. I would avoid using nested observeEvent and output.
library(shiny)
library(shinyMobile)
library(ggplot2)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
conditionalPanel(
condition = "input.switch==1",
htmlOutput("reactive_drop_down") #second drop down
)
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm hoping to display a reactive datatable for my Shiny app. I'm using renderDataTable() and have made sure that the data table is returned in the reactive function. I've noticed that the datatable renders fine outside of the Shiny App, so not a variable/computation error. The reason I'm hoping to use a datatable in the first place is so that I can display cleaned up column names and display the dataframe in a more clean manner. Please let me know what else I can try, or if I should change my approach.
Here is the server code:
server <- function(input, output) {
dataset <- reactive({
shiny_tuition_salary <- datatable(df_tuition_salary %>%
select(name, mean_net_cost, state) %>%
filter(mean_net_cost >= input$input_budget[1],
mean_net_cost <= input$input_budget[2],
state == input$input_state) %>%
select(name, mean_net_cost))
return(shiny_tuition_salary)
})
output$df <- renderDataTable({
dataset()
})
}
Currently nothing is displayed under the Table tab in the app. The app also successfully displays the table when DataTable is not used at all (i.e. removing datatable() from the server and using RenderTable instead of RenderDataTable), so I'm positive there's an issue with my implementation of RenderDataTable()
Thanks!
EDIT: Here's the ui code and a sample df_tuition_salary as well
ui <- fluidPage(
titlePanel("What colleges match your budget and rank?"),
# Sidebar laayout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "input_budget",
label = "Budget:",
min = 0,
max = 50000,
value = c(0, 15000)),
selectInput(inputId = "input_state",
label = "State (limited data, may limit options):",
choices = df_tuition_salary$state)
),
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
id = 'output_df',
# tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("df"))
)
)
)
)
df_tuition_salary:
df_tuition_salary <- data.frame(name = c("Aaniiih Nakoda College", "Abilene Christian University"),
mean_net_cost = c(7508.2414, 24884.0828),
state = c("N/A", "N/A"))
use dataTableOutput() function.
# Main panel for displaying outputs ----
mainPanel(
tabsetPanel(
id = 'output_df',
# tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", dataTableOutput("df"))
)
I have started practicing shiny package for making dashboard, and i am still an amateur at R, please help me to display the data which will be selected using selectinput in the allocated tab which i have created for display of data.
I shall share my ui code as well as server code. Please assist how to display selected data in the data tab created.
ui.R code
library(shiny)
library(shinydashboard)
shinyUI(fluidPage(
titlePanel(h1("Test for application of all the tutorials completed till now")),
sidebarLayout(
sidebarPanel((h2("Information Panel Enter")),
selectInput("data", "Select the dataset for hist analysis",
choices = c("iris","pressure","USArrests", selected = "pressure")),
numericInput("obs", "Select the number of observations for the dataset", value = 5,min = 5,max = 30,step = 1 ),
sliderInput("bins", "Select the number of bins for histogram", value = 6, min = 6, max = 20, step = 1),
radioButtons("color", "selecct the color of histogram" , choices = c("black","purple","brown"))),
mainPanel((h3("Main Panel of all the information display")),
tabsetPanel(type = c("pills"),
tabPanel("Summary" , h4(textOutput("Mysumhead")) ,verbatimTextOutput("Mysum")),
tabPanel("Structure and Observation" , h4(textOutput("Mystrhead")), verbatimTextOutput("Mystr")),
tabPanel("Plot"),
tabPanel("Data" , verbatimTextOutput("Mydata"))))
)))
server.R code
library(shiny)
library(shinydashboard)
library(datasets)
shinyServer(function(input,output){
output$Mysum <- renderPrint({
summary(get(input$data))
})
output$Mysumhead <- renderText({
paste("Data Selected for checking summary is " , input$data)
})
output$Mystr <- renderPrint({
str(get(input$data))
})
output$Mystrhead <- renderText({
paste("Data selected for observing summary of the data is " , input$data)
})
output$Mydata <- renderTable({
data(input$data)
})
})
you are good in all point except one.
In the UI.R, in Data TAB just change to tableOutput("Mydata") and in Server.R change the code inside rendertable({}) change it to get(input$data).
It will be good to go. You should use tableOutput for displaying Table when you want to use renderTable in server side