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")
Related
I'm struggeling with mouse over labels for my ggplot 2 polar plot in shiny.
Simple version of my code (without mouse over labels):
library(dplyr)
library(shiny)
library(ggplot2)
# Define UI for application that plots features of iris
ui <- fluidPage(
br(),
# Sidebar layout
sidebarLayout(
# Inputs
sidebarPanel(
),
# Outputs
mainPanel(
plotOutput(outputId = "radarplot"),
br()
)
)
)
# Define server function required to create the radarplot
server <- function(input, output) {
# Create radarplot with iris dataset
output$radarplot <- renderPlot ({
iris %>%
ggplot(.) + geom_histogram(aes(y = Petal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 1 ) +
geom_histogram(aes(y = Sepal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 0.3) +
coord_polar()
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I made a version using plotly, trying to add mouse over labels. But then I don't get a radar plot.
library(dplyr)
library(shiny)
library(ggplot2)
library(plotly)
# Define UI for application that plots features of iris
ui <- fluidPage(
br(),
# Sidebar layout
sidebarLayout(
# Inputs
sidebarPanel(
),
# Outputs
mainPanel(
plotlyOutput(outputId = "radarplot"),
br()
)
)
)
# Define server function required to create the radarplot
server <- function(input, output) {
# Create radarplot with iris dataset
output$radarplot <- renderPlotly ({
iris %>%
ggplot(.) + geom_histogram(aes(y = Petal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 1 ) +
geom_histogram(aes(y = Sepal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 0.3) +
coord_polar()
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
Ideally I want the mouse over label to give output about Petal.Width, Sepal.Width and Species when hovering over a particular Species 'wing'.
Any suggestions how to get these mouse over labels?
Here is an example of this using the ggiraph package.
First the tooltip needs to be created.
library(tidyverse)
iris_group_means <-
iris %>%
group_by(Species) %>%
summarise_all(mean) %>%
mutate(tooltip = sprintf("Sepal Length: %1.2f\nSepal Width: %1.2f\nPetal Length: %1.2f\nPetal Width: %1.2f",
Sepal.Length, Sepal.Width, Petal.Length, Petal.Width)) %>%
select(Species, tooltip)
Then this tooltip just needs to be provided as an aesthetic, and instead of geom_histogram, use the ggiraph::geom_histogram_interactive function.
my_gg <-
iris %>%
ggplot() +
geom_histogram(aes(y = Petal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 1 ) +
ggiraph::geom_histogram_interactive(aes(y = Sepal.Width, x = Species, fill = Species, tooltip = tooltip),
binwidth= 1,
stat= 'identity',
alpha = 0.3) +
coord_polar()
ggiraph::ggiraph(code = print(my_gg))
This can then be used in Shiny. A few other steps are involved and there is a separate ggiraph::renderggiraph function to use. Details are on the ggiraph site
Here is the final Shiny code. I don't use shiny much so this can probably be improved upon, but it worked for me.
# Define UI for application that plots features of iris
ui <- fluidPage(
br(),
# Sidebar layout
sidebarLayout(
# Inputs
sidebarPanel(
),
# Outputs
mainPanel(
ggiraph::ggiraphOutput(outputId = "radarplot"),
br()
)
)
)
# Define server function required to create the radarplot
server <- function(input, output) {
# Create radarplot with iris dataset
output$radarplot <- ggiraph::renderggiraph ({
iris_group_means <-
iris %>%
group_by(Species) %>%
summarise_all(mean) %>%
mutate(tooltip = sprintf("Sepal Length: %1.2f\nSepal Width: %1.2f\nPetal Length: %1.2f\nPetal Width: %1.2f",
Sepal.Length, Sepal.Width, Petal.Length, Petal.Width)) %>%
select(Species, tooltip)
iris <-
left_join(iris, iris_group_means, by="Species")
my_gg <-
iris %>%
ggplot() +
geom_histogram(aes(y = Petal.Width, x = Species, fill = Species),
binwidth= 1,
stat= 'identity',
alpha = 1 ) +
ggiraph::geom_histogram_interactive(aes(y = Sepal.Width, x = Species, fill = Species, tooltip = tooltip),
binwidth= 1,
stat= 'identity',
alpha = 0.3) +
coord_polar()
ggiraph::ggiraph(code = print(my_gg))
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I have a dataset with home values for all 50 states over ~30 years. Columns include State, Year, Value, etc. I am trying to create an interactive Shiny app where the user can select certain states so they will be the only ones displayed in the plot. I have successfully created the plot of all states independently where Year is on the x-axis and Value is on the y-axis, colored by State, and also have successfully subset the dataset so that only one state plots.
I am new to Shiny and having issues having anything other than the Input checkBox feature work in this. Is there something obvious I am missing?
ui <- fluidPage(
checkboxGroupInput(inputId = "state", label = "States", choices = levels(AllData2$STATE),
plotOutput(outputId = "hist")))
server <- function(input, output) {
output$hist <- renderPlot({
plot(data = subset(AllData2, AllData2 == input$state), mapping = aes(x = Date, y = HomeValue,
color = STATE) + geom_line(size=2, alpha=0.8) +
scale_y_continuous(breaks = seq(0, 1000000, 50000)) +
scale_x_continuous(breaks = seq(1975, 2020, 5)) +
ylab("Value in Dollars") + xlab("Year"))
})
}
shinyApp(ui = ui, server = server)
I get no output in my Shiny App except the checkbox options. Thank you for any help.
There are only syntax errors in your code. Many of them:
You have included plotOutput() inside the checkbox group, please place it outside it.
Use ggplot() instead of plot()
You have included everything inside plot() If you use ggplot() the syntax is: ggplot(data=AllData,mapping=aes())+geom_line()+scale_y_continuous()+scale_x_continuous()+labs(x="This is X label",y="This is ylab",color="This is the color legend label")
Your code will work after fixing these problems
Just copy paste this if you want instant result:
library(shiny)
library(ggplot2)
library(dplyr)
ui <- fluidPage(
column(12,checkboxGroupInput(inputId = "state", label = "States", choices = c(1,2,3,4,5))),
column(12,plotOutput(outputId = "hist")))
server <- function(input, output) {
output$hist <- renderPlot({
ggplot(data = subset(AllData2, AllData2$STATE %in% input$state), mapping = aes(x = Date, y = HomeValue,
color = STATE)) + geom_line(size=2, alpha=0.8) +
scale_y_continuous(breaks = seq(0, 1000000, 50000)) +
scale_x_continuous(breaks = seq(1975, 2020, 5)) +labs(x="Value in Dollars",y="Year")
})
}
shinyApp(ui = ui, server = server)
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"))
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")
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()