How can I format a specific cell with DT? In this example, how would I format every cell in the first column that is >0?
df = data.frame(
V1 = c(5, -31, '-2'),
V2 = c(-5, -7, '2'),
V3 = c(4, -10, '22'))
DT = datatable(df) %>%
formatStyle(...)
I thought something like backgroundColor = styleInterval(0, c('red', 'blue)) (in the formatStyle()) might work, but I have had no luck.
The below link for me is quite useful - has a variety of formatting permutations...
https://rstudio.github.io/DT/010-style.html
Specific to a column, which changes based on > 0:
library(DT)
df = data.frame(
V1 = c(5, -31, '-2'),
V2 = c(-5, -7, '2'),
V3 = c(4, -10, '22'))
DT = DT::datatable(df) %>%
formatStyle('V1', backgroundColor = styleInterval(c(0),c('red','blue')))
Might have been the c() specifying the cuts as a vector...
Below is an example to format cells (but is a slight hack - not sure myself of another way)
df = data.frame(
V1 = c(5, -31, '-2'),
V2 = c(-5, -7, '2'),
V3 = c(4, -10, '22'))
Now create a column which has your 'flag' value
df$FLAG <- c(0,0.5,1)
Now create your choice of styles/colours and format the data frame (I then make the FLAG (4) column not visible so looks as if cells are formatted)
styles <- c("rgb(245,242,242)",
"rgb(254, 204, 116)","rgb(255,83,83)")
datatable(df, caption = 'Test Format',
options = list(dom='t',columnDefs =
list(list(visible=FALSE,
targets=4)))) %>%
formatStyle("V1","FLAG",
backgroundColor = styleEqual(c(0,0.5,1),styles))
Note dom='t' just leaves out data table filtering and paging; And columnDefs is used to leave out the FLAG column
Related
I'm trying to apply conditional formatting based on data within a row. I've tried a number of libraries including DT, Reactablefmtr and formatter. The idea is to put it into shiny to present table of findings.
How do I make this function more dynamic to not call it for each row but reference it to the norm variable?
# the table
fin_ratios <- data.frame(
descr = c("Ratio 1", "Ratio 2"),
norm = c(10, 20),
`2021` = c(11, 19),
`2022` = c(9, 21)
)
The code to style the table:
library(formattable)
custom_color_tile <- function (x, x_norm = 10) {
formatter("span",
style = x ~ style(display = "block",
padding = "0 4px",
`color` = "white",
`border-radius` = "4px",
`background-color` = ifelse(x >= x_norm, "green", "red")))
}
fin_ratios %>%
formattable(
list(
area(col = 3:4, row = 1) ~ custom_color_tile(x_norm = 10),
area(col = 3:4, row = 2) ~ custom_color_tile(x_norm = 20)
)
)
Your function is already working. Instead of using single values for x_norm, you can use the norm variable as a vector fin_ratios$norm.
formattable(fin_ratios,
list(area(col = 3:4) ~ custom_color_tile(x_norm = fin_ratios$norm)))
You may just pay attention, if you want to color certain rows. Than you have to select the rows of the norm variable as well.
# color just first row
formattable(fin_ratios,
list(area(col = 3:4,
row = 1) ~ custom_color_tile(x_norm = fin_ratios$norm[1])))
Aim
Giving a different color to a table's cells according to numerical threshold(s).
R Package
gt
Reproducible example
mydata <- structure(list(none = c(4, 4, 25, 18, 10), light = c(2, 3, 10,
24, 6), medium = c(3, 7, 12, 33, 7), heavy = c(2, 4, 4, 13, 2
)), row.names = c("SM", "JM", "SE", "JE", "SC"), class = "data.frame")
Using the above dataset, I can produce a table (however crude), using the following code:
mytable <- gt::gt(mydata)
Where I got stuck
It must be really easy, but I can wrap my head around how to assign (say) red to the cells where the value is (say) larger than 20 AND blue to cells whose value is (say) smaller than 10. It's days now that I am trying to do a little of google search (example HERE), but I could not find a solution. It must be pretty simple but no success so far. My best guess is using the tab_style() function, but I am at loss of understanding how to tune the parameters to get what I am after.
This isn't ideal if you have an arbitrarily large data frame, but for an example of your size it's certainly manageable, imo. I generalized the tests as separate functions to reduce additional code duplication and make it easier to adjust your conditional parameters.
If you're looking for a more generalized solution it would be to look over a vector of columns, as described here.
library(gt)
isHigh <- function(x) {
x > 20
}
isLow <- function(x) {
x < 10
}
mydata %>%
gt() %>%
tab_style(
style = list(
cell_fill(color = 'red'),
cell_text(weight = 'bold')
),
locations =
list(
cells_body(
columns = none,
rows = isHigh(none)
),
cells_body(
columns = light,
rows = isHigh(light)
),
cells_body(
columns = medium,
rows = isHigh(medium)
),
cells_body(
columns = heavy,
rows = isHigh(heavy)
)
)
) %>%
tab_style(
style = list(
cell_fill(color = 'lightblue'),
cell_text(weight = 'bold')
),
locations =
list(
cells_body(
columns = none,
rows = isLow(none)
),
cells_body(
columns = light,
rows = isLow(light)
),
cells_body(
columns = medium,
rows = isLow(medium)
),
cells_body(
columns = heavy,
rows = isLow(heavy)
)
)
)
On the basis of the comment I got, and after having read the earlier post here on SO, I came up with the following:
Create a dataset to work with:
mydata <- structure(list(none = c(4, 4, 25, 18, 10), light = c(2, 3, 10,
24, 6), medium = c(3, 7, 12, 33, 7), heavy = c(2, 4, 4, 13, 2
)), row.names = c("SM", "JM", "SE", "JE", "SC"), class = "data.frame")
Create a 'gt' table:
mytable <- gt::gt(mydata)
Create a vector of columns name to be later used inside the 'for' loops:
col.names.vect <- colnames(mydata)
Create two 'for' loops, one for each threshold upon which we want our values to be given different colors (say, a RED text for values > 20; a BLUE text for values < 5):
for(i in seq_along(col.names.vect)) {
mytable <- gt::tab_style(mytable,
style = gt::cell_text(color="red"),
locations = gt::cells_body(
columns = col.names.vect[i],
rows = mytable$`_data`[[col.names.vect[i]]] > 20))
}
for(i in seq_along(col.names.vect)) {
mytable <- gt::tab_style(mytable,
style = gt::cell_text(color="blue"),
locations = gt::cells_body(
columns = col.names.vect[i],
rows = mytable$`_data`[[col.names.vect[i]]] < 5))
}
This seems to achieve the goal I had in mind.
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
)
)
I have tried using split trace with scatterpolar and it seems to partly work but can't get it to plot the values for all 10 variables. So I want each row (identified by "ean") be plotted as its own line using the values from X1 to X10.
library(tidyverse)
library(vroom)
library(plotly)
types <- rep(times = 10, list(
col_integer(f = stats::runif,
min = 1,
max = 5)))
products = bind_cols(
tibble(ean = sample.int(1e9, 25)),
tibble(kategori = sample(c("kat1", "kat2", "kat3"), 25, replace = TRUE)),
gen_tbl(25, 10, col_types = types)
)
plot_ly(
products,
type = 'scatterpolar',
mode = "lines+markers",
r = ~X1,
theta = ~"X1",
split = ~ean
)
How can I get plotly to plot all variables in the radarchart (X1-X10)? Usually I would select the columns with X1:X10 but I can't do that here (I think it has to do with that ~ is used to select variable here).
So I want the result to look something like this (but I only show lines and not filled polygons and I would have more products). So in the end 25 products is a lot but I am connecting it so that the user can select the diagrams it wants to show.
In plotly it's convenient to use data in long format - see ?gather.
Please check the following:
library(dplyr)
library(tidyr)
library(vroom)
library(plotly)
types <- rep(times = 10, list(
col_integer(f = stats::runif,
min = 1,
max = 5)))
products = bind_cols(
tibble(ean = sample.int(1e9, 25)),
tibble(kategori = sample(c("kat1", "kat2", "kat3"), 25, replace = TRUE)),
gen_tbl(25, 10, col_types = types)
)
products_long <- gather(products, "key", "value", -ean, -kategori)
plot_ly(
products_long,
type = 'scatterpolar',
mode = "lines+markers",
r = ~value,
theta = ~key,
split = ~ean
)
I have some tables in Microsoft Excel that I need to recreate in an R Shiny App. The formatting in R has to remain at least mostly the same as the original context.
Here are images of the original tables:
Table 1
Table 2
Notice the formatting: There are lines under table headers and above totals, headers and totals are bolded, numbers in the Monthly Bill column have thousands seperated by commas and have dollar symbols, and the final number in Table 2 is boxed in.
If the lines were not recreatable it would be fine, but I need to at least be able to bold the selected topics, headers, and totals, and be able to get the correct number format for the Monthly Bill column.
I have tried using the DT package but I can't figure out how to format rows instead of columns. I noticed DT uses wrappers for JavaScript functions but I don't personally know JavaScript myself. Is there a way to format this the way I that I need through R packages or Javascript?
Edit:
Although it would be simple, I cannot merely include an image of the tables because some of the numbers are going to be linked to user input and must have the ability to update.
pixiedust makes it easy to do cell-specific customizations.
T1 <- data.frame(Charge = c("Environmental", "Base Power Cost",
"Base Adjustment Cost", "Distribution Adder",
"Retail Rate Without Fuel", "Fuel Charge Adjustment",
"Retail Rate With Fuel"),
Summer = c(0.00303, 0.06018, 0.00492, 0.00501, 0.07314,
0.02252, 0.09566),
Winter = c(0.00303, 0.05707, 0.00468, 0.01264, 0.07742,
0.02252, 0.09994),
Transition = c(0.00303, 0.05585, 0.00459, 0.01264,
0.07611, 0.02252, 0.09863),
stringsAsFactors = FALSE)
T2 <- data.frame(Period = c("Summer", "Winter", "Transition", "Yearly Bill"),
Rate = c(0.09566, 0.09994, 0.09863, NA),
Monthly = c(118.16, 122.44, 121.13, 1446.92),
stringsAsFactors = FALSE)
library(shiny)
library(pixiedust)
library(dplyr)
options(pixiedust_print_method = "html")
shinyApp(
ui =
fluidPage(
uiOutput("table1"),
uiOutput("table2")
),
server =
shinyServer(function(input, output, session){
output$table1 <-
renderUI({
dust(T1) %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = c(5, 7),
cols = 2:4,
border = "top") %>%
sprinkle(rows = c(5, 7),
bold = TRUE) %>%
sprinkle(pad = 4) %>%
sprinkle_colnames(Charge = "") %>%
print(asis = FALSE) %>%
HTML()
})
output$table2 <-
renderUI({
T2 %>%
mutate(Monthly = paste0("$", trimws(format(Monthly, big.mark = ",")))) %>%
dust() %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = 4,
cols = 1,
bold = TRUE) %>%
sprinkle(rows = 4,
cols = 3,
border = "all") %>%
sprinkle(na_string = "",
pad = 4) %>%
sprinkle_colnames(Period = "",
Monthly = "Monthly Bill") %>%
print(asis = FALSE) %>%
HTML()
})
})
)
This would be easier if you provided an example of your data, but sticking with DT, you should be able to utilize formatStyle to change formatting of both rows and columns. For an example to bold the first row, see the following (assuming your data frame is called df):
df %>%
datatable() %>%
formatStyle(
0,
target = "row",
fontWeight = styleEqual(1, "bold")
)
The rstudio DT page offers more examples: http://rstudio.github.io/DT/010-style.html
Alternatively, I think you might be better off using the stargazer package.
The base plot would look very similar to your desired result.
stargazer::stargazer(df, type = "html", title = "Table 1")
That will get you started, but see here for a LOT more flexibility: https://www.jakeruss.com/cheatsheets/stargazer/