Hey I am using the package plotly to create diagrams and i am trying to set up 2 different yaxis, but it does not work. Here is my code:
Schuldenquote_Argentinien <- c(80.3,70.8,62.1,53.8,55.4,43.5,38.9,40.4,43.5,44.7,52.6,53.1,57.1)
Schuldenquote_Brasilien <- c(68.7,65.9,63.8,61.9,65,63.1,61.2,62.2,60.2,62.3,72.6,78.3,84.1)
Schuldenquote_Chile <- c(7,5,3.9,4.9,5.8,8.6,11.1,11.9,12.7,15,17.3,21,23.5)
Schuldenquote_Mexico <- c(38.5,37.4,37.2,42.5,43.7,42,42.9,42.7,45.9,48.9,52.8,56.8,54)
Schuldenquote_Peru <- c(40,34.8,31.9,27.9,28.4,25.4,23,21.2,20,20.7,24,24.5,25.4)
Schulden_Argentinien <- c(159783,0,0,0,0,184396,0,0,0,0,337657,0,367360)*1000000
Schulden_Brasilien <- c(610776,0,0,0,0,1391222,0,0,0,0,1306199,0,1726603)*1000000
Schulden_Chile <- c(8.6,0,0,0,0,18.67,0,0,0,0,42.131,0,65.395)*1000000000
Schulden_Mexico <- c(337621,0,0,0,0,443485,0,0,0,0,618382,0,625687)*1000000
Schulden_Peru <- c(29923,0,0,0,0,37706,0,0,0,0,46037,0,54448)*1000000
Einwohner_Argentinien <- c(39.1455,0,0,0,0,41.2239,0,0,0,0,43.4178,0,44.271)*1000000
Einwohner_Brasilien <- c(186.1974,0,0,0,0,196.7963,0,0,0,0,205.9621,0,209.2883)*1000000
Einwohner_Chile <- c(16.1471,0,0,0,0,16.9934,0,0,0,0,17.7627,0,18.0547)*1000000
Einwohner_Mexico <- c(108.4722,0,0,0,0,117.3189,0,0,0,0,125.8909,0,129.1633)*1000000
Einwohner_Peru <- c(27.6104,0,0,0,0,29.3736,0,0,0,0,31.3767,0,32.1655)*1000000
Schuldenkopf_Argentinien <- Schulden_Argentinien/Einwohner_Argentinien
Schuldenkopf_Brasilien <- Schulden_Brasilien/Einwohner_Brasilien
Schuldenkopf_Chile <- Schulden_Chile/Einwohner_Chile
Schuldenkopf_Mexico <- Schulden_Mexico/Einwohner_Mexico
Schuldenkopf_Peru <- Schulden_Peru/Einwohner_Peru
library(lubridate)
Jahr <- c("01/01/2005","01/01/2006","01/01/2007","01/01/2008","01/01/2009","01/01/2010","01/01/2011","01/01/2012","01/01/2013","01/01/2014","01/01/2015","01/01/2016","01/01/2017")
Jahr <- as.Date(Jahr, format = "%d/%m/%Y", origin = "1970-01-01")
Schuldenquote_Lateinamerika <- data.frame(Jahr,Schuldenquote_Argentinien,Schuldenquote_Brasilien,Schuldenquote_Chile,Schuldenquote_Mexico,Schuldenquote_Peru)
Schuldenkopf_Lateinamerika <- data.frame(Jahr, Schuldenkopf_Argentinien, Schuldenkopf_Brasilien, Schuldenkopf_Chile, Schuldenkopf_Mexico, Schuldenkopf_Peru)
names(Schuldenquote_Lateinamerika) <- c("Jahr","ARG","BRA","CHL","MEX","PER")
names(Schuldenkopf_Lateinamerika) <- c("Jahr","ARG","BRA","CHL","MEX","PER")
library(plotly)
Schulden_Plot <- plot_ly(data = Schuldenkopf_Lateinamerika, y = ~ARG, x = ~Jahr, name = "ARG", type = "bar", color = toRGB("cornflowerblue")) %>%
add_trace(y = ~BRA, name = "BRA", marker = list(color = toRGB("forestgreen"))) %>%
add_trace(y = ~CHL, name = "CHL", marker = list(color = toRGB("firebrick1"))) %>%
add_trace(y = ~MEX, name = "MEX", marker = list(color = toRGB("gold2"))) %>%
add_trace(y = ~PER, name = "PER", marker = list(color = toRGB("darkorchid"))) %>%
add_lines(y = Schuldenquote_Lateinamerika$ARG, name = " ", mode = "lines", line = list(color = toRGB("cornflowerblue"), width = 2, yaxis = "y2")) %>%
add_lines(y = Schuldenquote_Lateinamerika$BRA, name = " ", mode = "lines", line = list(color = toRGB("forestgreen"), width = 2, yaxis = "y2")) %>%
add_lines(y = Schuldenquote_Lateinamerika$CHL, name = " ", mode = "lines", line = list(color = toRGB("firebrick1"), width = 2, yaxis = "y2")) %>%
add_lines(y = Schuldenquote_Lateinamerika$MEX, name = " ", mode = "lines", line = list(color = toRGB("gold2"), width = 2, yaxis = "y2")) %>%
add_lines(y = Schuldenquote_Lateinamerika$PER, name = " ", mode = "lines", line = list(color = toRGB("darkorchid"), width = 2, yaxis = "y2")) %>%
layout(yaxis = list(title = "Schulden pro Kopf in USD", linewidth = 3), yaxis2 = list(side = "right", title = "Schulden in Relation zum GDP" , linewidth = 3, overlaying = "y"), xaxis = list(zerolinewidth = 2), barmode = "group", showlegend = FALSE, autosize = TRUE)
Schulden_Plot
I tried several different ways to implement it in the code, but I am probably missing something?
I think you used wrong argument position yaxis should be outside the line = list.
Additionally, I adjust the margin to looks clear.
Full code is shown below :
Schulden_Plot <- plot_ly(data = Schuldenkopf_Lateinamerika, y = ~ARG, x = ~Jahr, name = "ARG", type = "bar", color = toRGB("cornflowerblue")) %>%
add_trace(y = ~BRA, name = "BRA", marker = list(color = toRGB("forestgreen"))) %>%
add_trace(y = ~CHL, name = "CHL", marker = list(color = toRGB("firebrick1"))) %>%
add_trace(y = ~MEX, name = "MEX", marker = list(color = toRGB("gold2"))) %>%
add_trace(y = ~PER, name = "PER", marker = list(color = toRGB("darkorchid"))) %>%
add_lines(y = Schuldenquote_Lateinamerika$ARG, name = " ", mode = "lines", line = list(color = toRGB("cornflowerblue"), width = 2), yaxis = "y2") %>%
add_lines(y = Schuldenquote_Lateinamerika$BRA, name = " ", mode = "lines", line = list(color = toRGB("forestgreen"), width = 2), yaxis = "y2") %>%
add_lines(y = Schuldenquote_Lateinamerika$CHL, name = " ", mode = "lines", line = list(color = toRGB("firebrick1"), width = 2), yaxis = "y2") %>%
add_lines(y = Schuldenquote_Lateinamerika$MEX, name = " ", mode = "lines", line = list(color = toRGB("gold2"), width = 2), yaxis = "y2") %>%
add_lines(y = Schuldenquote_Lateinamerika$PER, name = " ", mode = "lines", line = list(color = toRGB("darkorchid"), width = 2), yaxis = "y2") %>%
layout(margin = list(l=50, r= 50, b= 50, t= 50),yaxis = list(title = "Schulden pro Kopf in USD", linewidth = 3),
yaxis2 = list(side = "right", title = "Schulden in Relation zum GDP" , linewidth = 3, overlaying = "y"),
xaxis = list(zerolinewidth = 2), barmode = "group", showlegend = FALSE, autosize = TRUE)
Related
I have two plots in my graph. One is group of some indicators.
Second is other group of indicators.
If they are plotted individually the grouping is proper. If they are plotted in single graph sharing the x axis, graphs groupings are showing improperly,
Section 1 should be (v_plot_sec1)
candlestick
ema_8
bbands
Section 2 should be (v_plot_sec2)
MACD
MACD_signal
RSI
VOLUME
While output in v_plot_fnl is mixed up
Can the proper grouping be generated...
library(quantmod)
library(dplyr)
library(purrr)
library(plotly)
get_data <- function(symbols = c("AAPL", "MSFT", "META", "ORCL",
"TSLA", "GOOG")) {
syms <- getSymbols(symbols, from = "2020/01/01",
to = Sys.Date(), periodicity = "daily")
map_dfr(syms, function(sym) {
raw_data <- get(sym)
raw_data %>%
as_tibble() %>%
set_names(c("OPEN", "HIGH", "LOW", "CLOSE", "VOLUME", "ADJUSTED")) %>%
mutate(SYMBOL = sym,
DATE = index(raw_data)) %>%
select(SYMBOL, DATE, OPEN, HIGH, LOW, CLOSE, VOLUME, ADJUSTED)
})
}
if (!exists("df_all")) {
df_all <- get_data()
}
p_from_date = Sys.Date() -180
p_to_date = Sys.Date()
p_isin = 'AAPL'
dt_tst <- as.data.table(df_all[df_all$SYMBOL == 'AAPL',])
dt_tst$inc_dec <- sign(dt_tst$CLOSE-dt_tst$OPEN)
dt_tst[dt_tst$inc_dec ==0, ]$inc_dec = 1
dt_tst$Color = ''
dt_tst[inc_dec==1,]$Color = '#2F6346'# '#00ff00'
dt_tst[inc_dec== -1,]$Color = '#FF4136' #'#ff0000'
# t line data
dt_tmp_ema8 <- as.data.table(EMA(dt_tst[,CLOSE], n = 8))
names(dt_tmp_ema8) <- 'ema_8'
dt_tst <- cbind(dt_tst, dt_tmp_ema8)
# #--Processing BBANDS
dt_tmp_bbands <- as.data.table(BBands(dt_tst[,CLOSE]))
names(dt_tmp_bbands) <- paste0('bbands_',names(dt_tmp_bbands))
dt_tst <- cbind(dt_tst,dt_tmp_bbands)
#----On Balance Volume
dt_tmp_obv <- as.data.table(OBV(dt_tst[,CLOSE], dt_tst[,VOLUME]))
names(dt_tmp_obv) <- 'obv'
dt_tst <- cbind(dt_tst,dt_tmp_obv)
#----StochWPR
dt_tmp_wpr <- as.data.table(sprintf(WPR(dt_tst[,c(HIGH,LOW,CLOSE)]),fmt = '%#.3f'))
#---- Average Directional Index
dt_tmp_adx <- as.data.table(ADX(dt_tst[,.(HIGH,LOW,CLOSE)]))
dt_tst <- cbind(dt_tst,dt_tmp_adx)
#-----RSI
dt_tmp_RSI <- as.data.table(RSI(dt_tst[,.(CLOSE)]))
names(dt_tmp_RSI) = 'RSI'
dt_tst <- cbind(dt_tst,dt_tmp_RSI)
#---- MACD
dt_tmp_macd <- as.data.table(MACD(dt_tst[,.(CLOSE)], 12, 26,9,maType = 'EMA'))
names(dt_tmp_macd) <- c('macd','macd_signal')
dt_tst <- cbind(dt_tst,dt_tmp_macd)
#-- Graphing--------------------------------------------------------------------
# Section 1
cndlstick <- plot_ly(name = 'candlestick' ,data = dt_tst,type='candlestick', x = ~DATE, low=~LOW, high = ~HIGH, open = ~OPEN, close=~CLOSE)
v_plot_sec1 <- add_trace(cndlstick, name = 'ema_8', data = dt_tst, type = 'scatter', mode = 'lines', x= ~DATE, y = ~ema_8, line = list(color = 'black', width = 2))
v_plot_sec1 <- add_trace(v_plot_sec1, name = 'bbands_dn', data = dt_tst, type = 'scatter', mode = 'lines', x= ~DATE, y = ~bbands_dn, line = list(color = 'gray', width = 1))
v_plot_sec1 <- add_trace(v_plot_sec1, name = 'bbands_mavg', data = dt_tst, type = 'scatter', mode = 'lines', x= ~DATE, y = ~bbands_mavg,
line = list(color = 'black', width = 1,linetype =I("dash") ))
v_plot_sec1 <- add_trace(v_plot_sec1, name = 'bbands_up', data = dt_tst, type = 'scatter', mode = 'lines', x= ~DATE, y = ~bbands_up, line = list(color = 'gray', width = 1))
# Section 2
v_plot_sec2 <- plot_ly(name = 'MACD', data = dt_tst, type = 'scatter', mode = 'lines', x=~DATE,y=~macd,line = list(color = 'black', width = 1))
v_plot_sec2 <- add_trace(v_plot_sec2, name = 'MACD_signal', data = dt_tst, type = 'scatter', mode = 'lines', x=~DATE,y=~macd_signal,line = list(color = 'red', width = 1))
y2 <- list(tickfont = list(color = "#ff7f0e"),titlefont = list(color = "#ff7f0e"),overlaying = "y",side = "left", anchor="free", position=0.15, title = "RSI")
v_plot_sec2 <- v_plot_sec2 %>% add_trace( type = 'scatter', mode = 'lines', x=~dt_tst$DATE,y=~dt_tst$RSI, yaxis = "y2", line = list(color = 'black', width = 1))
y3 <- list(tickfont = list(color = "#d62728"),titlefont = list(color = "#d62728"),overlaying = "y",side = "right",title = "yaxis3 title")
v_plot_sec2 <- v_plot_sec2%>% add_trace( data = dt_tst, type = 'bar', x=~DATE, y=~VOLUME, yaxis = "y3",marker = list(color = ~toRGB(Color, alpha = 0.5)))
v_plot_sec2 <- v_plot_sec2 %>% layout(title = "multiple y-axes example", yaxis2 = y2, yaxis3 = y3, xaxis = list(title = 'Date'),# domain = c(0.3, 0.7)),
yaxis = list(title="yaxis title", tickfont = list(color = "#1f77b4"),titlefont = list(color = "#1f77b4")) )%>%
layout(plot_bgcolor='#e5ecf6',xaxis = list(zerolinecolor = '#ffff',zerolinewidth = 2,gridcolor = 'ffff'),yaxis = list(zerolinecolor = '#ffff',zerolinewidth = 2,gridcolor = 'ffff'))
v_plot_fnl <- subplot(v_plot_sec1,v_plot_sec2,heights = c(0.6,0.3), nrows= 2, shareX = TRUE, titleY = TRUE)
Updated Request for a Multi-Plot Slider
If you wanted a range slider that controls both plots, you can use the crosstalk library.
First, create shared data.
library(crosstalk)
sd = SharedData$new(dt_tst)
Then instead of data = ds_tst in your plots, change that to sd, so the plots are using the shared data object you created.
I copied the plot code, changed the data source, and incremented the versions for the object names (they end in v3, instead of v2).
Then I created the filter_slider object.
fs <- filter_slider(id = "data-slider",
"Set the date range for both plots",
sd,
~DATE)
Lastly, I put it all together in bscols. (Also from crosstalk)
bscols(list(fs, sec1_v3, sec2_v3))
That code (less data creation) altogether.
library(plotly)
library(crosstalk)
sd = SharedData$new(dt_tst)
sec1_v3 <- plot_ly(name = 'candlestick',
data = sd, type='candlestick',
x = ~DATE, low = ~LOW, high = ~HIGH,
open = ~OPEN, close = ~CLOSE) %>%
add_lines(name = 'ema_8', y = ~ema_8,
line = list(color = 'black', width = 2)) %>%
add_lines(name = 'bbands_dn', y = ~bbands_dn,
line = list(color = 'gray', width = 1)) %>%
add_lines(name = 'bbands_mavg', y = ~bbands_mavg,
line = list(color = 'black', width = 1, linetype = I("dash"))) %>%
add_lines(name = 'bbands_up', y = ~bbands_up,
line = list(color = 'gray', width = 1))
sec2_v3 <- plot_ly(name = 'MACD', type = 'scatter', mode = 'lines',
data = sd, x = ~DATE, y = ~macd,
line = list(color = 'black', width = 1)) %>%
add_lines(name = 'MACD_signal', y = ~macd_signal,
line = list(color = 'red', width = 1)) %>%
add_lines(y = ~RSI, yaxis = "y2", line = list(color = 'black', width = 1)) %>%
add_bars(y = ~VOLUME, yaxis = "y3",
marker = list(color = ~toRGB(Color, alpha = 0.5))) %>%
layout(title = "multiple y-axes example", yaxis2 = y2, yaxis3 = y3,
plot_bgcolor='#e5ecf6',
xaxis = list(title = 'Date', zerolinecolor = '#ffff',
zerolinewidth = 2, gridcolor = 'ffff'),
yaxis = list(title="yaxis title",
tickfont = list(color = "#1f77b4"),
titlefont = list(color = "#1f77b4"),
zerolinecolor = '#ffff',
zerolinewidth = 2,gridcolor = 'ffff'))
fs <- filter_slider(id = "data-slider",
"Set the date range for both plots",
sd,
~DATE)
bscols(list(fs, sec1_v3, sec2_v3))
Original Answer
Instead of using subplot, which is unlikely to work out in this case, you could use browsable from the package htmltools.
I went through your plots a bit to see if there was anything amiss. I didn't change anything, but I did remove some redundancies. Yours work, so these changes aren't needed.
Your first plot:
sec1_v2 <- plot_ly(name = 'candlestick',
data = dt_tst, type='candlestick',
x = ~DATE, low = ~LOW, high = ~HIGH,
open = ~OPEN, close = ~CLOSE) %>%
add_lines(name = 'ema_8', y = ~ema_8,
line = list(color = 'black', width = 2)) %>%
add_lines(name = 'bbands_dn', y = ~bbands_dn,
line = list(color = 'gray', width = 1)) %>%
add_lines(name = 'bbands_mavg', y = ~bbands_mavg,
line = list(color = 'black', width = 1, linetype = I("dash"))) %>%
add_lines(name = 'bbands_up', y = ~bbands_up,
line = list(color = 'gray', width = 1))
Your second plot:
y2 <- list(tickfont = list(color = "#ff7f0e"),
titlefont = list(color = "#ff7f0e"),
overlaying = "y", side = "left", anchor="free",
position=0.15, title = "RSI")
y3 <- list(tickfont = list(color = "#d62728"),
titlefont = list(color = "#d62728"),
overlaying = "y",side = "right", title = "yaxis3 title")
sec2_v2 <- plot_ly(name = 'MACD', type = 'scatter', mode = 'lines',
data = dt_tst, x = ~DATE, y = ~macd,
line = list(color = 'black', width = 1)) %>%
add_lines(name = 'MACD_signal', y = ~macd_signal,
line = list(color = 'red', width = 1)) %>%
add_lines(y = ~RSI, yaxis = "y2", line = list(color = 'black', width = 1)) %>%
add_bars(y = ~VOLUME, yaxis = "y3",
marker = list(color = ~toRGB(Color, alpha = 0.5))) %>%
layout(title = "multiple y-axes example", yaxis2 = y2, yaxis3 = y3,
plot_bgcolor='#e5ecf6',
xaxis = list(title = 'Date', zerolinecolor = '#ffff',
zerolinewidth = 2, gridcolor = 'ffff'),
yaxis = list(title="yaxis title",
tickfont = list(color = "#1f77b4"),
titlefont = list(color = "#1f77b4"),
zerolinecolor = '#ffff',
zerolinewidth = 2,gridcolor = 'ffff'))
Calling them together:
browsable(div(div(sec1_v2), div(sec2_v2))) # functions browsable & div from htmltools
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:
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 having a dataframe as follows
avgHours <- data.frame("QuarterYear" = c('2019 Q4','2020 Q1','2020 Q2'), average = c(44.5,44.5,42.0), leave = c(24.0,9.3,0.0), freeTime = c(0,0,0))
I need to plot 3 line graphs. In this case, I'm having a non-zero columns and 1 column with all the rows as 0. I need to omit that column while plotting.
This is the code for plotting the graph
plot_ly(avgHours) %>%
add_trace(x = avgHours$QuarterYear,
y = avgHours$average,
type = 'scatter',
mode = 'lines+markers+text',
hovertext = paste('Quarter: ', avgHours$QuarterYear,
'<br>Average hours per week: ', avgHours$average),
line = list(color = 'rgb(242,142,43)',
width = 3),
marker = list(color = 'rgb(242,142,43)',
size = 8),
hoverinfo = "text",
text = avgHours$average,
textposition = "top center",
name = "Average Hours")%>%
add_trace(x = avgHours$QuarterYear,
y = avgHours$leave,
type = 'scatter',
mode = 'lines+markers+text',
hovertext = paste('Quarter: ', avgHours$QuarterYear,
'<br>Average OOO hours per week: ', avgHours$leave),
line = list(color = 'rgb(205, 12, 24)',
width = 3),
marker = list(color = 'rgb(205, 12, 24)',
size = 8),
hoverinfo = "text",
text = avgHours$leave,
textposition = "top center",
name = "Leave Average Hours")%>%
add_trace(x = avgHours$QuarterYear,
y = avgHours$freeTime,
type = 'scatter',
mode = 'lines+markers+text',
hovertext = paste('Quarter: ', avgHours$QuarterYear,
'<br>Average Free Time per week: ', avgHours$freeTime),
line = list(color = '#003049',
width = 3),
marker = list(color = '#003049',
size = 8),
hoverinfo = "text",
text = avgHours$freeTime,
textposition = "top center",
name = "Free Time Average Hours")%>%
layout(
yaxis = list(
range = c(0,70),
title = "Average Hours Per Week"
)
) %>%
layout(hoverlabel = list(bgcolor= 'white'), showlegend = TRUE) %>%
layout(yaxis = list(showgrid = FALSE, zeroline = FALSE, showline = FALSE)) %>%
layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showline = FALSE)) %>%
layout(legend = list(orientation = "h",
xanchor = "center",
x = 0.5,
y = -0.13))
}
How can I plot the non-zero columns dynamically using plot_ly() in R?
Thanks in advance!!
You can have the add_trace in loop and specify the column selection by if condition as below:
p <- plot_ly(data = avgHours)
for(i in colnames(avgHours[-1])){
if(sum(avgHours[[i]])>0){
p <- p %>%
add_trace(x = avgHours[[1]],
y = avgHours[[i]],
type = 'scatter',
mode = 'lines+markers+text',
hovertext = paste('Quarter: ', avgHours[[1]],
'<br>Average hours per week: ', avgHours[[i]]),
line = list(width = 3),
marker = list(size = 8),
hoverinfo = "text",
text = avgHours[[i]],
textposition = "top center",
name = i)
}
}
p <- p %>%
layout(yaxis = list(
range = c(0,70),
title = "Average Hours Per Week")) %>%
layout(hoverlabel = list(bgcolor= 'white'), showlegend = TRUE) %>%
layout(yaxis = list(showgrid = FALSE, zeroline = FALSE, showline = FALSE)) %>%
layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showline = FALSE)) %>%
layout(legend = list(orientation = "h", xanchor = "center", x = 0.5, y = -0.13))
If you want to have specific colours for each line and markers, you can add the list of colours and sub-setting it.
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