I want to change chart type from e_line to e_bar based on a condition. What I tried to do was using some reactive expression or if else inside plot, but neither of them works. Any ideas how to tackle this?
So, I need to change dynamically e_line, I tried this:
newChartType <- reactive({
df = switch(
someCondition,
'1' = echarts4r::e_line(ColumnName2),
'2' = echarts4r::e_bar(ColumnName2)
)
})
output$plot <- echarts4r::renderEcharts4r({
dataChartStats() %>%
echarts4r::e_charts(ColumnName1) %>%
newChartType() %>%
echarts4r::e_legend(show = FALSE)
})
but it doesn't work. I'm interested in general rule on how to change dynamically building elements of plot code (can be ggplot as well etc, here I used echarts4r).
I couldn't find a way of obtaining the chart type directly from an input element, but here's one way of doing it:
library(shiny)
library(tidyverse)
ui <- fluidPage(
selectInput(
"type",
"Select a chart type:",
c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlot({
if (input$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Next time, please provide a minimum working example.
EDIT in response to OP's request for a solution based on a button click:
library(shiny)
library(tidyverse)
ui <- fluidPage(
actionButton("go", "Click me!"),
textOutput("type"),
# selectInput(
# "type",
# "Select a chart type:",
# c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
v <- reactiveValues(type="line")
observeEvent(input$go, {
if (v$type == "line") v$type <- "point"
else v$type <- "line"
})
output$type <- renderText({ v$type })
output$plot <- renderPlot({
if (v$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
My application has two selectInputs. It updates the secound selectInput depending on the first selectInput and then it plots a timeline for df data. The app works completely well, but when I try to modularize it, it doesn't work properly (just the selectInputs work, but no plot is built). I have created a minimal example. I really appreciate any help everybody can provide.
library(shiny)
library(plotly)
library(reshape2)
# data preparation
df<-data.frame(Name1<-c("Aix galericulata","Grus grus"," Alces alces"),
Name2<-c("Mandarin Duck","Common Crane" ,"Elk"),
eventDate<-c("2015-03-11","2015-03-10","2015-03-10"),
individualCount<-c(1, 10, 1)
)
colnames(df)<-c("Name1","Name2","eventDate","individualCount")
#----------------------------------------------------------------------------------------
# module dataselect
dataselect_ui<- function(id) {
ns<-NS(id)
tagList(
selectInput(ns("Nametype"),"Select a name type",
choices=c("Name1","Name2","choose"),selected = "choose"),
selectInput(ns("Name"),"Select a name",
choices="",selected = "",selectize=TRUE)
)
}
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
# Putting columns Name1 and Nam2 of df in one column called nameType using melt()function
# This format of data is needed for the choices argument of updateSelectizeInput()
df2<-reshape2::melt(df,id=c("eventDate","individualCount"))
colnames(df2)<-c("eventDate","individualCount","nameType","Name")
observeEvent(
input$Nametype,
updateSelectizeInput(session, "Name", "Select a name",
choices = unique(df2$Name[df2$nameType==input$Nametype]),selected = ""))
# finalDf() is the data used to plot the timeline
finalDf<-reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
# if the first selectInput is set to Name1, from df select rows their Name1 column is
# equal to the second selectInput value
else if(input$Nametype=="Name1"){
finalDf<-df[which(df$Name1==input$Name) ,]
}
# if the first selectInput is set to Name2, from df select rows their Name2 column is
# equal to the second selectInput value
else if(input$Nametype=="Name2"){
finalDf<-df[which(df$Name2==input$Name) ,]
}
return(
reactive({
input$Name
})
)
})
})
}
#-------------------------------------------------------------------------------------
# application
ui <- fluidPage(
# Application title
navbarPage(
"app",
tabPanel("plot",
sidebarPanel(
dataselect_ui("dataselect")
),
mainPanel(
plotlyOutput("timeline")
)
)
)
)
server <- function(session,input, output) {
dataselect_server("dataselect")
# timeline plot
output$timeline <- renderPlotly({
req(input$Name)
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
}
shinyApp(ui = ui, server = server)
If you return input$Name from the server module, as you correctly do, you have to use the returned value of this module in renderPlotly:
server <- function(session,input, output) {
input_Name <- dataselect_server("dataselect")
# timeline plot
output$timeline <- renderPlotly({
req(input_Name()) # don't forget the parentheses!
p<-ggplot(finalDf(),aes(x=eventDate,y=individualCount)) +geom_point(alpha=0.2, shape=21, color="black",fill="red",size=5)+
labs( x = "Date Event",y= "Individual Count") +theme_bw()
p<-ggplotly(p)
p
})
}
EDIT
There is a problem in your code: your return statement of reactive(input$Name) is inside the reactive conductor finalDf.
Moreover you need to return finalDf as well, to use it outside the module.
So:
dataselect_server <- function(id) {
moduleServer(id, function(input, output, session) {
......
finalDf <- reactive({
if(input$Name=="choose"){
return(NULL)
}
if(input$Name==""){
return(NULL)
}
if(input$Nametype=="choose"){
return(NULL)
}
if(input$Nametype=="Name1") {
finalDf <- df[which(df$Name1==input$Name) ,]
} else if(input$Nametype=="Name2") {
finalDf <- df[which(df$Name2==input$Name) ,]
}
return(finalDf)
})
return(
list("finalDf" = finalDf, "input_Name" = reactive(input$Name))
)
})
}
and:
server <- function(session,input, output) {
module_outputs <- dataselect_server("dataselect")
input_Name <- module_outputs$input_Name
finalDf <- module_outputs$finalDf
# timeline plot
output$timeline <- renderPlotly({
req(input_Name()) # don't forget the parentheses!
p <- ggplot(finalDf(), aes(x = eventDate, y = individualCount))
+ geom_point(alpha = 0.2, shape = 21, color = "black", fill = "red", size = 5) +
labs(x = "Date Event", y = "Individual Count") + theme_bw()
ggplotly(p)
})
}
I'm trying to make an app which shows some data after the user clicks a point. It works, except that when the data is longer than the window the scrollbar shows up, resizing the plot and erasing the data. How to make the data show and stay?
Below the code of a minimal example.
library(shiny)
library(tidyr)
ui <- fluidPage(
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
np <- nearPoints(mtcars, input$plot_click) %>%
pull(gear)
mtcars %>%
filter(gear == np)
})
}
shinyApp(ui = ui, server = server)
The problem here is, that once the vertical scrollbar shows up the plotOutput is resized and therefore re-rendered, this results in input$plot_click being reset to NULL causing an empty table.
We can use req()'s cancelOutput parameter to avoid this behaviour.
Please see ?req:
cancelOutput: If TRUE and an output is being evaluated, stop processing as usual but instead of clearing the output, leave it in
whatever state it happens to be in.
library(shiny)
library(tidyr)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
req(input$plot_click, cancelOutput = TRUE)
np <- nearPoints(mtcars, input$plot_click) %>% pull(gear)
if(length(np) > 0){
mtcars %>% filter(gear == np)
} else {
NULL
}
})
}
shinyApp(ui = ui, server = server)
How can I get the x and y coordinates of an interactive map created with ggplot and plotly in R shiny? I want to get the x axis values and based on that display other data. Here is some dummy code.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("distPlot")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
gg1 = iris %>% ggplot(aes(x = Petal.Length, y = Petal.Width)) + geom_point()
ggplotly(gg1)
})
}
shinyApp(ui = ui, server = server)
Maybe this is what your are looking for. The plotly package offers a function event_data() to get e.g. the coordinates of click events inside of a shiny app. See here. If you have multiple plots you could use the source argument to set an id and to get the event data for a specific plot:
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
plotlyOutput("distPlot"),
verbatimTextOutput("info")
)
server <- function(input, output) {
output$distPlot <- renderPlotly({
gg1 = iris %>% ggplot(aes(x = Petal.Length, y = Petal.Width)) + geom_point()
ggplotly(gg1, source = "Plot1")
})
output$info <- renderPrint({
d <- event_data("plotly_click", source = "Plot1")
if (is.null(d)) {
"Click events appear here (double-click to clear)"
} else {
x <- round(d$x, 2)
y <- round(d$y, 2)
cat("[", x, ", ", y, "]", sep = "")
}
})
}
shinyApp(ui = ui, server = server)
This is my app code:
app.R
library(shiny)
source("func.R")
# create data
name <- c("Moller", "Mayer", "Bernard")
sales <- c(35000, 40000, 60000)
df <- data.frame(name, sales)
# app
server <- function(input, output, session) {
x <- callModule(testPlot, "test", data = reactive(df), xAxis = reactive("name"), yAxis = reactive("sales"))
}
ui <- fluidPage(
testPlotUI(id = "test", stringName = "test")
)
shinyApp(ui = ui, server = server)
And this is my module code:
func.R
library(shiny)
library(ggplot2)
testPlotUI <- function(id, stringName){
ns <- NS(id)
fluidRow(
column(12,
plotOutput(stringName)
)
)
}
testPlot <- function(data, xAxis, yAxis){
output$test <- renderPlot({
ggplot(data(), aes_string(x=xAxis(), y=yAxis())) + geom_bar(stat = "identity")
})
}
This code ends up with this error:
Error in module(childScope$input, childScope$output, childScope, ...)
: unused arguments (childScope$input, childScope$output,
childScope)
How can I make this work?
The reason you are getting that error is that it is essential that the first three arguments to the server part of the module be input, output and session. So you need to change:
testPlot <- function(data, xAxis, yAxis){
output$test <- renderPlot({
ggplot(data(), aes_string(x=xAxis(), y=yAxis())) + geom_bar(stat = "identity")
})
}
into:
testPlot <- function(input, output, session, data, xAxis, yAxis){
output$test <- renderPlot({
ggplot(data(), aes_string(x=xAxis(), y=yAxis())) + geom_bar(stat = "identity")
})
}
With that change alone, your code will now run without any errors. However, nothing will appear. That is because you forgot another key component of using modules, which is to wrap all input/output ids in the ns() function. So change:
column(12,
plotOutput(stringName)
)
into:
column(12,
plotOutput(ns(stringName))
)
Now you should see your plot appear with no problems.
Could anyone can tell me why I get an error when I change a dataset in first selectInput widget? When I change a dataset from diamonds to mtcars I get an error Could not find 'carat' in input$bins and in the plot just for one second and after that everything works fine. Why it happened?
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data,
diamonds = diamonds,
mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- data()
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1,
max = max_value,
value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(input$cols) & !is.null(input$bins)) {
basicData <- data()
var <- eval(input$cols)
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
Your respective output objects respond to any changes of your input variables. Thus, when you change your dataset via input$data, the plot rebuilds itself, although input$cols did not yet adjust. Actually, try inserting some print("a") inside the output$plot to see that it is called up to three times if you change input$data.
The fix is to rethink your reaction logic and let your elements respond only to specific changes, to get some kind of response "thread".
For example, input$data should only trigger output$server_cols. And output$server_bins should only be triggered by input$cols (because this already implies that input$data changed earlier). Ultimately, output$plot just has to listen to changes of input$bins (because changes in input$cols and input$data always result in changes of input$bins since it is at the end of the thread).
Here is my suggestion using isolate.
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- isolate(data())
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1, max = max_value, value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(isolate(input$cols)) & !is.null(input$bins)) {
basicData <- isolate(data())
var <- eval(isolate(input$cols))
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
You might also want to look into updateSelectInput and updateSliderInput if you want to alter Input Elements depending on other input.