Could someone help me to implement this excellent jsfiddle in a "shiny" application with the highcharter package ?
https://jsfiddle.net/BlackLabel/nr1y47a9/
I started writing something like this but there are still some problems ...
Here's the result : https://pasteboard.co/J7qWN7v.png
library(highcharter)
library(httr)
library(dplyr)
getContent <- function(url) {
content(GET(url))
}
world <- getContent("https://cdn.jsdelivr.net/gh/highcharts/highcharts#v7.0.0/samples/data/world-population.json")
mapdata <- get_data_from_map(download_map_data("custom/world"))
hcmap("custom/world", showInLegend = FALSE) %>%
hc_add_series(name = "Countries", color = '#E0E0E0') %>%
hc_add_series(data= world,type = "mapbubble", name = "Population", joinBy = c("iso-a3", "code3"), color= '#E0E0E0',
minSize = 4, maxSize = "12%",
tooltip = list(pointFormat = '{point.properties.hc-a2}: {point.z} thousands')) %>%
hc_colorAxis(
dataClasses = color_classes(c(0, 50000, 100000, 500000),
colors = c("green","#81c784","#43a047","#1b5e20")#,
# names = c("sg","tf","qsd")
)) %>%
hc_legend(title = list(text = "Mon titre"),
bubbleLegend = list(
enabled = TRUE,
borderColor = '#000000',
borderWidth = 3,
color = '#8bbc21',
connectorColor = '#000000'
),
align = "bottom", layout = "horizontal",
verticalAlign = "bottom",
floating = TRUE ,valueDecimals = 0,
symbolHeight = 11, symbolWidth = 11, symbolRadius = 0,
backgroundColor='#E0E0E8') %>%
hc_mapNavigation(enabled = TRUE) %>%
hc_exporting(enabled = TRUE)
Many thanks in advance !
Here's where I am, only the bubbleLegend (in comments #) doesn't work (it is displayed 3 times on the map)
mydf <- data.frame(
lat = c(-7.1871, 36.95733, 17.9356, -20.4379, 30.2496, -54.9593,
18.0365, 17.9688, 18, 18.005, 17.9538),
lon = c(129.3989, -121.576, -66.6961, -68.773, 138.6162, -128.3548,
-66.8143, -66.9705, -66.7603, -66.7765, -66.8265),
z = c(4.5, 2.77, 4.1, 5.2, 4.5, 5.1, 2.52, 3.7, 2.68, 2.71, 2.88),
part = c(10,15,8,20,30,12,5,17,21,9,11)
)
mydf <- mydf %>%
mutate(color = case_when(
part < 10 ~ "red",
part < 20 ~ "green",
TRUE ~ "blue"
))
hcmap() %>%
hc_add_series(data = mydf, type = "mapbubble", name = "EarthQuake", maxSize = '12%') %>%
hc_tooltip(useHTML = T,headerFormat='',pointFormat = paste('Location :{point.place}<br> Part: {point.part} <br> Magnitude : {point.z}')) %>%
hc_legend(enabled = TRUE,
title = list(text = "Mon titre"),
# bubbleLegend = list(
# enabled = TRUE,
# borderColor = '#000000',
# borderWidth = 3,
# color = '#8bbc21',
# connectorColor = '#000000'
# ),
align = "bottom", layout = "horizontal",
floating = TRUE ,valueDecimals = 0,
symbolHeight = 11, symbolWidth = 11, symbolRadius = 0) %>%
hc_colorAxis(
dataClasses = color_classes(breaks = c(0, 10, 20, 100),
colors = c("red","green","blue")
)) %>%
hc_title(text = "Global Seismic Activity") %>%
hc_mapNavigation(enabled = T)%>%
hc_exporting(enabled = TRUE)
Rather an easy solution but this bug is no longer present in the development version of highcharter.
Try
remotes::install_github("jbkunst/highcharter")
Related
I'm trying to reproduce in R Plotly a 2 categorical variables violin plot that works just fine in ggplot2. But when I set the widths of the individual violins to be the same, using scalemode = "width", as described in the reference (https://plotly.com/r/reference/violin/), it simply wont work. Instead, it shows the widths (violin maximum) proportional to the counts in each category.
Here is an example:
# Paths:
path_data = "data/"
path_lib = "renv/library/R-4.1/x86_64-pc-linux-gnu/"
# Packages:
require(dplyr, lib = path_lib)
require(readr, lib = path_lib)
require(RColorBrewer, lib = path_lib)
require(plotly, lib = path_lib)
# Dataset:
df = readr::read_csv(paste0(path_data, "nasa_exoplanets.csv")) %>%
as.data.frame()
attr(df, "spec") = NULL
df_varnames = readr::read_csv(paste0(path_data, "nasa_exoplanets_var_names.csv")) %>%
as.data.frame()
attr(df_varnames, "spec") = NULL
# Variables:
cat_var1 = "st_metratio"
cat_var2 = "disc_locale"
cat_var_name1 = (df_varnames %>%
dplyr::filter(var == cat_var1))$var_name
cat_var_name2 = (df_varnames %>%
dplyr::filter(var == cat_var2))$var_name
num_var = "sy_dist"
num_var_name = (df_varnames %>%
dplyr::filter(var == num_var))$var_name
# Adapt the data:
df_plot = df %>%
dplyr::select(cat_var1,
cat_var2,
num_var)
# Deal with NA:
df_plot[which(is.na(df_plot[, cat_var1])), cat_var1] = "NA"
df_plot[which(is.na(df_plot[, cat_var2])), cat_var2] = "NA"
df_plot = df_plot[which(!is.na(df_plot[, num_var])), ]
# Levels order:
sorted_levels1 = sort(unique(df_plot[, cat_var1]))
df_plot[, cat_var1] = factor(x = df_plot[, cat_var1],
levels = sorted_levels1)
sorted_levels2 = sort(unique(df_plot[, cat_var2]))
df_plot[, cat_var2] = factor(x = df_plot[, cat_var2],
levels = sorted_levels2)
# Plot:
my_palette = colorRampPalette(c("#111539", "#97A1D9"))
n_levels2 = length(unique(df_plot[, cat_var2]))
p = plot_ly(
data = df_plot,
type = "violin",
x = ~eval(parse(text = cat_var1)),
y = ~eval(parse(text = num_var)),
color = ~eval(parse(text = cat_var2)),
colors = my_palette(n_levels2),
spanmode = "hard",
alpha = 1,
box = list(visible = FALSE),
meanline = list(visible = FALSE),
points = FALSE,
scalemode = "width" ### this doesn't work ###
) %>%
layout(
xaxis = list(
title = paste0("<b>", cat_var_name1, "</b>"),
titlefont = list(size = 20),
tickfont = list(size = 18),
categoryorder = "array"
),
yaxis = list(
title = paste0("<b>", num_var_name, "</b>"),
titlefont = list(size = 20),
tickfont = list(size = 18),
type = "log"
),
margin = list(
l = 10,
r = 10,
t = 10,
b = 10
),
legend = list(
title = list(
text = paste0("<br><b>", cat_var_name2, "</b>"),
font = list(size = 18)
)
),
hoverlabel = list(font = list(size = 16)),
showlegend = TRUE,
violinmode = "group"
)
p
data file: https://github.com/rafael747cardoso/Data_Visualization_Gallery/blob/main/data/nasa_exoplanets.csv
How it should be, plotted in ggplot2:
How it is with R Plotly:
I am trying to add custom button to update the y axis, here is a small example that is similar.
When I click on “frq” or “count” the correct bar chart appears, but the values are wrong (its take only one value for each city and put it in all gender categories bars)
library(plotly)
library(dplyr)
library(tidyr)
Occupation = c("Tel Aviv", "Paris", "Amsterdam", "Kyoto")
Gender = c("F", "M", "[missing]")
df <- crossing(Occupation, Gender) %>%
mutate(n = row_number()) %>%
group_by(.data[["Occupation"]]) %>%
mutate(frq = round(100 * (n / sum(n)), 1))
chart_type <- list(
type = "buttons",
direction = "right",
xanchor = 'center',
yanchor = "top",
pad = list('r' = 0, 't' = 10, 'b' = 10),
x = 0.1,
y = 1.20,
buttons = list(
list(
method = "update",
args = list(list(y = list(df$n))),
label = "count"
),
list(
method = "update",
args = list(list(y = list(df$frq))),
label = "frq"
)
)
)
df %>%
plot_ly(
x = ~ Occupation,
y = ~ n,
color = ~ Gender,
text = ~ n,
textposition = 'auto',
type = "bar"
) %>%
layout(updatemenus = list(chart_type))
Another version:
chart_type <- list(
type = "buttons",
direction = "right",
xanchor = 'center',
yanchor = "top",
pad = list('r'= 0, 't'= 10, 'b' = 10),
x = 0.1,
y = 1.20,
buttons = list(
list(method = "update",
args = list(list(visible = c(TRUE, FALSE)
)),
label = "count"),
list(method = "update",
args = list(list(visible = c(FALSE, TRUE)
)),
label = "frq")
))
df %>%
plot_ly(mode = 'markers',type = "bar") %>%
add_trace(x = ~Occupation, y = ~n, color = ~Gender,
text=~n, textposition = 'auto', visible = FALSE,
colorbar = list()) %>%
add_trace(x = ~Occupation, y = ~frq, color = ~Gender,
text=~frq, textposition = 'auto', visible = TRUE,
colorbar = list()) %>%
layout(updatemenus = list(chart_type))
After the click:
I'm trying to plot some (interactive) highcharts plots for some quantmod works. Plots (in R-studio viewer tab) works fine when I "run" them. or polts then interactively on the console window, but shows nothing when I source the whole program.
How can I source the whole script and get all the plots in the viewer window?
How can I save the plots (from the script) to a pdf file?
thanks.
code example:
library(quantmod)
library(highcharter)
SPY <- getSymbols("SPY", from = Sys.Date() - lubridate::years(3), auto.assign = FALSE)
SPY <- adjustOHLC(SPY)
SPY.EMA.20 <- EMA(Cl(SPY), n = 20)
SPY.EMA.50 <- EMA(Cl(SPY), n = 50)
SPY.RSI.14 <- RSI(Cl(SPY))
SPY.RSI.SellLevel <- xts(rep(70, NROW(SPY)), index(SPY))
SPY.RSI.BuyLevel <- xts(rep(30, NROW(SPY)), index(SPY))
AAPL <- getSymbols("AAPL", from = Sys.Date() - lubridate::years(3), auto.assign = FALSE)
highchart(type = "stock") %>%
hc_add_series(AAPL, name = "AAPL", color = hex_to_rgba("red", 0.7))
hchart(AAPL)
highchart(type = "stock") %>%
hc_yAxis_multiples(
create_yaxis(3, height = c(3, 1, 1), turnopposite = TRUE)
) %>%
hc_add_series(SPY, yAxis = 0, name = "SPY", color = hex_to_rgba("red", 0.7)) %>%
hc_add_series(SPY.EMA.20, yAxis = 0, name = "EMA 20") %>%
hc_add_series(SPY.EMA.50, yAxis = 0, name = "EMA 50") %>%
hc_add_series(SPY$SPY.Volume, yAxis = 1, color = "gray", name = "Volume", type = "column", title = 'volume') %>%
hc_subtitle(yAxis = 1, text = "Volume", align = "left", style = list(color = "#2b908f", fontWeight = "bold")) %>%
hc_add_series(SPY.RSI.14, yAxis = 2, name = "Osciallator", color = hex_to_rgba("green", 0.7)) %>%
hc_add_series(SPY.RSI.SellLevel, yAxis = 2, color = hex_to_rgba("red", 0.7), name = "Sell level") %>%
hc_add_series(SPY.RSI.BuyLevel, yAxis = 2, color = hex_to_rgba("blue", 0.7), name = "Buy level")
I want to make a loop to add polygons to a leaflet map according to different columns of a data frame.
for (i in 18:22)
createMap = lapply((concello_wgs84_Datos#data[,i]),function(x){
data <- concello_wgs84_Datos#data[,i]
nombre <- names(concello_wgs84_Datos#data[,i])
pal3 <- leaflet::colorBin("YlOrRd", domain = data, 20, pretty = TRUE)
m = leaflet(data=concello_wgs84_Datos[1:17 & concello_wgs84_Datos#data[,i] == x], options = leafletOptions(minZoom = 8, maxZoom = 18)) %>%
addProviderTiles(providers$Esri.WorldImagery) %>% setView(-8.00, 42.80, zoom = 8.3) %>%
addPolygons(data=datos,
fill= TRUE,
fillColor = ~pal3(data),
stroke = FALSE,
color = "#0000CD",
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 1,
weight = 0.5,
label = ~as.character(datos$CONCELLO),
labelOptions = labelOptions(noHide = F,
textsize = "7px",
direction = "topright"),
highlightOptions = highlightOptions(color = "white",
weight = 1,
bringToFront = TRUE)) %>%
addCircles(data = coordenadasOAC,
lat = ~ coordenadasOAC$LAT,
lng = ~ coordenadasOAC$LONG,radius =0.3,
color="#CD3333",
fillOpacity = 0.8,
popup = ~as.character(coordenadasOAC$OAC)) %>%
addLegend("bottomleft",
pal = pal3,
values = data,
title = nombre,
labFormat = labelFormat(prefix = ""),opacity = 1)})
htmltools::tagList(createMap)
but I have the following error: Error in`[.data.frame´(x#data,i,j,...,drop=False): undefined columns selected.
Could you help me?
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'))
)
)