Add country polygons to mapbox - r

I want to recreate a choropleth map with country polygons like the county level choropleth map here. And here is its result.
I try to repeat the same procedure for a world map
library(ggplot2)
library(dplyr)
library(maps)
WorldData <- map_data('world') %>% filter(region != "Antarctica") %>% fortify
Country<-c("United States","Canada","France","Italy","Turkey","United States","Canada","France","Italy","Turkey")
Val<-c(50,67,89,567,9,50,67,89,567,9)
Name<-c('AD',"FGH","BGH","FGFG","EWRW",'ADy',"FGyH","BGyH","FGFyG","EyWRW")
Test<-data.frame(Country,Val,Name)
V1 <- aggregate(Val~Country,Test,sum)
colnames(WorldData)[5]<-"Country"
m2 <- data.frame(merge(V1,WorldData , by=c("Country"), all.x=T))
p <- m2 %>%
group_by(group) %>%
plot_mapbox(x = ~long, y = ~lat, color = ~Val1, colors = c('#ffeda0','#f03b20'),
text = ~Country, hoverinfo = 'text', showlegend = FALSE) %>%
add_polygons(
line = list(width = 0.4)
) %>%
add_polygons(fillcolor = ~Val1,
line = list(color = 'black', width = 0.5),
showlegend = FALSE, hoverinfo = 'none'
) %>%
layout(
xaxis = list(title = "", showgrid = FALSE, showticklabels = FALSE),
yaxis = list(title = "", showgrid = FALSE, showticklabels = FALSE),
mapbox = list(
style = 'light',
zoom = 4,
center = list(lat = ~median(lat), lon = ~median(long))),
margin = list(l = 0, r = 0, b = 0, t = 0, pad = 0)
)
p
but I get:


I think you just need to order your data per the 'order' column in your data:
p <- m2 %>%
arrange(order) %>%
group_by(group) %>%
...
...
That worked for me.

Related

Setting proper title on Pyramid plot

I am trying to plot a pyramid plot. Below you can see data and code :
library(plotly)
library(dplyr)
df1<-data.frame(
Age=c("Y_0_4","Y_5_9","Y10_14","Y15_19","Y20_24","Y25_29","Y30_34","Y35_39","Y40_44","Y45_49","Y50_54","Y55_59","Y_0_4","Y_5_9","Y10_14","Y15_19","Y20_24","Y25_29","Y30_34","Y35_39","Y40_44","Y45_49","Y50_54","Y55_59"),
variable=c("Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female"),
value=c(158,196,168,156,140,693,854,892,904,925,817,257,170,204,178,150,817,763,784,818,823,766,779,349)
)
df1$color <- factor(df1$variable, labels = c('#1f77b4','#ff7f0e'))
df_pyramid<-df1%>%
mutate(value = ifelse(test = variable == "Male", yes = -value, no = value)) %>%
mutate(abs_pop = abs(value)) %>%
plot_ly(x= ~value, y=~Age, marker = list(color = ~color), name = ~variable) %>%
add_bars(orientation = 'h', hoverinfo = 'text', text = ~abs_pop) %>%
layout(title = "Structure by age and sex",bargap = 0.1, barmode = 'overlay',
xaxis = list(tickmode = 'array', tickvals = c(-15000, -10000, -5000, 0, 5000, 10000, 15000),
ticktext = c('15000', '10000', '5000', '0', '5000', '10000', '15000')),
annotations =
list(x = 0, y = -0.1,
text = "Source: Some institution",
showarrow = F,
xref='paper',
yref='paper'))
df_pyramid
This code produce pyramid plot same as the picture below. But below of this chart on the x-axis, you can see the title of the axis value. So can anybody help me with how to remove this title but without changes on the x-axis?

You can use title="" argument in layout of xaxis to remove that title like this:
library(plotly)
library(dplyr)
df1<-data.frame(
Age=c("Y_0_4","Y_5_9","Y10_14","Y15_19","Y20_24","Y25_29","Y30_34","Y35_39","Y40_44","Y45_49","Y50_54","Y55_59","Y_0_4","Y_5_9","Y10_14","Y15_19","Y20_24","Y25_29","Y30_34","Y35_39","Y40_44","Y45_49","Y50_54","Y55_59"),
variable=c("Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female"),
value=c(158,196,168,156,140,693,854,892,904,925,817,257,170,204,178,150,817,763,784,818,823,766,779,349)
)
df1$color <- factor(df1$variable, labels = c('#1f77b4','#ff7f0e'))
df_pyramid<-df1%>%
mutate(value = ifelse(test = variable == "Male", yes = -value, no = value)) %>%
mutate(abs_pop = abs(value)) %>%
plot_ly(x= ~value, y=~Age, marker = list(color = ~color), name = ~variable) %>%
add_bars(orientation = 'h', hoverinfo = 'text', text = ~abs_pop) %>%
layout(title = "Structure by age and sex",bargap = 0.1, barmode = 'overlay',
xaxis = list(tickmode = 'array', tickvals = c(-15000, -10000, -5000, 0, 5000, 10000, 15000),
ticktext = c('15000', '10000', '5000', '0', '5000', '10000', '15000'),
title = ""),
annotations =
list(x = 0, y = -0.1,
text = "Source: Some institution",
showarrow = F,
xref='paper',
yref='paper'))
df_pyramid
Created on 2022-07-29 by the reprex package (v2.0.1)

Titles in plotly subplots using grid

I'm trying to apply the solution for having titles in a plotly subplot to a plotly grid using this Subplots Using Grid example:
library(plotly)
library(dplyr)
f <- list(family="Courier New, monospace",size = 18,color = "black")
fig <- plot_ly()
fig <- fig %>% add_pie(data = count(diamonds, cut), labels = ~cut, values = ~n,
name = "Cut", domain = list(row = 0, column = 0)) %>%
layout(annotations=list(text = "Cut",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig <- fig %>% add_pie(data = count(diamonds, color), labels = ~color, values = ~n,
name = "Color", domain = list(row = 0, column = 1)) %>%
layout(annotations=list(text = "Color",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig <- fig %>% add_pie(data = count(diamonds, clarity), labels = ~clarity, values = ~n,
name = "Clarity", domain = list(row = 0, column = 2)) %>%
layout(annotations=list(text = "Clarity",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig <- fig %>% layout(showlegend = F,grid=list(rows=1, columns=3),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
And what I'm getting is this:
Any idea?

You can use this code:
f <- list(family="Courier New, monospace",size = 18,color = "black")
fig <- plot_ly()
fig1 <- fig %>% add_pie(data = count(diamonds, cut), labels = ~cut, values = ~n,
name = "Cut", domain = list(row = 0, column = 0)) %>%
layout(annotations=list(text = "Cut",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig2 <- fig %>% add_pie(data = count(diamonds, color), labels = ~color, values = ~n,
name = "Color", domain = list(row = 0, column = 1)) %>%
layout(annotations=list(text = "Color",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig3 <- fig %>% add_pie(data = count(diamonds, clarity), labels = ~clarity, values = ~n,
name = "Clarity", domain = list(row = 0, column = 2)) %>%
layout(annotations=list(text = "Clarity",font = f,xref = "paper",yref = "paper",yanchor = "bottom",xanchor = "center",align = "center",x = 0.5,y = 1,showarrow = FALSE))
fig <- fig %>% layout(showlegend = F,grid=list(rows=1, columns=3),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
p <- subplot(fig1, fig2, fig3, titleX = TRUE, titleY = TRUE) %>%
layout(showlegend = FALSE, grid=list(rows=1, columns=3),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
p
Output:

Ghost duplicate annotations

I'm trying to create a bar chart with annotations on the right hand side. I can achieve this with the below code but it also produces some bonus ghost annotations that move when the size of the chart changes. What am I missing here?
library(highcharter)
x <- rev(c(.27, .18, .03, .07)) * 100
highchart() %>%
hc_chart(type = "bar",
backgroundColor = "#eee",
margin = c(0, 0, 0, 0)) %>%
hc_add_series_labels_values(labels = 1:length(x),
dataLabels = list(enabled = TRUE,
inside = FALSE,
format = '{y}% ',
style = list(color = "contrast",
fontSize = "14px",
textOutline = "none",
fontWeight = "normal")),
values = rev(x),
color = rep("#333333", length(x))) %>%
hc_legend(enabled = FALSE) %>%
hc_tooltip(enabled = FALSE) %>%
hc_yAxis(visible = FALSE, max = 110) %>%
hc_add_annotations(
list(
list(xValue = 0.5, yValue = 100, title = list(text = 'A')),
list(xValue = 1.5, yValue = 100, title = list(text = 'B')),
list(xValue = 2.5, yValue = 100, title = list(text = 'C'))
)
)

How to add Data markers in Waterfall chart in Plotly

I am trying to plot waterfall chart with the following code. The only issue I am facing currently is the data marker which is not at the correct place. I want the data marker to be just below the end of each bar.
source('./r_files/flatten_HTML.r')
library("plotly")
dataset <- data.frame(Category = c("Akash Jain","Ankit Jain","Pankaj Jain","Nitin Pandey","Gopal Pandit","Ramnath Agarwal"),
TH = c(-62,-71,-1010,44,-44,200))
#dataset <- data.frame(Category = Values$Category, TH = Values$TH)
#dataset <- as.data.frame(cbind(Values$Category,Values$TH))
dataset$Category = dataset$Category
dataset$TH = dataset$TH
dataset$SortedCategoryLabel <- sapply(dataset$Category, function(x) gsub(" ", " <br> ", x))
dataset$SortedCategory <- factor(dataset$SortedCategoryLabel, levels = dataset$SortedCategoryLabel)
dataset$id <- seq_along(dataset$TH)
dataset$type <- ifelse(dataset$TH > 0, "in", "out")
dataset$type <- factor(dataset$type, levels = c("out", "in"))
dataset$end <- cumsum(dataset$TH)
dataset$start <- c(0, head(dataset$end, -1))
Hover_Text <- paste(dataset$Category, "= ", dataset$TH, "<br>")
dataset$colors <- ifelse(dataset$type =="out","red","green")
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar', marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text", text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "dataset$SortedCategoryLabel",
yref = "dataset$end",
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g
Attached the screenshot of the waterfall chart.
So for the first bar, I need the data marker to be just below the end of red bar. Currently it is overlapping with the bar. And similarly for others.
Any help would be really appreciated.
Regards,
Akash

You should specify valign and height inside add_annotations:
vert.align <- c("bottom","top")[as.numeric(dataset$TH>0)+1]
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text",
text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "x",
yref = "y",
valign=vert.align, height=40,
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g

Placing donut charts side by side using plotly in R

I have created donut charts from plotly from the following:
library(plotly)
library(RColorBrewer)
test<-data_frame(Score=c("Green","Green","Yellow","Yellow","Clear","Clear","Red","Red"),Lang=c(rep("Eng",4),rep("Esp",4)))
test1<-data_frame(Score=c("Green","Yellow","Yellow","Yellow","Clear","Clear","Red","Red"),Lang=c(rep("Eng",4),rep("Esp",4)))
color_order<-c("Green","Clear","Yellow","Red")
colors<-c("#31a354","#bdbdbd","#fec44f","#de2d26")
a<-test %>%
mutate(Score=factor(Score,levels=color_order))%>%
arrange(Score)%>%
group_by(Score)%>%
summarize(count = n()) %>%
plot_ly(labels = ~Score,
values = ~count,
hoverinfo="skip",
text = ~count,
marker = list(colors = colors),
legendgroup = ~Score) %>%
add_pie(hole = 0.6) %>%
layout(title = "test chart1", showlegend = TRUE,
font=list(family="sans serif",color="#000"),
plot_bgcolor="#f0f0f0",
legend = list(orientation = 'h',font=list(size=28)),
xaxis = list(title=paste0("Total: ",nrow(test)), showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
b<-test1 %>%
mutate(Score=factor(Score,levels=color_order))%>%
arrange(Score)%>%
group_by(Score)%>%
summarize(count = n()) %>%
plot_ly(labels = ~Score,
values = ~count,
hoverinfo="skip",
text = ~count,
marker = list(colors = colors),
legendgroup = ~Score) %>%
add_pie(hole = 0.6) %>%
layout(title = "test chart2", showlegend = FALSE,
font=list(family="sans serif",color="#000"),
plot_bgcolor="#f0f0f0",
legend = list(orientation = 'h',font=list(size=28)),
xaxis = list(title=paste0("Total: ",nrow(test1)),showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
I am attempting to put them side by side with the common legend from plot a, and I run the following:
subplot(a,b,nrows = 1)
However, I only see one plot which appears to be a combination of the two. I also tried the approach here: Plotly: Bar and pie charts side by side, but it just gave me inception style donut within a donut. How can I put them next to each other with the common legend? Thanks.

According to this (https://plot.ly/r/pie-charts/), in order to create pie chart subplots, you need to use the domain attribute. You could try something like this (adjust domain for your needs):
a <- test %>%
mutate(Score=factor(Score,levels=color_order))%>%
arrange(Score)%>%
group_by(Score)%>%
summarize(count = n())
b<-test1 %>%
mutate(Score=factor(Score,levels=color_order))%>%
arrange(Score)%>%
group_by(Score)%>%
summarize(count = n())
p <- plot_ly() %>%
add_pie(data = a, labels = ~Score, values = ~count, hole = 0.6,
name = "a", domain = list(x = c(0, 0.4), y = c(0.4, 1))) %>%
add_pie(data = b, labels = ~Score, values = ~count, hole = 0.6,
name = "b", domain = list(x = c(0.6, 1), y = c(0.4, 1))) %>%
layout(title = "test chart1", showlegend = TRUE,
font=list(family="sans serif",color="#000"),
plot_bgcolor="#f0f0f0",
legend = list(orientation = 'h',font=list(size=28)),
xaxis = list(title=paste0("Total: ",nrow(test)), showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

Resources