I am trying to use sparkline with a flextable I created for a report. Unfortunately, I can't get the function tabwid() to work, to convert this into an HTML widget. It is cited as being part of flextable v0.4.0, but it isn't in v0.5.
I note in the documentation below that the tabwid() function is deprecated:
https://www.rdocumentation.org/packages/flextable/versions/0.4.0/topics/tabwid
Is there an equivalent function in v0.5? If not, is there another way to use the sparkline function within a sparktable?
I noticed a conversation regarding this with the developer of flextable in 2016, and the code described there includes the tabwid() function. I can't find an alternative and would be grateful for any guidance provided.
https://github.com/davidgohel/flextable/issues/1
The code cited in the link above is as follows:
#devtools::install_github("davidgohel/oxbase")
#devtools::install_github("davidgohel/flextable")
#devtools::install_github("htmlwidgets/sparkline")
library(dplyr) library(oxbase) library(flextable) library(sparkline)
mtcars %>% group_by(cyl) %>% summarise(
hp = spk_chr(
hp, type="box",
chartRangeMin=0, chartRangeMax=max(mtcars$hp)
),
mpg = spk_chr(
mpg, type="box",
chartRangeMin=0, chartRangeMax=max(mtcars$mpg)
) ) %>% flextable() %>% tabwid() %>% spk_add_deps()
If this isn't possible, has anyone else found a way to add a sparkline into a flextable (e.g., through another package?)?
Thanks in advance for any guidance you can provide!
With the dev version on github, you can do the following - these are not interactive graphics:
# remotes::install_github("davidgohel/flextable")
library(data.table)
library(magrittr)
library(flextable)
# data prep ----
z <- as.data.table(iris)
z <- z[, list(
Sepal.Length = mean(Sepal.Length, na.rm = TRUE),
z = list(.SD$Sepal.Length)
), by = "Species"]
# flextable ----
ft <- flextable(
data = z,
col_keys = c("Species", "Sepal.Length", "box", "density", "line")
) %>%
compose(j = "box", value = as_paragraph(
plot_chunk(
value = z, type = "box",
border = "white", col = "transparent",
width = 1.5, height = .4
)
)) %>%
compose(j = "line", value = as_paragraph(
plot_chunk(value = z, type = "line", col = "white",
width = 1.5, height = .4)
)) %>%
compose(j = "density", value = as_paragraph(
plot_chunk(value = z, type = "dens", col = "white",
width = 1.5, height = .4)
)) %>%
theme_vader() %>%
align(j = c("box", "density", "line"), align = "center", part = "all") %>%
autofit()
ft
Related
I am trying to develop a Business Cycle Clock similar to https://kosis.kr/visual/bcc/index/index.do?language=eng.
I've already achieved most of the things I wanted to replicate, but I can't figure it out how to add these traces (for example, in the link above set speed to 10 and trace length to 5 and then click on 'Apply' to understand what I mean).
Does anyone have any idea how to implement it? It would make the "clock" much easier to read. Thanks in advance.
Reprocible example:
library(plotly)
library(dplyr)
library(magrittr)
variable <- rep('A',10)
above_trend <- rnorm(10)
mom_increase <- rnorm(10)
ref_date <- seq.Date('2010-01-01' %>% as.Date,
length.out = 10,by='m')
full_clock_db <- cbind.data.frame(variable, above_trend, mom_increase, ref_date)
freq_aux = 'm'
ct = 'Brazil'
main_title = paste0('Business Cycle Clock para: ', ct)
m <- list(l=60, r=170, b=50, t=70, pad=4)
y_max_abs = 2
x_max_abs = 5
fig = plot_ly(
data = full_clock_db,
x = ~mom_increase,
y = ~above_trend,
color = ~variable,
frame = ~ref_date,
text = ~variable,
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
animation_opts( frame = 800,
transition = 500,
easing = "circle",
redraw = TRUE,
mode = "immediate") %>%
animation_slider(
currentvalue = list(prefix = "Período", font = list(color="red"))
)
fig
Another more elegant solution would be to rely on ggplot2 + gganimate:
library(ggplot2)
library(gganimate)
ggplot(full_clock_db, aes(x = mom_increase, y = above_trend)) +
geom_point(aes(group = 1L)) +
transition_time(ref_date) +
shadow_wake(wake_length = 0.1, alpha = .6)
You cna play with different shadow_* functions to find the one to your liking.
One way would be to use a line plot and repeat points as necessary. Here's an example as POC:
library(dplyr)
library(plotly)
e <- tibble(x = seq(-3, 3, 0.01)) %>%
mutate(y = dnorm(x)) %>%
mutate(iter = 1:n())
accumulate <- function(data, by, trace_length = 5L) {
data_traf <- data %>%
arrange({{ by }}) %>%
mutate(pos_end = 1:n(),
pos_start = pmax(pos_end - trace_length + 1L, 1L))
data_traf %>%
rowwise() %>%
group_map(~ data_traf %>% slice(seq(.x$pos_start, .x$pos_end, 1L)) %>%
mutate("..{{by}}.new" := .x %>% pull({{by}}))) %>%
bind_rows()
}
enew <- e %>%
accumulate(iter, 100)
plot_ly(x = ~ x, y = ~ y) %>%
add_trace(data = e, type = "scatter", mode = "lines",
line = list(color = "lightgray", width = 10)) %>%
add_trace(data = enew, frame = ~ ..iter.new,
type = "scatter", mode = "lines") %>%
animation_opts(frame = 20, 10)
The idea is that for each step, you keep the trace_length previous steps and assign them to the same frame counter (here ..iter.new). Then you plot lines instead of points and you have a sort of trace..
I have multiple highcharts in my shiny app and the structure is similar in all of them, so I'm trying to use a function to generalise:
In my data file:
Edit
set.seed(5)
data <- data.frame(id=1:10,
period=seq(2011,2020, 1),
program=rep(LETTERS[1:2], 5),
total=rnorm(10))
gral <- function(df,x,y,group,theme){
highchart() %>%
hc_xAxis(type = "category") %>%
hc_add_series(df, "line",
hcaes(x = x, y = y
,group = group),
dataLabels = list(enabled = TRUE,
style = list(fontSize = '13px'))
) %>%
hc_legend(enabled = TRUE) %>%
hc_tooltip(shared = TRUE, crosshairs = TRUE
,style = list(fontSize = "18px")
) %>%
hc_add_theme(theme) }
In my server file (for each highchart)
output$usuariosgral <- renderHighchart({ gral(df = data, x = period, y = total,
group = program, theme = hc_theme_elementary()) })
But it is not working, anyone knows why?
Finally, I found the answer here, in case it is useful to anyone --> https://stackoverflow.com/a/64392483/13529820
Just need to use the function ensym from library rlang. So in my code jus changed the hcaes line to this:
hcaes(x = !!rlang::ensym(x), y = !!rlang::ensym(y), group = !!rlang::ensym(group))
This is a common issue: hcaes is based on ggplot2::aes and acts similarly, luckily, you can access it as a string, ggplot2 has aes_string and highcharter has hcaes_string
library(shiny)
library(highcharter)
gral <- function(df,x,y,group,theme){
highchart() %>%
hc_xAxis(type = "category") %>%
hc_add_series(df, "line",
hcaes_string(x = x, y = y, group = group),
dataLabels = list(enabled = TRUE,
style = list(fontSize = '13px'))) %>%
hc_legend(enabled = TRUE) %>%
hc_tooltip(shared = TRUE, crosshairs = TRUE,style = list(fontSize = "18px")) %>%
hc_add_theme(theme)
}
ui <- basicPage(
column(12,
highchartOutput('usuariosgral')
)
)
server <- function(input, output, session) {
output$usuariosgral <- renderHighchart({
gral(df = mtcars,x ='mpg',y = 'disp',group ='cyl',theme = hc_theme_elementary())
})
}
shinyApp(ui, server)
I found the answer here in case it is useful to anyone.
Just need to use the function ensym from library rlang. So in my code jus changed the hcaes line to this:
hcaes(x = !!rlang::ensym(x), y = !!rlang::ensym(y), group = !!rlang::ensym(group))
at the moment I try to create an interactive heatmap in R with apexcharter. This works fine at manual chart creation but fails on interactive use within shiny.
library(shiny)
library(tidyverse)
library(apexcharter)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Test Heatmap"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "heatmap_filter",
label = "heatmap filter",
choices = c(1999, 2008),
selected = 2008
)
),
mainPanel(
apexchartOutput("heatmap")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$heatmap <- renderApexchart({
df <- mpg %>% filter(year == input$heatmap_filter) %>% mutate_if(is.character, as.factor) %>% group_by(manufacturer, class) %>% summarise(cnt = n()) %>% tidyr::complete(class, fill = list(cnt = 0))
q20 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[2],0)
q40 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[3],0)
q60 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[4],0)
q80 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[5],0)
apex(
data = df,
type = "heatmap",
mapping = aes(x = manufacturer, y = class, fill = cnt)
) %>%
ax_dataLabels(enabled = TRUE) %>%
ax_plotOptions(
heatmap = heatmap_opts(
enableShades = FALSE,
colorScale = list(
ranges = list(
list(from = 0, to = q20, color = "#106e45"), #grün
list(from = q20, to = q40, color = "#90dbba"), #leichtes grün
list(from = q40, to = q60, color = "#fff33b"), #gelb
list(from = q60, to = q80, color = "#f3903f"), # orange
list(from = q80, to = 20, color = "#e93e3a") #rot
)
)
)
) %>%
ax_title(
text = paste("Test interactive heatmap",
input$heatmap_filter
), align = "center"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
With the manual approach everthing works as expected. But when I change the input select only the values changes but not the heatmap quantil ranges and not the title input. Its seems like the input value is not pushing the changes to already calculated variables. I already tried to use an reactive df or reactive variables but so far nothing works.
I added a minimal example where you could change the year input and this should change the title and the color ranges.
Can you help me?
Thanks in advance.
Try setting auto_update to FALSE in the call to apex
apex(
data = df,
type = "heatmap",
auto_update = FALSE,
...
How can I change the label of the line generated with e_mark_line? Here is my attempt, instead of showing the number 200, I'd like it to have my own label.
library(echarts4r)
library(tidyverse)
line <- list(
xAxis = 200
, name = "label 1"
)
USArrests %>%
e_charts(Assault) %>%
e_scatter(Murder, Rape) %>%
e_mark_line(data = line, symbol = "none", name = "label 2")
The underlying echarts JavaScript to mark lines, points and areas is rather convoluted. The title must be specified in the data. In the dev version there are convenience title related arguments.
library(echarts4r)
cars %>%
e_charts(speed) %>%
e_scatter(dist, symbol_size = 5) %>%
e_legend(FALSE) %>%
# manual
e_mark_line(data = list(xAxis = 7, symbol = "rect", label = list(formatter = "tortoise"))) %>%
# convenience arguments in latest github version
e_mark_line(data = list(xAxis = 12), title = "Speed Limit") %>%
e_mark_line(data = list(xAxis = 22), title = "Need for Speed")
I'm trying to create a scatter plot in highcharts shiny R but I need to give a different color to points, individually. Consider for instance the following example:
library("MASS")
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{series.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")
My objective is to give to this 20 points, an unique color.
I tried to set the "fillColor" inside marker list as also as to define the color of the series, both with a vector of 20 colors but I had no success.
Can any one give me a hint?
Thank you
In highcharts (the highcharter) the point can be given as other parameter, same as x and y. So first
library("MASS")
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
dscars <- as.data.frame(dscars)
names(dscars) <- c("x", "y") # it's better give a named list IMHO
dscars$color <- colorize(1:nrow(dscars))
colorizeis a function to create a color vector given other vector. In this case the input vector is a sequence (no repeated) so the output will be differents colors. But if you want yo can use your own colors.
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{point.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list_parse(dscars),
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")
Note we used:
color:{point.color}; in the poinFormat, beacuse every point has its own color in the color accesor.
I used list_parse which parse the data frame in a named list instead of unnamed list so highcharts understand how to use the data. list_parse is the same list.parse3 for old version of highcharts.
Hope it helps.
Is this what you want?
rm(list = ls())
library(highcharter)
library(MASS)
dscars <- data.frame(round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2))
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{colorByPoint:true};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),colorByPoint = TRUE,
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")