Change labels in R shiny/ggvis plot - r

I need to have with ggvis in shiny the labels= axis feature.
In R the labels axis argument allow to change the x labels (adding a Kb format), that keep the order and the relative distance between items:
mtcars <- mtcars[1:10, ]
my_data <- mtcars[order(mtcars$disp),]
xpos <- sort(mtcars$disp)
plot(my_data$disp, my_data$mpg, type = "l", xaxt="n")
axis(1, at=xpos, labels=sprintf("%.2fKb", xpos/10))
With this we get what we need:
Now we try to get the exact same on shiny with ggvis:
library(shiny)
library(ggvis)
mtcars
ui <- pageWithSidebar( div(),
sidebarPanel(uiOutput("plot_ui"),width=2),
mainPanel(ggvisOutput("plot"))
)
server <- function(input, output, session) {
mtc <- reactive({
my_data <- mtcars[1:10, ]
# Do some sorting/ordering if you want (here sorted by disp)
my_data <- my_data[order(my_data$disp), ]
my_labels <- c(as.character(paste0((my_data$disp)/1000, "Kb")))
y <- my_data$mpg
x <- factor(c(my_data$disp), labels = c(unique(my_labels)))
data.frame(x = x, y = y)
})
mtc %>%
ggvis(~x,~y ) %>%
layer_lines() %>%
add_axis("x", properties=axis_props(labels=list(fontSize = 10))) %>%
bind_shiny("plot", "plot_ui")
}
shinyApp(ui = ui, server = server)
As we highlight in red, the distances are not correct. So how can we have on shiny the same plot we have on plain R with axis(label=... ?

Ok, I fiddled around with it and you have to convert your x-axis into a factor first. I've added some sorting to the dataframe as you probably want these to be in order also (you can easily remove it otherwise). You can put labels on the axis yourself. Let me know if you have any questions. Also I changed the data on the x-axis to display mtcars$disp as it has values in 100s
rm(list = ls())
library(shiny)
library(ggvis)
mtcars
ui <- pageWithSidebar(
div(),
sidebarPanel(
sliderInput("n", "Number of points", min = 1, max = nrow(mtcars),value = 10, step = 1),
uiOutput("plot_ui"),width=2),
mainPanel(ggvisOutput("plot"))
)
server <- function(input, output, session) {
mtc <- reactive({
my_data <- mtcars[1:input$n, ]
# Do some sorting/ordering if you want (here sorted by disp)
my_data <- my_data[order(my_data$disp),]
my_labels <- c(as.character(paste0((my_data$disp)/1000,"Kb")))
y <- my_data$mpg
x <- factor(c(my_data$disp), labels=c(unique(my_labels)))
data.frame(x = x, y = y)
})
mtc %>%
ggvis(~x,~y ) %>%
layer_lines() %>%
add_axis("x", properties=axis_props(labels=list(fontSize = 10))) %>%
bind_shiny("plot", "plot_ui")
}
shinyApp(ui = ui, server = server)
Updated Output

Related

In Shiny/R how to control number of Ggplots charts displayed with SliderInput

I need to control the number of chart using a slideInput.
I have a list with ggplot charts. Once my slider came from 1 to 2 it will display the first 2 charts of this list. If the slider range is from 1:3 it will display the first 3 charts from this list chart.
This is what Ive done so far:
library(shiny)
library(gapminder)
library(highcharter)
df <- gapminder %>% group_split(country)
countries <- df[1:10] %>% set_names(1:10)
ggplots_list <- countries %>% map(~ .x %>% ggplot(aes(x = year, y = pop)) + geom_line())
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "slider_new",
label = "Projections Range",
width = '100%',
min = 1, max = 10,
value = 1
) ,
plotOutput('chart_1', height = '500px')
)
server <- function(input, output, session) {
output$chart_1 <- renderPlot({
ggplots_list[input$slider_new[1]]
})
}
shinyApp(ui, server)
The idea is to have a grid of charts as I increase the slider value.
Any help?
Try this
library(gapminder)
library(highcharter)
library(purrr)
df <- gapminder %>% group_split(country)
countries <- df[1:10] %>% set_names(1:10)
ggplots_list <- countries %>% map(~ .x %>% ggplot(aes(x = year, y = pop)) + geom_line())
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "slider_new",
label = "Projections Range",
width = '100%',
min = 1, max = 10,
value = 1
) ,
uiOutput("chart_1")
)
server <- function(input, output, session) {
lapply(1:10, function(i){
output[[paste0("plots",i)]] <- renderPlot({ ggplots_list[i] })
})
output$chart_1 <- renderUI({
n <- input$slider_new
lapply(1:n, function(i) plotOutput(paste0("plots",i), height=500))
})
}
shinyApp(ui, server)

Is there a way to define X in sparkline lines, so that the tooltip describes both axes?

I want to add more detail to the sparkline tooltips.
How do I tell the sparkline what to use for x?
If I add any other variables to the spk_chr(c(Sepal.Length))it just appends them to y.
I want the tooltip to say "Sepal.Width: Sepal.Length" e.g. "3.3: 6.5". Currently, it is just showing position within the group.
(In my actual app I'm creating a time series so X would be a date)
library(shiny)
library(dplyr)
library(sparkline)
library(DT)
ui <- fluidPage(
htmlwidgets::getDependency('sparkline'),
dataTableOutput("table")
)
server <- function(input, output) {
cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}')
mydata <- iris %>%
group_by(Species) %>%
arrange(Sepal.Width) %>%
summarise(
"Sepal Length" = spk_chr(
c(Sepal.Length),
tooltipFormat = '{{x}}: {{y}}'
))
output$table <- renderDataTable({
datatable(
data = mydata,
escape = FALSE,
options = list(drawCallback = cb)
)
})
}
shinyApp(ui = ui, server = server)
I worked it out. Annoyingly simple.
Add xvalues = Sepal.Width into spk_chr() This causes some issues with grouping using this example data set, but when the x values are all unique it works.
mydata <- iris %>%
group_by(Species) %>%
arrange(Sepal.Width) %>%
summarise(
"Sepal Length" = spk_chr(
c(Sepal.Length),
xvalues = Sepal.Width,
tooltipFormat = '{{x}}: {{y}}'
))

Slider with years for barplot

I am trying to get a slider within my barplot page to make the data interactive per year.
#library
library(dplyr)
library(shiny)
library(shinythemes)
library(ggplot2)
#Source
dataset <- read.csv("Wagegap.csv")
SFWage <- dataset %>%
group_by(gender,JobTitle, Year) %>%
summarise(averageBasePay = mean(BasePay, na.rm=TRUE)) %>%
select(gender, JobTitle, averageBasePay, Year)
clean <- SFWage %>% filter(gender != "")
#UI
ui <- fluidPage(
theme = shinytheme("united"),
navbarPage("San Fransisco Wages",
tabPanel("Barplot",
mainPanel(
plotOutput("barplot")
)) ,
tabPanel("Table",
mainPanel(
dataTableOutput("table")
))
)
)
#server
server <- function(input, output){
output$barplot <- renderPlot({
ggplot(clean, aes(x = JobTitle, y = averageBasePay ))+
geom_bar(stat="Identity", width = 0.3, fill="orange")+
labs(x= "Jobs", y = "Wage", title = "Wage per job")
})
output$table <- renderDataTable({
clean
})
}
#Run App
shinyApp(ui = ui, server = server)
I don't fully understand it yet how to put this input in.
I have tried sliding it into the navbarpage but I can't figure out how it works.
I also tried making year reactive but with no success.
It's not the year that has to be reactive; it's the whole data frame. Therefore, in your ui, you can do:
[...]
tabPanel("Barplot",
mainPanel(
sliderInput("year", label = "Which year should be displayed?", min = 1900, max = 2020, step = 5, value = 2000) # new
plotOutput("barplot")
)) ,
[...]
I put it there for convenience; the layout is yours. I tried do change as little as possible.
The server would then have:
server <- function(input, output){
# NEW ########################################
clean <- reactive({
SFWage <- dataset %>%
group_by(gender,JobTitle, Year) %>%
summarise(averageBasePay = mean(as.numeric(BasePay), na.rm=TRUE)) %>% # Notice the as.numeric()
select(gender, JobTitle, averageBasePay, Year)
SFWage %>% filter(gender != "" & Year == input$year)
})
# OLD ########################################
output$barplot <- renderPlot({
ggplot(clean(), aes(x = JobTitle, y = averageBasePay ))+ # Parenthesis
geom_bar(stat="Identity", width = 0.3, fill="orange")+
labs(x= "Jobs", y = "Wage", title = "Wage per job")
})
output$table <- renderDataTable({
clean() # Parenthesis
})
}
Don't forget to add the parenthesis, as I did here.
This should work, but I might have mistyped something or got it completely wrong. Since I don't have your data, I can't test it.
EDIT: Due to your comment, I added the as.numeric() term, as you can see above. However, if your data is not only not numeric but also with ,, you can do:
[...]
summarise(averageBasePay = mean(as.numeric(gsub(",", ".", BasePay)), na.rm=TRUE)) %>% # Notice the as.numeric() and the gsub()
[...]

alignment of ggplots in a modularized shiny app

I have a modularized shiny app that displays in real time 4 variables. The monitor module takes as an input one big data frame, and displays the signal assigned. The 4 modules are stacked together in the ui:
tabBox(id = "monitoring_tabBox",
height = monitor_height_px,
width = "500px",
tabPanel(id = "layout1",
title = "Layout 1",
monitorModuleUI("sbto2"),
monitorModuleUI("icp"),
monitorModuleUI("map"),
monitorModuleUI("ptio2")
)
),
The problem is the following: the plots are not perfectly aligned across modules. Mainly because the y ticks values have different ranges (see how the icp and the ptio2 are aligned because both signals have two digits, without decimals)
I've seen several techniques to align ggplots but you need to take as an input the 4 plots, and then merge them all in a single plot / render. I would like to avoid this step to keep the modularized structure of the app.
Is there any way I can align those plots without having to marge them together? (i.e by constraining the length of the y ticks)
Thank you in advance !
Screenshot:
screenshot showing the 4 modules and the misalignment issue
Reproducible example:
library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
# Sample Data
df <- data.frame(timestamp = seq(as.POSIXct("2020-06-01 10:00:00"), as.POSIXct("2020-06-01 12:00:00"), "1 min"),
sbto2 = round(10000*rnorm(121, 0, 2), 1),
map = round(100*rnorm(121, 0, 2), 1),
icp = round(10*rnorm(121, 0, 1.5), 1),
ptio2 = round(1000*rnorm(121, 0, 1.2), 1))
# monitorModule
monitorModuleUI <- function(id){
ns <- NS(id)
fluidRow(
column(8,
plotOutput(ns("monitoring_plot"),
height = "150px")
),
column(2,
uiOutput(ns("monitoring_text"))
)
)
}
monitorModule <- function(input, output, server, variable_name, df){
output$monitoring_plot <- renderPlot({
p()
})
p <- reactive({
df %>%
gather("var", "value",seq(2,5)) %>%
filter(var == variable_name) %>%
ggplot(aes(x = timestamp, y = value)) + geom_line() -> p
return(p)
})
output$monitoring_text <- renderUI({
value <- p()$data$value[nrow(p()$data)]
h1(strong(paste(value)), style = "font-size:90;")
})
}
# APP
ui <- shinyServer(fluidPage(
monitorModuleUI("sbto2"),
monitorModuleUI("icp"),
monitorModuleUI("ptio2"),
monitorModuleUI("map")
))
server <- shinyServer(function(input, output, session){
callModule(monitorModule, "sbto2", "sbto2", df)
callModule(monitorModule, "icp", "icp", df)
callModule(monitorModule, "ptio2", "ptio2", df)
callModule(monitorModule, "map", "map", df)
})
shinyApp(ui=ui,server=server)
One alternative would be to return a reactive plot from each module and then to organize them with the package {patchwork}.
Here's an example:
library(shiny)
library(dplyr)
library(ggplot2)
library(tidyr)
library(patchwork)
# Sample Data
df <- data.frame(timestamp = seq(as.POSIXct("2020-06-01 10:00:00"), as.POSIXct("2020-06-01 12:00:00"), "1 min"),
sbto2 = round(10000*rnorm(121, 0, 2), 1),
map = round(100*rnorm(121, 0, 2), 1),
icp = round(10*rnorm(121, 0, 1.5), 1),
ptio2 = round(1000*rnorm(121, 0, 1.2), 1))
# monitorModule
monitorModuleUI <- function(id){
# ns <- NS(id)
# plotOutput(ns("monitoring_plot"),
# height = "150px")
}
monitorModule <- function(input, output, server, variable_name, df){
test <- reactive({
df %>%
gather("var", "value",seq(2,5)) %>%
filter(var == variable_name) %>%
ggplot(aes(x = timestamp, y = value)) + geom_line() -> p
return(p)
})
}
# APP
ui <- fluidPage(
monitorModuleUI("sbto2"),
monitorModuleUI("icp"),
monitorModuleUI("ptio2"),
monitorModuleUI("map"),
plotOutput("all_plots")
)
server <- function(input, output, session){
plot_1 <- callModule(monitorModule, "sbto2", "sbto2", df)
plot_2 <- callModule(monitorModule, "icp", "icp", df)
plot_3 <- callModule(monitorModule, "ptio2", "ptio2", df)
plot_4 <- callModule(monitorModule, "map", "map", df)
output$all_plots <- renderPlot({
plot_1() / plot_2() / plot_3() / plot_4()
})
}
shinyApp(ui=ui,server=server)

Shiny / Plotly: Update plot with labels of only selected points

Using R Shiny and plotly I created a interactive scatter plot.
How can I modify my code to interactively label only the points which were selected by the user?
Example plot
Thank you so much for your help!
All the best,
Christian
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point()
ggplotly(p) %>% layout(dragmode = "select")
})
}
shinyApp(ui, server)
Below is a possible solution. I use a reactive function to "label" selected points. I wasn't sure how exactly you want to display the IDs for selected points. The code adds the ID as text when a point is selected. Also, I add some jitter to move the IDs away from the points.
library(plotly)
library(shiny)
library(dplyr)
data <- data.frame(matrix(runif(500,0,1000), ncol = 2, nrow = 100)) %>%
mutate(ID = row_number())
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("hover"),
verbatimTextOutput("click"),
verbatimTextOutput("brush"),
verbatimTextOutput("zoom"))
server <- function(input, output, session) {
output$plot <- renderPlotly({
data <- get_data()
p <- ggplot(data, aes(x = X1, y = X2, key = ID)) +
geom_point() + geom_text(data=subset(data, show_id),aes(X1,X2,label=ID), position = position_jitter(width = 20,height = 20))
ggplotly(p, source = "subset") %>% layout(dragmode = "select")
})
get_data <- reactive({
event.data <- event_data("plotly_selected", source = "subset")
data <- data %>% mutate(show_id = FALSE)
if (!is.null(event.data)) {
data$show_id[event.data$pointNumber + 1] <- TRUE
}
data
})
}
shinyApp(ui, server)

Resources