I'm trying to add an ALL option in both of my dynamically linked selectInput widgets, which filters through to a graph in my main panel. Basically, I want the user to select a Service, e.g. Online or Mail-Order, or all services, and similarly with the Prof.Los column, I want the user to select either Profit or Loss, or a sum of both.
I'm not sure how to add this extra option when the two Inputs are dynamically linked. So my question is, how can I include an option to filter my data by ALL variables in both drop-down menus?
My library and data:
library("shiny")
library("plotly")
library("tidyverse")
library("dplyr")
data <- data.frame(Services = c("Online","Online","Online","Online","Online","Online","Online","Online","Online", "Online","Online","Online","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop"),
Month = c("2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01"),
Sales = c(40,50,20,30,40,50,200,100,250,100, 120,130,40,80,20,30,30,50,400,100,150,100,75,50,100,50,700,30,40,50,100,120,220,100,75,150),
Prof.Los = c("Profit","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Profit","Profit","Loss","Profit","Loss","Profit","Loss","Loss","Loss","Profit","Loss","Loss","Profit","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Loss"))
My code:
UI
ui <- fluidPage(
# App title ----
titlePanel(h1("Analyser tool")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
# Input: Select service type ----
uiOutput("services"),
uiOutput("rev")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Bar Chart", plotlyOutput("Plot", height = "450px"))
)
)
))
Server
server <- function(input, output) {
# Service analyser reactive dataset
output$services = renderUI({
selectInput("services",
"Select services:",
choices = unique(data$Services))
})
ServiceSub <- reactive({
data %>%
filter(Services == input$services)
})
output$rev = renderUI({
selectInput(inputId = "rev",
label = "Profit/loss",
choices = unique(ServiceSub()[,"Prof.Los"]),
selected = unique(ServiceSub()[,"Prof.Los"]))
})
RevSub <- reactive({
req(input$services)
filter(ServiceSub(), Prof.Los %in% input$rev)
})
output$Plot = renderPlotly({
# plotly code
plot_ly(RevSub(), x = ~Month, y = ~Sales, type = "bar")
})
}
# Create Shiny app ----
shinyApp(ui, server)
You can use pickerInput from {shinyWidgets}.
I ran your code, with the following adjustments:
pickerInput("services",
"Select services:",
choices = unique(data$Services),
multiple = TRUE,
selected = NULL,
options = list(
title = "Services",
#"max-options" = 1,
`actions-box` = TRUE,
`deselect-all-text` = "Remove"
))
pickerInput(inputId = "rev",
label = "Profit/loss",
choices = unique(ServiceSub()[,"Prof.Los"]),
selected = unique(ServiceSub()[,"Prof.Los"]),
multiple = TRUE,
options = list(
title = "Profit/loss",
#"max-options" = 1,
`actions-box` = TRUE,
`deselect-all-text` = "Remove"
))
Related
I have a shiny app where the user uploads a csv file. Then, using the column names from the csv file, I create sortable bucket list. I would like drag the column name from the first rank list and have it cloned (i.e. not depleted). I tried to use the options parameter in add_rank_list() setting pull='clone', but that did not work. Any idea on how to do this? Below is my code, and some fake data can be accessed here.
library(shiny)
library(shinyjs)
library(sortable)
ui <- fluidPage(
titlePanel("App"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
fileInput(inputId = "file1", label = "Select a .csv file",
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")
),
uiOutput("show_button")
),
mainPanel(
DT::dataTableOutput("table")
)
),
fluidRow(uiOutput("buckets"))
)
server <- function(input, output) {
# input csv file
input_file <- reactive({
if (is.null(input$file1)) {
return("")
}
# actually read the file
read.csv(file = input$file1$datapath)
})
# button to hide/show table
## only show when table is loaded
output$show_button = renderUI({
req(input$file1)
actionButton(inputId = "button", label = "show / hide table")
})
## observe the button being pressed
observeEvent(input$button, {
shinyjs::toggle("table")
})
# output table
output$table <- DT::renderDataTable({
# render only if there is data available
req(input_file())
# reactives are only callable inside an reactive context like render
data <- input_file()
data
})
# Drag and Drop Col names
output$buckets = renderUI(
{
# create list of colnames
req(input$file1)
data = input_file()
cols = colnames(data)
# create bucket list
bucket_list(
header = "Drag the items in any desired bucket",
group_name = "bucket_list_group",
orientation = "horizontal",
add_rank_list(
text = "Drag from here",
labels = as.list(cols),
input_id = "rank_list_1",
css_id = "list1",
options = sortable_options(
group = list(
pull = "clone",
name = "list_group1",
put = FALSE))
),
add_rank_list(
text = "to here",
labels = NULL,
input_id = "rank_list_2",
css_id = "list2",
options = sortable_options(group = list(name = "list_group1")))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This is a follow-up to this Dynamic change in vtree within shiny: How to deselect
With this code below, I try to switch the arguments prunesmaller and prunebigger of the vtree package. I am quite sure to do this with an if else but I am not able to fix it:
In general I want to know how to tweak any argument of any function depending on a radiobutton in r shiny:
Here is my code so far:
library(shiny)
library(vtree)
# Define UI ----
ui <- pageWithSidebar(
# App title ----
headerPanel("Cyl vtree"),
# Sidebar panel for inputs ----
sidebarPanel(
radioButtons("smaller_bigger", h3("Prune smaller or bigger?"), choices = c("smaller", "bigger"), inline = TRUE),
sliderInput(inputId = "prune", label = "Number to prune?", step = 10, min = 0, max = 100, value = 0),
selectizeInput("level", label = "Level", choices = NULL, multiple=TRUE),
# This line is the only change from the original code
selectizeInput("values", label= "Values", choices = NULL, multiple=TRUE),
),
# Main panel for displaying outputs ----
mainPanel(
vtreeOutput("VTREE")
)
)
# Define server logic to plot ----
server <- function(input, output,session) {
df <- reactiveVal(mtcars)
vector <- c("cyl","vs", "am","gear")
observe({
updateSelectizeInput(session, "level", choices = colnames(df()[vector]), selected = NULL)
updateSelectizeInput(session, "values", choices = unique(df()$cyl))
})
output[["VTREE"]] <- renderVtree({
vtree(df(), c(input$level),
sameline = TRUE,
follow=list(cyl=input$values),
if(input$smaller_bigger=="smaller"){
prunesmaller = input$prune
} else
(input$smaller_bigger == "bigger"){
prunebigger = input$prune
}
)
})
}
shinyApp(ui, server)
In essence I try to handle this part of the code:
if(input$smaller_bigger=="smaller"){
prunesmaller = input$prune
} else
(input$smaller_bigger == "bigger"){
prunebigger = input$prune
}
)
It should do:
If radiobutton smaller is choosen then the argument should be prunesmaller == input$prune (where input$prune comes from the sliderinput)
If I replace the if else part by prunesmaller = input$prune the code works but only with prunesmaller:
The way you use the if will not work to set the functions argument. Instead use a single if for each argument, e.g. prunesmaller = if (input$smaller_bigger == "smaller") input$prune.
Note: Maybe I missed something, but I got an error when trying to set prunebigger and according to the docs there is no prunebigger argument.
library(shiny)
library(vtree)
# Define UI ----
ui <- pageWithSidebar(
# App title ----
headerPanel("Cyl vtree"),
# Sidebar panel for inputs ----
sidebarPanel(
radioButtons("smaller_bigger", h3("Prune smaller or bigger?"), choices = c("smaller", "bigger"), inline = TRUE),
sliderInput(inputId = "prune", label = "Number to prune?", step = 10, min = 0, max = 100, value = 0),
selectizeInput("level", label = "Level", choices = NULL, multiple = TRUE),
# This line is the only change from the original code
selectizeInput("values", label = "Values", choices = NULL, multiple = TRUE),
),
# Main panel for displaying outputs ----
mainPanel(
vtreeOutput("VTREE")
)
)
# Define server logic to plot ----
server <- function(input, output, session) {
df <- reactiveVal(mtcars)
vector <- c("cyl", "vs", "am", "gear")
observe({
updateSelectizeInput(session, "level", choices = colnames(df()[vector]), selected = NULL)
updateSelectizeInput(session, "values", choices = unique(df()$cyl))
})
output[["VTREE"]] <- renderVtree({
vtree(df(), c(input$level),
sameline = TRUE,
follow = list(cyl = input$values),
prunesmaller = if (input$smaller_bigger == "smaller") input$prune
#prunebigger = if (input$smaller_bigger == "bigger") input$prune
)
})
}
shinyApp(ui, server)
New to R, now I am working on shiny app that include several select input, most of them i need to add "All" to enable the use to control whole outputs.
but it is not working. here is the code. my request is how to make the data frame update with each selection accordingly i will be able to plot any variables
library(shiny)
library(dplyr)
library(plotly)
library(tidyverse)
brand<-mutate(mtcars,brand=substr(mtcars$model,1,4))
shinyUI(fluidPage(
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
sliderInput("bins", "cost", min = 0,max = 10000,value = 1000),
selectInput("f1","brand",choices=unique(mtcars$m),selected = "Merc"),
selectInput("f2","model",choices=NULL),
selectInput("f3","cyl",choices= c("All",unique(mtcars$cyl)),selected = "All"),
selectInput("f4","hp",choices=c("All", unique(mtcars$hp)),selected = "All"),
selectInput("f5","vs",choices=c("All", unique(mtcars$vs)),selected = "All"),
selectInput("f6","gear",choices=c("All", unique(mtcars$gear)),selected = "All")),
mainPanel(
plotlyOutput("Test2", height = "250px"),
plotlyOutput("Test3", height = "250px")
)
)
)
server<-function(input,output,session){
observe({
print(input$brand)
df2<-brand%>%filter(brand==input$f1)
updateSelectInput(session,"f2","model",choices=unique(df2$model))
print(df2)
})
observe({
df3<-reactive({
if(input$f3=="All"){df2}
else {df3<-df2%>%filter(cyl==input$f3)
updateSelectInput(session,"f3","cyl",choices=unique(df3$cyl))}
print(df3)
})
output$plot <- renderPlotly({
plot_ly(df3, x = ~mpg, y = ~wt)
})
})}
I am trying to make a Shiny app that will plot gene of interest for a chosen patient. Each row is the gene name, and each column is a patient ID. For example:
99901 99902 99903 99904
SKI 4.789 5.789 6.324 1.2222
VWA1 6.901 7.002 5.89 4.567
TTLL10 6.783 7.345 8.987 6.345
library(shiny)
library(shinythemes)
library(lattice)
anno <- as.matrix(anno_genExp_gen3[1:3, 1:3])
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off[,1:25]),
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off[1:25,]),
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
pdata <- reactive(input$patients)
gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(anno,
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shinyApp(ui = ui, server = server)
The code above just plots a small matrix, but how do I get it to plot user inputs using reactivity?
If the user chooses SKI and TTlLL10 only for patient 99901, how will I go about plotting this?
I've myself created a sample dataframe as you mentioned above. Here's the modified code.
Changes i made:
input$geneExp and input$patients are already reactive so there is no need to use a separate reactive function.
Filtered the dataframe for plotting use the same
Also, made a default selected value in the selectInput to avoid the initial error message when nothing is selected
library(shiny)
library(shinythemes)
library(lattice)
anno_genExp_off <- data.frame(`99901` = c(4.3,6.5,6.6),
`99902` = c(5.3,7.5,8.6),
`99903` = c(6.3,8.5,9.6),
row.names = c("SKI","VWA1","TTLL10"))
anno <- as.matrix(anno_genExp_off)
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off),
selected = colnames(anno_genExp_off)[1],
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off),
selected = rownames(anno_genExp_off)[1],
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
#pdata <- reactive(input$patients)
#gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(x = as.matrix(anno_genExp_off[which(rownames(anno_genExp_off) %in% input$geneExp) ,input$patients]),
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shiny::shinyApp(ui,server)
Issues between inputs and plot output
Hi,
I'm testing out a basic ShinyApp where I can generate a plot of commercial services broken down by geography and service type.
The idea is I want the user to use three drop-down menu inputs, each dependent upon the previous selection, to subset the data, which then gets output in a ggplot.
However, I'm having issues connecting the inputs to the plot output (see below). The inputs are working fine and reactive when selected, but I can't work out how to link that to the plot, I get the feeling I'm not using the right data source (but have no idea how to ensure it is). Furthermore, I'm not familiar with how I would go about adding a third filter (for "service") seeing as I don't know how to link my data source in the first place.
Sorry this is probably simple, but some help would be really appreciated.
UI
#Data
Test <- dataframe(
Geography1 = c("Region","Local Authority","County"...),
Geography2 = c("North West","Aldershot","Cheshire"...),
Service = c("Shop","Cafe","Library"...),
Overall_rating = c("Awesome","Good","Fantatstic"...),
Locations = c(4000, 1300, 1700...)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
Server
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
output$geography2 = renderUI({
datasub <- Test[Test$Geography1 == input$geog1, "Name"]
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub),
selected = unique(datasub)[1])
})
output$service = renderUI({
datasub2 <- unique(datasub)
selectInput(inputId = "service",
label = "Service type:",
choices = unique(...),
selected = unique(...)[1])
})
output$plot = renderPlot({
ggplot(datasub2(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
It's hard to tell how the provided data is supposed to be filtered in the app but this code will at least run and be interactive. Hopefully from there you can figure out how to adjust the dataset.
As BigDataScientist said one fault is that you're not using a reactive dataset.
#Data
Test <- data.frame(
Geography1 = c("Region","Local Authority","County"),
Geography2 = c("North West","Aldershot","Cheshire"),
Service = c("Shop","Cafe","Library"),
Overall_rating = c("Awesome","Good","Fantatstic"),
Locations = c(4000, 1300, 1700)
)
#SHINY APP
ui <- fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
uiOutput("geography1"),
uiOutput("geography2"),
uiOutput("service")),
mainPanel(
plotOutput("plot", height = "400px"))
)
)
server <- function(input, output) {
output$geography1 = renderUI({
selectInput(inputId = "geog1",
label = "Geography 1:",
choices = as.character(unique(Test$Geography1)),
selected = "Region")
})
datasub <- reactive({
Test[Test$Geography1 == input$geog1,]
})
output$geography2 = renderUI({
selectInput(inputId = "geog2",
label = "Geography2:",
choices = unique(datasub()[,"Geography2"]),
selected = unique(datasub()[,"Geography2"])[1])
})
datasub2 <- reactive({
datasub()[Test$Geography2 == input$geog2, ]
})
output$service = renderUI({
selectInput(inputId = "service",
label = "Service type:",
choices = unique(datasub2()[,"Service"]),
selected = unique(datasub2()[,"Service"])[1])
})
datasub3 <- reactive({
datasub()[Test$Service == input$service, ]
})
output$plot = renderPlot({
ggplot(datasub3(),aes(x = Overall_rating, y = Locations, fill= Overall_rating))+
geom_bar(stat = "identity")
})
}
shinyApp(ui, server)