I am currently trying to a shiny app that outputs the summary of a simple linear regression and a graph. For both scenarios I would like the user to select the independent and dependent variables from the columns of the table and use those same inputs to run the regression and graph. Right now I can't figure out how to pass the user selected input into plotly for a display. Can anyone assist, thanks in advance!
Here is the sample data:
AvgIR SumCount AvgLTV AvgGFEE AvgRTC Date
1: 0.04106781 180029 0.753180543134717 0.002424778 319.6837 2015-10-01
2: 0.04036154 160061 0.738038310394162 0.002722529 312.6314 2015-11-01
3: 0.04001407 145560 0.739287372904644 0.002425912 313.0351 2015-12-01
4: 0.04034078 147693 0.739693214979721 0.002600640 315.0238 2016-01-01
5: 0.04055688 142545 0.734515977410642 0.002449523 310.3950 2016-02-01
6: 0.04007467 176344 0.735780463185592 0.002459228 309.9615 2016-03-01
Here is the ui:
ui <- fluidPage(
headerPanel("Regression and Time Series Analysis"),
sidebarPanel(
p("Select a Dependent Variable"),
selectInput(inputId = "DepVar", label = "Dependent Variables", multiple = FALSE, choices = names(RegData2)),
p("Select input(s) for the Independent Variable(s)"),
selectInput(inputId = "IndVar", label = "Independent Variables", multiple = FALSE, choices = list( "SumCount", "AvgIR", "AvgLTV", "AvgGFEE", "AvgRTC", "Date"), selected = "AvgLTV"),
p("Summary of Regression"),
verbatimTextOutput(outputId = "RegSum")
),
mainPanel(
verbatimTextOutput(outputId = "IndPrint"),
verbatimTextOutput(outputId = "DepPrint"),
verbatimTextOutput(outputId = "test"),
verbatimTextOutput(outputId = "xaxis"),
verbatimTextOutput(outputId = "yaxis"),
tableOutput("table"),
plotlyOutput("graph")
)
)
Here is the server:
server <- function(input, output) {
lm1 <- reactive({lm(reformulate(input$IndVar, input$DepVar), data = RegData2)})
Ind <- reactive({input$IndVar})
Dep <- reactive({input$DepVar})
plotdata <- reactive({as.data.frame(RegData2[, c(which(names(RegData2) == Ind()), which(names(RegData2) == Dep())), with = FALSE])})
xaxis <- reactive({names(RegData2)[which(names(RegData2) == Ind())]})
yaxis <- reactive({names(RegData2)[which(names(RegData2) == Dep())]})
# xaxisN <- reactive({names(xaxis())})
# yaxisN <- reactive({names(yaxis())})
output$table <- renderTable({
x<-plotdata()
#RegData2[, c(which(names(RegData2) == Ind()), which(names(RegData2) == Dep())), with = FALSE]
})
output$graph <- renderPlotly({
#xaxis <- paste(input$IndVar)
#yaxis <- paste(input$DepVar)
#THIS ONE WORKS, but isn't reactive
#plot<-plot_ly(plotdata(), x = ~AvgLTV, y = ~AvgIR, mode = "markers", type = "scatter")
#THIS ONE DOESN'T WORK, is reactive
plot<-plot_ly(plotdata(), x = ~input$IndVar, y = ~input$DepVar, mode = "markers", type = "scatter")
})
output$IndPrint <- renderPrint({str(Ind())})
output$test <- renderPrint({str(plotdata())})
output$xaxis <- renderPrint({xaxis()})
output$yaxis <- renderPrint({yaxis()})
output$DepPrint <- renderPrint({input$DepVar})
output$RegSum <- renderPrint({summary(lm1())})
}
shinyApp(ui = ui, server = server)
I think the problem is you can't use variable selectors in plotly, like the aes_string function would do for you in ggplot2 - at least the way you tried.
There may be a way to pass character names in plotly, but the docs are really not great and I could find nothing.
However I did make this work - which could be acceptable.
put the plot dataframe into a local variable df.
created two new variables xx and yy with the variables to be plotted
overrode the xaxis and yaxis labels with the layout command.
This made output$graph look like this:
output$graph <- renderPlotly({
df <- plotdata()
df$xx <- df[[input$IndVar]]
df$yy <- df[[input$DepVar]]
plot<-plot_ly(df, x = ~xx, y = ~yy, mode = "markers", type = "scatter") %>%
layout( xaxis = list( title=input$IndVar),
yaxis = list( title=input$DepVar ) )
plot
})
Yielding:
Note: Here is how I reformatted and entered the data in case someone wants a repro - took about 5 minutes:
AvgIR <- c(0.04106781,0.04036154,0.04001407,0.04034078,0.04055688,0.04007467 )
SumCount <-c(180029 ,160061 ,145560 ,147693 ,142545 ,176344 )
AvgLTV <-c(0.753180543134717 ,0.738038310394162 ,0.739287372904644 ,0.739693214979721 ,0.734515977410642 ,0.735780463185592 )
AvgGFEE<-c(0.002424778 ,0.002722529 ,0.002425912 ,0.002600640 ,0.002449523 ,0.002459228 )
AvgRTC <-c(319.6837,312.6314 ,313.0351 ,315.0238 ,310.3950 ,309.9615 )
Date <- c("2015-10-01","2015-11-01","2015-12-01","2016-01-01","2016-02-01","2016-03-01")
RegData2 <- data.frame(AvgIR=AvgIR,SumCount=SumCount,AvgLTV=AvgLTV,AvgGFEE=AvgGFEE,AvgRTC=AvgRTC,Date=Date)
RegData2$Date <- as.POSIXct(RegData2$Date)
Related
I am struggling to find a way to add axis labels to this plotly graph. Since it's a bit different than when I've used plotly or even ggplot outside of apps, I can't seem to make it work. Any tips?
I would need the x and y axis labels to change with the widget on the right side of the code. I'm also not sure if the labels already show and its a matter of the graph being too large to show them.
library(shiny)
library(plotly)
library(tibble)
library(tidyverse)
library(tidyr)
library(readr)
library(dplyr)
library(ggplot2)
library(gapminder)
#read data
gm <- gapminder
# Define UI ----
ui <- fluidPage(
column(3,offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel('Graphs'),
mainPanel(
plotlyOutput('plot')
),
sidebarPanel(
#variable selection for x-axis
selectInput(inputId ='xvrbl', #The input slot that will be used to access the value.
label = 'X-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'CO2 emissions (metric tons per capita)'
),
checkboxInput(inputId = "LogX",
label = "Log Transform",
value = FALSE),
#variable selection for y-axis
selectInput(inputId ='yvrbl', #The input slot that will be used to access the value.
label = 'Y-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'gdpPercap'
),
checkboxInput(inputId = "LogY",
label = "Log Transform",
value = FALSE),
# date range - slider
sliderInput(
inputId = "time",
label = "Years",
min = min(gm$year),
max = max(gm$year),
step = 5,
value = range(gm$year)
)
)
)
server <- function(input, output) {
x <- reactive({
x <- dat()[[input$xvrbl]]
if (input$LogX) x <- log(x)
return(x)
})
y <- reactive({
y <- dat()[[input$yvrbl]]
if (input$LogY) y <- log(y)
return(y)
})
dat <- reactive({
subset(gm, year >= input$time[[1]], year <= input$time[[2]])
})
output$plot <- renderPlotly({
plot_ly(
x = x(),
y = y(),
type = "scatter",
mode = "markers",
color = dat()$continent
)
})
}
# Run the app
shinyApp(ui = ui, server = server)
You should specify the layout parameter to renderPlotly:
output$plot <- renderPlotly({
plot_ly(
x = ~x(),
y = ~y(),
type = "scatter",
mode = "markers",
color = dat()$continent) %>%
layout(
yaxis = list(title = input$yvrbl),
xaxis = list(title = input$xvrbl)
)
})
I am struggling with getting the code to work for this log widget I want to add to my interactive plot in shiny. I am able to modify the graphs x and y axis to a log scale by adding log(dat()[[input$yvrbl]]) to the server coder
server <- function(input, output) {
x <- reactive({
log(dat()[[input$yvrbl]])
})
y <- reactive({
log(dat()[[input$yvrbl]])
})
I was able to create the widgets on the ui code as well. I am still unable to transform the data to the log version based on whether or not the widget is checked. I tried making a separate reactive expression to host the changed log version of the x and y axis depending on an if statement. Please let me know what else I can do.
library(shiny)
library(plotly)
library(tibble)
library(tidyverse)
library(tidyr)
library(readr)
library(dplyr)
library(ggplot2)
# set working directory
setwd("~/BDSWD")
#read data
gm <- read_csv("gapminder_clean.csv")
# Define UI ----
ui <- fluidPage(
column(3,offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel('Graphs'),
mainPanel(
plotlyOutput('plot')
),
sidebarPanel(
#variable selection for x-axis
selectInput(inputId ='xvrbl', #The input slot that will be used to access the value.
label = 'X-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'CO2 emissions (metric tons per capita)'
),
checkboxInput(inputId = "LogX",
label = "Log Transform",
value = FALSE),
#variable selection for y-axis
selectInput(inputId ='yvrbl', #The input slot that will be used to access the value.
label = 'Y-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'gdpPercap'
),
checkboxInput(inputId = "LogY",
label = "Log Transform",
value = FALSE),
#date range - slider
sliderInput(inputId = "time",
label = "Years",
min = min(gm$Year),
max = max(gm$Year),
step = 5,
value = c(min(gm$Year),max(gm$Year)))
)
)
server <- function(input, output) {
x <- reactive({
dat()[[input$xvrbl]]
})
y <- reactive({
dat()[[input$yvrbl]]
})
dat <- reactive({
subset(gm, Year %in% input$time)
})
lgrthmc <- reactive({
if(isTRUE(input$LogY)) {
y <- reactive({
log(dat()[[input$yvrbl]])
})
} else {}
if(isTRUE(input$LogX)) {
x <- reactive({
log(dat()[[input$xvrbl]])
})
} else {}
})
output$plot <- renderPlotly({
plot_ly(
x = x(),
y = y(),
type = "scatter",
mode = "markers",
color = dat()$continent
) %>%
layout(
title = 'Gapminder Dataset',
plot_bgcolor = "#e5ecf6",
xaxis = list(title = input$xvrbl),
yaxis = list(title = input$yvrbl),
legend = list(title=list(text='<b> Continent </b>'))
)
})
}
# Run the app
shinyApp(ui = ui, server = server)
Instead of wrapping reactives inside a reactive you could achieve your desired result by adding an if inside your reactives, e.g.
Note: I slightly adjusted the subsetting of your data to take the sliderInput into account.
x <- reactive({
x <- dat()[[input$xvrbl]]
if (input$LogX) x <- log(x)
return(x)
})
library(gapminder)
library(shiny)
library(plotly)
library(tidyverse)
gm <- gapminder |> rename(Year = year)
# Define UI ----
ui <- fluidPage(
column(3, offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel("Graphs"),
mainPanel(
plotlyOutput("plot")
),
sidebarPanel(
# variable selection for x-axis
selectInput(
inputId = "xvrbl", # The input slot that will be used to access the value.
label = "X-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "lifeExp"
),
checkboxInput(inputId = "LogX",
label = "Log Transform",
value = FALSE),
# variable selection for y-axis
selectInput(
inputId = "yvrbl", # The input slot that will be used to access the value.
label = "Y-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "gdpPercap"
),
checkboxInput(
inputId = "LogY",
label = "Log Transform",
value = FALSE
),
# date range - slider
sliderInput(
inputId = "time",
label = "Years",
min = min(gm$Year),
max = max(gm$Year),
step = 5,
value = range(gm$Year)
)
)
)
server <- function(input, output) {
x <- reactive({
x <- dat()[[input$xvrbl]]
if (input$LogX) x <- log(x)
return(x)
})
y <- reactive({
y <- dat()[[input$yvrbl]]
if (input$LogY) y <- log(y)
return(y)
})
dat <- reactive({
subset(gm, Year >= input$time[[1]], Year <= input$time[[2]])
})
output$plot <- renderPlotly({
plot_ly(
x = x(),
y = y(),
type = "scatter",
mode = "markers",
color = dat()$continent
)
})
}
# Run the app
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:6593
This shiny app has some radio buttons to see whether the plotly object needs to have a log scale. The textOutput verifies that the reactive function is following the changes in the input, yet the layout does not change.
Could anyone help?
library(tidyverse)
library(plotly)
c1 <- c(1,2,3,4,5)
c2 <- c(6,3,4,6,5)
c3 <- c(1,2,3,4,5)
df<- data.frame(c1,c2,c3)
cols <- names(df)
ui <- fluidPage(
titlePanel("Log Test"),
sidebarLayout(
sidebarPanel(
selectInput("x",
"x-axis",
cols),
selectInput("y",
"y-axis",
cols),
radioButtons("rb", "Log Axis", choiceNames = list("X", "Y", "Both", "None"), choiceValues = list("X", "Y", "Both", "None"))
),
mainPanel(
plotlyOutput("plot"),
textOutput("note")
)
)
)
server <- function(input, output, session) {
x <- reactive({
df[,input$x]
})
y <- reactive({
df[,input$y]
})
logsc <- reactive({
if (input$rb=='X'){
list('log','linear')
}else if (input$rb=='Y'){
list('linear','log')
}else if (input$rb=='Both'){
list('log','log')
}else{
list('linear','linear')
}
})
output$plot <- renderPlotly(
{
plot1 <- plot_ly(
x = x(),
y = y(),
type = 'scatter',
mode = 'markers',
)
plot1 <- layout(plot1, xaxis = list(type = logsc()[1], ticks ='inside'),yaxis = list(type = logsc()[2], ticks = 'inside'))
plot1
}
)
output$note <- renderText({
paste0("rb ", logsc()[1],"-", logsc()[2])
})
}
shinyApp(ui = ui, server = server)
As you checked it, reactive works fine. Your issue is with logsc() value (of type list) and being subset with single bracket (like a vector).
Single bracket subsetting of a list returns a list containing one item:
> list(1,2,3)[2]
[[1]]
[1] 2
Double bracket subsetting of a list returns a single item of the list
> list(1,2,3)[[2]]
[1] 2
You have been fooled by paste that unlisted you list
To fix your code you can write the call to layout() this way:
plot1 <- layout(plot1,
xaxis = list(type = logsc()[[1]],
ticks ='inside'),
yaxis = list(type = logsc()[[2]],
ticks = 'inside'))
I'd like to include the reactive outputs of two data sets as different geom_lines in the same ggplotly figure. The code runs as expected when only one reactive data.frame is included as a geom_line. Why not two?
ui <- fluidPage(
sidebarLayout(
selectInput("Var1",
label = "Variable", #DATA CHOICE 1
selected = 10,
choices = c(10:100)),
selectInput("Var1",
label = "Variable2", #DATA CHOICE 2
selected = 10,
choices = c(10:100))
# Show a plot of the generated distribution
),
mainPanel(
plotlyOutput('plot') #Draw figure
)
)
server <- function(input, output) {
out <- reactive({
data.frame(x = rnorm(input$Var1), #Build data set 1
y = 1:input$Var1)
})
out2 <- reactive({
data.frame(x = rnorm(input$Var2), #Build data set 2
y = 1:input$Var2)
})
output$plot <- renderPlotly({
p <- ggplot() +
geom_line(data = out(), aes(x = x, y = y)) #Add both data sets in one ggplot
geom_line(data = out2(), aes(x = x, y = y), color = "red")
ggplotly(p)
})
}
# Run the application
shinyApp(ui = ui, server = server)
When you put the data into long format and give each group a group identifier it seems to work. Note that you should be able to change sliderInput back to selectInput - this was one of the entries I toggled during testing, but the choice of UI widget should not matter.
This works -- code can be simplified inside the reactive from here:
library(plotly)
ui <- fluidPage(
sidebarLayout(
sliderInput("Var1",
label = "Variable", #DATA CHOICE 1
min=10, max=100, value=10),
sliderInput("Var2",
label = "Variable2", #DATA CHOICE 2
min=10, max=100, value=10),
),
mainPanel(
plotlyOutput('plot') #Draw figure
)
)
server <- function(input, output) {
out <- reactive({
x1 <- rnorm(input$Var1)
y1 <- seq(1:input$Var1)
x2 <- rnorm(input$Var2)
y2 <- seq(1:input$Var2)
xx <- c(x1,x2)
yy <- c(y1,y2)
gg <- c( rep(1,length(y1)), rep(2,length(y2)) )
df <- data.frame(cbind(xx,yy,gg))
df
})
output$plot <- renderPlotly({
p <- ggplot() +
geom_line(data=out(), aes(x = xx, y = yy, group=gg, colour=gg))
ggplotly(p)
})
}
shinyApp(ui = ui, server = server)
I've been working on a visualization project in shiny. I'm trying to filter a data set by given input - number of state and range of the slider. Unfortunately, r 'omits' the the code part and outputs the entire data set. I also get warnings: 'data' is not a graphical parameter.
library(shiny)
library(Ecdat)
u <- shinyUI(pageWithSidebar(
headerPanel("Social benefits"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Unemployment",
"Max benefit"
)),
#Specification of state
textInput("state", "State:", value = "93"),
# Specification of range within an interval
sliderInput("range", "Range:",
min = 1, max = 100, value = c(20,100))
),
mainPanel(
plotOutput("mpgPlot")
)
))
s <- shinyServer(function(input, output)
{
#filter by state -ERROR
p <- reactive({ Benefits[Benefits$state == input$state,]})
#filter by slider range - ERROR
dataX <- reactive({ p()[input$range[1]:input$range[2],,drop = FALSE] })
variable <- reactive({
switch(input$variable,
"Unemployment" = stateur,
"Max benefit" = statemb
)
})
caption <- reactive({
paste(input$variable)
})
output$mpgPlot <- renderPlot({
plot(variable(), data = dataX(), type = "l",ylab = caption())
})
})
shinyApp(u,s)
All that was actually needed was to specify the data set name before the variable, since the data set from the environment was overshadowing the filtered one.
output$urPlot <- renderPlot({
plot(dataX()$stateur, data = dataX(), type = "l",ylab = "Unemployment")
})
output$mbPlot <- renderPlot({
plot(dataX()$statemb, data = dataX(), type = "l",ylab = "Max benefit")
})