Related
I have a shiny app that renders a DT table that has formatted numeric values. The table contains data that is both percentages and data that represents currency. The data is not tidy in that the table is effectively transposed with each row representing a feature and each column being an observation. Ultimately, my goal is to encode logic that anytime a cell has a negative value (the first character of the string is a '-'), the cell is colored red. Here is my reproducible example:
library(tidyverse)
library(DT)
example_df <- data.frame(
x = c("$1", "-2%", "$3"),
y = c("$10", "10%", "$20")
)
determine_cell_color <- function(x) {
if (str_sub(x, 1, 1) == "-") {
return("red")
}
else {
return("white")
}
}
# how to get an individual cell to be a different color
# if first character in string value is '-'
example_df %>%
datatable() %>%
formatStyle(target = 'row', backgroundColor = styleEqual(~determine_cell_color))
This approach can be generalized to many more columns. The main idea is to style one column with another column, the only downside is that it doubles the number of cols in the data frame. Fortunately we can hide those columns.
library(tidyverse)
library(DT)
example_df <- data.frame(
x = c("$1", "-2%", "$3"),
y = c("$10", "10%", "$20"),
z = c("$10", "-10%", "$20"),
w = c("-$10", "-10%", "$20")
)
pattern <- names(example_df) %>% str_c(collapse = "|")
determine_cell_color <- function(vector) {
str_detect(vector, "-") %>% as.numeric()
}
example_df <- example_df %>% mutate(across(matches(pattern), determine_cell_color, .names = "cell_color_{.col}"))
DT <- datatable(example_df, options = list(
columnDefs = list(list(targets = (ncol(example_df) / 2 + 1):ncol(example_df), visible = FALSE))
))
walk(str_subset(names(example_df), "^.$"), ~ {
DT <<- DT %>% formatStyle(
.x, str_c("cell_color_", .x),
backgroundColor = styleEqual(c(1, 0), c("red", "white"))
)
})
DT
Created on 2022-01-07 by the reprex package (v2.0.1)
I'm developing an R shiny app and ideally I would need to do precisely what is done here:
More specifically, I have dataframe with stocks open, close, high, low data and I would need to replicate what's displayed in the attached image in column "Range".
I understand I should attach some code, but the truth here, I can't find anything close to what I'm asking online.
A sample dataframe would be:
df = data.frame(STOCK=c("IBM","MSFT","FB"), OPEN=c(100,90, 80), CLOSE=c(102, 85, 82), LOW=c(99,81,78), HIGH=c(105, 91, 88))
Then, I have no idea of what to do from here. Any suggestions? Thanks
You can use custom-rendering follow this guide
https://glin.github.io/reactable/articles/examples.html#custom-rendering-1
library(dplyr)
library(sparkline)
data <- chickwts %>%
group_by(feed) %>%
summarise(weight = list(weight)) %>%
mutate(boxplot = NA, sparkline = NA)
reactable(data, columns = list(
weight = colDef(cell = function(values) {
sparkline(values, type = "bar", chartRangeMin = 0, chartRangeMax = max(chickwts$weight))
}),
boxplot = colDef(cell = function(value, index) {
sparkline(data$weight[[index]], type = "box")
}),
sparkline = colDef(cell = function(value, index) {
sparkline(data$weight[[index]])
})
))
I have a dataset with mean gene counts for each decade as shown below:
structure(list(decade_0 = c(92.500989948184, 2788.27384875413,
28.6937227408861, 1988.03831525414, 1476.83143096418), decade_1 = c(83.4606306426572,
537.725421951383, 10.2747132062782, 235.380422949258, 685.043600629146
), decade_2 = c(188.414375201462, 2091.84249935145, 17.080858894829,
649.55107199935, 1805.3484565514), decade_3 = c(43.3316024314987,
141.64396529835, 2.77851259926935, 94.7748265692319, 413.248354335235
), decade_4 = c(54.4891626582901, 451.076574268175, 12.4298374245007,
346.102609621018, 769.215535857077), decade_5 = c(85.5621750431284,
131.822699578988, 13.3130607062134, 151.002200923853, 387.727911723968
), decade_6 = c(112.860998806804, 4844.59668489898, 19.7317645111144,
2084.76584309876, 766.375852567831), decade_7 = c(73.2198969730458,
566.042952305845, 3.2457873699886, 311.853982701609, 768.801733767044
), decade_8 = c(91.8161648275608, 115.161700090147, 10.7289451320065,
181.747670625714, 549.21661120626), decade_9 = c(123.31045087146,
648.23694540667, 17.7690326882018, 430.301803845829, 677.187054208271
)), row.names = c("ANK1", "NTN4", "PTPRH", "JAG1", "PLAT"), class = "data.frame")
I would like to plot a line graph with the changes in counts over time for each of >30 genes as shown here in excel.
To do this with ggplot I have to convert it to col1: decade, col2: gene, col3: counts.
My question is, either how to convert my table into this ggplot friendly table, or if there is a better way to produce the plot with a different tool?
Thanks!
One possibility: transpose your data frame, convert rownames to columns, then gather ("make long"). Plotting is then easy.
library(tidyverse)
mydat <- structure(list(decade_0 = c(92.500989948184, 2788.27384875413,
28.6937227408861, 1988.03831525414, 1476.83143096418), decade_1 = c(83.4606306426572,
537.725421951383, 10.2747132062782, 235.380422949258, 685.043600629146
), decade_2 = c(188.414375201462, 2091.84249935145, 17.080858894829,
649.55107199935, 1805.3484565514), decade_3 = c(43.3316024314987,
141.64396529835, 2.77851259926935, 94.7748265692319, 413.248354335235
), decade_4 = c(54.4891626582901, 451.076574268175, 12.4298374245007,
346.102609621018, 769.215535857077), decade_5 = c(85.5621750431284,
131.822699578988, 13.3130607062134, 151.002200923853, 387.727911723968
), decade_6 = c(112.860998806804, 4844.59668489898, 19.7317645111144,
2084.76584309876, 766.375852567831), decade_7 = c(73.2198969730458,
566.042952305845, 3.2457873699886, 311.853982701609, 768.801733767044
), decade_8 = c(91.8161648275608, 115.161700090147, 10.7289451320065,
181.747670625714, 549.21661120626), decade_9 = c(123.31045087146,
648.23694540667, 17.7690326882018, 430.301803845829, 677.187054208271
)), row.names = c("ANK1", "NTN4", "PTPRH", "JAG1", "PLAT"), class = "data.frame")
newdat <- mydat %>% t() %>% as.data.frame() %>% tibble::rownames_to_column('decade') %>%
pivot_longer(-decade, names_to = 'gene', values_to = 'count')
ggplot(newdat) + geom_line(aes(decade, count, color = gene, group = gene))
Created on 2020-02-14 by the reprex package (v0.3.0)
I have boxplots on highcharter and I would like to customize both the
Fill color
Border color
Here is my code
df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))
hcboxplot(var = df$categ, x = as.numeric(df$value)) %>%
hc_chart(type = "column") %>%
hc_colors(c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"))
The hc_colors works only if I put var2 instead of var but then the box plot are shrunken...
API for styling fillColor: https://api.highcharts.com/highcharts/series.boxplot.fillColor
And for "Border color": https://api.highcharts.com/highcharts/series.boxplot.color
Pure JavaScript example of how to style and define points: https://jsfiddle.net/BlackLabel/6tud3fgx
And R code:
library(highcharter)
df = data.frame(cbind(categ = rep(c('a','b','c','d', 'e')),value = rnorm(1000)))
hcboxplot(var = df$categ, x = as.numeric(df$value)) %>%
hc_chart(type = "column", events = list(
load = JS("function() {
var chart = this;
chart.series[0].points[2].update({
color: 'red'
})
chart.series[0].points[4].update({
x: 4,
low: 600,
q1: 700,
median: 800,
q3: 900,
high: 1000,
color: 'orange'
})
}")
)) %>%
hc_plotOptions(boxplot = list(
fillColor = '#F0F0E0',
lineWidth = 2,
medianColor = '#0C5DA5',
medianWidth = 3,
stemColor = '#A63400',
stemDashStyle = 'dot',
stemWidth = 1,
whiskerColor = '#3D9200',
whiskerLength = '20%',
whiskerWidth = 3,
color = 'black'
)) %>%
hc_colors(c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"))
I made a couple functions to do some stuff with highcharts and boxplots. It will let you color each boxplot and fill it accordingly, and then inject new graphical parameters according to the Highcharts API, should you desire.
Check it out:
## Boxplots Data and names, note the data index (0,1,2) is the first number in the datum
series<- list(
list(
name="a",
data=list(c(0,1,2,3,4,5))
),
list(
name="b",
data=list(c(1,2,3,4,5,6))
),
list(
name="c",
data=list(c(2,3,4,5,6,7))
)
)
# Graphical attribute to be set: fillColor.
# Make the colors for the box fill and then also the box lines (make them match so it looks pretty)
cols<- viridisLite::viridis(n= length(series2), alpha = 0.5) # Keeping alpha in here! (for box fill)
cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines
gen_key_vector<-function(variable, num_times){
return(rep(variable, num_times))
}
kv<- gen_key_vector(variable = "fillColor", length(series))
# Make a function to put stuff in the 'series' list, requires seq_along to be used since x is the list/vector index tracker
add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
base::stopifnot(length(key_vector) == length(value_vector))
base::stopifnot(length(series_list) == length(key_vector))
series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
return(series_list[[x]])
}
## Put the extra stuff in the 'series' list
series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text="This is a title") %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=c("a", "b", "c"), title=list(text="Some x-axis title")) %>%
highcharter::hc_add_series_list(series2) %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
hc
This probably could be adjusted to work with a simple dataframe, but I think it will get you what you want for right now without having to do too much extra work. Also, maybe look into list_parse or list_parse2' fromhighcharter...it could probably help with building out theseries` object..I still need to look into that.
Edit:
I have expanded the example to make it work with a regular DF. As per some follow up questions, the colors are set using the viridis palette inside the make_highchart_boxplot_with_colored_factors function. If you want to allow your own palette and colors, you could expose those arguments and just include them as parameters inside the function call. The expanded example borrows how to add outliers from the highcharter library (albeit in a hacky way) and then builds everything else up from scratch. Hopefully this helps clarify my previous answer. Please note, I could probably also clean up the if condition to make it a little more brief, but I kept it verbose for illustrative purposes.
Double Edit: You can now specify a vector of colors for each level of the factor variable
library(highcharter)
library(magrittr)
library(viridisLite)
df = data.frame(cbind(categ = rep(c('a','b','c','d')),value = rnorm(1000)))
df$value<- base::as.numeric(df$value)
add_variable_to_series_list<- function(x, series_list, key_vector, value_vector){
base::stopifnot(length(key_vector) == length(value_vector))
base::stopifnot(length(series_list) == length(key_vector))
series_list[[x]][length(series_list[[x]])+1]<- value_vector[x]
names(series_list[[x]])[length(series_list[[x]])]<- key_vector[x]
return(series_list[[x]])
}
# From highcharter github pages:
hc_add_series_bwpout = function(hc, value, by, ...) {
z = lapply(levels(by), function(x) {
bpstats = boxplot.stats(value[by == x])$stats
outliers = c()
for (y in na.exclude(value[by == x])) {
if ((y < bpstats[1]) | (y > bpstats[5]))
outliers = c(outliers, list(which(levels(by)==x)-1, y))
}
outliers
})
hc %>%
hc_add_series(data = z, type="scatter", ...)
}
gen_key_vector<-function(variable, num_times){
return(rep(variable, num_times))
}
gen_boxplot_series_from_df<- function(value, by,...){
value<- base::as.numeric(value)
by<- base::as.factor(by)
box_names<- levels(by)
z=lapply(box_names, function(x) {
boxplot.stats(value[by==x])$stats
})
tmp<- lapply(seq_along(z), function(x){
var_name_list<- list(box_names[x])
#tmp0<- list(names(df)[x])
names(var_name_list)<- "name"
index<- x-1
tmp<- list(c(index, z[[x]]))
tmp<- list(tmp)
names(tmp)<- "data"
tmp_out<- c(var_name_list, tmp)
#tmp<- list(tmp)
return(tmp_out)
})
return(tmp)
}
# Usage:
#series<- gen_boxplot_series_from_df(value = df$total_value, by=df$asset_class)
## Boxplot function:
make_highchart_boxplot_with_colored_factors<- function(value, by, chart_title="Boxplots",
chart_x_axis_label="Values", show_outliers=FALSE,
boxcolors=NULL, box_line_colors=NULL){
by<- as.factor(by)
box_names_to_use<- levels(by)
series<- gen_boxplot_series_from_df(value = value, by=by)
if(is.null(boxcolors)){
cols<- viridisLite::viridis(n= length(series), alpha = 0.5) # Keeping alpha in here! (COLORS FOR BOXES ARE SET HERE)
} else {
cols<- boxcolors
}
if(is.null(box_line_colors)){
if(base::nchar(cols[[1]])==9){
cols2<- substr(cols, 0,7) # no alpha, pure hex truth, for box lines
} else {
cols2<- cols
}
} else {
cols2<- box_line_colors
}
# Injecting value 'fillColor' into series list
kv<- gen_key_vector(variable = "fillColor", length(series))
series2<- lapply(seq_along(series), function(x){ add_variable_to_series_list(x = x, series_list = series, key_vector = kv, value_vector = cols) })
if(show_outliers == TRUE){
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text=chart_title) %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
highcharter::hc_add_series_list(series2) %>%
hc_add_series_bwpout(value = value, by=by, name="Outliers") %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
} else{
hc<- highcharter::highchart() %>%
highcharter::hc_chart(type="boxplot", inverted=FALSE) %>%
highcharter::hc_title(text=chart_title) %>%
highcharter::hc_legend(enabled=FALSE) %>%
highcharter::hc_xAxis(type="category", categories=box_names_to_use, title=list(text=chart_x_axis_label)) %>%
highcharter::hc_add_series_list(series2) %>%
hc_plotOptions(series = list(
marker = list(
symbol = "circle"
),
grouping=FALSE
)) %>%
highcharter::hc_colors(cols2) %>%
highcharter::hc_exporting(enabled=TRUE)
}
hc
}
# Usage:
tst_box<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title", chart_x_axis_label = "Some X Axis", show_outliers = TRUE)
tst_box
# Custom Colors:
custom_colors_with_alpha_in_hex<- paste0(gplots::col2hex(sample(x=colors(), size = length(unique(df$categ)), replace = FALSE)), "80")
tst_box2<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
chart_x_axis_label = "Some X Axis",
show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex)
tst_box2
tst_box3<- make_highchart_boxplot_with_colored_factors(value = df$value, by=df$categ, chart_title = "Some Title",
chart_x_axis_label = "Some X Axis",
show_outliers = TRUE, boxcolors = custom_colors_with_alpha_in_hex, box_line_colors = "black")
tst_box3
I hope this helps, please let me know if you have any more questions. I'm happy to try to help as best I can.
-nate
Since there's no highcharter answer yet, I give you at least a base solution.
First, your definition of the data frame is somewhat flawed, rather do:
dat <- data.frame(categ=c('a','b','c','d'), value=rnorm(1000))
Now, using boxplot is quite straightforward. border option colors your borders. With option col you also could color the fills.
boxplot(value ~ categ, dat, border=c("#203d7d","#a0a0ed","#203d7e","#a0a0ad"), pars=list(outpch=16))
Gives
Note: See this nice solution for further customizations.
I'm trying to render a graph in a shiny app using highcharter that shares an x-axis (days) but has multiple y-axes (a percent and a count). After some research it seems like I should use the 'hc_yAxis_multiples' method. On the left y-axis, I have % displayed. On the right y-axis, I want the count displayed. There is a line graph that is based on the left y-axis (%), and a stacked bar graph that is displayed based on the right y-axis.
I have been able to overlay the two graphs, but the bar chart portion based on the right y-axis is not formatted to the corresponding y-axis. Based on what I have been looking at, it seems like something like this would produce a result that I want:
##This first block is to show what the data types of the variables I'm using are and what the structure of my df looks like
df$inbox_rate <- df$total_inbox / df$total_volume
df$inbox_rate <- round((df$inbox_rate*100),0)
df$received_dt <- as.character(df$received_dt)
df$received_dt <- as.Date(df$received_dt, "%Y%m%d")
df <- df[order(df$received_dt),]
## This second block here is where I'm trying to build the chart with two Y-axes
hc <- highchart()%>%
hc_title(text = paste(domain_name,sep=""),align = "center") %>%
hc_legend(align = "center") %>%
hc_xAxis(type = "datetime", labels = list(format = '{value:%m/%d}')) %>%
hc_yAxis_multiples(list(title = list(text = "IPR"),labels=list(format = '{value}%'),min=0,
max=100,showFirstLabel = TRUE,showLastLabel=TRUE,opposite = FALSE),
list(title = list(text = "Total Subscribers"),min=0,max = max(df$total_users),
labels = list(format = "{value}"),showLastLabel = FALSE, opposite = TRUE)) %>%
hc_plotOptions(column = list(stacking = "normal")) %>%
hc_add_series(df,"column",hcaes(
x=received_dt,y=total_users,group=isp,yAxis=total_users)) %>%
hc_add_series(df,type="line",hcaes(
x=received_dt,y=inbox_rate,group=isp,yAxis=inbox_rate)) %>%
hc_exporting(enabled = TRUE) %>%
hc_add_theme(thm)
hc
However this produces something that looks like this.
To give more insight about the data I'm using, the domain_name is a string variable that looks like this: example.com. The total_users variable is a number that varies from 0 to about 50000. The received_dt variable is a date, formatted using as.Date(df$received_dt, "%Y%m%d"). The inbox_rate variable is a percent, from 0 to 100.
The bar counts are all displaying to the full height of the graph, even though the values of the bars vary widely. To reiterate, I want the right y-axis that the bar chart heights are based on to be the count of the df$total_users. Within the hc_yAxis_multiples function, there are two lists given. I thought that the first list gives the left y-axis, and the second gives the right. The closest answer to my question that I could find was given by this stackoverflow response
If anyone has any insight, it would be very much appreciated!
Your use of the yAxis statement in hc_add_series seems to be off. First, it should not be inside hcaes and second, it's a number specifying which axis (in order of appearance in hy_yAxis_multiple call) the series belongs to. So hc_add_series(..., yAxis = 1) should be used to assign a series to the second (right) axis.
Below is a (fully self-explaining, independent, minimal) example that shows how it should work.
library(highcharter)
df <- data.frame(
total_inbox = c(2, 3, 4, 5, 6),
total_volume = c(30, 30, 30, 30, 30),
total_users = c(300, 400, 20, 340, 330),
received_dt = c("20180202", "20180204", "20180206", "20180210", "20180212"),
isp = "ProviderXY"
)
df$inbox_rate <- df$total_inbox / df$total_volume
df$inbox_rate <- round((df$inbox_rate*100),0)
df$received_dt <- as.character(df$received_dt)
df$received_dt <- as.Date(df$received_dt, "%Y%m%d")
df <- df[order(df$received_dt),]
hc <- highchart()%>%
hc_xAxis(type = "datetime", labels = list(format = '{value:%m/%d}')) %>%
hc_yAxis_multiples(list(title = list(text = "IPR"),labels=list(format = '{value}%'),min=0,
max=100,showFirstLabel = TRUE,showLastLabel=TRUE,opposite = FALSE),
list(title = list(text = "Total Subscribers"),min=0,max = max(df$total_users),
labels = list(format = "{value}"),showLastLabel = FALSE, opposite = TRUE)) %>%
hc_plotOptions(column = list(stacking = "normal")) %>%
hc_add_series(df,type="column",hcaes(x=received_dt,y=total_users,group=isp),yAxis=1) %>%
hc_add_series(df,type="line",hcaes(x=received_dt,y=inbox_rate,group=isp))
hc
Maybe take this as an example how code in questions should be like. Copy-Paste-Runnable, no outside variables and minus all the things that dont matter here (like the theme and legend for example).