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!
Related
when doing a job I have found a problem that I don't know how to solve.
I have a data frame that has 2 columns:
date
value
And it has a total of 1303 rows.
For each date there are 12 values (1 for each month), except in the last year that only has 7
The work I have to do would be to create a 'drilldown' style chart using the 'highcharter' library. The problem is that I don't know how to do it efficiently.
The solution that comes to my mind is not very efficient, below I show my solution so you can see what I mean.
dataframe
# Load packages
library(tidyverse)
library(highcharter)
library(lubridate)
# Load dataset
df <- read.csv('example.csv')
# Prepare df to use
dfDD <- tibble(name = year(df$date),
y = round(df$value, digits = 2),
drilldown = name)
# Create a data frame to use in 'drilldown' (for each year)
df1913 <- df %>%
filter(year(date) == 1913) %>%
data.frame()
df1914 <- df %>%
filter(year(date) == 1914) %>%
data.frame()
# Create a drilldown chart using Highcharter library
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Example Drilldown") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_plotOptions(series = list(boderWidth = 2,
dataLabels = list(enabled = TRUE))) %>%
hc_add_series(data = dfDD,
name = "Mean",
colorByPoint = TRUE) %>%
hc_drilldown(allowPointDrilldown = TRUE,
series = list(list(id = 1913,
data = list_parse2(df1913)),
list(id = 1914,
data = list_parse2(df1914))))
Seeing my solution for the first time, I realized that in order to complete the graph I would have to create a subset of values for each year. Having realized that I tried to find a more efficient solution using a 'for loop' but so far I can't get it to work.
Is there a more efficient way to create this graph using a 'loop'!?
If it can be done in another way than using loops, I would also like to know.
Thank you for reading my question and I hope I explained myself well.
Using split and purrr::imap you could split your data by years and loop over the resulting list to convert your data to the nested list object required by hc_drilldown. Note: It's important to make the id a numeric and to pass a unnamed list.
library(tidyverse)
library(highcharter)
library(lubridate)
series <- split(df, year(df$date)) %>%
purrr::imap(function(x, y) list(id = as.numeric(y), data = list_parse2(x)))
# Unname list
names(series) <- NULL
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Example Drilldown") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_plotOptions(series = list(boderWidth = 2,
dataLabels = list(enabled = TRUE))) %>%
hc_add_series(data = dfDD,
name = "Mean",
colorByPoint = TRUE) %>%
hc_drilldown(allowPointDrilldown = TRUE,
series = series)
Using the library echarts4r, I'd like to format the tooltip when using the calendar.
Adding the another line to John Coene's example
library(echarts4r)
dates <- seq.Date(as.Date("2018-01-01"), as.Date("2018-12-31"), by = "day")
values <- rnorm(length(dates), 20, 6)
year <- data.frame(date = dates, values = values)
year %>%
e_charts(date) %>%
e_calendar(range = "2018") %>%
e_heatmap(values, coord.system = "calendar") %>%
e_visual_map(max = 30) %>%
e_title("Calendar", "Heatmap") %>%
e_tooltip(trigger = "item", show = TRUE)
This shows tooltip of the value 1.23456 when mouseover a cell in the calendar .
How do I format the value so it shows my value is 1.2.
I've tried to understand using the formatter in echarts documentation, however I'm not sure what to do with the a, b, c, d
From the vignette (https://github.com/JohnCoene/echarts4r/blob/master/vignettes/tooltip.Rmd), it looks as though it's necessary to format in java script. One possible version is
year %>%
e_charts(date) %>%
e_calendar(range = "2018") %>%
e_heatmap(values, coord.system = "calendar") %>%
e_visual_map(max = 30) %>%
e_title("Calendar", "Heatmap") %>%
e_tooltip(formatter = htmlwidgets::JS("
function(params){
return('value: ' +
parseFloat((params.value[1] * 10) / 10).toFixed(1))
}
")
)
This approach shows the name 'value' - not necessary and can be removed if you want to show only the numeric value. This also rounds to the nearest tenth - not sure if that was wanted. To display more than one value include '< br >/' (without spaces around 'br') to create a line break in the tooltip display (an example is in the vignette).
I would approach it very simply as follows:
year$values_rounded <- round(year$values, digits = 1)
year %>%
e_charts(date) %>%
e_calendar(range = "2018") %>%
e_heatmap(values_rounded, coord.system = "calendar") %>%
e_visual_map(max = 30) %>%
e_title("Calendar", "Heatmap") %>%
e_tooltip(trigger = "item", show = TRUE)
If rounding to the first digit wasn't what you were looking for, let me know.
pay attentiom to line:
e_heatmap(values, coord.system = "calendar") %>%
the right one is:
e_heatmap(values, coord_system = "calendar") %>%
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!"
)
)
)
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"))
})
I've searched a bit, but I'm not able to find a way to acheive my axis goals. There are really 2 questions here.
How can I guarantee the spacing between my major ticks is the same? If it means some dots overlap, then so be it.
Is there a way to add a zoom/date range control to this chart? Data goes from 2013 to current and is continually added.
2.b. If I do this, is there a way to have it as you zoom out it automatically start bucketing by week, then month, then year? and of course the inverse.
Here is where you can get the data: https://opendata.miamidade.gov/311/311-Service-Requests-Miami-Dade-County/dj6j-qg5t
Here is the image of the current chart:
Note that I am doing this to learn R, and hence any erraneous suggestions are also appreciated. Here is the code that generates this:
#Graphics Visualizations Package
library("ggvis")
#Adds %>% forward pipe operator
library("magrittr")
#adds grouping and manipulations
library("dplyr")
#adds data fiendlyness stuffs
library("tidyr")
library("shiny")
library("checkpoint")
checkpoint("2016-03-29")
rData <- read.csv("C:\\data\\Miami_311.csv",
header=TRUE,
sep=",")
rDSamp <- rData[sample(1:length(rData$Case.Owner), 1000),]
#Convert to known date time
rDSamp$Ticket.Created.Date...Time <-
rDSamp$Ticket.Created.Date...Time %>%
as.POSIXct(format="%m/%d/%Y") %>%
as.character()
FilterDateRange = function(data, feature, minDate, maxDate) {
minDate = minDate %>%
as.POSIXct(format="%m/%d/%Y") %>%
as.character()
maxDate = maxDate %>%
as.POSIXct(format="%m/%d/%Y") %>%
as.character()
result = subset(data, data[feature] <= maxDate)
subset(result, result[feature] >= minDate)
}
d <- rDSamp %>%
FilterDateRange("Ticket.Created.Date...Time", "1/1/2013", "12/31/2013") %>%
group_by(Ticket.Created.Date...Time, Case.Owner) %>%
summarise(
count = n()
) %>%
arrange(Ticket.Created.Date...Time)
xAxisValues = "1/1/2013" %>%
as.Date(format="%m/%d/%Y") %>%
as.character() %>%
as.Date() %>%
seq(by = "1 months", length.out = 12)
d %>%
ggvis(~Ticket.Created.Date...Time, ~count) %>%
layer_points(fill = ~Case.Owner) %>%
add_tooltip(function(data){
paste("Owner:", data$Case.Owner, "<br>","Date:", data$Ticket.Created.Date...Time)
}, "hover") %>%
add_axis("x",
title = "Date",
values = xAxisValues,
ticks = 365,
properties = axis_props(
majorTicks = list(strokeWidth = 2)))