Plotly R : how to add dynamic annotation which belongs to frame - r

I'm struggeling on a simple task. I have a database with 3 columns :
Year (numeric)
Age (numeric)
Pop (numeric)
Part60 : The % of individuals with age >= 60 (string like '% of poeple over 60 : 12%'). This value is the same for each rows of a year.
Dataset looks like :
I built a plotly bargraph with a frame based on the year. So I have a slider which allow me to show for each age the number of individuals and this is animated year by year.
I would like to add an anotation which shows the value of Part60 for the year of the frame... I know that it's possible with a ggplot sent to ggplotly function, however I want to do it from scratch with a plot_ly function as parameters are (for me) easier to control and follow the logic of my code.
This is my code :
gH <- plot_ly(data = dataH,
name = 'Hommes',
marker = list(color = ispfPalette[4]),
x = ~Pop,
y = ~Age,
frame = ~Annee)
gH <- gH %>% layout(yaxis = list(categoryorder="array",
categoryarray=dataH$Age))
gH <- gH %>% layout(yaxis = list(title = '',
zeroline = TRUE,
showline = TRUE,
showticklabels = TRUE,
showgrid = FALSE),
xaxis = list(title = '',
zeroline = TRUE,
showline = TRUE,
autorange = "reversed"),
shapes = hline(60))
gH <- gH %>% add_annotations(
x = 3000,
y = 62,
text = 'Part des 60 ans et + : 12 %',
showarrow = F,
color = ispfPalette[8]
Where text = 'Part des 60 ans et + : 12 %' should be replaced by something which allow me to get the value which belongs to the year of the slider.
Is someone may help me to do it ?
Thanks in advance for your great help.

Since I don't have your data, it's pretty difficult to give you the best answer. Although, here is a method in which you can add text that changes throughout the animation.
library(plotly)
library(tidyverse)
data(gapminder, package = "gapminder")
str(gapminder)
funModeling::df_status(gapminder)
# continent, lifeExp, year
gap <- gapminder %>% group_by(year, continent) %>%
summarise(Expectancy = mean(lifeExp))
# plot
p1 <- plot_ly(gap, x = ~Expectancy, y = ~continent,
frame = ~year, type = 'bar',
showlegend = F,
hovertemplate = paste0("Continent: %{y}<br>",
"<extra></extra>"),
texttemplate = "Life Expectancy: %{x:.2f}") %>%
layout(yaxis=list(title=""),
xaxis=list(title="Average Life Expectancy per Continent By Year"),
title=list(text=paste("Fancy Title")),
margin = list(t = 100))
p1
If you had text you wanted to animate that is not connected to each marker (bar, point, line), then you could do it this way.
# Something to add in the annotation text
gap2 <- gap %>% filter(continent == "Asia") %>%
droplevels() %>%
arrange(year)
# build to see frames
p2 <- plotly_build(p1)
# modify frames; need an annotation for each frame
# make sure the data is in order by year (order by frame)
lapply(1:nrow(gap2), # for each frame
function(i){
annotation = list(
data = gap2,
type = "text",
x = 77,
y = .5,
yref = "paper",
showarrow = F,
text = paste0("Asian Life Expectancy<br>",
sprintf("%.2f", gap2[i, ]$Expectancy)),
font = list(color = "#b21e29", size = 16))
p2$x$frames[[i]]$layout <<- list(annotations = list(annotation)) # change plot
})
p2
If anything is unclear, let me know.

Related

R Chorpleth Plotly Colorscale Keeps Resetting to Default when Moving through Frames

I'm currently making a choropleth map in plotly that tracks the population of ever US state from 1910 - 2020. The data is sorted into categorical variables with the percent change of every state in a decade. When I run my code the first year (1910) looks right, however when pressing "play" or moving the slider to any other year the colorscale resets to the default and the discrete scale and ticks are replaced with a continuous version. To be honest, I'm completely lost as to why only the first frame is correct, and when I return to the first frame after navigating to any of the other frames it changes to be like the other frames (colorscale wise).
Here is my code:
`
library(plotly)
library(dplyr)
library(readr)
library("RColorBrewer")
states <- read_csv("states.csv")
AllCountryPop <- read_csv("All50%d.csv",
col_types = cols(Year = col_number(),
Percent = col_number()))%>%
inner_join(states, by.x = State, by.x = state) %>%
select(Year, Code, Percent, Category) %>%
mutate(hover = paste(Code, "\n", 100*Percent, "%"))
AllCountryPop$Category = factor(AllCountryPop$Category)
AllCountryPop$Val = as.numeric(AllCountryPop$Category)
nfactor = length(levels(AllCountryPop$Category))
colr <- brewer.pal(n = nfactor,name = "Blues") #Color scale should be blue with five leves (for each category)
levels(AllCountryPop$Category) <- c("-30% - 0%" , "0% - 30%", "30% - 60%", "60% - 90%", "90% - 130%")
names(colr) = levels(AllCountryPop$Category)
colrS = function(n){
CUTS = seq(0,1,length.out=n+1)
rep(CUTS,ifelse(CUTS %in% 0:1,1,2))
}
graph_properties <- list(
scope = 'usa',
showland = TRUE,
landcolor = toRGB("white"),
color = toRGB("white")
)
font = list(
family = "DM Sans",
size = 15,
color = "black"
)
label = list(
bgcolor = "#EEEEEE",
bordercolor = "transparent",
font = font
)
colorScale <- data.frame(z=colrS(nfactor),
col=rep(colr,each=2),stringsAsFactors=FALSE)
p <- plot_geo(AllCountryPop,
locationmode = "USA-states",
frame = ~Year)%>%
add_trace(locations = ~ Code,
locationmode = "USA-states",
z = AllCountryPop$Val,
zmin = min(AllCountryPop$Val),
zmax = max(AllCountryPop$Val),
text = ~hover,
hoverinfo = 'text',
colorbar=list(tickvals=1:nfactor, ticktext=names(colr)),
colorscale= colorScale) %>%
layout(geo = graph_properties,
title = "Population Percent Change in the US\n1910 - 2020",
font = list(family = "DM Sans")) %>%
config(displayModeBar = FALSE) %>%
style(hoverlabel = label) %>%
colorbar(title = "Percent")
p
`
In case my CSV data may be of use:
The first two lines of "states.csv":
"State","Abbrev","Code" "Alabama","Ala.","AL"
The first two lines of "All50%d.csv":
State,Percent,Year,Category Alabama,0.051,2020,0% - 30%
P.S. First time asking a question here, please let me know if I need to change how I ask a question, provide info, etc,

Adding hover annotations to a Heatmap plotly R

I'm currently using plotly's heatmap to make a risk matrix (if anyone knows a more efficient way to do it I'd be open to suggestions). Currently I add information about the different risks with annotations but I would like that instead of annotations it was a marker that contains the information when hovering over it, as in the image that I attached below.
Below I attach the code and an image of how I would like it to be.
I'll appreciate any suggestion, advice, etc. Thanks!
df.risk <- data.frame(
Risk = paste0("R",1:5),
Prob = runif(5),
Cons = runif(5,1,5))
m <- c(rep(0.1,4),0.5,rep(0.1,2),rep(0.5,3),0.1,rep(0.5,3),0.9,0.1,rep(0.5,2),rep(0.9,2),rep(0.5,2),rep(0.9,3))
scale <- matrix(m, nrow = 5, ncol = 5)
pal <- c("#1A9641",
"#EFE90F",
"#F44336")
fig <- plot_ly(
x = seq(1,16,by = 4),
y = seq(0,1,by = 0.2),
z = scale,
type = "heatmap",
colors = colorRamp(pal))
fig <- fig %>%
layout(xaxis = list(title = 'Cons'),
yaxis = list(title = 'Prob'))
fig %>%
add_annotations(y = df.risk$Prob,
x = df.risk$Cons,
text = df.risk$Risk,
showarrow = FALSE) %>% hide_colorbar()
Let me know if this is what you were looking for. I changed your data in df.risk, so that the template was a bit more obvious. Other than that the content leading up to the plot_ly object remained as you presented it in your question.
The data changes first
df.risk <- data.frame(
Risk = rep(c("Product rendered obsolete",
"Strict legal requirements",
"Sufficient human resources",
"Sufficient material resources",
"Sufficient manufacturing equipment",
"Sufficient sales",
"Reliable suppliers",
"Unknown/unintended costs exceeding ROI",
"Evidence technology will work",
"Sufficient market share long term"), 3),
Prob = runif(10),
Cons = runif(10,1,5))
Then the initial creation of the plot_ly object.
fig <- plot_ly(
x = seq(1,16,by = 4),
y = seq(0,1,by = 0.2),
z = scale,
hoverinfo = "none",
type = "heatmap",
colors = colorRamp(pal)) %>%
add_markers(
inherit = F,
x = ~Cons, y = ~Prob,
data = df.risk,
showlegend = F,
text = ~Risk,
color = I("white"), # I("transparent") or whatever color you prefer
hovertemplate = paste0("%{text}<br><br>", # risks
"Probability: %{y:.0%}<br>", # prob % rounded
"Severity: %{x:.2f}", # severity, rounded
"<extra></extra>")) # no trace info
fig %>%
layout(xaxis = list(title = 'Consequences/Severity'),
yaxis = list(title = 'Probability')) %>% hide_colorbar()
This is what it looks like.

Plotly animated map not showing countries with NA values

I posted this in the plotly community forum but got absolutely no activity! Hope you can help here:
I have map time-series data, some countries don’t have data and plotly does not plot them at all. I can have them outlined and they look different but it appears nowhere that the data is missing there (i.e. I want a legend entry). How can I achieve this? Here is a reprex:
library(plotly)
library(dplyr)
data = read.csv('https://github.com/lc5415/COVID19/raw/master/data.csv')
l <- list(color = toRGB("grey"), width = 0.5)
g <- list(
scope = 'world',
countrycolor = toRGB('grey'),
showframe = T,
showcoastlines = TRUE,
projection = list(type = 'natural earth')
)
map.time = data %>%
plot_geo() %>%
add_trace(z = ~Confirmed, color = ~Confirmed, frame = ~Date, colors = 'Blues',
text = ~Country, locations = ~Alpha.3.code, marker = list(line = l)) %>%
colorbar(title = 'Confirmed') %>%
layout(
title = 'Number of confirmed cases over time',
geo = g
) %>%
animation_opts(redraw = F) %>%
animation_slider(
currentvalue = list(
prefix = paste0("Days from ",
format(StartDate, "%B %dnd"),": "))) %>%
plotly_build()
map.time
Note that the countries with missing data (e.g. Russia) have as many data points as all other countries, the issue is not that they do not appear in the dtaframe passed to plotly.
The obvious way to handle this is to create a separate labels column for the tooltip that reads "No data" for NA values (with the actual value otherwise), then make your actual NA values 0. This will give a uniform appearance to all the countries but correctly tells you when a country has no data.
map.time = data %>%
mutate_if(is.numeric, function(x) {x[is.na(x)] <- -1; x}) %>%
plot_geo() %>%
add_trace(z = ~Confirmed, color = ~Confirmed, frame = ~Date, colors = 'Blues',
text = ~Country, locations = ~Alpha.3.code,
marker = list(line = l)) %>%
colorbar(title = 'Confirmed') %>%
layout(
title = 'Number of confirmed cases over time',
geo = g
) %>%
animation_opts(redraw = F) %>%
animation_slider(
currentvalue = list(
prefix = paste0("Days from ",
format(StartDate, "%B %dnd"),": "))) %>%
plotly_build()
Which gives:

Select top 3 parents (groups) in plotly graph using R

What I want is to plot only 3 of my parents, the ones that spend the highest cost with below coding.
parent <- as.character(c("Sam","Elena","Sam","Jhon","Raul","Sam","Jhon","Sara","Paul","Chris"))
cost <- as.numeric(as.character(c(15000,10000,12000,15000,10000,12000,15000,14000,19000,2000)))
topic <- as.character(c("Banana","Banana","Berries","Apple","Watermelon","Banana","Berries","Avocado","Watermelon","Pinneaple"))
sample <- as.data.frame(cbind(parent,cost,topic))
sample$cost <- as.numeric(as.character(sample$cost))
sample$parent <- as.character(sample$parent)
sample$topic <- as.character(sample$topic)
# Color setting
ramp2 <- colorRamp(c("deepskyblue4", "white"))
ramp.list2 <- rgb( ramp2(seq(0, 1, length = 15)), max = 255)
plot_ly(sample, x = ~parent, y = ~cost, type = 'bar', color = ~topic) %>%
layout(yaxis = list(title = 'Cost'), xaxis = list(title = 'Parent'), barmode = 'stack', colorway = ramp.list2) %>%
config(displayModeBar = FALSE)
I tried to use transforms inside plotly function, like this:
transforms = list(
list(
type = 'aggregate',
groups = sample$parent,
aggregations = list(
list(
target = 'x',
func = 'max',
enabled = T))
))
But it still gives me the same output and I want to select only 3. Also, tried to use it like this:
transforms = list(
list(
type = 'filter',
target = 'y',
operation = '>',
value = cost[-3:-1]))
But it takes only cost without takin the full cost parent spent on and only gives me 2 parents instead of 3. And finally, it's not using ramp.list2 to select colors.
According to what I understood, you can use the following code to get the top 3 parents separately, as follows:
top_3 <- sample %>%
group_by(parent) %>%
summarise(cost = sum(cost)) %>%
arrange(-cost) %>%
head(3)
This will give you the following:
# A tibble: 3 x 2
# parent cost
# <chr> <dbl>
# 1 Sam 39000
# 2 Jhon 30000
# 3 Paul 19000
Then, in your plot_ly, you can just refer to these top_3 parents, as follows:
plot_ly(sample[sample$parent %in% top_3$parent,], x = ~parent, y = ~cost, type = 'bar', color = ~topic) %>%
layout(yaxis = list(title = 'Cost'), xaxis = list(title = 'Parent'), barmode = 'stack', colorway = ramp.list2) %>%
config(displayModeBar = FALSE)
which will produce the following plot:
Hope it helps.

Line graph not displayed with plotly in R

My final aim is to create 2 time series line graphs on the same plot, with the one being static and the other being animated (the former refers to the actual data and the latter on my model's fitted values). I am trying to accomplish that with plotly, however I am completely new and have crossed difficulties.
In order to get familiar with plotly first before attempting the above I initially tried to create just one animated graph on a plot. However I cannot even make that ostensibly simple script work. When running the below no graph is displayed on my plot area, like there are no data. My script is created based on following link: https://plot.ly/r/cumulative-animations/
plot_ly(data
, x=~data$RequCreatedFull_Date
, y=~data$fitted_TotalRequ_Qnt_pm
, name="Fitted"
, type='scatter'
, mode = "lines"
, line = list(color = "rgb(255,128,0)")
, frame = ~data$RequCreatedFull_Date
, line = list(simplyfy = F)) %>%
layout(title="name"
, xaxis = list(range =
c(as.numeric(min(data$RequCreatedFull_Date))*1000
,as.numeric(max(data$RequCreatedFull_Date))*1000)
, type = "date"
, title = "Requisition Date"
, zeroline = F)
, yaxis = list(title="Total Requisition Qnts"
, range = c(1000,30000)
, zeroline = F)) %>%
animation_opts(frame = 100,
transition = 0,
redraw=FALSE) %>%
animation_button(x = 1, xanchor = "right", y = 0, yanchor = "bottom")
data is a 53 obs, 4 variables (dates, actuals, fits, index) data frame.
When 'Play' button for animation is clicked and while the animation's frames proceed, when hovering on the plot area the data points' tooltips are displayed for a moment, however no graph is displayed.
Thank you in advance for all your assistance, hope I provided you with sufficient info.
I mistakenly took part of the script the below link for the animated plotting (https://plot.ly/r/cumulative-animations/). The problem is that I did not modify the to-be-framed variable (variable to be used in frame parameter of plot_ly function) before using it.
Therefore, in order for the plot to work properly I should: 1. define accumulate_by function, 2. use it with the to-be-framed variable as input, 3. the output column produced from step 2 will be the value for the frame parameter of 'plot_ly' function.
Initial working data frame is data2, with columns RequCreatedFull-Date(as POSIXct), Requs_Qnt_pm(as num), Type(as Factor), date(as num) where
date=(year(RequCreatedFull_Date)+(month(RequCreatedFull_Date)-1)/12).
Please refer to working script below:
library(plotly)
library(dplyr)
library(lubridate)
#step 1: function definition
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
#step 2: creation of to-be-used for framing variable
data2mod <- data2 %>%
accumulate_by(~date)
#graph creation
my_graph<-data2mod %>%
plot_ly(
x = ~date,
y = ~Requs_Qnt_pm,
split = ~Type,
frame = ~frame, #step 3, to be frame variable insertion
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "x axis title",
zeroline = F
),
yaxis = list(
title = "y axis title",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
In xaxis and in yaxis showline=TRUE

Resources