设置 formattable() 对象的宽度

Question

我正在使用 formattable 包 (AWESOME PACKAGE) 对我从网络上抓取的数据表进行一些条件格式化。我想将生成的对象与另一个 formattable() 表并排放置在 html 文档中。但是，我无法弄清楚如何设置表格的宽度（在函数中或在 knitr 块中），因此无法将两个对象并排放置。

这是我的代码。我意识到这很草率。有人可以帮我在.rmd knitting to html中并排放置两张同一张桌子吗？它实际上是两个不同的 formattable() 表，但这并不重要。

library(formattable, quietly = T)
library(rvest, quietly = T)



#Part 1: Air pollution forecast from sparetheair.org
#read the page
#0-50 Good Green
#51-100 Moderate Yellow
#101-150 Unhealthy for Sensitive Groups Orange
#151-200 Unhealthy  Red
#201-300 Very Unhealthy Purple --> Also red for simplicity
air_quality <- read_html("http://sparetheair.org/stay-informed/todays-     air-quality/five-day-forecast")
#Scrape table
box <- html_nodes(air_quality,"div div .f5day")
content <- html_text(box)
#Text cleaning, removing artifacts
fulltext <- gsub("\n"," ",content)
fulltext1 <- gsub("\n"," ",fulltext)
fulltext2 <- gsub("\r"," ", fulltext1)
fulltext3 <- gsub("\t"," ", fulltext2)
#split the string into a character vector of strings
mytext <- unlist(strsplit(fulltext3," "))
#Leave empty spaces out, 
wholething <- mytext[mytext != ""]
#vector of days
Days <- wholething[1:5]
#character data for table construction
wholedata <- wholething[6:69]
#a subset of Oakland related data
baydata <- wholedata[13:26]  
#convert to data frame exactly as it is on website
mydf <- data.frame(rbind(baydata[5:9], baydata[10:14]),    row.names=c("AQI","PMI"))
#transposed data frame (tidy data, observations in rows, variables in cols)
tmydf <- data.frame(cbind(Days, baydata[5:9], baydata[10:14]), row.names = NULL, stringsAsFactors = F)
#replace the names of the new df with the webscraped days of the week
names(tmydf) <- c("Day","AQI","PMI")
tmydf$PMI <- gsub("PM","",tmydf$PMI)
#Print to an html table the resulting dataframe
#eventually this will have some color coding or reactive element
#focus only on numeric variables
smaller <- tmydf[1:2,]
#Coerce to numeric
smaller$AQI <- as.numeric(smaller$AQI)
smaller$PMI <- as.numeric(smaller$PMI)
#Format ouput based on scale above
nicetable <- formattable(smaller, 
                         list( 
                             AQI = formatter("span", style = x ~ 
                                                 ifelse(x <= 50, style(display = "block",`border-radius` = "4px",
                                                                       padding = "0 4px",background = "green", 
                                                                       color = "white", font.weight = "bold"), 
                                                        ifelse(x <= 100, style(display = "block",`border-radius` = "4px",
                                                                               padding = "0 4px", background = "yellow", 
                                                                               color ="white", font.weight = "bold"), 
                                                               style(display = "block",`border-radius` = "4px",
                                                                     padding = "0 4px",background = "red", 
                                                                     color = "white", font.weight = "bold") ) ) ), 
                             PMI = formatter("span",style = x ~ 
                                                 ifelse(x == 2.5, style(display = "block",`border-radius` = "4px",
                                                                        padding = "0 4px",background = "red", 
                                                                        color = "white", font.weight = "bold"), 
                                                        style(display = "block",`border-radius` = "4px",
                                                              padding = "0 4px",background = "green", 
                                                              color = "white", font.weight = "bold") ) )
                         )
)

nicetable

GithubRepo

Answer 1

我将尝试在代码中进行解释，但要指定宽度，我们只需手动将 formattable 转换为 htmlwidget 和 as.htmlwidget()。这也应该适用于rmarkdown。

library(formattable, quietly = T)
library(rvest, quietly = T)



#Part 1: Air pollution forecast from sparetheair.org
#read the page
#0-50 Good Green
#51-100 Moderate Yellow
#101-150 Unhealthy for Sensitive Groups Orange
#151-200 Unhealthy  Red
#201-300 Very Unhealthy Purple --> Also red for simplicity
air_quality <- read_html("http://sparetheair.org/stay-informed/todays-air-quality/five-day-forecast")
#Scrape table
box <- html_nodes(air_quality,xpath="//div//div[contains(@class, 'f5day')]")
content <- html_text(box)
#Text cleaning, removing artifacts
fulltext <- gsub("\n"," ",content)
fulltext1 <- gsub("\n"," ",fulltext)
fulltext2 <- gsub("\r"," ", fulltext1)
fulltext3 <- gsub("\t"," ", fulltext2)
#split the string into a character vector of strings
mytext <- unlist(strsplit(fulltext3," "))
#Leave empty spaces out, 
wholething <- mytext[mytext != ""]
#vector of days
Days <- wholething[1:5]
#character data for table construction
wholedata <- wholething[6:69]
#a subset of Oakland related data
baydata <- wholedata[13:26]  
#convert to data frame exactly as it is on website
mydf <- data.frame(rbind(baydata[5:9], baydata[10:14]),    row.names=c("AQI","PMI"))
#transposed data frame (tidy data, observations in rows, variables in cols)
tmydf <- data.frame(cbind(Days, baydata[5:9], baydata[10:14]), row.names = NULL, stringsAsFactors = F)
#replace the names of the new df with the webscraped days of the week
names(tmydf) <- c("Day","AQI","PMI")
tmydf$PMI <- gsub("PM","",tmydf$PMI)
#Print to an html table the resulting dataframe
#eventually this will have some color coding or reactive element
#focus only on numeric variables
smaller <- tmydf[1:2,]
#Coerce to numeric
smaller$AQI <- as.numeric(smaller$AQI)
smaller$PMI <- as.numeric(smaller$PMI)
#Format ouput based on scale above
nicetable <- formattable(smaller, 
                         list( 
                           AQI = formatter("span", style = x ~ 
                                             ifelse(x <= 50, style(display = "block",`border-radius` = "4px",
                                                                   padding = "0 4px",background = "green", 
                                                                   color = "white", font.weight = "bold"), 
                                                    ifelse(x <= 100, style(display = "block",`border-radius` = "4px",
                                                                           padding = "0 4px", background = "yellow", 
                                                                           color ="white", font.weight = "bold"), 
                                                           style(display = "block",`border-radius` = "4px",
                                                                 padding = "0 4px",background = "red", 
                                                                 color = "white", font.weight = "bold") ) ) ), 
                           PMI = formatter("span",style = x ~ 
                                             ifelse(x == 2.5, style(display = "block",`border-radius` = "4px",
                                                                    padding = "0 4px",background = "red", 
                                                                    color = "white", font.weight = "bold"), 
                                                    style(display = "block",`border-radius` = "4px",
                                                          padding = "0 4px",background = "green", 
                                                          color = "white", font.weight = "bold") ) )
                         )
)

nicetable

#  so what happens is a formattable object
#   gets converted to an htmlwidget
#   for viewing when interactive
#  to specify a width
#   we have to do the htmlwidget conversion ourselves
#   with as.htmlwidget
as.htmlwidget(nicetable, width=200)



# just use shiny to get helper fluid functions
library(shiny)
library(htmltools)

browsable(
  tagList(
    fluidRow(
      column(
        width = 6,
        as.htmlwidget(nicetable)
      ),
      column(
        width = 6,
        as.htmlwidget(nicetable)
      )
    )
  )
)