I am trying to create an animation where an image has to move together with the dot that you can see in this image:
I have a dataset about Formula 1 and I want to show the image of the car instead of the dot in the image.
Here you have a summary of my dataset:
And the code of the graph:
prep = data[data$year == 2021,] %>% split(.$date) %>% accumulate(., ~bind_rows(.x,.y))%>%
bind_rows(.id = "frame")
prep2 = data[data$year == 2021,] %>% split(.$date) %>%
bind_rows(.id = "frame")
prep%>%
plot_ly(x = ~name, y = ~points, color = ~factor(name)) %>%
add_lines(frame = ~as.Date(frame, format = '%Y-%m-%d'))%>%
add_markers(data = prep2, frame = ~as.Date(frame, format = '%Y-%m-%d'))%>%
layout(yaxis = list(title = 'Puntos'),showlegend = FALSE,xaxis = list(title = 'Fecha de la carrera',range = c(as.Date(min(data$date[data$year == 2021]), format="%d/%m/%Y"),as.Date(max(data$date[data$year == 2021]), format="%d/%m/%Y"))))%>%
animation_slider(currentvalue = list(prefix = "Carrera "))
Related
I am trying to use both hc_motion and hc_drilldown within a highcharter map.
I can manage to get the hc_motion working with the full map, and also a drilldown from a larger area to its smaller ones (UK Region to Local Authority in this instance).
However, after drilling-down and zooming back out again, the hc_motion is now frozen.
Why is this and is there anyway around it? Or are hc_motion and hc_drilldown not compatible?
While in this instance the drilldown is static, if it possible hc_motion within each drilldown would be ideal, although will no even bother trying if even a static can't be incorporated without affecting the hc_motion.
Anyway, example code is below, thanks!
region_lad_lookup = read_csv("https://opendata.arcgis.com/api/v3/datasets/6a41affae7e345a7b2b86602408ea8a2_0/downloads/data?format=csv&spatialRefId=4326") %>%
clean_names() %>%
select(
region_code = rgn21cd,
region_name = rgn21nm,
la_name = lad21nm,
la_code = lad21cd,
value = fid
) %>%
inner_join(
read_sf("https://opendata.arcgis.com/api/v3/datasets/21f7fb2d524b44c8ab9dd0f971c96bba_0/downloads/data?format=geojson&spatialRefId=4326") %>%
clean_names() %>%
filter(grepl("^E", lad21cd)) %>%
select(la_code = lad21cd),
by = "la_code"
)
region_map = read_sf("https://opendata.arcgis.com/api/v3/datasets/bafeb380d7e34f04a3cdf1628752d5c3_0/downloads/data?format=geojson&spatialRefId=4326") %>%
clean_names() %>%
select(
area_code = rgn18cd,
area_name = rgn18nm
) %>%
st_as_sf(crs = 27700) %>%
sf_geojson() %>%
fromJSON(simplifyVector = F)
year_vec = c(2015, 2016, 2017, 2018, 2019)
region_data = region_lad_lookup %>%
select(
area_code = region_code,
area_name = region_name
) %>%
distinct() %>%
crossing(year_vec) %>%
mutate(
value = runif(nrow(.)),
drilldown = tolower(area_name)
)
region_vec = region_data %>%
select(area_name) %>%
distinct() %>%
pull()
get_la_map = function(data, region_val){
data = data %>%
filter(region_name == region_val) %>%
select(
area_code = la_code,
area_name = la_name,
geometry
) %>%
st_as_sf(crs = 27700) %>%
sf_geojson() %>%
fromJSON(simplifyVector = F)
return(data)
}
get_la_data = function(data, region_val){
data = data %>%
filter(region_name == region_val) %>%
select(
area_name = la_name,
area_code = la_code,
value
)
return(data)
}
get_region_map_list = function(region_val){
output = list(
id = tolower(region_val),
data = list_parse(get_la_data(region_lad_lookup, region_val)),
mapData = get_la_map(region_lad_lookup, region_val),
name = region_val,
value = "value",
joinBy = "area_name"
)
return(output)
}
region_ds = region_data %>%
group_by(area_name) %>%
do(
item= list(
area_name = first(.$area_name),
sequence = .$value,
value = first(.$value),
drilldown = first(.$drilldown)
)
) %>%
.$item
highchart(type = "map") %>%
hc_add_series(
data = region_ds,
mapData = region_map,
value = "value",
joinBy = "area_name",
borderWidth = 0
) %>%
hc_colorAxis(
minColor = "lightblue",
maxColor = "red"
) %>%
hc_motion(
enabled = TRUE,
axisLabel = "year",
series = 0,
updateIterval = 200,
magnet = list(
round = "floor",
step = 0.1
)
) %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = lapply(region_vec, get_region_map_list)
)
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:
I want to add data labels for a treemap I have created. I am using this treemap for an image so having the pts and fgpct for each box would be helpful. I want what's listed in the tooltip and the legend to appear in each box.
My code:
library(highcharter)
gamelogs %>%
filter(slugTeam == "MEM") %>%
group_by(namePlayer) %>%
summarise(pts = sum(pts), fgpct = sum(fgm) / sum(fga)) %>%
hchart("treemap", hcaes(name = namePlayer, value = pts, color = fgpct)) %>%
hc_title(text = "Grizzlies Scoring") %>%
hc_subtitle(text = "Shaded by Field Goal %") %>%
hc_chart(
backgroundColor = '#FFFFFF' # Chart Background Color
) %>%
hc_exporting(enabled = TRUE,
filename = "Grizzlies Scoring")
My Output:
The output I would like:
This output would have the points 1,041 in the box and also the fgpct of 49% that is shown in the legend. Anyway to add the data labels using highcharter treemap?
Try this
gamelogs %>%
filter(slugTeam == "MEM") %>%
group_by(namePlayer) %>%
summarise(pts = sum(pts), fgpct = round(sum(fgm) / sum(fga),digits=2)) %>%
hchart("treemap", hcaes(name = namePlayer, value = pts, color = fgpct),
dataLabels = list(enabled = TRUE, format='{point.namePlayer}<br/>{point.pts} pts<br/>{point.fgpct} fgpct'),
tooltip = list(pointFormat = "{point.namePlayer}: {point.pts}, {point.fgpct}%")) %>%
hc_title(text = "Grizzlies Scoring") %>%
hc_subtitle(text = "Shaded by Field Goal %") %>%
hc_chart(
backgroundColor = '#FFFFFF' # Chart Background Color
) %>%
hc_exporting(enabled = TRUE,
filename = "Grizzlies Scoring") %>%
hc_tooltip(crosshairs = TRUE)
you will get this output
I have made twoplots using plotly, which are working fine individually, but when combined using subplot I can't seem to figure out how to combine the legends. I have tried to use showlegend = F in plot_ly in one of the plots, but this just removes it completely - what I want is to control both subplots with the same legend.
My code is as follows:
coronavirus_not_china <- coronavirus %>%
filter(!(country == "China"))
cases_not_china_plot <- coronavirus_not_china %>%
group_by(type, date) %>%
summarise(total_cases = sum(cases)) %>%
pivot_wider(names_from = type, values_from = total_cases) %>%
arrange(date) %>%
mutate(active = confirmed - death - recovered) %>%
mutate(active_total = cumsum(active),
recovered_total = cumsum(recovered),
death_total = cumsum(death)) %>%
plot_ly(x = ~ date,
y = ~ active_total,
name = 'Active',
fillcolor = '#1f77b4',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
showlegend = F) %>%
add_trace(y = ~ death_total,
name = "Death",
fillcolor = '#E41317') %>%
add_trace(y = ~recovered_total,
name = 'Recovered',
fillcolor = 'forestgreen') %>%
layout(title = "Distribution of Covid19 Cases outside China",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of Cases", showgrid = T))
coronavirus_china <- coronavirus %>%
filter((country == "China"))
cases_china_plot <- coronavirus_china %>%
group_by(type, date) %>%
summarise(total_cases = sum(cases)) %>%
pivot_wider(names_from = type, values_from = total_cases) %>%
arrange(date) %>%
mutate(active = confirmed - death - recovered) %>%
mutate(active_total = cumsum(active),
recovered_total = cumsum(recovered),
death_total = cumsum(death)) %>%
plot_ly(x = ~ date,
y = ~ active_total,
name = 'Active',
fillcolor = '#1f77b4',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
showlegend = T) %>%
add_trace(y = ~ death_total,
name = "Death",
fillcolor = '#E41317') %>%
add_trace(y = ~recovered_total,
name = 'Recovered',
fillcolor = 'forestgreen') %>%
layout(title = "Distribution of Covid19 Cases inside China",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of Cases", showgrid = F))
And I create the subplots as:
subplot(cases_not_china_plot, cases_china_plot, nrows = 2, margin = 0.05, shareX = T) %>%
layout(title="Coronavirus cases outside China and in China", ylab("Number of cases"))
I am quite new to R, so if there is a smarter way to do what I desire, please let me know.
With the above code, my output is:
I would like to create a variwide chart in Highcharter to use in R,but the result is empty。
library(data.table)
library(highcharter)
labor_cost <- data.table(country =c('挪威','丹麦','比利时','瑞典','法国','荷兰','芬兰','德国','奥地利','爱尔兰','意大利','英国','西班牙','希腊','葡萄牙','捷克共和国','波兰','罗马尼亚'),cost=c(50.2,42,39.2,38,35.6,34.3,33.2,33,32.7,30.4,27.8,26.7,21.3,14.2,13.7,10.2,8.6,5.5),gdp=c(335504,277339,421611,462057,2228857,702641,215615,3144050,349344,275567,1672438,2366911,1113851,175887,184933,176564,424269,169578))
highchart() %>%
hc_title(text = "欧洲各国人工成本", align="center")%>%
hc_xAxis(type = "category",title = list(text = "* 柱子宽度与 GDP 成正比")) %>%
hc_legend(enabled = FALSE) %>%
hc_add_series(data = labor_cost,type = "variwide",hcaes(x = country,width= gdp),dataLabels = list(enabled = TRUE,format="€{point.y:.0f}"),colorByPoint = TRUE)
The code executes normally，no errors appear.