I am having issues to be able to subset dynamically a dataframe by the column selected in a dropdown menu. Basically, I want to allow the user to decide which one is going to be the column to be on the y axis.
File global.R:
library(shiny)
library(plotly)
# Cars
data("USArrests")
USArrests$state <- row.names(USArrests)
File ui.R:
ui <- fluidPage(
fluidRow(
selectInput(inputId = "select_col",
label = tags$h4("Select Column"),
choices = c("Murder", "Assault", "UrbanPop", "Rape"),
selected = "Murder"
),
plotlyOutput("plot")
)
)
File server.R:
server <- function(input, output) {
output$plot <- renderPlotly({
plot_ly(USArrests,
x = ~state,
y = ~input$select_col, # this works but is not reactive y = ~Murder
type = 'bar')
})
}
Here on this last file is the problem that I am having. It is not accepting as a valid input the value from the select_col dropdown menu (y = ~input$select_col).
Bad Solution:
I have come up with this solution, bad I do not like it. It is too verbose. There is a more efficient way to do it?
Corrected server.R:
server <- function(input, output) {
output$plot <- renderPlotly({
df <- USArrests[c('state', input$select_col)]
names(df) <- c('state', 'to_y')
plot_ly(df,
x = ~state,
y = ~to_y,
type = 'bar')
})
}
One option is to generate the formula programmatically:
server <- function(input, output) {
output$plot <- renderPlotly({
plot_ly(USArrests,
x = ~state,
y = formula(paste("~", input$select_col)),
type = 'bar')
})
}
Related
I have the following code, which produces a plot based on the user inputs. if, for example, the user selects three x variables, three plots shall be produced in the output. However, at the moment, only the plot relevant to the last selection is only produced.
library(dplyr)
library(ggplot2)
library(shiny)
plt_func <- function(x,y){
plt_list <- list()
for (X_var in x){
plt_list[[X_var]] <- mtcars %>% ggplot(aes(get(X_var), get(y)))+
geom_point() +
labs(x = X_var, y = y)
}
return(plt_list)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
selectInput(inputId = "y",label = "Y", choices = names(mtcars),multiple = F),
actionButton("plot", label = "Plot")),
mainPanel(
plotOutput("finalplot")
)
)
)
server <- function(input, output, session) {
plt <- eventReactive(input$plot, {
req(input$x, input$y)
x <- input$x
y <- input$y
do.call(plt_func, list(x,y))
})
output$finalplot <- renderPlot({
plt()
})
}
shinyApp(ui, server)
Here is a screenshot of the output:
I wonder how I should tackle this issue.
To me, the easiest way to solve this problem is to create a module that will manage a single plot and then create the required number of instances of the module in the main server function. You can read more about Shiny modules here.
A Shiny module consists of two functions, a UI function and a server function. These are paired by the fact that they share a common ID. The ID is used to distinguish different instances of the same module. Namespacing (the ns function) is used to distinguish instances of the same widget in different instances of the module.
The module UI function is straightforward. It simply creates a plotOutput:
plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
The module server function takes three parameters: an id and the names of the x and y variables to plot.
plotServer <- function(id, Xvar, Yvar) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot({
req(Xvar)
mtcars %>%
ggplot(aes(get(Xvar), get(Yvar))) +
geom_point() +
labs(x = Xvar, y = Yvar)
})
}
)
}
The main UI function creates the sidebar menu (there's no need for a Plot actionButton as Shiny's reactivity makes sure everything gets updated at the correct time) and a main panel that consists only of a uiOutput.
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
selectInput(inputId = "y",label = "Y", choices = names(mtcars), multiple = F)
),
mainPanel(
uiOutput("plotUI")
)
)
)
The main server function is where the magic happens. Every time there's a change to input$x or input$y, new instances of the module UI and server functions are created. One for each selection in input$x. The id for each module is simply an integer. The appropriate column names are passed to each instance of the module server function. A call to renderUI creates the UI for each instance of the module.
server <- function(input, output, session) {
output$plotUI <- renderUI({
ns <- session$ns
tagList(
lapply(1:length(input$x),
function(i) {
plotUI(paste0("plot", i))
}
)
)
})
observeEvent(c(input$x, input$y), {
plotServerList <- lapply(
1:length(input$x),
function(i) {
plotServer(paste0("plot", i), input$x[i], input$y)
}
)
})
}
Putting it all together:
library(dplyr)
library(ggplot2)
library(shiny)
# Plot module UI function
plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
# Plot module server function
plotServer <- function(id, Xvar, Yvar) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot({
req(Xvar)
mtcars %>%
ggplot(aes(get(Xvar), get(Yvar))) +
geom_point() +
labs(x = Xvar, y = Yvar)
})
}
)
}
# Main UI
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "x",label = "X", choices = names(mtcars), multiple = T),
selectInput(inputId = "y",label = "Y", choices = names(mtcars), multiple = F)
),
mainPanel(
uiOutput("plotUI")
)
)
)
# Main server
server <- function(input, output, session) {
output$plotUI <- renderUI({
ns <- session$ns
tagList(
lapply(1:length(input$x),
function(i) {
plotUI(paste0("plot", i))
}
)
)
})
observeEvent(c(input$x, input$y), {
plotServerList <- lapply(
1:length(input$x),
function(i) {
plotServer(paste0("plot", i), input$x[i], input$y)
}
)
})
}
shinyApp(ui, server)
I am developing a shiny app for regression analysis. I get an error when I want to change some variables to factor using the factor() function.
I want the user to select the variables he\she wants to change to factor from a selectInoput() and use a reactive function to feed the results to a new dataframe but the result is very weird! :(
I put a simplified version of what I do here.
Spent a day and could find the solution. Would appreciate your help.
x <- c( 1:5 )
y <- c( 10:14)
df <- data.frame(
x = x,
y = y
)
library(shiny)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "str", label = "which variables should be changed to factors",choices = names(df), multiple = T)
),
mainPanel(
verbatimTextOutput("output")
)
)
)
server <- function(input, output) {
df_2 <- reactive({
df[ , input$str ] <- factor(df[ , input$str ])
})
output$output <- renderPrint({
str( df_2() )
})
}
shinyApp(ui = ui, server = server)
Your code only needs minor modification in server.
x <- c( 1:5 )
y <- c( 10:14)
df <- data.frame(
x = x,
y = y
)
library(shiny)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "vars", label = "which variables should be changed to factors",choices = names(df), multiple = T)
),
mainPanel(
verbatimTextOutput("output")
)
)
)
server <- function(input, output) {
selected_vars <- reactive(input$vars)
df_2 <- reactive({
df[selected_vars()] <- lapply(df[selected_vars()], as.factor)
return(df)
})
output$output <- renderPrint({
str(df_2())
})
}
shinyApp(ui = ui, server = server)
I am building a Shiny app, where the user can add different curves to the plot, but I can't make the plot to retain the already added curves. How can I make that happen?
In the simplified reproducible code below are altogether 8 curve possibilities, based on 3 radiobuttons selections which have 2 options each. I would like to keep these as radiobuttons and not use checkboxes, as in my real app that I am working on there will be about 300 combinations that would be too confusing to use with checkboxes. Please see the code below:
library(shiny)
library(plotly)
library(dplyr)
data111 <-data.frame("x"=1:10, "y"=c(99,98,97,96,95,94,93,92,91,90))
data112 <-data.frame("x"=5:14, "y"=c(79,78,77,76,75,74,73,72,71,70))
data121 <-data.frame("x"=9:18, "y"=c(59,58,57,56,55,54,53,52,51,50))
data122 <-data.frame("x"=3:12, "y"=c(49,48,47,46,45,44,43,42,41,40))
data211 <-data.frame("x"=7:16, "y"=c(29,28,27,26,25,24,23,22,21,20))
data212 <-data.frame("x"=11:20, "y"=c(19,18,17,16,15,14,13,12,11,10))
data221 <-data.frame("x"=2:11, "y"=c(95,94,93,92,91,90,89,88,87,86))
data222 <-data.frame("x"=1:10, "y"=c(45,44,43,42,41,40,39,38,37,36))
ui <- fluidPage(
titlePanel("Curve selection"),
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "option",
label="Choose the option",
choices=c("option1"=1,
"option2"=2),
selected = 1),
radioButtons(inputId = "type",
label="Choose the type",
choices=c("type1"=1,
"type2"=2),
selected = 1),
radioButtons(inputId = "group",
label="Choose the group",
choices=c("group1"=1,
"group2"=2),
selected = 1),
actionButton("add","Add curve to the plot")
),
mainPanel(
plotlyOutput("plot")
)
)
)
server <- function(input, output) {
data <- eventReactive(input$add,{
get(paste0("data",input$option,input$type, input$group))
})
output$plot <- renderPlotly({
data <- data()
p <-plot_ly(type = "scatter", mode="lines")
p<-add_data(p, data) %>% add_trace(p, x= ~x, y = ~y)
p
})
}
shinyApp(ui = ui, server = server)
I expect that the user can choose the option, type and group in the radiobutton selections, then add the curve. After that, make a new selection of option, type and group and add the new curve to the already existing one in the plot. The user should be able to do this several times. Do you know how this can be achived?
Thanks!
You will have to use a reactiveValues object, in which you save already added traces.
Then you can use add_trace with a for loop for example:
I changed your eventReactive to an observeEvent, which appends the new data to the reactiveValues list.
To prevent plotting the same object twice, I created a reactiveValues usedData object, which will save the plot legend names. If the name is already at hand, nothing will be added to the plot.
server <- function(input, output) {
d <- reactiveValues(a=NULL, name=NULL)
usedData <- reactiveValues(d = NULL)
data <- observeEvent(input$add,{
src = paste0("data",input$option,input$type, input$group)
var <- get(src)
if (src %in% usedData$d) {
print("Data is already plotted")
req(F)
}
if (is.null(d$a)) {
d$a <- list(var)
d$name = list(src)
usedData$d <- src
} else {
d$a <- append(d$a, list(var))
d$name = append(d$name, list(src))
usedData$d <- append(usedData$d, src)
}
})
output$plot <- renderPlotly({
req(d$a)
data <- d$a
names = d$name
p <- plot_ly(data = data[[1]], type = "scatter", mode="lines")
if (length(data) == 1) {
p <- add_trace(p, x= ~x, y = ~y, name = names)
} else {
for (i in 1:length(data)) {
d <- data[[i]]
p <- add_trace(p, data = d, x= ~x, y = ~y, type = "scatter", mode="lines", name = names[[i]])
}
}
p
})
}
I've put together this Shiny app from tutorial and examples, and I've become stuck. My aim is to make the plot reactive, so that the data points in 'uval$df' are plotted, meaning that selected points will be removed from the graph, and it can't be selected twice. How do I do this? (I've got a feeling it's something lacking in my basic understanding)
Thanks!
library(shiny)
library(plotly)
library(dplyr)
ui <- fluidPage(
fluidRow(
column(12,plotlyOutput("plot"),
verbatimTextOutput("txtout1"),
verbatimTextOutput("txtout2"),
verbatimTextOutput("txtout3"))
)
)
server <- function(input, output, session) {
x<-c(1,2,34,2,1,23,24)
y<-c(10,20,30,40,50,60,70)
df<-data.frame(x,y)
vector.is.empty <- function(x) return(length(x) ==0 )
K <-reactive({
event_data("plotly_selected",source = "B")
})
M<-reactive({
K()[,c("x","y")]
})
values <- reactiveValues()
values$df <- data.frame(x = numeric(0), y = numeric(0))
newEntry <- observeEvent(K(),priority = 1,{
new0 <- isolate(M())
isolate(values$df <- rbind(values$df, new0))
})
uval <- reactiveValues()
uval$df <- df
newEntry1 <- observeEvent({values$df},priority = 2,{
new1 <- isolate(data.frame(values$df))
isolate(uval$df <- setdiff(df,new1))
})
output$plot <- renderPlotly({
plot_ly(x = df$x, y = df$y, mode = "markers",source="B") %>%
layout(dragmode = "select", title = "Original Plot", font=list(size=10))
})
output$txtout1 <- renderPrint({
if(vector.is.empty(K())) "Click and drag across points" else M()
})
output$txtout2 <- renderPrint({
uval$df
})
output$txtout3 <- renderPrint({
values$df
})
}
shinyApp(ui, server, options = list(display.mode = "showcase"))
Simple, as I thought.
plot_ly(uval$df, x = x, y = y, mode = "markers",source="B")
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.