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

Question

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)

Answer 1

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