In my Shiny app, plotly produces a trace 0 in the legend that imbalances my graph.
This is what the graph looks like (notice the trace 0 in the legend).
However on clicking on trace 0 in the legend, the graph returns back to normal
Is there a way of removing this trace 0 from my plot completely?
Here is my code:
1) My dataframe is first filtered inside a reactive function
global_evolution=reactive({
results_combined %>%
filter(!is.na(SVM_LABEL_QOL) & SVM_LABEL_QOL=='QoL' & globalsegment==input$inp_pg1segment & Account==input$inp_pg1clientsfiltered & Date >=input$inp_pg1daterange[1] & Date <=input$inp_pg1daterange[2]) %>% #Input: Account
select(Account,Date,SVM_LABEL_DIMENSION) %>%
mutate(Month=month(as.Date(format(as.POSIXct(Date),format = "%d/%m/%Y"),"%d/%m/%Y"))) %>%
select(Account,Month,SVM_LABEL_DIMENSION,-Date) %>%
group_by(Month,SVM_LABEL_DIMENSION) %>%
summarise(Monthly_Count=n()) %>%
spread(SVM_LABEL_DIMENSION,Monthly_Count) %>%
ungroup() %>%
mutate(Month=month.abb[Month]) %>%
mutate_all(funs(replace(., is.na(.), 0)))
})
2) Then some more changes are made to the filtered dataframe inside another reactive function
global_evolution_final=reactive({
global_evolution() %>%
mutate(Month=factor(Month,levels=c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")))
})
3) Finally I use plot_ly to construct the bar chart. However the trace 0 cannot be removed
output$pg1evolution <- renderPlotly({
colNames <- names(global_evolution_final())[-1] #Assuming Month is the first column
p <- plotly::plot_ly(data = global_evolution_final(), x = ~Month, type = "bar")
for(trace in colNames){
p <- p %>% plotly::add_trace(y = as.formula(paste0("~`", trace, "`")), name = trace)
}
p %>%
layout(title = "Trend Over Time",showlegend = FALSE,
xaxis = list(title = ""),
yaxis = list (title = "Monthly Count of QoL Tweets"))
})
Any help with this would be greatly appreciated.
My apologies in advance for not being able to include reproducible data.
There's a problem with your approach.
Check this below reproducible code to fix yours.
df <- iris
p <- plotly::plot_ly()
colNames <- names(df)
colNames <- colNames[-which(colNames == 'Species')]
for(trace in colNames){
p <- p %>% plotly::add_trace(data= df, x = ~ Species, y = as.formula(paste0("~`", trace, "`")), name = trace)
print(paste0("~`", trace, "`"))
}
p
Ideally, Your modified code should be something like this:
output$pg1evolution <- renderPlotly({
colNames <- names(global_evolution_final())[-1] #Assuming Month is the first column
p <- plotly::plot_ly()
for(trace in colNames){
p <- p %>% plotly::add_trace(data = global_evolution_final(), x = ~Month, y = as.formula(paste0("~`", trace, "`")), name = trace, type = "bar")
}
p %>%
layout(title = "Trend Over Time",showlegend = FALSE,
xaxis = list(title = ""),
yaxis = list (title = "Monthly Count of QoL Tweets"))
})
Related
I have made an interactive plot with e-charts for r. The y-axis has negative values causing a horizontal x-axis to be drawn at zero. How can I move this line to the bottom (at the value of -100)? And, second how can I show all date values (preferably days) on the x-axis (as shown in the ggplot example below)
####################
# interactive plot #
####################
library(tidyverse)
library(lubridate)
library(echarts4r)
birthdate <- ymd("1980-04-20")
timeline <- seq(ymd(Sys.Date()-14), (ymd(Sys.Date()+14)), by = "days")
t <- as.numeric(timeline - birthdate)
physical <- sin(2*pi*t/23)*100
emotional <- sin(2*pi*t/28)*100
intellectual <- sin(2*pi*t/33)*100
df <- tibble(timeline,t, physical, emotional, intellectual)
df <- df |> pivot_longer(cols = c('physical', 'emotional', 'intellectual'),
names_to = 'biorhythms',
values_to = 'value')
df$biorhythms <- as.factor(df$biorhythms)
# view data tibble
df
# interactive plot
df |> dplyr::group_by(biorhythms) %>%
e_charts(x = timeline) |>
e_line(value) |>
e_format_y_axis(suffix = "%") |>
e_mark_line(data = list(xAxis = Sys.Date()), title = "Today", symbol = 'none') |>
e_title("Biorhythm Pseudo-Science") |>
e_tooltip() |>
e_theme("dark-digerati")
Regarding your first question, just add e_x_axis(axisLine = list(onZero = FALSE)) |> to your code:
# interactive plot
df |> dplyr::group_by(biorhythms) %>%
e_charts(x = timeline) |>
e_line(value) |>
e_x_axis(axisLine = list(onZero = FALSE)) |>
e_format_y_axis(suffix = "%") |>
e_mark_line(data = list(xAxis = Sys.Date()), title = "Today", symbol = 'none') |>
e_title("Biorhythm Pseudo-Science") |>
e_tooltip() |>
e_theme("dark-digerati")
Regarding your second question, aren't those numbers actually days? I think it is better to add a new issue for that one and try to show/explain what you want as an output. Thanks!
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 was using Highchart to plot some time series and wanted to add some annotation to the plot to highlight some key points. I knew putting the cursor on the graph can pop up the context, however, some automatic graph generation is needed and hence annotating is the best approach.
And I did that, with the last line in the code below. However, the effect is not what I expected. The text was located at the bottom left corner, not located at the right horizontal position yet the vertical position is right. The time series are created using xts library, which means the horizontal axis is simply the date data structure, nothing fancy. xValue is specified as the 900th element of all the time points which have a total length of 1018, so the 900th time point must be in the second half of the graph.
Anyone knows how I can put the annotation at the right location? Many thanks.
hc <- highchart(type = "stock") %>%
hc_title(text = "Some time series") %>%
hc_add_series(x, color='green', name="x", showInLegend = TRUE) %>%
hc_add_series(y, color='red', name="y", showInLegend = TRUE) %>%
hc_add_series(z, color='blue', name="z", showInLegend = TRUE) %>%
hc_navigator(enabled=FALSE) %>%
hc_scrollbar(enabled=FALSE) %>%
hc_legend(enabled=TRUE, layout="horizontal") %>%
hc_annotations(list(enabledButtons=FALSE, xValue = index(x)[900], yValue = -5, title =list(text = "Hello world! How can I make this work!")))
hc
The data can be roughly generated using the following script:
dt <- seq(as.Date("2014/1/30"), as.Date("2018/2/6"), "days")
dt <- dt[!weekdays(dt) %in% c("Saturday", "Sunday")]
n <- length(dt)
x <- xts(rnorm(n), order.by=dt)
y <- xts(rnorm(n), order.by=dt)
z <- xts(rnorm(n), order.by=dt)
Let's star with the #kamil-kulig example, this will be a little out of R world but I want to give some justification if you don't mind.
If we see annotations options is not a object but a list of object(s), so in highcharter is implemented the hc_add_annotation function.
Now, you are using a old version of highcharter. Highcharter devlopment version is using v6 of highchartsJS which made some changes: before the annotations.js was a pluging now is included as a module with some changes in the names of arguments.
Example I: Simple
The example by Kamil Kulig is replicated doing:
highchart(type = "stock") %>%
hc_add_annotation(
labelOptions = list(
backgroundColor = 'rgba(255,255,255,0.5)',
verticalAlign = 'top',
y = 15
),
labels = list(
list(
point = list(
xAxis = 0,
yAxis = 0,
x = datetime_to_timestamp(as.Date("2017/01/02")),
y = 1.5
),
text = "Some annotation"
)
)
) %>%
hc_xAxis(
minRange = 1
) %>%
hc_add_series(
pointStart = start,
pointInterval = day,
data = c(3, 4, 1)
)
Example II: With your data
Be careful in the way you add the x position. Highcharter include a datetime_to_timestamp function to convert a date into a epoch/timestap which is required for highcharts.
library(xts)
dt <- seq(as.Date("2014/1/30"), as.Date("2018/2/6"), "days")
dt <- dt[!weekdays(dt) %in% c("Saturday", "Sunday")]
n <- length(dt)
x <- xts(rnorm(n), order.by=dt)
y <- xts(rnorm(n), order.by=dt)
z <- xts(rnorm(n), order.by=dt)
highchart(type = "stock") %>%
hc_title(text = "Some time series") %>%
hc_add_series(x, color='green', name="x", showInLegend = TRUE) %>%
hc_add_series(y, color='red', name="y", showInLegend = TRUE) %>%
hc_add_series(z, color='blue', name="z", showInLegend = TRUE) %>%
hc_navigator(enabled=FALSE) %>%
hc_scrollbar(enabled=FALSE) %>%
hc_legend(enabled=TRUE, layout="horizontal") %>%
hc_add_annotation(
labels = list(
list(
point = list(
xAxis = 0,
yAxis = 0,
x = datetime_to_timestamp(as.Date(index(x)[900])),
y = 1
),
text = "Hello world! How can I make this work!"
)
)
)
I'm asking myself how to solve the following problem the most elegant. My data encompasses of some actual values and some proposed values. Right now I have data that looks like the reproducible example below:
library(plotly)
library(dplyr)
test_dt <- data.frame(Age=1:5, Key=c("Actuals", "Actuals", "Actuals", "Other", "Other") , Value=rnorm(5))
plot_ly(data = (test_dt %>% group_by(., Key) %>% arrange(desc(Age))),
x = ~Age,
y = ~Value,
type = 'scatter',
mode = 'lines',
color = ~Key,
linetype = ~Key
) %>% layout(
yaxis = list(
title = "SD"),
margin = list(top=100, b=50)
)
The output of this code looks like this:
how plot a dashed line where i drew the red arrow?
My solution so far is that I access the last value of my actuals and insert this value as a new row for my "other" line. But I don't think that's very elegant and sometimes, if no other values exist which can happen in my data depending on the inputs then I have a legend plotted for my "other" line without actually having one.
act_age_max <- filter(test_dt, Key=="Actuals") %>% .[["Age"]] %>% max
propval_names <- filter(test_dt, Key!="Actuals") %>% .[["Key"]]
last_actual <- filter(test_dt, Age==act_age_max, Key=="Actuals") %>% .[["Value"]]
acts_year <- filter(test_dt, Age==act_age_max, Key=="Actuals") %>% .[["Year"]]
append_dt <- data.frame(Age=act_age_max, Key=propval_names, Value=last_actual)
plot_data <- rbind(test_dt, append_dt)
plot_ly(data = (plot_data %>% group_by(., Key) %>% arrange(desc(Age))),
x = ~Age,
y = ~Value,
type = 'scatter',
mode = 'lines',
color = ~Key,
linetype = ~Key
) %>% layout(
yaxis = list(
title = "SD"),
margin = list(top=100, b=50)
)
I have a dataframe in my Shiny app that gets filtered based on various user inputs.
global_evolution=reactive({
results_combined %>%
filter(!is.na(SVM_LABEL_QOL) & SVM_LABEL_QOL=='QoL' & globalsegment==input$inp_pg1segment & Account==input$inp_pg1clientsfiltered & Date >=input$inp_pg1daterange[1] & Date <=input$inp_pg1daterange[2]) %>% #Inputs
select(Account,Date,SVM_LABEL_DIMENSION) %>%
mutate(Month=month(as.Date(format(as.POSIXct(Date),format = "%d/%m/%Y"),"%d/%m/%Y"))) %>%
select(Account,Month,SVM_LABEL_DIMENSION,-Date) %>%
group_by(Month,SVM_LABEL_DIMENSION) %>%
summarise(Monthly_Count=n()) %>%
spread(SVM_LABEL_DIMENSION,Monthly_Count) %>%
ungroup() %>%
mutate(Month=month.abb[Month]) %>%
mutate_all(funs(replace(., is.na(.), 0)))
})
In the next step, I pass this filtered dataframe through a plot_ly function
Here is where I need help
I am trying to get plot_ly to conditionally add lines (add traces), based on whether the given column is available in the dataframe or not. At the moment, plot_ly throws an error if any of the columns included in the add_traces is not available after the dataframe is filtered.
Here is the part of my Shiny app with the plot_ly output.
I attempted to add if-else statements between the add_trace arguments, but my attempts haven't been successful.
output$pg1evolution <- renderPlotly({
global_evolution_final() %>%
plot_ly(x = ~Month, y = ~`COLUMN_1`, name = 'Column 1', type = 'scatter', mode = 'lines') %>%
add_trace(y = ~`COLUMN_2`, name = 'Column 2') %>%
add_trace(y = ~`COLUMN_3`, name = 'Column 3') %>%
add_trace(y = ~`COLUMN_4`, name = 'Column 4') %>%
add_trace(y = ~`COLUMN_5`, name = 'Column 5') %>%
add_trace(y = ~`COLUMN_6`, name = 'Column 6') %>%
layout(title = "Trend Over Time",
xaxis = list(title = ""),
yaxis = list (title = "Monthly Count of Products Sold"))
})
My apologies for not being able to include a reproducible dataframe, I realise that would make things easier.
Very grateful for any tips/pointers you might have.
One way to do it could be to use a for loop to add a trace per column
output$pg1evolution <- renderPlotly({
colNames <- names(global_evolution_final())[-1] #Assuming Month is the first column
p <- plotly::plot_ly(data = global_evolution_final(), x = ~Month, type = "scatter",
mode = "lines")
for(trace in colNames){
p <- p %>% plotly::add_trace(y = as.formula(paste0("~`", trace, "`")), name = trace)
}
p %>%
layout(title = "Trend Over Time",
xaxis = list(title = ""),
yaxis = list (title = "Monthly Count of Products Sold"))
})