数据源
https://raw.githubusercontent.com/lgellis/MiscTutorial/master/Austin/Imagine_Austin_Indicators.csv
library(data.table)
library(dplyr)
#Download the Austin indicator data set
#Original data set from: https://data.austintexas.gov/City-Government/Imagine-Austin-Indicators/apwj-7zty/data
austinData= data.table::fread('G:/Imagine_Austin_Indicators.csv', data.table=FALSE, header = TRUE, stringsAsFactors = FALSE)
i1 <- austinData %>%
filter(`Indicator Name` %in%
c('Prevalence of Obesity', 'Prevalence of Tobacco Use',
'Prevalence of Cardiovascular Disease', 'Prevalence of Diabetes')) %>%
select(c(`Indicator Name`, `2011`, `2012`, `2013`, `2014`, `2015`, `2016`)) %>%
mutate (Average = round(rowMeans(
cbind(`2011`, `2012`, `2013`, `2014`, `2015`, `2016`), na.rm=T),2),
`Improvement` = round((`2011`-`2016`)/`2011`*100,2))
prevalence = i1
只需要一个简单的formattable()
函数,我们就可以得到该数据的整洁版本,并且表头,也就是变量名自动加粗了。我们还可以设置不同行的对齐方式,使用的是align参数,其中”l”表示左对齐,“r”表示右对齐。
library(formattable)
formattable(prevalence)
formattable(prevalence, align = c("l",rep("r", NCOL(prevalence) - 1)))
prevalence[, "Improvement"] = prevalence[, "Improvement"] / 100
formattable(prevalence,
align = c("l",rep("r", NCOL(prevalence) - 1)),
list(`Indicator Name` = formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
`Average` = color_bar("#FA614B"),
`Improvement` = percent))
formatter 创建一个格式化程序函数来创建HTML元素
,第一个参数默认为span
formattable(prevalence,
align = c("l",rep("r", NCOL(prevalence) - 1)),
list(`Indicator Name` = formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
`Average` = color_bar("#FA614B"),
`Improvement` = formatter("span",
x ~ percent(x / 100),
style = x ~ style(color = ifelse(x < 0, "red", "green")))))
需要用到数据值的时候,则为x ~
,如果不需要对数据值进行判断,则直接为~
formattable(prevalence,
align = c("l",rep("r", NCOL(prevalence) - 1)),
list(`Indicator Name` = formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
`Average` = color_bar("#FA614B"),
`Improvement` = formatter("span",
x ~ icontext(ifelse(x > 0, "ok", "remove"), ifelse(x > 0, "Yes", "No")),
style = x ~ style(color = ifelse(x < 0, "red", "green")))))
formattable(prevalence, align = c("l",rep("r", NCOL(prevalence) - 1)), list(
`Indicator Name` = formatter("span", style = ~ style(color = "grey",font.weight = "bold")),
area(col = 2:7) ~ color_tile("#DeF7E9", "#71CA97")))
区域渐变色
prev.sig = prevalence[, c(1, 6:7)]
prev.sig$z = c(-1.97, .12, 2.2, 2.1)
prev.sig
formattable(prev.sig,
list(z = FALSE,
`2016` = formatter("span",
style = ~ style(color = ifelse(`2016` >`2015`, "green", "red")),
~ icontext(sapply(`z`, function(x) if (x < -1.96) "arrow-down" else if (x > 1.96) "arrow-up" else ""), `2016`))))
purrr版本
formattable(prev.sig,
list(z = FALSE,
`2016` = formatter("span",
style = ~ style(color = ifelse(`2016` >`2015`, "green", "red")),
~ icontext(purrr::map_chr(prev.sig$z, function(x) if (x < -1.96) "arrow-down" else if (x > 1.96) "arrow-up" else ""), `2016`))))
library(sparkline)
library(formattable)
df = data.frame("Type" = c("bar", "line", "bullet", "pie", "tristate", "discrete"),
Sparkline = c(as.character(htmltools::as.tags(sparkline(c(1,2,7,6,5), type = "bar"))),
as.character(htmltools::as.tags(sparkline(c(1,2,7,6,5), type = "line"))),
as.character(htmltools::as.tags(sparkline(c(1,2,7,6,5), type = "bullet"))),
as.character(htmltools::as.tags(sparkline(c(1,2,7,6,5), type = "pie"))),
as.character(htmltools::as.tags(sparkline(c(-1,0,1,1,1,-1,0,2), type = "tristate"))),
as.character(htmltools::as.tags(sparkline(c(1,2,7,6,5), type = "discrete")))))
out = as.htmlwidget(formattable(df))
out$dependencies = c(out$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
out
表格出图
library(formattable)
library(sparkline)
prevalence$` ` = c(4.1, -.3, .5, 1.4)
prevalence$`2012` = apply(prevalence[, 2:7], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line"))))
names(prevalence)[3] = "  "
new.prevalance = prevalence[, c(1, 2, 3, 7, 10)]
out = as.htmlwidget(formattable(new.prevalance,
align = c("l",rep("r", NCOL(prevalence) - 1)),
list(`Indicator Name` = formatter("span", style = ~ style(color = "grey", font.weight = "bold")),
" " = formatter("span",
style = ~ style(color = ifelse(`2016` >`2011`, "green", "red")),
~ icontext(sapply(` `, function(x) if (x < -1.96) "arrow-down" else if (x > 1.96) "arrow-up" else ""))))))
out$dependencies <- c(out$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
out