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)
Related
I have a dataframe:
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
I am drawing a 3d plot with plotly by adding add_trace in a loop, like:
library(shiny)
library(plotly)
library(tidyverse)
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
test<-unique(df1$ID2)
tempt.col<-c("red","blue","green","yellow")
p<-plot_ly()
for(i in 1:length(test)){
df2<-df1[df1$ID2==test[i],] %>%
select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
marker = list(size=5,color=tempt.col[i]),
mode="markers"
)
}
p
It works very well like:
Now I want to achieve this in shiny, I would like to generate colourInput based on the length of the selected ID, the ui:
ui<-fluidPage(
fluidRow(
sidebarPanel(
selectInput("select1","Select the ID",choices = colnames(df1[,4:5]),multiple = FALSE),
actionButton("act1","Go"),
uiOutput("ui1"),
),
mainPanel(
tableOutput("table1"),
plotlyOutput("plot.3d",height = "1000px")
)
)
)
server:
server<-function(input,output){
tempt.group<-reactive({
unique(df1[,input$select1])
})
observeEvent(input$act1,{
tempt.vector<-list()
tempt.col.name<-isolate(
vector(mode = "list",length = 2)
)
for(i in 1:length(tempt.group())){
tempt.vector[[i]]<-colourpicker::colourInput(
inputId = paste0("ColorID",i),
label = tempt.group()[i])
tempt.col.name[[1]][i]<-paste0("ColorID",i)
tempt.col.name[[2]][i]<-tempt.group()[i]
}
output$ui1<-renderUI({
tempt.vector
})
names(tempt.col.name)<-c("inputId","label")
col.name<-reactive({
data.frame(sapply(tempt.col.name,cbind))
})
col.df<-reactive({
tempt.col.df<-reactiveValuesToList(input)
data.frame(
names = names(tempt.col.df[grepl("ColorID", names(tempt.col.df))]),
values = unlist(tempt.col.df[grepl("ColorID", names(tempt.col.df))], use.names = FALSE)
)
})
group.col.df<-reactive({
merge(col.df(),col.name(),by.x="names",by.y="inputId")
})
output$table1<-renderTable(
group.col.df()
)
pp<-reactive({
p<-plot_ly()
for(i in 1:length(tempt.group())){
# col<-group.col.df()[group.col.df()[,"label"]==tempt.group()[i],"values"] ####it should be something wrong with here
df2<-df1[df1$ID==tempt.group()[i],] %>%
select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
# marker = list(size=5,color=col[i]), ####it should be something wrong with here
mode="markers"
)
}
p
})
output$plot.3d<-renderPlotly({
pp()
})
})
}
shinyApp(ui=ui,server=server)
The app is like:
I want to fetch the colourInput and pass to the color of the 3d scatter plot, but nothing works. The page either keeps refreshing or frozen,
That must be something wrong with col<-group.col.df()[group.col.df()[,"label"]==tempt.group()[i],"values"] and marker = list(size=5,color=col[i]),
please help.
The below works as intended.
library(shiny)
library(plotly)
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
# Define UI
ui<-fluidPage(
fluidRow(
sidebarPanel(
selectInput("select1","Select the ID",choices = colnames(df1[,4:5]),multiple = FALSE),
# actionButton("act1","Go"),
uiOutput("myui"),
# keep track of the last selection on all selectInput created dynamically
),
mainPanel(
#tableOutput("table1"),
plotlyOutput("plot.3d",height = "1000px")
)
)
)
# Define server logic required to draw a histogram
server<-function(input,output){
rv <- reactiveValues(mygroup=0, uitaglist = list(), uilabels = list(), input_subset = list(), plotly=NULL)
observeEvent(input$select1, {
newgroup <- unique(df1[,input$select1])
rv$mygroup <- newgroup
# ui tags
rv$uitaglist <- list()
for(i in 1:length(rv$mygroup)){
rv$uitaglist[[i]]<-colourpicker::colourInput(
inputId = paste0("ColorID",i),
label = rv$mygroup[i])
rv$uilabels[[i]] <- paste0("ColorID",i)
}
})
output$myui <- renderUI({
rv$input_subset <- rv$uitaglist
})
observe({
rv$input_subset <- lapply(rv$uilabels, function(x) input[[x]])
p<-plot_ly()
for(i in 1:length(rv$mygroup)) {
df2<-df1[df1$ID2 == rv$mygroup[i],] %>% select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
marker = list(size=5,color=rv$input_subset[[i]]),
mode="markers"
)
}
rv$plotly <- p
})
output$plot.3d<-renderPlotly({
rv$plotly
})
} # end server
# Run the application
shinyApp(ui = ui, server = server)
The main difficulty was to observe all your dynamically-generated UI inputs at once. Turns out it could be done using observe and lapply.
Observing several inputs is problematic because the error Must use single string to index into reactivevalues is returned by trying to index input by a vector or list.
Now, Why this can't be done out-of-the-box is a good question.
I am trying to create my first shiny app but I am facing a difficulty: in the reproducible example below I am creating a reactive pickerInput (i.e. only show brands proposing a cylindre equal to the input visitors select).
I then want that based on the combination input_cyl and picker_cny (remember that picker_cny depends on input_cyl) to display a table which shows the relevant data for the observation matching the combination input_cyl and picker_cny.
Thank you for your help!
df <- mtcars
df$brand <- rownames(mtcars)
df$brand <- gsub("([A-Za-z]+).*", "\\1", df$brand)
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_cyl", label = "Cyl",
choices = c("6", "4", "8")),
pickerInput(
inputId = "picker_cny",
label = "Select Company",
choices = paste0(unique(df$brand)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Show Text
mainPanel(
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_cyl, {
df_mod <- df[df$cyl == paste0(input$input_cyl), ]
# Method 1
disabled_choices <- !df$cyl %in% df_mod$cyl
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(df$brand)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
output$table <- renderTable(df)
}
}
# Run the application
shinyApp(ui = ui, server = server)
You need a reactive that will handle the change in the input and subset the dataframe before giving it to the output table. For that, you just need to add this block to your server:
data <- reactive({
if (length(input$picker_cny) > 0)
df[df$brand %in% input$picker_cny,]
else
df
})
and update the output$table like this:
output$table <- renderTable(data())
Note: feel free to remove the if else in the reactive to get that:
data <- reactive({
df[df$brand %in% input$picker_cny,]
})
The only difference in that case is: would you show all or nothing when no input has been entered yet. That's a matter of taste.
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)
I have the following data frame that I extract from google analytics
ga_data <- google_analytics_4(viewId = my_id,
date_range = c(Sys.Date()-7, Sys.Date()-1),
metrics = c("sessions","pageviews",
"entrances","bounces"),
dimensions = c("date","deviceCategory",
"channelGrouping"),
anti_sample = TRUE)
Now I want to show a graph of ga_data in a Shiny application. Therefore I include the following code:
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Shiny Text"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "dataset",
label = "Choose a dataset:",
choices = c("ga_data")),
numericInput(inputId = "obs",
label = "Number of observations to view:",
value = 10)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("view")
)
)
)
server <- function(input, output) {
ga_data <- google_analytics_4(viewId = 156004565,
date_range = c(Sys.Date()-7, Sys.Date()-1),
metrics = c("sessions","pageviews",
"entrances","bounces"),
dimensions = c("date","deviceCategory",
"channelGrouping"),
anti_sample = TRUE)
datasetInput <- reactive({
switch(input$dataset,
"ga_data" = ga_data)
})
output$view <- renderTable({
hist(ga_data$sessions)
})
}
shinyApp(ui = ui, server = server)
However when I run it I get the following error:
cannot coerce class ""histogram"" to a data.frame
But this is strange cause when I want to make normal plot of the dataframe it does work. So the problem probably has to do with Shiny.
Any thoughts on what can go wrong here?
Since I don't have googleAnalyticsR set up, I reduced your problem to his simple app.
library(shiny)
shinyApp(
fluidPage(tableOutput("table")),
server = function(input, output, session){
output$table <- renderTable({hist(mtcars$mpg)})
}
)
## Warning: Error in as.data.frame.default: cannot coerce class ""histogram"" to a
## data.frame
The problem here is that you try to render a plot using renderTable. If you use renderPlot instead, everything works.
shinyApp(
fluidPage(plotOutput("plot")),
server = function(input, output, session){
output$plot <- renderPlot({hist(mtcars$mpg)})
}
)
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)