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)
Related
I'm trying to make a dual axis plot of rainfall and temperature. I have ordered the months on the bottom, but that causes my line graph to screw up. How do I make sure the added line uses the same x axis?
temprain<-data.frame(month = c(1:12),
Train = c(250,220, 180,97,38,27,31,47,70,140,200,250),
Tair = c(17,16, 15,13,9,6,5,9,12,13,14,16))
tempseq<-seq(0,20,by=0.5)
rainseq<-seq(0,260,by=1)
xlab<-list(type = "category",
categoryorder = "array",
categoryarray = month.name,
showgrid = TRUE,
showline = TRUE,
autorange = TRUE,
showticklabels = TRUE,
ticks = "outside",
tickangle = 0
)
plot_ly(temprain) %>%
add_bars(x = ~MonthName, y = ~Train, type = "bar", name = "Rain") %>%
add_lines(x = ~MonthName, y = ~Tair, yaxis = "y2", name = "Temp") %>%
layout(xaxis = xlab,
yaxis = list(showline = TRUE, side = "left",
title = "Rainfall (mm)Temp", range = tempseq),
yaxis2 = list(showline = TRUE, side = "right",
overlaying = "y", title = "Air Temp (C)", range = rainseq),
showlegend = FALSE,
margin = list(pad = 0, b = 50, l = 50, r = 50))
I tried this as well, and it doesn't work, the temp graph disappears
plot_ly(temprain, x = ~MonthName, y = ~Tair, name = "Temp") %>%
add_bars(x = ~MonthName, y = ~Train, yaxis = "y2", type = "bar", name = "Rain") %>%
layout(xaxis = xlab,
yaxis = list(showline = TRUE, side = "left",
title = "Air Temp (C)", range = tempseq),
yaxis2 = list(showline = TRUE, side = "right",
overlaying = "y",
title = "Rainfall (mm)", range = rainseq),
showlegend = FALSE,
margin = list(pad = 0, b = 50, l = 50, r = 50))
Below is the solution:
Your data:
temprain<-data.frame(month = c(1:12),
Train = c(250,220, 180,97,38,27,31,47,70,140,200,250),
Tair = c(17,16, 15,13,9,6,5,9,12,13,14,16))
Generate a column for month abbreviations from month:
mymonths <- c("Jan","Feb","Mar",
"Apr","May","Jun",
"Jul","Aug","Sep",
"Oct","Nov","Dec")
# match the month numbers against abbreviations:
temprain$MonthAbb = mymonths[ temprain$month ]
# This is the code to archieving a consistent combined graph:
temprain$MonthAbb <- factor(temprain$MonthAbb, levels = c(as.character(temprain$MonthAbb)))
Now plot your data:
fig <- plot_ly(temprain)
# Add the Train trace:
fig <- fig %>% add_trace(x = ~MonthAbb, y = ~Train, name = "Train", type = "bar")
ay <- list(
tickfont = list(color = "red"),
overlaying = "y",
side = "right",
title = "<b>Tair</b>")
# Add the Tair trace:
fig <- fig %>% add_trace(x = ~MonthAbb, y = ~Tair, name = "Tair", yaxis = "y2", mode = "lines+markers", type = "scatter")
fig <- fig %>% layout(yaxis2 = ay,
xaxis = list(title="Month"),
yaxis = list(title="<b>Train</b>"))%>%
layout(xaxis = list(
zerolinecolor = '#ffff',
zerolinewidth = 2,
gridcolor = 'ffff'),
yaxis = list(
zerolinecolor = '#ffff',
zerolinewidth = 2,
gridcolor = 'ffff')
)
fig
Output:
I have used bargap to decrease the width of bars in plotly but I want to bring themcloser whild keeping this width and not make them thicker.
library(tidyr)
library(stringr)
library(forcats)
library(plotly)
# data
Category<-c("First dose","Full vaccination")
`Uptake first dose`<-c(19.8,0)
`Uptake full vaccination`<-c(0,7.6)
`Not vaccinated`<-c(80.2,92.4)
ch5<-data.frame(Category,`Uptake first dose`,`Uptake full vaccination`,`Not vaccinated`)
# transform data
data.long <- ch5 %>%
pivot_longer(cols = -Category,
names_to = "vac",
values_to = "percent") %>%
mutate(vac = str_replace_all(vac, "\\.", " "),
vac = fct_rev(factor(vac)))
library(plotly)
plot_ly(data.long) %>%
add_bars(y = ~Category,
x = ~percent,
color = ~vac,
text = ~vac,
colors = c("#458d35", "#63bb47", "#e6e7e8"),
hovertemplate = paste('<b>%{y}</b>',
'<br>%{text}: %{x} ',
'<extra></extra>')) %>%
layout(font = list(color = '#a2a2a2'),barmode = "stack",
bargap = 0.7,
yaxis = list(fixedrange = TRUE,autorange="reversed",
title = "",
showticklabels = FALSE,
showgrid = FALSE,
showline = FALSE,
zeroline = FALSE),
xaxis = list(fixedrange = TRUE,title = "",ticksuffix = '%',
zeroline = FALSE,
showgrid = FALSE),
hoverlabel = list(bgcolor = "black",
bordercolor = "black",
font = list(color = "white")),
shapes = list(type = "line",
y0 = 0, y1 = 1, yref = "paper",
x0 = 70, x1 = 70),
annotations = list(text = "Target (70%)",
showarrow = FALSE,
x = 70,
y = 1.05,
yref = "paper"),
legend = list(orientation = 'h'))
How can I add a horizontal x-axis scroll bar in a long plotly line chart?
library(plotly)
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
fig <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines')
fig
Case that rangeslider() does not work.
VaccinationWeek<-c("2020w1","2020w1","2020w1","2020w2","2020w2","2020w2")
Country<-c("EU","CHE","ITA","EU","CHE","ITA")
Value<-c(3,2,1,5,3,2)
dat<-data.frame(VaccinationWeek,Country,Value)
plot_ly(dat,
x = ~VaccinationWeek,
y = ~Value/100,
text = ~Value,
color = ~Country,
customdata = dat$Country) %>%
add_trace(
type = 'scatter',
mode = 'lines+markers',
hovertemplate = paste("Country: %{customdata}",
"Uptake full vaccination (%): %{y}",
"<extra></extra>",
sep = "\n"),
hoveron = 'points') %>%
add_text(
textposition = "top center",
showlegend = F,
hoverinfo = "skip") %>%
layout(font = list(color = '#a2a2a2'),title=list(text="by reporting week",x = 0),
xaxis = list(fixedrange = TRUE,title="",showgrid = FALSE,tickangle = 45
),
yaxis = list(fixedrange = TRUE,rangeslider = list(),title="",showgrid = FALSE,showline=T,tickformat = "%"),
hovermode = "x unified",
hoverlabel = "none",
legend = list(itemclick = F, itemdoubleclick = F))%>%
config(modeBarButtonsToRemove = c('toImage',"zoom2d","toggleSpikelines","hoverClosestCartesian","hoverCompareCartesian","drawline","autoScale2d" ,"resetScale2d","zoomIn2d","zoomOut2d","pan2d",'select2d','lasso2d'))%>%
config(displaylogo = FALSE)
I'd suggest using a rangeslider:
library(plotly)
x <- c(1:100)
random_y <- rnorm(100, mean = 0)
data <- data.frame(x, random_y)
fig <- plot_ly(data, x = ~x, y = ~random_y, type = 'scatter', mode = 'lines') %>%
layout(xaxis = list(rangeslider = list()))
fig
After #firmo23's edit:
library(plotly)
VaccinationWeek <- c("2020w1", "2020w1", "2020w1", "2020w2", "2020w2", "2020w2")
Country <- c("EU", "CHE", "ITA", "EU", "CHE", "ITA")
Value <- c(3, 2, 1, 5, 3, 2)
dat <- data.frame(VaccinationWeek, Country, Value)
plot_ly(
dat, x = ~ VaccinationWeek, y = ~ Value / 100, text = ~ Value, color = ~ Country, customdata = dat$Country
) %>%
add_trace(
type = 'scatter', mode = 'lines+markers', hovertemplate = paste(
"Country: %{customdata}", "Uptake full vaccination (%): %{y}", "<extra></extra>", sep = "\n"
), hoveron = 'points'
) %>%
add_text(textposition = "top center", showlegend = F, hoverinfo = "skip") %>%
layout(
font = list(color = '#a2a2a2'), title = list(text = "by reporting week", x = 0), xaxis = list(
fixedrange = TRUE, title = "", showgrid = FALSE, tickangle = 45, rangeslider = list()
), yaxis = list(
fixedrange = TRUE, rangeslider = list(), title = "", showgrid = FALSE, showline = T, tickformat = "%"
), hovermode = "x unified", hoverlabel = "none", legend = list(itemclick = F, itemdoubleclick = F)
) %>%
config(
modeBarButtonsToRemove = c(
'toImage',
"zoom2d",
"toggleSpikelines",
"hoverClosestCartesian",
"hoverCompareCartesian",
"drawline",
"autoScale2d" ,
"resetScale2d",
"zoomIn2d",
"zoomOut2d",
"pan2d",
'select2d',
'lasso2d'
),
displaylogo = FALSE
)
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'))
)
)
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