How can I render a text column containing the output of {sparkline}s' spk_chr() with {reactable}?
Note that I do not want to use the way described in the docs (https://glin.github.io/reactable/articles/examples.html), but explicitly use spk_chr() output.
Here is a reprex:
library(dplyr)
library(sparkline)
data <- chickwts %>%
count(feed)
summary_table <- data.frame(
x = "obs 1",
spark = spk_chr(
data$n,
barWidth = 500,
barSpacing = 100,
height = 50,
width = 300,
type = "bar",
tooltipFormatter = htmlwidgets::JS(
sprintf(
"function(sparkline, options, field){
debugger;
return 'value=' + %s[field[0].offset] + '<br/> n=' + field[0].value;
}",
jsonlite::toJSON(
data$feed
)
)
)
)
)
reactable(summary_table) #I want to render the spark column
Related
I created an areaRange plot with the dreamRs apexcharter package and have a few issues formatting the hoverlabel/tooltip.
This is my sample code:
First, I installed the dreamRs apexcharter version using this:
#install.packages("remotes")
#remotes::install_github("dreamRs/apexcharter")
And then I loaded the following packages:
library(dplyr)
library(apexcharter)
The apexcharter version I have now is: apexcharter_0.3.1.9200
This is my example data:
test_data <- data.frame(seq(as.POSIXct('2022/09/04 22:00:00'), as.POSIXct('2022/09/08 10:00:00'), by="hour"))
test_data$MIN <- runif(n = 85, min = 70, max = 100)
test_data$MEDIAN <- runif(n = 85, min = 100, max = 120)
test_data$MAX <- runif(n = 85, min = 120, max = 150)
colnames(test_data) <- c("Date", "MIN", "MEDIAN", "MAX")
And this is my plot so far:
axc_plot <- apex(data = test_data, # plot the area range
mapping = aes(x = test_data[20:60,]$Date,
ymin = test_data[20:60,]$MIN,
ymax = rev(test_data[20:60,]$MAX)),
type = "rangeArea",
serie_name = "Vertrauensbereich") %>%
add_line(mapping = aes(x = Date, y = MEDIAN), # add the line
type = "line",
serie_name = "Median") %>%
ax_colors("lightblue", "red") %>% # why is the line not red?
ax_labs(x = "Zeit [h]",
y = "Q [m³/s]") %>%
ax_tooltip(enabled = T,
shared = T, # I want it shared but it's not
x = list(format = "dd.MM. HH:mm"), # changes grey hoverlabel at the bottom -> works
y = list(formatter = JS("function(seriesName) {return seriesName;}"), # instead of the time I want it to say "Median" and "Vertrauensbereich"
title = list(formatter = JS("function(test_data$Date) {return test_data$Date;}")))) # the title of the hoverlabel should be the time in the format "yyyy-MM-dd HH:mm:ss"
axc_plot
Here's how it looks:
rangeArea Plot with tooltip
As you can see the data in the tooltip is not displayed very well, so I want to format it using ax_tooltip but that hasn't worked very well so far. I found out that using x = will change the grey hoverlabel at the bottom of the plot and y = changes the label that runs along with the lines (which is the one I want to change). I tried to make a custom tooltip using formatter = but I don't really know how to work with it because all examples I see are made with Java Script and I don't know how to implement that in R. In ax_tooltip(y = ...) you can see how I tried to change the format using JS() because I saw it once somewhere (can't find the link anymore sadly) but I'm pretty sure that's not the way to do it as it doesn't change anything.
In the end, I'd like to achieve a tooltip that looks something like this with the Date at the top (as title) in the format "yyyy-MM-dd HH:mm:ss" if possible and then the series names with the corresponding values and hopefully also with the unit m³/s:
apex desired tooltip
Thanks in advance for any answers. I'm looking forward to hearing your suggestions!
I also asked this question on GitHub where pvictor solved my problem perfectly. This is what they answered and what works for me:
library(htmltools)
test_data <- data.frame(seq(as.POSIXct('2022/09/04 22:00:00'), as.POSIXct('2022/09/08 10:00:00'), by="hour"))
test_data$MIN <- runif(n = 85, min = 70, max = 100)
test_data$MEDIAN <- runif(n = 85, min = 100, max = 120)
test_data$MAX <- runif(n = 85, min = 120, max = 150)
colnames(test_data) <- c("Date", "MIN", "MEDIAN", "MAX")
# explicit NA if not used in area range
test_data$MIN[-c(20:60)] <- NA
test_data$MAX[-c(20:60)] <- NA
# Construct tooltip with HTML tags
test_data$tooltip <- unlist(lapply(
X = seq_len(nrow(test_data)),
FUN = function(i) {
d <- test_data[i, ]
doRenderTags(tags$div(
style = css(padding = "5px 10px;", border = "1px solid #FFF", borderRadius = "5px"),
format(d$Date, format = "%Y/%m/%d %H:%M"),
tags$br(),
tags$span("Q Median:", tags$b(round(d$MEDIAN), "m\u00b3/s")),
if (!is.na(d$MIN)) {
tagList(
tags$br(),
tags$span("Vertrauensbereich:", tags$b(round(d$MIN), "m\u00b3/s -", round(d$MAX), "m\u00b3/s"))
)
}
))
}
))
axc_plot <- apex(
data = test_data[20:60, ], # plot the area range
mapping = aes(
x = Date,
ymin = MIN,
ymax = rev(MAX),
tooltip = tooltip # variable containing the HTML tooltip
),
type = "rangeArea",
serie_name = "Vertrauensbereich"
) %>%
add_line(
data = test_data,
mapping = aes(x = Date, y = MEDIAN, tooltip = tooltip), # use same tooltip variable
type = "line",
serie_name = "Median"
) %>%
ax_colors(c("lightblue", "#FF0000")) %>% # use HEX code instaed of name
ax_theme(mode = "dark") %>%
ax_labs(
x = "Zeit [h]",
y = "Q [m³/s]"
) %>%
ax_tooltip(
# Custom tooltip: retrieve the HTML tooltip defined in data
custom = JS(
"function({series, seriesIndex, dataPointIndex, w}) {",
"var tooltip = w.config.series[seriesIndex].data[dataPointIndex].tooltip;",
"return typeof tooltip == 'undefined' ? null : tooltip;",
"}"
)
)
axc_plot
You can find the GitHub entry here: https://github.com/dreamRs/apexcharter/issues/62
I have some data I'm trying to present using reactable. I am styling the background of cells based on the value. There are a number of groups in the data which are useful, but the groups themselves do not have an aggregated value that is useful.
The issue I'm facing is that when the data is grouped with the custom grouping select, the table will retain the style of the first few rows of data so the background is coloured. I would like it to be blank for the grouped row.
In the example below, when grouping by group you'll notice that A and C have the background coloured, inheriting the style from rows 1 and 3 in the data. I could imagine a hacky way of organizing the data so only non-stylized rows come first, but that is not really appropriate as the data would be too disorganized at initial presentation.
Is there a way to strip the style when grouped, but retain it for the rows with values?
library(reactable)
library(htmltools)
set.seed(1)
data <- data.frame(
group = rep(c("A", "B", "C"), each = 5),
value = rnorm(15)
)
htmltools::browsable(
tagList(
div(tags$label("Group by", `for` = "tab")),
tags$select(
id = "tab",
onchange = "Reactable.setGroupBy('tab', this.value ? [this.value] : [])",
tags$option("None", value = ""),
tags$option("Group", value = "group"),
),
reactable(
data,
columns = list(
value = colDef(style = function(value){
if (value < 0) list(background = "#ffa500")
})
),
defaultPageSize = 15,
elementId = "tab"
)
)
)
I found a way using JavaScript. I've changed the variable value to num in the example below so it's more clear how to apply the function.
The grouping is done via JavaScript in the browser, so there isn't a way to control group styling in R as far as I'm aware.
library(reactable)
library(htmltools)
set.seed(1)
data <- data.frame(
group = rep(c("A","B","C"), each = 5),
num = rnorm(15)
)
htmltools::browsable(
tagList(
div(tags$label("Group by", `for` = "tab")),
tags$select(
id = "tab",
onchange = "Reactable.setGroupBy('tab', this.value ? [this.value] : [])",
tags$option("None", value = ""),
tags$option("Group", value = "group"),
),
reactable(
data,
columns = list(
num = colDef(style = JS("function(rowInfo) {
var value = rowInfo.row['num']
if (value < 0) {
var background = '#ffa500'
}
return {background: background}
}"))
),
defaultPageSize = 15,
elementId = "tab"
)
)
)
Columns in reactable (R package reactable) can be styled with a list of styles, a function or javascript - which works if I want to use one way only. How can these be combined (without rewriting the list, function or javascript code?
Example:
library(reactable)
list_style <- list(background = "#eee")
js_style <- JS("
function(rowInfo) {
return {fontWeight: 'bold' }
}
")
fn_style <- function(value) {
color <- "#008000"
list(color = color)
}
df <- data.frame(x = 1:10, y = 11:20)
reactable(
df,
columns = list(
x = colDef(
style = c(list_style, js_style, fn_style) # This generates the below error
)
)
)
Error:
Error in colDef(style = c(list_style, js_style, fn_style)) :
`style` must be a named list, character string, JS function, or R function
reactable(
df,
columns = list(
x = colDef(
style = list(list_style, js_style, fn_style)
)
)
)
it seems that your style out of list, please replace those code with this reactable
I have a dataframe like the one below, with one column for a large "Group" and another indicating the "Team" someone is on within that group, and additional columns indicating their expenditure in different time periods.
data <- data.frame("Team" = c("Alex", "Beth", "Andrew", "Bert"),
"Group" = c("A","B","A","B"),
"Spending_Q1" = c(1000, 500, 1500, 1000),
"Spending_Q2" = c(500, 2000, 1000, 500))
Using the DT package, I would like to color the Spending_Q1 and Spending_Q2 columns based on their respective values (with a gradient: darker colors for higher values), but with a different color for each Team. I've been able to do most of this, with the same color gradient (e.g. shades of blue) applied to all values, but am not sure if it's possible to limit the shading to specific rows and columns. Can anyone advise?
I've consulted the RStudio guide to data table styling but it doesn't have any examples for specifying shading for both specific rows and columns.
Thanks!
Here is a way. The rendering does not work in RStudio, but it works in the browser.
library(DT)
dat <- data.frame(
"Team" = c("Alex", "Beth", "Andrew", "Bert"),
"Group" = c("A","B","A","B"),
"Spending_Q1" = c(1000, 500, 1500, 1000),
"Spending_Q2" = c(500, 2000, 1000, 500),
"Spending_Q3" = c(500, 1000, 1500, 1500)
)
columns <- c(3, 4, 5) # columns we want to colorize
nrows <- nrow(dat)
rowCallback <- c(
"function(row, data, index){",
sprintf(" var columns = [%s];", toString(columns)),
" var min = data[columns[0]];",
" var max = data[columns[0]];",
" for(let i = 1; i < columns.length; i++){",
" min = Math.min(min, data[columns[i]]);",
" max = Math.max(max, data[columns[i]]);",
" }",
sprintf(" var nrows = %d;", nrows),
" var h = index * 360/nrows;",
" for(let i = 0; i < columns.length; i++){",
" var j = columns[i];",
" var l = 75 - 50*(data[j]-min)/(max-min);",
" var color = 'hsl(' + h + ', 100%, ' + l + '%)';",
" $('td:eq(' + j + ')', row).css('background-color', color);",
" }",
"}"
)
datatable(
dat,
options = list(
rowCallback = JS(rowCallback),
columnDefs = list(
list(className = "dt-center", targets = "_all")
)
)
)
Using a variation of the below example dimple chart, how can I get this to auto scale with Shiny bootstrap without having to hard code height and width of the chart?
#get data used by dimple for all of its examples as a first test
data <- read.delim(
"http://pmsi-alignalytics.github.io/dimple/data/example_data.tsv"
)
#eliminate . to avoid confusion in javascript
colnames(data) <- gsub("[.]","",colnames(data))
#example 27 Bubble Matrix
d1 <- dPlot(
x = c( "Channel", "PriceTier"),
y = "Owner",
z = "Distribution",
groups = "PriceTier",
data = data,
type = "bubble",
aggregate = "dimple.aggregateMethod.max"
)
d1$xAxis( type = "addCategoryAxis" )
d1$yAxis( type = "addCategoryAxis" )
d1$zAxis( type = "addMeasureAxis", overrideMax = 200 )
d1$legend(
x = 200,
y = 10,
width = 500,
height = 20,
horizontalAlign = "right"
)
d1
Hi you have to put width="100%" in dplot(), like this :
d1 <- dPlot(
x = c( "Channel", "PriceTier"),
y = "Owner",
z = "Distribution",
groups = "PriceTier",
data = data,
type = "bubble",
aggregate = "dimple.aggregateMethod.max",
width="100%"
)