{gtExtras} column showing in wrong order in {gt} table when grouped - r

I am making a gt table showing the progress of individuals towards a goal. In the table, there is a row showing a horizontal bar graph of progress towards that goal (if goal is 50 and score is 40, the bar is at 80%).
However, when I change the order of the gt rows by using the groupname_col argument, the order of the other cells changes, but not the order of the gtExtras gt_plt_bar_pct column, so it's showing the wrong bars for the name and score in that row, instead, that column seems to always be represented in the order of rows in the input data.
I understand that I can fix this by using arrange on the df before the gt begins, but this doesn't seem like a good solution since I'm going to want to change the order of the rows to view by different groups. Is this a flaw with gtExtras? is there a better fix?
thanks!
reprex:
library(tibble)
library(gt)
library(gtExtras)
library(dplyr)
# make dataframe of individuals and their goals
df <- tribble(
~name, ~group, ~score, ~goal,
"Bob", "C", 20, 40,
"Chris", "A", 50, 40,
"Dale", "B", 30, 50,
"Jay", "A", 0, 40,
"Ben", "B", 10, 20
) %>%
# calculate percent towards goal, and cap at 100%
mutate(percent_to_goal = score/goal *100,
percent_to_goal = case_when(percent_to_goal >= 100 ~ 100,
TRUE ~ percent_to_goal))
df %>%
# this fixes the issue, but doesn't seem like a permanent solution
#arrange(group, name) %>%
# make gt table
gt(rowname_col = "name", groupname_col = "group") %>%
# order groups
row_group_order(groups = c("A","B","C")) %>%
# add bar chart column
gt_plt_bar_pct(column = percent_to_goal) %>%
# highlight blue if person reaches their goal
tab_style(
style = list(
cell_fill(color = "lightcyan"),
cell_text(weight = "bold")),
locations = cells_body(
columns = c(goal,score, percent_to_goal),
rows = score >= goal
)
)
Here is the output from the above code: notice that the length of the bar charts do not always reflect the values of the rows they are appearing in. Instead, they reflect the order of the original dataset.
EDIT: remove row_group_order. If I run the above code again, but comment out the line meant to rearrange the appearance of groups, the grouping shows up in a different order (order of appearance of groups in the original dataset), and the name and first two columns sort into these groups accordingly, but the bar chart column still does not, and remains in the original order of the dataset. Image below:

Per gtExtras v 0.2.4 this bug has been fixed. Thanks for raising and the great reprex!
library(tibble)
library(gt)
library(gtExtras)
library(dplyr)
# make dataframe of individuals and their goals
df <- tribble(
~name, ~group, ~score, ~goal,
"Bob", "C", 20, 40,
"Chris", "A", 50, 40,
"Dale", "B", 30, 50,
"Jay", "A", 0, 40,
"Ben", "B", 10, 20
) %>%
# calculate percent towards goal, and cap at 100%
mutate(percent_to_goal = score/goal *100,
percent_to_goal = case_when(percent_to_goal >= 100 ~ 100,
TRUE ~ percent_to_goal))
df %>%
# make gt table
gt(rowname_col = "name", groupname_col = "group") %>%
# order groups
row_group_order(groups = c("A","B","C")) %>%
# add bar chart column
gt_plt_bar_pct(column = percent_to_goal) %>%
# highlight blue if person reaches their goal
tab_style(
style = list(
cell_fill(color = "lightcyan"),
cell_text(weight = "bold")),
locations = cells_body(
columns = c(goal,score, percent_to_goal),
rows = score >= goal
)
)

Related

gt conditional color based on dynamic column names & filtered rows

I'm trying to color a text, based on a specific values for selected rows & columns. Since column names are dynamically changed I cannot use them as a reference, hence I'm struggling with a final code. I would like to mark all the values as red < 0 but only when Name = 'Row2'. For the rest I'd like to do the opposite, mark as red > 0 when Name != 'Row2'. I'm including only first part of the code which doesn't work. I'd like to ask for help about the logic in general. Thank you!
data %>% gt() %>%
tab_style(
locations = cells_body(
columns = 2:4,
rows = 'Name' == "Row2" & 4 < 0
),
style = list(cell_text(color = 'red')))
One option would be to use purrr::reduce (or base Reduce) to loop over the column names and apply the style to each column one by one like so:
data <- data.frame(
Name = paste0("Row", 1:3),
Col_june = c(1, -1, 0),
Col_june2 = c(2, 3, -2),
Col_june3 = c(3, -2, 2)
)
library(gt)
library(rlang)
data %>%
gt() %>%
purrr::reduce(names(data)[2:4], function(x, y) {
tab_style(x,
locations = cells_body(
columns = all_of(y),
rows = Name == "Row2" & !!sym(y) < 0
),
style = list(cell_text(color = 'red')))
}, .init = .)

Can I have grouped boxplots in R reactable

I would like to have boxplots for subgroups in my reactable::reactable() table. It does not show boxplots for my groups but when I expand the subgroups it shows many individual boxplots. Can I tell reactable() to made a boxplot for each subgroup (and perhaps show individual values when the groups are fully expanded). Here is as far as I have gotten:
library(dplyr)
library(medicaldata)
lar_data <- as_tibble(medicaldata::laryngoscope) %>% #
mutate(
Laryngoscope =
if_else(Randomization == 0, "MacIntosh", "Pentax AWS")
) %>%
mutate( # asa as roman numerals
asa_rm = factor(as.character(as.roman(asa)))
) %>%
select(Laryngoscope, BMI, asa_rm)
# needs to use GitHub release for grouped JS()
# remotes::install_github("glin/reactable")
library(reactable)
library(sparkline)
reactable(
lar_data,
groupBy = c("Laryngoscope", "asa_rm"),
columns = list(
asa_rm = colDef(
aggregate = "frequency",
grouped = JS("function(cellInfo) {return cellInfo.value}")
),
BMI = colDef(cell = function(value) {
sparkline(lar_data$BMI, type = "box")
})
),
bordered = TRUE
)

Re-arrange data so a single cell is header

I am looking to re-arrange my data. Currently it looks like data 1 and I would like for it to look like data2. Essentially, I would like to move 'total' so that it is its own column, and I'd like to move its n along with it. I am using R. Thank you.
data1 <- data.frame (
question = c("recommend", "recommend", "overall", "overall"),
response = c("top box score", "total", "top box score", "total"),
n = c(673, 784, 654, 784))
data2 <- data.frame (
question = c("recommend", "overall"),
response = c("top box score", "top box score"),
n = c(673, 654),
total = c(784, 784))
You can use data.table as follows:
library(data.table)
data2 <- setDT(data1)[response != "total"][data1, total := i.n, on = "question"]
One way would be to filter data for "total" rows, get them in wide format and join to the original data without "total" rows.
library(dplyr)
library(tidyr)
data1 %>%
filter(response != 'total') %>%
left_join(data1 %>%
filter(response == 'total') %>%
pivot_wider(names_from = response, values_from = n), by = 'question')
# question response n total
#1 recommend top box score 673 784
#2 overall top box score 654 784

Multiple y-axes in shiny app w/ highcharter

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).

"Nested" barplots, with multiple levels of grouping

How can I group bars in a barplot by a third variable?
I would like to achieve this in base R, without, for example, ggplot2, as in this related question. In another related question the groups of groups are labeled, but not (visually) grouped – as in my example above –, making the plot difficult to read.
Sample data:
groups = c("A", "B")
choices = c("orange", "apple", "beer")
supergroups = c("fruits", "non-fruits")
dat <- data.frame(
group = rep(groups, c(93, 94)),
choice = factor(c(
rep(choices, c(51, 30, 12)),
rep(choices, c(47, 29, 18))
),
levels = choices
),
supergroup = c(
rep(supergroups, c(81, 12)),
rep(supergroups, c(76, 18))
)
)
barplot(table(dat), beside = TRUE)
Which returns the error:
Error in barplot.default(table(dat), beside = TRUE) :
'height' must be a vector or a matrix

Resources