Skip to Content

Tabelas no R

Posted on 15 mins read

Meus pacotes do R favoritos para criar tabelas

Existem também muitos pacotes que fornecem funções para produzir tabelas bem formatadas.

Aqui estão os principais pacotes do R que conheço para produzir tabelas com boa aparência.

1. gt

O gt “é projetado para ser simples, mas poderoso … [com] ênfase em funções simples para as necessidades diárias para construção de tabelas.”

library(gt)
# Define the start and end dates for the data range
start_date <- "2010-06-02"
end_date <- "2010-06-15"

# The HTML decimal references for the black
# up- and down-pointing triangles are: #9650 and #9660;
# use an in-line style to apply color
up_arrow <- "<span style=\"color:green\">&#9650;</span>"
down_arrow <- "<span style=\"color:red\">&#9660;</span>"

# Create a gt table based on a preprocessed `sp500`
sp500 %>%
  dplyr::filter(date >= start_date & date <= end_date) %>%
  dplyr::select(-adj_close) %>%
  gt() %>%
  tab_header(
    title = "S&P 500",
    subtitle = glue::glue("{start_date} to {end_date}")
  ) %>%
  fmt_date(
    columns = vars(date),
    date_style = 7
  ) %>%
  fmt_currency(
    columns = vars(open, high, low, close),
    currency = "USD"
  ) %>%
  fmt_number(
    columns = vars(volume),
    scale_by = 1 / 1E9,
    pattern = "{x}B"
  ) %>%
  text_transform(
    locations = cells_body(
      columns = "close",
      rows = close > open),
    fn = function(x) paste(x, up_arrow)
  ) %>%
  text_transform(
    locations = cells_body(
      columns = "close",
      rows = close < open),
    fn = function(x) paste(x, down_arrow)
  ) %>%
  cols_label(
    date = "Date", open = "Open", high = "High",
    low = "Low", close = "Close", volume = "Volume"
  )
S&P 500
2010-06-02 to 2010-06-15
Date Open High Low Close Volume
15 jun 2010 $1,091.21 $1,115.59 $1,091.21 $1,115.23 ▲ 4.64B
14 jun 2010 $1,095.00 $1,105.91 $1,089.03 $1,089.63 ▼ 4.43B
11 jun 2010 $1,082.65 $1,092.25 $1,077.12 $1,091.60 ▲ 4.06B
10 jun 2010 $1,058.77 $1,087.85 $1,058.77 $1,086.84 ▲ 5.14B
9 jun 2010 $1,062.75 $1,077.74 $1,052.25 $1,055.69 ▼ 5.98B
8 jun 2010 $1,050.81 $1,063.15 $1,042.17 $1,062.00 ▲ 6.19B
7 jun 2010 $1,065.84 $1,071.36 $1,049.86 $1,050.47 ▼ 5.47B
4 jun 2010 $1,098.43 $1,098.43 $1,060.50 $1,064.88 ▼ 6.18B
3 jun 2010 $1,098.82 $1,105.67 $1,091.81 $1,102.83 ▲ 5.00B
2 jun 2010 $1,073.01 $1,098.56 $1,072.03 $1,098.38 ▲ 5.03B

2. kable & kableExtra

O pacote kable é muito simples e sempre gera uma tabela. o kableExtra adiciona uma formatação.

library(knitr)
library(kableExtra)
data("iris")
vs_dt <- iris[1:10, ]
vs_dt[1:4] <- lapply(vs_dt[1:4], function(x) {
    cell_spec(x, bold = T, 
              color = spec_color(x, end = 0.9),
              font_size = spec_font_size(x))
})
vs_dt[5] <- cell_spec(vs_dt[[5]], color = "white", bold = T,
    background = spec_color(1:10, end = 0.9, option = "A", direction = -1))
kable(vs_dt, escape = F, align = "c")
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
5.1 3.5 1.4 0.2 setosa
4.9 3 1.4 0.2 setosa
4.7 3.2 1.3 0.2 setosa
4.6 3.1 1.5 0.2 setosa
5 3.6 1.4 0.2 setosa
5.4 3.9 1.7 0.4 setosa
4.6 3.4 1.4 0.3 setosa
5 3.4 1.5 0.2 setosa
4.4 2.9 1.4 0.2 setosa
4.9 3.1 1.5 0.1 setosa

3. formattable

Esse é um dos pacotes favoritos para criar tabelas formatadas. Se você quer mexer no estilo, acho que esse é o pacote.

library(formattable)
df <- data.frame(
  id = 1:10,
  name = c("Bob", "Ashley", "James", "David", "Jenny", 
    "Hans", "Leo", "John", "Emily", "Lee"), 
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
  stringsAsFactors = FALSE)

formattable(df, list(
  age = color_tile("white", "orange"),
  grade = formatter("span", style = x ~ ifelse(x == "A", 
    style(color = "green", font.weight = "bold"), NA)),
  area(col = c(test1_score, test2_score)) ~ normalize_bar("pink", 0.2),
  final_score = formatter("span",
    style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
    x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
  registered = formatter("span",
    style = x ~ style(color = ifelse(x, "green", "red")),
    x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))
id name age grade test1_score test2_score final_score registered
1 Bob 28 C 8.9 9.1 9.00 (rank: 06) Yes
2 Ashley 27 A 9.5 9.1 9.30 (rank: 03) No
3 James 30 A 9.6 9.2 9.40 (rank: 02) Yes
4 David 28 C 8.9 9.1 9.00 (rank: 06) No
5 Jenny 29 B 9.1 8.9 9.00 (rank: 06) Yes
6 Hans 29 B 9.3 8.5 8.90 (rank: 08) Yes
7 Leo 27 B 9.3 9.2 9.25 (rank: 04) Yes
8 John 27 A 9.9 9.3 9.60 (rank: 01) No
9 Emily 31 C 8.5 9.1 8.80 (rank: 09) No
10 Lee 30 C 8.6 8.8 8.70 (rank: 10) No

4. DT

O pacote DT permite criar tabelas paginadas, ferramentas para download e filtros.

library(DT)
datatable(head(iris), colnames = c('Aqui', 'Temos', 'os nomes', 'das', 'variaveis'))
datatable(
  head(iris), extensions = 'Buttons', options = list(
    dom = 'Bfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
  )
)
m = matrix(c(
  '<b>Bold</b>', '<em>Emphasize</em>', '<a href="http://rstudio.com">RStudio</a>',
  '<a href="#" onclick="alert(\'Hello World\');">Hello</a>'
), 2)
colnames(m) = c('<span style="color:red">Column 1</span>', '<em>Column 2</em>')

#datatable(m)  # escape = TRUE by default
datatable(m, escape = FALSE)
datatable(
  iris,
  options = list(dom = 'Pfrtip', columnDefs = list(list(
    searchPanes = list(show = FALSE), targets = 1:4
  ))),
  extensions = c('Select', 'SearchPanes'),
  selection = 'none'
)

5. reactable

Esse pacote criou a tabela mais bonita que eu já vi no RMarkdown. Vou reproduzi-la abaixo.

library(reactable)
library(htmltools)
forecasts <- read.csv("C:/Users/Hp/Documents/GitHub/Base_de_dados/wwc_forecasts.csv", stringsAsFactors = FALSE)
rating_cols <- c("spi", "global_o", "global_d")
group_cols <- c("group_1", "group_2", "group_3")
knockout_cols <- c("make_round_of_16", "make_quarters", "make_semis", "make_final", "win_league")
forecasts <- forecasts[, c("team", "points", "group", rating_cols, group_cols, knockout_cols)]
rating_column <- function(maxWidth = 55, ...) {
  colDef(maxWidth = maxWidth, align = "center", class = "cell number", ...)
}
group_column <- function(class = NULL, ...) {
  colDef(cell = format_pct, maxWidth = 70, align = "center", class = paste("cell number", class), ...)
}
knockout_column <- function(maxWidth = 70, class = NULL, ...) {
  colDef(
    cell = format_pct,
    maxWidth = maxWidth,
    class = paste("cell number", class),
    style = function(value) {
      # Lighter color for <1%
      if (value < 0.01) {
        list(color = "#aaa")
      } else {
        list(color = "#111", background = knockout_pct_color(value))
      }
    },
    ...
  )
}
format_pct <- function(value) {
  if (value == 0) "  \u2013 "    # en dash for 0%
  else if (value == 1) "\u2713"  # checkmark for 100%
  else if (value < 0.01) " <1%"
  else if (value > 0.99) ">99%"
  else formatC(paste0(round(value * 100), "%"), width = 4)
}
make_color_pal <- function(colors, bias = 1) {
  get_color <- colorRamp(colors, bias = bias)
  function(x) rgb(get_color(x), maxColorValue = 255)
}
off_rating_color <- make_color_pal(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)
def_rating_color <- make_color_pal(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 0.6)
knockout_pct_color <- make_color_pal(c("#ffffff", "#f2fbd2", "#c9ecb4", "#93d3ab", "#35b0ab"), bias = 2)
tbl <- reactable(
  forecasts,
  pagination = FALSE,
  defaultSorted = "win_league",
  defaultSortOrder = "desc",
  defaultColGroup = colGroup(headerClass = "group-header"),
  columnGroups = list(
    colGroup(name = "Team Rating", columns = rating_cols),
    colGroup(name = "Chance of Finishing Group Stage In ...", columns = group_cols),
    colGroup(name = "Knockout Stage Chances", columns = knockout_cols)
  ),
  defaultColDef = colDef(class = "cell", headerClass = "header"),
  columns = list(
    team = colDef(
      defaultSortOrder = "asc",
      minWidth = 200,
      headerStyle = list(fontWeight = 700), 
      cell = function(value, index) {
        div(
          class = "team",
          img(class = "flag", alt = paste(value, "flag"), src = sprintf("C:/Users/Hp/Documents/GitHub/blog/tables-in-r/images/%s.png", value)),
          div(class = "team-name", value),
          div(class = "record", sprintf("%s pts.", forecasts[index, "points"]))
        )
      }
    ),
    points = colDef(show = FALSE),
    group = colDef(defaultSortOrder = "asc", align = "center", maxWidth = 75,
                   class = "cell group", headerStyle = list(fontWeight = 700)),
    spi = rating_column(format = colFormat(digits = 1)),
    global_o = rating_column(
      name = "Off.",
      cell = function(value) {
        scaled <- (value - min(forecasts$global_o)) / (max(forecasts$global_o) - min(forecasts$global_o))
        color <- off_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "spi-rating", style = list(background = color), value)
      }
    ),
    global_d = rating_column(
      name = "Def.", 
      defaultSortOrder = "asc",
      cell = function(value) {
        scaled <- 1 - (value - min(forecasts$global_d)) / (max(forecasts$global_d) - min(forecasts$global_d))
        color <- def_rating_color(scaled)
        value <- format(round(value, 1), nsmall = 1)
        div(class = "spi-rating", style = list(background = color), value)
      }
    ),
    group_1 = group_column(name = "1st Place", class = "border-left"),
    group_2 = group_column(name = "2nd Place"),
    group_3 = group_column(name = "3rd Place"),
    make_round_of_16 = knockout_column(name = "Make Round of 16", class = "border-left"),
    make_quarters = knockout_column(name = "Make Qtr-Finals"),
    make_semis = knockout_column(name = "Make Semifinals", maxWidth = 90),
    make_final = knockout_column(name = "Make Final"),
    win_league = knockout_column(name = "Win World Cup")
  ),
  # Emphasize borders between groups when sorting by group
  rowClass = JS("
    function(rowInfo, state) {
      const firstSorted = state.sorted[0]
      if (firstSorted && firstSorted.id === 'group') {
        const nextRow = state.pageRows[rowInfo.viewIndex + 1]
        if (nextRow && rowInfo.row.group !== nextRow.group) {
          return 'group-last'
        }
      }
    }"
  ),
  showSortIcon = FALSE,
  borderless = TRUE,
  class = "standings-table"
)
div(class = "standings",
  div(class = "title",
    h2("2019 Women's World Cup Predictions"),
    "Soccer Power Index (SPI) ratings and chances of advancing for every team"
  ),
  tbl,
  "Forecast from before 3rd group matches"
)

2019 Women's World Cup Predictions

Soccer Power Index (SPI) ratings and chances of advancing for every team
Forecast from before 3rd group matches

6. flextable

dat <- tibble::tribble(
  ~namePlayer, ~ratioBPM, ~ratioOBPM, ~ratioDBPM, ~urlPlayerStats, ~urlPlayerHeadshot,
"James Harden", 11.7, 10.5, 1.1, "https://stats.nba.com/player/201935", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/201935.png",
"Giannis Antetokounmpo", 10.8, 5.7, 5, "https://stats.nba.com/player/203507", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/203507.png",
"Nikola Jokic", 9.5, 5.7, 3.8, "https://stats.nba.com/player/203999", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/203999.png",
"Anthony Davis", 8.5, 4.7, 3.9, "https://stats.nba.com/player/203076", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/203076.png",
"LeBron James", 8.1, 6.2, 1.9, "https://stats.nba.com/player/2544", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/2544.png",
"Rudy Gobert", 7, 2, 5.1, "https://stats.nba.com/player/203497", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/203497.png",
"Karl-Anthony Towns", 6.8, 4.8, 2, "https://stats.nba.com/player/1626157", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/1626157.png",
"Russell Westbrook", 6.5, 2.5, 3.9, "https://stats.nba.com/player/201566", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/201566.png",
"Kyrie Irving", 6.4, 6, 0.4, "https://stats.nba.com/player/202681", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/202681.png",
"Nikola Vucevic", 6.4, 3, 3.4, "https://stats.nba.com/player/202696", "https://ak-static.cms.nba.com/wp-content/uploads/headshots/nba/latest/260x190/202696.png"
)
library(flextable)
ft <- flextable(dat, cwidth = c(1.7, .7, .7, .7, 1, .7)) %>%
  flextable::add_header_lines("Top 10 Box Plus/Minus") %>%
  set_header_labels(namePlayer = "", ratioBPM = "BPM", ratioOBPM = "OBPM",
    ratioDBPM = "DBPM", urlPlayerStats = "Link", urlPlayerHeadshot = "") %>%
  compose( j = "urlPlayerStats",
           value = as_paragraph( hyperlink_text(x = "player stats", url = urlPlayerStats ) ) ) %>% 
  compose( j = "urlPlayerHeadshot",
           value = as_paragraph(
             as_image(src = urlPlayerHeadshot, width = .52, height = .38)
           ), part = "body") %>% 
  footnote( i = 1, j = 1, ref_symbols = "*",
            value = as_paragraph("Players with 500+ minutes."), part = "header") %>% 
  footnote( i = 2, j = 2:4, ref_symbols = c("†", "‡", "§"),
            value = as_paragraph(
              c("Box Plus/Minus: a box score estimate of the points per 100 possessions that a player contributed above a league-average player, translated to an average team.", 
                "Offensive Box Plus/Minus.", "Defensive Box Plus/Minus.")
            ), part = "header") %>% 
  theme_zebra(odd_header="transparent") %>% 
  valign(valign = "bottom", part = "all") %>% 
  fontsize(i = 1, part = "header", size = 20) %>% 
  bold(i = 1, part = "header", bold = TRUE) %>% 
  bold(part = "footer", bold = FALSE) %>% 
  italic(part = "footer", italic = TRUE) %>% 
  color(j = 5, color = "#337ab7") %>% 
  vline(j = 1, part = "body", border = officer::fp_border()) %>% 
  border_inner_h(part = "header", border = officer::fp_border()) %>% 
  hline_bottom(part = "all", border = officer::fp_border()) %>% 
  colformat_num(col_keys = c("ratioBPM", "ratioOBPM", "ratioDBPM"), digits = 1 )

ft

Top 10 Box Plus/Minus*

BPM†

OBPM‡

DBPM§

Link

James Harden

11.7

10.5

1.1

player stats

Giannis Antetokounmpo

10.8

5.7

5.0

player stats

Nikola Jokic

9.5

5.7

3.8

player stats

Anthony Davis

8.5

4.7

3.9

player stats

LeBron James

8.1

6.2

1.9

player stats

Rudy Gobert

7.0

2.0

5.1

player stats

Karl-Anthony Towns

6.8

4.8

2.0

player stats

Russell Westbrook

6.5

2.5

3.9

player stats

Kyrie Irving

6.4

6.0

0.4

player stats

Nikola Vucevic

6.4

3.0

3.4

player stats

*Players with 500+ minutes.

†Box Plus/Minus: a box score estimate of the points per 100 possessions that a player contributed above a league-average player, translated to an average team.

‡Offensive Box Plus/Minus.

§Defensive Box Plus/Minus.

7. huxtable

Esse é o melhor pacote para tabelas no LaTeX e criação de pdfs.

library(huxtable)
data(mtcars)
carros<-head(mtcars)
car_ht <- as_hux(carros)

lego_hux <- as_hux(carros) %>% 
      set_background_color(1:2, 1:2, "red") %>% 
      set_background_color(1:2, 3:4, "yellow") %>% 
      set_background_color(3:4, 1:2, "darkgreen") %>% 
      set_background_color(3:4, 3:4, "blue") %>% 
      set_text_color(3:4, 1:4, "white") %>% 
      set_all_borders(brdr(2, "solid", "white"))

lego_hux %>% set_caption("Original table")
Original table
mpgcyldisphpdratwtqsecvsamgearcarb
21  61601103.9 2.6216.50144
21  61601103.9 2.8817  0144
22.84108933.852.3218.61141
21.462581103.083.2119.41031
18.783601753.153.4417  0032
18.162251052.763.4620.21031
car_ht %>% 
      set_width(0.8) %>% 
      set_font_size(8) %>% 
      set_lr_padding(2) %>% 
      set_col_width(rep(c(0.4, 0.2, 0.2, 0.2, 0.2), 3)/3) %>% 
      set_position("left")
mpgcyldisphpdratwtqsecvsamgearcarb
21  61601103.9 2.6216.50144
21  61601103.9 2.8817  0144
22.84108933.852.3218.61141
21.462581103.083.2119.41031
18.783601753.153.4417  0032
18.162251052.763.4620.21031

8. Rhandsomtable

library(rhandsontable)
DF = data.frame(
  title = c(
    "<a href='http://www.amazon.com/Professional-JavaScript-Developers-Nicholas-Zakas/dp/1118026691'>Professional JavaScript for Web Developers</a>",
    "<a href='http://shop.oreilly.com/product/9780596517748.do'>JavaScript: The Good Parts</a>",
    "<a href='http://shop.oreilly.com/product/9780596805531.do'>JavaScript: The Definitive Guide</a>"
  ),
  desc = c(
    "This <a href='http://bit.ly/sM1bDf'>book</a> provides a developer-level introduction along with more advanced and useful features of <b>JavaScript</b>.",
    "This book provides a developer-level introduction along with <b>more advanced</b> and useful features of JavaScript.",
    "<em>JavaScript: The Definitive Guide</em> provides a thorough description of the core <b>JavaScript</b> language and both the legacy and standard DOMs implemented in web browsers."
  ),
  comments = c(
    "I would rate it &#x2605;&#x2605;&#x2605;&#x2605;&#x2606;",
    "This is the book about JavaScript",
    "I've never actually read it, but the <a href='http://shop.oreilly.com/product/9780596805531.do'>comments</a> are highly <strong>positive</strong>."
  ), 
  cover = c(
    "http://ecx.images-amazon.com/images/I/51bRhyVTVGL._SL50_.jpg",
    "http://ecx.images-amazon.com/images/I/51gdVAEfPUL._SL50_.jpg",
    "http://ecx.images-amazon.com/images/I/51VFNL4T7kL._SL50_.jpg"
 ),
 stringsAsFactors = FALSE
)

rhandsontable(DF, allowedTags = "<em><b><strong><a><big>", 
              width = 800, height = 450, rowHeaders = FALSE) %>%
  hot_cols(colWidths = c(200, 200, 200, 80)) %>%
  hot_col(1:2, renderer = "html") %>%
  hot_col(1:3, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
  hot_col(4, renderer = "
    function(instance, td, row, col, prop, value, cellProperties) {
      var escaped = Handsontable.helper.stringify(value),
        img;
  
      if (escaped.indexOf('http') === 0) {
        img = document.createElement('IMG');
        img.src = value;
  
        Handsontable.dom.addEvent(img, 'mousedown', function (e){
          e.preventDefault(); // prevent selection quirk
        });
  
        Handsontable.dom.empty(td);
        td.appendChild(img);
      }
      else {
        // render as text
        Handsontable.renderers.TextRenderer.apply(this, arguments);
      }
  
      return td;
    }")

Esses são os principais. Tem muito mais.

Os pacotes pander, pixiedust, ztable, condformat, xtable, flexpivot, e stargazer também são interessantes.