Related
I am very new to (plotting in) R and I stumbled across this example on the plotly.com pages
library(plotly)
fig1 <- plot_ly(x = c(1,2,3), y = c(4,5,6), type = 'bar',
marker = list(color = c(4,5,6), coloraxis="coloraxis"))
fig2 <- plot_ly(x = c(1,2,3), y = c(2,3,5), type = 'bar',
marker = list(color = c(2,3,5), coloraxis="coloraxis"))
fig <- subplot(fig1, fig2, shareY = TRUE)
fig <- fig %>%layout(showlegend = FALSE, coloraxis=list(colorscale='RdBu'),
plot_bgcolor='#e5ecf6',
xaxis = list(
zerolinecolor = '#ffff',
zerolinewidth = 2,
gridcolor = 'ffff'),
yaxis = list(
zerolinecolor = '#ffff',
zerolinewidth = 2,
gridcolor = 'ffff'))
fig
And I wanted to know what I would have to add in order to print the subplot without the color bar on the right hand side?
Thanks in advance!
I tried with hide_colorbar(fig) after the code above, but that didn´t change anything
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 am creating a plot with several time series, plotting the mean value and two quantiles in the process and highlighting the region between the quantiles. Then I have a unified hoverinfo showing me all points at one point in time. I do not want this hoverinfo to display the dummy trace that is only there for the highlighting. I tried both hoverinfo = skip and hoverinfo = none, but that only hides any text info, not the trace itself in the hoverinfo.
Here is the code I have (without most "beautification parameters" such as axis width and the likes...):
###creating dummy data
test_data <- data.frame(matrix(0,nrow = 27,ncol = 4))
colnames(test_data) <- c("x","y","value","date")
test_data$x <- c(-1,-1,-1,0,0,0,1,1,1,-1,-1,-1,0,0,0,1,1,1,-1,-1,-1,0,0,0,1,1,1)
test_data$y <- c(-1,0,1,-1,0,1,-1,0,1,-1,0,1,-1,0,1,-1,0,1,-1,0,1,-1,0,1,-1,0,1)
test_data$value <- rnorm(27,mean = 5,sd = 1)
date_vec <- c(rep(as.Date("2022-01-01"),9),rep(as.Date("2022-01-02"),9),rep(as.Date("2022-01-03"),9))
test_data$date <- date_vec
x_levels <- unique(test_data$x)
y_levels <- unique(test_data$y)
avg <- data.frame(matrix(0,nrow = 3,ncol = 1))
colnames(avg) <- c("value")
avg$date <- unique(date_vec)
Q75 <- data.frame(matrix(0,nrow = 3,ncol = 1))
colnames(Q75) <- c("value")
Q75$date <- unique(date_vec)
Q25 <- data.frame(matrix(0,nrow = 3,ncol = 1))
colnames(Q25) <- c("value")
Q25$date <- unique(date_vec)
for (i in 1:length(unique(date_vec))){
avg$value[i] <- mean(test_data$value[test_data$date == unique(date_vec)[i]])
Q75$value[i] <- quantile(test_data$value[test_data$date == unique(date_vec)[i]],0.75)
Q25$value[i] <- quantile(test_data$value[test_data$date == unique(date_vec)[i]],0.25)
}
##creating plot
fig <- plot_ly()
fig <- fig %>% layout(hovermode = 'x unified')
for(i in 1:length(x_levels)){
for(j in 1:length(y_levels)){
fig <- fig %>% add_trace(data = test_data, type = 'scatter', mode = 'lines+markers',
x = test_data$date[test_data$x == x_levels[i] & test_data$y == y_levels[j]],
y = test_data$value[test_data$x == x_levels[i] & test_data$y == y_levels[j]],
showlegend = FALSE, line = list(color = 'grey'), marker = list(color = 'grey'),
hoverinfo = 'text', text = paste0("some text dependent on x and y"))
}}
fig <- fig %>% add_trace(data = Q25, type = 'scatter', mode = 'lines', name = '25%-quantile', x = Q25$date,
y = Q25$value, showlegend = TRUE, line = list(color = 'darkred', dash = 'dot'),
hoverinfo = 'text', text = paste0("some text dependent on Q25"))
fig <- fig %>% add_trace(data = avg, type = 'scatter', mode = 'lines', name = 'mean value', x = avg$date,
y = avg$value, showlegend = TRUE, line = list(color = 'darkred', dahs = 'dash'),
hoverinfo = 'text', text = paste0("some text depenent on avg"))
fig <- fig %>% add_trace(data = Q75, type = 'scatter', mode = 'lines', name = '75%-quantile', x = Q75$date,
y = Q75$value, showlegend = TRUE, line = list(color = 'darkred', dash = 'dot'),
hoverinfo = 'text', text = paste0("some text dependent on Q75"))
#### This is the dummy trace in question:
fig <- fig %>% add_trace(x = Q25$date, y = Q25$value, type = 'scatter', mode = 'lines', fill = 'tonexty',
fillcolor = 'rgba(139,0,0,0.2)', line = list(color = 'darkred', width = 0.1), showlegend = FALSE,
hoverinfo = 'skip')
print(fig)
Is this a bug? Am I missing something obvious? Is there a better way to make the highlighting that does not create an additional hoverinfo? Thanks in advance!
Alright, this answer is not ideal—but it works.
There is good news, though. Plotly developers are already working on a solution. They're in the testing phase, which is where I got the idea for this answer. You can read about what Plotly's doing here.
First, I set a seed because you have random data. I used set.seed(3509). There were no changes to the data or fig.
When you hover over any point on your graph, your fill color will disappear. The tooltip does not show the trace that shouldn't be there anyway.
The fill color will return as soon as you move on or when the tooltip goes away.
This is the Javascript to call this hover event.
# the notation [12] is the curvenumber; it represnts a single trace
hoverer = "function(el, x) {
el.on('plotly_hover', function(d){
dt = {'fill': 'none'};
Plotly.restyle(el.id, dt, [12]);
});
el.on('plotly_unhover', function(d){
ft = {'fill':'tonexty'};
Plotly.restyle(el.id, ft, [12]);
});
}"
To visualize your plot with this event:
fig %>% htmlwidgets::onRender(hoverer)
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 have a bar chart like below, which is drawn by the plotly package.
You can see the data and code below:
#CODE
#Data
test_data_set<-structure(list(Name = c("Cars_sale_1", "Cars_sale_2", "Cars_sale_3",
"Cars_sale_4", "Cars_sale_5", "Cars_sale_6", "Cars_sale_7", "Cars_sale_8",
"Cars_sale_9", "Cars_sale_10", "Cars_sale_11", "Cars_sale_12",
"Cars_sale_13"), First = c(156300.824706096, 10006.2467099491,
3212.0722933848, 3319.03842779435, 9658.39620986138, 8434.32181084401,
1367.81891559923, 717.880329882435, 260.817687313564, 196.525706264257,
1042.98999824531, 7036.46253728724, 14974.7002155131), Second = c(227324.372696964,
16086.4713107563, 6318.58220740481, 21832.8829619231, 15740.5860677312,
10538.8313739252, 4399.92981224776, 2872.64432356554, 1391.68275135989,
0, 1979.57536409896, 12618.0733462011, 20694.7337436906), Third = c(277421.301982804,
18264.5376381821, 10922.6180031584, 30805.9659589402, 23327.3205825583,
14162.2038954203, 9179.99649061239, 5272.22319705212, 3019.19635023688,
0, 3587.71714335848, 17227.7241621337, 21867.2276106995), Fourth = c(307141.042288121,
27274.1182663625, 15141.1826636252, 51266.257238112, 25035.1289699947,
18876.8555886998, 13549.8859449026, 12045.9027899632, 4577.92595192139,
0, 9101.66695911564, 19369.2928583962, 30971.5263285415), Fifth = c(345904.895595719,
35406.3519915775, 21022.9163011055, 70233.5146516933, 28311.4932444288,
22832.3565537814, 21108.8261098438, 14801.7546938059, 4776.69766625724,
56.1502017897877, 11680.6457273206, 24203.544481488, 25989.4022630561
), Sixth = c(375676.013335673, 38199.2630286015, 34954.3428671697,
96511.528338305, 33332.4442884717, 27694.4025267591, 27706.1940691349,
26899.0349184067, 8709.73855062292, 224.600807159151, 16098.5436041411,
31910.4404281453, 32467.4847713049), Seventh = c(433176.346727496,
47455.623793648, 51832.251272153, 121340.024565713, 41695.1745920337,
31331.5318476926, 44969.8543604141, 24795.9291103702, 10157.0100017547,
828.215476399368, 27548.4120021056, 41680.0140375504, 35955.6910763933
), Eight = c(501520.687839972, 55052.4653447973, 74202.4916652044,
162651.693279523, 45550.4474469205, 40385.1903842779, 54554.132303913,
43609.6157220565, 16360.2035444815, 4171.95999298123, 45789.3665555361,
53713.5637831198, 29226.7897579876), Ninth = c(567436.251974031,
65858.0101772241, 104945.288647131, 238514.82716266, 60495.6659062993,
52381.4002456571, 100849.973679593, 61956.6941568696, 27927.4258641867,
4159.60694858747, 77211.5809791192, 69056.0449201614, 29472.1253015506
), Tenth = c(755730.057904896, 89047.2012633796, 208602.210914195,
544052.500438673, 195334.760484295, 129515.213195297, 220957.50131602,
119074.083172486, 115559.080540446, 36932.7952272328, 156449.622740832,
120385.751886296, 33197.0639513509)), row.names = c(NA, -13L), class = c("tbl_df",
"tbl", "data.frame"))
# Draw bar chart
library(plotly)
t_df <- data.frame(t(test_data_set[,-1]))
colnames(t_df) <- test_data_set$Name
t_df$Number <- factor(row.names(t_df),levels=row.names(t_df),ordered=TRUE)
p <- plot_ly(t_df, x = ~Number, y = ~Cars_sale_1, type = 'bar', name = 'Cars_sale_1') %>%
add_trace(y = ~Cars_sale_2, name = 'Cars_sale_2') %>%
add_trace(y = ~Cars_sale_3, name = 'Cars_sale_3') %>%
add_trace(y = ~Cars_sale_4, name = 'Cars_sale_4') %>%
add_trace(y = ~Cars_sale_5, name = 'Cars_sale_5') %>%
add_trace(y = ~Cars_sale_6, name = 'Cars_sale_6') %>%
add_trace(y = ~Cars_sale_7, name = 'Cars_sale_7') %>%
add_trace(y = ~Cars_sale_8, name = 'Cars_sale_8') %>%
add_trace(y = ~Cars_sale_9, name = 'Cars_sale_9') %>%
add_trace(y = ~Cars_sale_10, name = 'Cars_sale_10') %>%
add_trace(y = ~Cars_sale_11, name = 'Cars_sale_11') %>%
add_trace(y = ~Cars_sale_12, name = 'Cars_sale_12') %>%
add_trace(y = ~Cars_sale_13, name = 'Cars_sale_13') %>%
layout(yaxis = list(title = 'Count'), barmode = 'stack')
p
The chart shows 13 different categories but my problem are the colors.
Car_sale_1 and Car_sale_11 have the same color, as do Car_sale_2 and Car_sale_12 etc.
My intention is to make a graph with unique colors per category. Can anybody help me fix this problem ?
I have reedited the code to make it much easier for you to see a possible way to manually select the colors. Also, do not add as many traces manually since you would get crazy if you had 100. Do it the following way:
library(plotly)
library(reshape2)
t_df <- data.frame(t(test_data_set[,-1]))
colnames(t_df) <- test_data_set$Name
t_df$Number <- factor(row.names(t_df),levels=row.names(t_df),ordered=TRUE)
t_df<-melt(t_df, id.vars = c("Number"))
t_df$color <- factor(t_df$variable, labels = c("blue", "red", "green", "yellow", "brown",
"black","orange","purple", "grey","white",
"chocolate", "coral", "cornflowerblue"))
p <- plot_ly(t_df, x = ~Number, y = ~value,
type = 'bar',
marker = list(color = ~color), name = ~variable) %>%
layout(yaxis = list(title = 'Count'), barmode = 'stack')
p