I'm creating a simple line chart which renders correctly in Shiny.
I've now added a selectInput with the names of 2 different measures, written as they appear in my data set. I'd like my y variable to change accordingly.
p <- plot_ly(data = LineChartData(), x= Calendar.Month, y = input$Measure, type = "line", group = Calendar.Year, col = Calendar.Year)
Unfortunately, the chart renders with just one point. It's not taking input$Measure and finding that field in my data set.
I know when using ggplot, i'd switch my aes to aes_string. Is there a similar solution in plotly?
EDIT: here's some reproducible code
Here's the ui.R file
#ui.R
shinyUI(
fluidPage(
titlePanel("Inbound Intermediary Performance"),
sidebarLayout(
sidebarPanel(
h4("Parameters"),
br(),
selectInput("Measure", "Measure", c("Var1","Var2"))
),
mainPanel(
plotlyOutput("lineChart")
)
)
)
)
server.R
#server.R
library(plotly)
library(shiny)
library(ggplot2)
#Create data
data <- data.frame(Month = c(1,2,3,4,5,6,7,8,9,10,11,12), Var1 = c(36,33,30,27,24,21,18,15,12,9,6,3), Var2 = c(4,8,12,16,20,24,28,32,36,40,44,48))
shinyServer(function(input, output) {
#Create plot
output$lineChart <- renderPlotly({
#using ggplot
p <- ggplot(data=data, aes_string(x='Month', y = input$Measure)) +geom_line(size = 1.5) + theme_minimal()
ggplotly(p)
#Using PLotly
#p <- plot_ly(data = data, x= Month, y = input$Measure, type = "line")
})
})
In the example above, I can use my drop down to switch between Var1 and Var2. My plot changes accordingly. The code uses ggplot and it's aes_string function to take an input. This is then converted into a plotly interactive plot using the ggplotly function.
Is there a way I can do this natively with plotly?
Use base::get() function:
p <- plot_ly(data = data, x = ~Month, y = ~get(input$Measure), type = "line")
or the same using ggplot:
p <- ggplot(data = data, aes(x = Month, y = get(input$Measure))) +
geom_line(size = 1.5) +
theme_minimal()
ggplotly(p)
Simply just use data[ ,input$Measure] as Your y variable:
p <- plot_ly(data = data, x= Month, y = data[ ,input$Measure], type = "line")
Related
I have plotted a bar in R shiny as follow:
Now, I need to show the respective value of y axis and also the difference in percentage between 2nd and 1st bar( decrease rate from right to left in percentage).
My server.R is :
output$plot1 <- renderPlot({
plot <- ggplot(data = phnData1_load(df), aes_string(x="quarter", y = input$column1))
plot <- plot + geom_col(fill = blue)
plot <- plot + xlab("QUARTER")
plot
})
UI
selectInput(inputId = "column1", label = "Select a column to plot against Quarter", choices = c("ACN","BCN"))
Y axis is taking the value of input of column1 as dynamic/reactive way.
I am not having so much clue how to go ahead to get the desired measure of decrease from Right to left. Looking for your kind help.
Thanks
Perhaps this is close to what you are seeking?
df <- data.frame(quarter = c('q1', 'q2'),
value = c(43000, 47000))
ggplot(data = df, aes(x = quarter, y = value)) +
geom_col(fill = 'blue') +
geom_text(aes(label = value),
vjust = -0.5) +
annotate('text',
x =1.5,
y = max(df$value) + 1500,
label = paste0('Difference = ', min(df$value) - max(df$value)),
fontface = 2)
You will need to provide more of your code from the Shiny UI for a full solution, but you should be able to generalize from here
I am trying to format my ggplotly tooltip in a percent stacked barchart. In order to do this, I am editing a 'text' parameter in 'aes'
library(scales)
library(tidyverse)
library(plotly)
library(ggplot2)
library(shiny)
#Define dataframe
weeknum <- c(1,1,1,1,2,2,2,2,3,3,3,3)
channel <- rep(c("a", "b"), 6)
product <- c(rep("x",6), rep("y",6))
data <- data.frame(weeknum, channel, product)
# Define UI
ui <- fluidPage(theme = shinytheme("flatly"),
mainPanel(
h1("plot"),
plotlyOutput(outputId = "plot_1", height = "800px")
))
# Define server function
server <- function(input, output) {
output$plot_1 <- renderPlotly({
p1 <- data %>%
ggplot(aes(x=weeknum, fill=channel, text = paste('share:', percent(..count..), "<br> channel", fill))) +
geom_bar(position = "fill", stat ='count')+
facet_grid(rows = vars(product))
fig1 <- ggplotly(p1, tooltip = "text")
fig1
})
}
# Create Shiny object
shinyApp(ui = ui, server = server)
so here I got only count * 100% in the tooltip. I know I need to divide it by a dynamic height of a bar, because in this dashboard I'm gonna use some filters. Question is how can I do this? (..count..)/sum(..count..) doesn't work.
Since you did not provide a reproducible example, I created one using mtcars data set. This is how I would approach your task.
library(ggplot2)
library(dplyr)
plot <- mtcars %>%
count(cyl, am, name = "count") %>%
mutate(across(c(cyl, am), as.character)) %>%
ggplot(
aes(x = cyl, fill= am, y = count,
text = paste('share:', scales::percent(count/sum(count)), '<br>AM:', am)
)
) +
geom_col(position = "fill")
plotly::ggplotly(plot, tooltip = "text")
I'm trying to plot a vertical line on a plot in shiny, where the x intercept is a function of two of the user inputs. The variable is used in other outputs, so I am creating it an storing it in a variable. I can print the variable in an renderText so I know the calculation is correct, however ggplot is returning "object 'xintercept' not found". Below is the server function that isn't working. Note the ggplot call, when the geom_vline is removed, works find. Furthermore if the time_after_formation() is wrapped in a renderText works fine too.
library(shiny)
library(ggplot2)
library(data.table)
ui = fluidPage(
sidebarLayout(
# Inputs
sidebarPanel(
numericInput(inputId = 'lon', label="Longitude:", value=-20),
numericInput(inputId = 'lat', label="Lattitude:", value=20),
numericInput(inputId = 'time_bp', label="Time:", value=65)
),
mainPanel(
plotOutput(outputId="ocean_sub", width="auto", height="200px")
)))
server = function(input, output){
elementwise.all.equal <- Vectorize(function(x, y) {isTRUE(all.equal(x, y))})
seafloor_age_drop = data.table(lon=-20, lat=20, age=150)
setnames(floor_age_drop, c("lon", "lat", "age"))
setkey(floor_age_drop, lon, lat)
# Make model
model_age = seq(0,200, by=0.1)
crosby_depth =
ifelse(model_age <=75, 2652+324*sqrt(model_age),
ifelse(model_age>75 & model_age <=160, 5028+5.26*model_age-250*sin(((model_age-75)/30)),
ifelse(model_age>160, 5750,NA)))
crosby_model = data.frame(age=model_age, depth=crosby_depth)
# Reactives
age_from_grid = reactive({floor_age_drop[.(round(input$lon, digits=1), round(input$lat, digits=1)),'age']})
time_after_floor_formation = reactive({age_from_grid() - input$time_bp})
depth_crosby = reactive({crosby_model$depth[elementwise.all.equal(crosby_model$age, round(time_after_floor_formation(), 1))]
})
output$ocean_sub=renderPlot({
ggplot(crosby_model, aes(x=age, y=depth)) + geom_line() +
scale_y_reverse(lim=c(6000, 2500)) +
geom_vline(xintercept=time_after_floor_formation(), colour='red')})
}
shinyApp(ui=ui, server=server)
First create the plot in a reactive environment and then you use render plot for plotting it something like this:
p = reactive({ggplot(my_model, aes(x=age, y=depth)) + geom_line() +
scale_y_reverse(lim=c(6000, 2500)) +
geom_vline(xintercept=time_after_formation(), colour='red')})
output$ocean_sub = renderPlot({p})
EDITED
I found your problem and it is that the variable is data.table and that's why it doesn't work. just rap it up in as.numeric and it works perfect
ggplot(crosby_model, aes(x=age, y=depth)) + geom_line() +
scale_y_reverse(lim=c(6000, 2500)) +
geom_vline(xintercept=as.numeric(time_after_floor_formation()), colour='red')
When I do a facet_grid in ggplotly() for a Shiny App, with a large number of faceting groups, the plot is messed up. However it works correctly outside Shiny.
How can I fix this?
I suspect it is linked to the Y scale but I couldn't find the solution.
Here's a reproducible example based on diamonds example from plotly.
Comparison of Shiny vs non Shiny outputs : Comparison of facet_grid outside and within Shiny
Code
Outside Shiny:
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
ggplot(diamonds , aes_string(x = diamonds$x, y = diamonds$y, color = diamonds$x)) +
geom_point() + facet_grid(rdmGroup~.) +
guides(color=FALSE) +
labs(x = "X", y="Y")
The same code in a Shiny App:
library(shiny)
library(plotly)
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
ui <- fluidPage(
headerPanel("Diamonds Explorer"),
sidebarPanel(
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot')
)
)
server <- function(input, output) {
output$trendPlot <- renderPlotly({
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y")
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
PS: I used aes_string() instead of aes() intentionally as I need it in my real app.
The first thing to note is that the problem has nothing to do with Shiny but rather your use of ggplotly. The problem can be replicated with just:
library(ggplot2)
library(plotly)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
p <- ggplot(diamonds , aes_string(x = diamonds$x, y = diamonds$y, color = diamonds$x)) +
geom_point() + facet_grid(rdmGroup~.)
ggplotly(p)
though you will need something to view the output in, which may well be shiny.
In answer to your question, the problem seems to be that you cannot have more than 25 facets. If you remove any single group from rdmGroup then the plotly output works fine e.g.
diamonds <- subset(diamonds, rdmGroup != "Q")
To update your shiny example:
library(shiny)
library(plotly)
library(ggplot2)
data(diamonds, package = "ggplot2")
# new faceting group
diamonds$rdmGroup <- as.factor(sample(LETTERS, dim(diamonds)[1], replace=TRUE))
# subset of diamonds
diamonds <- diamonds[sample(nrow(diamonds), 1000),]
diamonds <- subset(diamonds, rdmGroup != "Q")
ui <- fluidPage(
headerPanel("Diamonds Explorer"),
sidebarPanel(
sliderInput('plotHeight', 'Height of plot (in pixels)',
min = 100, max = 2000, value = 1000)
),
mainPanel(
plotlyOutput('trendPlot')
)
)
server <- function(input, output) {
output$trendPlot <- renderPlotly({
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y")
ggplotly(p) %>%
layout(height = input$plotHeight, autosize=TRUE)
})
}
shinyApp(ui, server)
provides the following output:
A workaround could be to simply have more than one plot, splitting the dataset into groups of 25.
EDIT: I did some more research and the plot stops displaying as expected when the panel margins are too large to allow all of the plots to display. You can display all 26 by reducing the panel.spacing.y but this will only go so far depending on how many rows you need:
p <- ggplot(diamonds, aes_string(x = diamonds$x, y =diamonds$y, color = diamonds$x)) +
geom_point()+ facet_grid(rdmGroup~., scales = "free_y") +
labs(x = "X", y="Y") + theme(panel.spacing.y = unit(0.2, "lines"))
Just discovering shiny apps but this is driving me insane.......I have looked at numerous examples of server.R and ui.R code and cannot figure out what I am doing wrong. Apologies in advance if it's something very basic..........
Taking the iris dataset as an example, I want to plot one column against another, something simple using qplot or preferably ggplot
However, using qplot I get this:
and using ggplot2, I get the error:
I don't think I need the reactive function as I'm not subsetting the dataset, just extracting columns to plot.
server.R code
library(shiny)
library(shinyapps)
library(ggplot2)
shinyServer(function(input, output, session) {
output$text1 <- renderText({input$id1})
output$text2 <- renderText({input$select1})
output$plot1 <- renderPlot({
g <- qplot(Sepal.Length, input$select1, data = iris)
print(g)
})
})
or using ggplot function to replace the qplot call
g <- ggplot(iris, aes(x = Sepal.Length, y = input$select1))
g <- g + geom_line(col = "green", lwd =1) +
labs(x = "Date", y = "Ranking") +
theme_bw() + scale_y_reverse()
ui.R code
library(shiny)
library(shinyapps)
data(iris)
opts <- unique(colnames(iris))
opts <- opts[-1] ## want to keep Sepal.Length as the x values
shinyUI(pageWithSidebar(
headerPanel('test with iris database'),
sidebarPanel(
selectInput(inputId = "select1", label = "select",
choices = opts),
textInput(inputId = "id1", label = "Input Text", "")
),
mainPanel(
p('Output text1'),
textOutput('text1'),
textOutput('text2'),
plotOutput('plot1')
)
))
Change your aes statement to aes_string and make x a string. This should fix the problem.
g <- ggplot(iris, aes_string(x = "Sepal.Length", y = input$select1))
g <- g + geom_line(col = "green", lwd =1) +
labs(x = "Date", y = "Ranking") +
theme_bw() + scale_y_reverse()