Using Reactive to trigger log scale in shiny/plotly - r

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'))

Related

how to add reactive x and y axis labels to shiny plotly graph?

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)
)
})

how to add a logarithmic widget to plotly scatter plot in shiny?

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

How to retain the curves after plotting in R Shiny?

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
})
}

Select which plot to display in a shiny app based on user choice

I have a shiny app which generates 2 plots and one table. As you will see I want to select which one of them will be displayed every time based on the radiobuttons() input. Until now I get an error object of type 'closure' is not subsettable Which object exactly is of type closure? Note that the first is a ggplot object the second is a plotly object and the third a datatable.
# ui.R
library(shiny)
library(plotly)
pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
uiOutput("filter_degree")
),
mainPanel(
uiOutput('plot')
)
)
#server.r
function(input, output, session) {
output$filter_degree<-renderUI({
radioButtons("rd","Select Option",choices = c("Mileage","Regression",'Table'),
selected = "Mileage")
})
output$plot <- renderUI({
if(input$rd=="Mileage"){
output$plot1<-renderUI({
# Boxplots of mpg by number of gears
# observations (points) are overlayed and jittered
qplot(gear, mpg, data=mtcars, geom=c("boxplot", "jitter"),
fill=gear, main="Mileage by Gear Number",
xlab="", ylab="Miles per Gallon")
})
}
else if(input$rd=="Regression"){
output$plot2<-renderUI({
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
p <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines')
})
}
else if(input$rd=="Table"){
output$tbl = DT::renderDataTable(datatable(
iris, options = list(lengthChange = FALSE,scrollY = T, scroller = TRUE, scrollX = T),selection = list(target="cell",mode="single"),rownames = F)
)
}
})
}
You need to provide the plot/table output as part of the if/then sequence (plotOutput("plot1"), etc.). Otherwise, it has nothing to render. Also, there appears to be an error in the ploty call, but I haven't fixed it for you.
library(shiny)
library(DT)
library(plotly)
ui <- pageWithSidebar(
headerPanel('Iris k-means clustering'),
sidebarPanel(
uiOutput("filter_degree")
),
mainPanel(
uiOutput('plot')
)
)
#server.r
server <- function(input, output, session) {
output$filter_degree<-renderUI({
radioButtons("rd","Select Option",choices = c("Mileage","Regression",'Table'),
selected = "Mileage")
})
output$plot <- renderUI({
if(input$rd=="Mileage"){
output$plot1<-renderPlot({
# Boxplots of mpg by number of gears
# observations (points) are overlayed and jittered
qplot(gear, mpg, data=mtcars, geom=c("boxplot", "jitter"),
fill=gear, main="Mileage by Gear Number",
xlab="", ylab="Miles per Gallon")
})
plotOutput("plot1")
}
else if(input$rd=="Regression"){
output$plot2<-renderUI({
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
p <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines')
})
plotlyOutput("plot2")
}
else if(input$rd=="Table"){
output$tbl = DT::renderDataTable(datatable(
iris, options = list(lengthChange = FALSE,scrollY = T, scroller = TRUE, scrollX = T),selection = list(target="cell",mode="single"),rownames = F)
)
dataTableOutput("tbl")
}
})
}
shinyApp(ui = ui, server = server)

Passing Reactive Input into axis of a plotyly chart in R Shiny

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)

Resources