I'm trying to do a semi circle donut with highcharter library but I only know how to do a pie chart. I know that with JS you can do it by adding "startAngle" and "endAngle" but I want to know how to do it with R:
A <- c("a", "b", "c", "d")
B <- c(4, 6, 9, 2)
C <- c(23, 26, 13, 15)
df <- data.frame(A, B, C)
highchart() %>%
hc_chart(type = "pie") %>%
hc_add_series_labels_values(labels = df$A, values = df$B)%>%
hc_tooltip(crosshairs = TRUE, borderWidth = 5, sort = TRUE, shared = TRUE, table = TRUE,
pointFormat = paste('<b>{point.percentage:.1f}%</b>')
) %>%
hc_title(text = "ABC",
margin = 20,
style = list(color = "#144746", useHTML = TRUE))
Thank you!
You can do something like this though not using Highcharts library.
library(tidyverse)
library(ggforce)
library(scales)
library(ggplot2)
# -------------------------------------------------------------------------
A <- c("a", "b", "c", "d")
B <- c(4, 6, 9, 2)
C <- c(23, 26, 13, 15)
df <- data.frame(A, B, C)
# Ensure A is a factor (we'll be using it to fill the pie)
df$A <- factor(df$A)
# compute the individual proportion in this case using var C
df$prop <- df$C/sum(df$C)
# compute the cumulative proportion and use that to plot ymax
df$p_end <- cumsum(df$prop)
# generate a y-min between 0 and 1 less value than p_end (using p_end)
df$p_start <- c(0, head(df$p_end ,-1))
# -------------------------------------------------------------------------
# plot
df %>%
mutate_at(c("p_start", "p_end"), rescale, to=pi*c(-.5,.5), from=0:1) %>%
ggplot +
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = .5, r = 1, start = p_start, end = p_end, fill=A)) +
coord_fixed() +xlab("X_label") + ylab("Y_lablel") + guides(fill=guide_legend(title="Legend Title"))
Output
Hope that helps.
Try adding startAngle = -90, endAngle = 90 inside hc_add_series_labels_values.
Note as per the warning hc_add_series_labels_values is deprecated so suggest using hc_add_series.
highchart() %>%
hc_add_series(type = "pie", data = df, hcaes(x = A, y = B), startAngle = -90, endAngle = 90) %>%
hc_tooltip(pointFormat = '<b>{point.percentage:.1f}%</b>') %>%
hc_title(text = "ABC",
margin = 20,
style = list(color = "#144746", useHTML = TRUE))
Related
I am trying to use plotly to scatter the results of applying kmeans to dataframe and I want to color the scattered points based on the results of the kmeans. I am following this this link to use plotly but plotly is not coloring the scattered plots as I would like. Here is my code.
library(plotly)
library(data.table)
library(tidyverse)
# generate the data
sample1_x <- rnorm(n = 1000, mean = 0, sd = 1)
sample1_y <- rnorm(n = 1000, mean = 1, sd = 1)
sample2_x <- rnorm(n = 1000, mean = 5, sd = 1)
sample2_y <- rnorm(n = 1000, mean = 3, sd = 1)
# store the data in dataframes
df1 <- data.frame(sample1_x, sample1_y)
df2 <- data.frame(sample2_x, sample2_y)
df <- rbind(as.data.table(df1), as.data.table(df2), use.names = FALSE)
clusts <- kmeans(df, 2, 5)
clusts <- array(unlist(clusts), dim = c(2000, 1, 1))
df <- df %>%
add_column(clusters = clusts)
# rename the columns
colnames(df)[1: 2] <- c("col1", "col2")
# plot
fig <- plot_ly(data = df,
x = ~col1, y = ~col2,
color = ~clusters,
colors = c("red", "blue"),
type = "scatter", mode = "markers")
fig
is what plotly is returning, but what I want is .
The problem is that your clusters column is an <array> instead of a <num>.
set.seed(1)
df <- data.frame(col1 = c(rnorm(1000, 0), rnorm(1000, 5)),
col2 = c(rnorm(1000, 1), rnorm(1000, 3)))
setDT(df)
clusts <- kmeans(df, 2, 5)
df[, clusters := clusts$cluster]
plot_ly(data = df,
x = ~col1, y = ~col2,
color = ~clusters,
colors = c("red", "blue"),
type = "scatter", mode = "markers")
I think I'm basically looking for an R plotly equivalent to this python plotly post:
I have a XY data.frame that I'd like to plot using R's plotly, where each point belongs to either one of two types ("a"/"b"), and nested within each type is a group, and the group assignment is redundant.
My purpose is to color code the points according to the group frequency, where each type uses a different color scale.
Here's the data.frame:
library(dplyr)
set.seed(1)
df <- rbind(data.frame(type = "a", group = paste0("a", sample(1000, 500, replace = T))) %>%
cbind(as.data.frame(MASS::mvrnorm(n = 1000,mu = c(-5,-5),Sigma = matrix(c(5, 3, 4, 4), ncol=2)))),
data.frame(type = "b", group = paste0("b", sample(500, 50, replace = T))) %>%
cbind(as.data.frame(MASS::mvrnorm(n = 500,mu = c(5,5),Sigma = matrix(c(5, 3, 4, 4), ncol=2))))) %>%
dplyr::rename(x = V1, y = V2)
Here I compute the frequency of each group, for each type, and then add two artificial points per each type, with the global minimum and maximum frequency (f), so that the color scales use a comment numeric scale:
freq.df <- rbind(dplyr::group_by(dplyr::filter(df, type == "a"), type, group) %>%
dplyr::tally() %>%
dplyr::mutate(f = 100*n/sum(n)) %>%
dplyr::select(-n),
dplyr::group_by(dplyr::filter(df, type == "b"), type, group) %>%
dplyr::tally() %>%
dplyr::mutate(f = 100*n/sum(n)) %>%
dplyr::select(-n)) %>%
dplyr::ungroup() %>%
rbind(data.frame(type = c(rep("a", 2), rep("b", 2)), group = c(rep("a", 2), rep("b", 2)), f = rep(c(min(.$f), max(.$f)), 2), stringsAsFactors = F))
And now joining freq.df to df:
df <- df %>% dplyr::left_join(freq.df)
Here's how I'm trying to plot it:
plotly::plot_ly(marker = list(size = 3), type = 'scatter', mode = "markers", color = dplyr::filter(df, type == "a")$f, colors = viridis::viridis_pal(option = "D")(3), x = dplyr::filter(df, type == "a")$x, y = dplyr::filter(df, type == "a")$y) %>%
plotly::add_trace(marker = list(size = 3),type = 'scatter', mode = "markers",color = dplyr::filter(df, type == "b")$f,colors = viridis::viridis_pal(option = "A")(3), x = dplyr::filter(df, type == "b")$x,y=dplyr::filter(df,type == "b")$y) %>%
plotly::layout(xaxis = list(zeroline = F, showticklabels = F, showgrid = F),yaxis = list(zeroline = F,showticklabels = F, showgrid = F))
Which only gives me the colorbar of first color scale (viridis's cividis):
Any idea how to get both colorbars (viridis's cividis and viridis's magma) appear side by side?
When I run this
library(tidyverse)
df = data.frame(
stringsAsFactors = FALSE,
Type = c("a", "b", "c", "d"),
A = c(51, 5, 10, 155.5),
P1 = c(40.1, 50.5, 127.8, 216),
C = c(40, 45, 50, 255)
)
library(huxtable)
ht = as_hux(df)
ht %>% map_text_color( row = 2:nrow(df), col = 2:3,
by_cases(. < 50 ~ "red")) %>%
set_all_borders()
ht
I get table:
table
The problem is that 127.8 is bigger than 50 so it shouldn't be red. How to make it to be as I want?
The underlying issue is that adding cases has turned your numbers to character(). A workaround is to use by_cases(as.numeric(.) < 50 ~ "red"). Alternatively, write:
ht = as_hux(df, add_colnames = FALSE)
ht %>% map_text_color(col = 2:3,
by_cases(. < 50 ~ "red")) %>%
add_colnames() %>%
set_all_borders() %>%
which keeps the data as numeric until after you've done the colour mapping.
I'm trying to add like an information box on hover on title of the highcharter graph. When the user hovers over title, it should show some information about the graph. Can this be achieved using Highcharter in R ?
Thank You! Here is a sample code to which I want to add hover property for title.
library(dplyr)
library(stringr)
library(purrr)
n <- 5
set.seed(123)
colors <- c("#d35400", "#2980b9", "#2ecc71", "#f1c40f", "#2c3e50", "#7f8c8d")
colors2 <- c("#000004", "#3B0F70", "#8C2981", "#DE4968", "#FE9F6D", "#FCFDBF")
df <- data.frame(x = seq_len(n) - 1) %>%
mutate(
y = 10 + x + 10 * sin(x),
y = round(y, 1),
z = (x*y) - median(x*y),
e = 10 * abs(rnorm(length(x))) + 2,
e = round(e, 1),
low = y - e,
high = y + e,
value = y,
name = sample(fruit[str_length(fruit) <= 5], size = n),
color = rep(colors, length.out = n),
segmentColor = rep(colors2, length.out = n)
)
create_hc <- function(t) {
dont_rm_high_and_low <- c("arearange", "areasplinerange",
"columnrange", "errorbar")
is_polar <- str_detect(t, "polar")
t <- str_replace(t, "polar", "")
if(!t %in% dont_rm_high_and_low) df <- df %>% select(-e, -low, -high)
highchart() %>%
hc_title(text = paste(ifelse(is_polar, "polar ", ""), t, '\u2370'),
style = list(fontSize = "15px")) %>%
hc_chart(type = t,
polar = is_polar) %>%
hc_xAxis(categories = df$name) %>%
hc_add_series(df, name = "Fruit Consumption", showInLegend = FALSE)
}
hcs <- c("line") %>%
map(create_hc)
Is there a way to move the plot down so that there is some space between the legend and the plot area? Ideally have the chart area automatically spaced below the legend.
df <- data.frame(
x = seq(50),
y = rnorm(50, 10, 3),
z = rnorm(50, 11, 2),
w = rnorm(50, 9, 2)
)
df %>%
e_charts(x) %>%
e_line(w) %>%
e_line(y) %>%
e_line(z) %>%
e_legend(orient = 'vertical', left = 0, top = 0)
Use the e_grid function to adjust the "grid" on which the graph is plotted.
library(echarts4r)
df <- data.frame(
x = seq(50),
y = rnorm(50, 10, 3),
z = rnorm(50, 11, 2),
w = rnorm(50, 9, 2)
)
df %>%
e_charts(x) %>%
e_line(w) %>%
e_line(y) %>%
e_line(z) %>%
e_legend(
orient = 'vertical',
left = 0,
top = 0,
selectedMode = "single" # might be of use
) %>%
e_grid(left = 100, top = 5)
Plenty more options in the grid can be found here