1

I am using gt to show two columns representing values at specific points in time, and a third column that shows a percent change, which was calculated in preprocessing. I would like a summary row that contains the sum of the values in each column, and the percent change between those sums beneath the column of percent changes for the individual observations.

To illustrate, I modified an example using the sp500 table.

library(gt)
library(tidyverse)

start_date <- "2010-06-07"
end_date <- "2010-06-14"

data <- sp500 %>%
  filter(date >= start_date & date <= end_date) %>%
  select(date, open, close) %>%
  mutate(intraday_pct_ch = (close/open - 1)*100)

data
#> # A tibble: 6 x 4
#>   date        open close intraday_pct_ch
#>   <date>     <dbl> <dbl>           <dbl>
#> 1 2010-06-14 1095  1090.          -0.490
#> 2 2010-06-11 1083. 1092.           0.827
#> 3 2010-06-10 1059. 1087.           2.65 
#> 4 2010-06-09 1063. 1056.          -0.664
#> 5 2010-06-08 1051. 1062            1.06 
#> 6 2010-06-07 1066. 1050.          -1.44

data %>% gt() %>%
  summary_rows(
    fns = list(Week_Sum = ~sum(.)),
    columns = vars(open, close, intraday_pct_ch))

Created on 2021-04-20 by the reprex package (v2.0.0)

As written, I get the sum of the percent changes, which I obviously do not want. Is there a way to write a function here that takes the two previous columns as arguments and would keep the result in the same row?

Thanks!

Update: Here is the reprex that gives me the result I want, but it will become unwieldy as the number of "_stock#" groups increases. I deleted the html from the first reprex.

library(gt)
library(tidyverse)

set.seed(42)  
data1 <- sp500 %>%
  filter(date >= "2010-06-07" & date <= "2010-06-14") %>%
  select(date, open, close) %>%
  mutate(intraday_pct_ch = (close/open - 1)*100)

data2 <- data1 %>%
  mutate(open = (open + rnorm(1, 100, 10)),
         close = (close + rnorm(1, 100, 10)),
         intraday_pct_ch = (close/open - 1)*100)

data_bind <- data1 %>% bind_cols(data2, .name_repair = "minimal") %>%
  rename_with(~ str_replace(., "$", "_stock1"), .cols = 1:4) %>%
  rename_with(~ str_replace(., "$", "_stock2"), .cols = 5:8) %>%
  select(!starts_with("date"))

data_bind
#> # A tibble: 6 x 6
#>   open_stock1 close_stock1 intraday_pct_ch_stock1 open_stock2 close_stock2
#>         <dbl>        <dbl>                  <dbl>       <dbl>        <dbl>
#> 1       1095         1090.                 -0.490       1209.        1184.
#> 2       1083.        1092.                  0.827       1196.        1186.
#> 3       1059.        1087.                  2.65        1172.        1181.
#> 4       1063.        1056.                 -0.664       1176.        1150.
#> 5       1051.        1062                   1.06        1165.        1156.
#> 6       1066.        1050.                 -1.44        1180.        1145.
#> # … with 1 more variable: intraday_pct_ch_stock2 <dbl>

#vectorized William Gram's suggested solution
intraday_pct_ch_vec <- c((sum(data_bind$close_stock1) / sum(data_bind$open_stock1)-1)*100 , (sum(data_bind$close_stock2) / sum(data_bind$open_stock2)-1)*100 )

data_bind %>% gt() %>%
  summary_rows(
    fns = list(Week_Sum = ~sum(.)),
    columns = starts_with(c("o", "c"))) %>%
  summary_rows(
    fns = list(Week_Sum = ~ return(intraday_pct_ch_vec[1])),
    columns = 4) %>%
  summary_rows(
    fns = list(Week_Sum = ~ return(intraday_pct_ch_vec[2])),
    columns = 7)

<style>html {
  font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, Oxygen, Ubuntu, Cantarell, 'Helvetica Neue', 'Fira Sans', 'Droid Sans', Arial, sans-serif;
}

#jdrzqoxgdy .gt_table {
  display: table;
  border-collapse: collapse;
  margin-left: auto;
  margin-right: auto;
  color: #333333;
  font-size: 16px;
  font-weight: normal;
  font-style: normal;
  background-color: #FFFFFF;
  width: auto;
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #A8A8A8;
  border-right-style: none;
  border-right-width: 2px;
  border-right-color: #D3D3D3;
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #A8A8A8;
  border-left-style: none;
  border-left-width: 2px;
  border-left-color: #D3D3D3;
}

#jdrzqoxgdy .gt_heading {
  background-color: #FFFFFF;
  text-align: center;
  border-bottom-color: #FFFFFF;
  border-left-style: none;
  border-left-width: 1px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 1px;
  border-right-color: #D3D3D3;
}

#jdrzqoxgdy .gt_title {
  color: #333333;
  font-size: 125%;
  font-weight: initial;
  padding-top: 4px;
  padding-bottom: 4px;
  border-bottom-color: #FFFFFF;
  border-bottom-width: 0;
}

#jdrzqoxgdy .gt_subtitle {
  color: #333333;
  font-size: 85%;
  font-weight: initial;
  padding-top: 0;
  padding-bottom: 4px;
  border-top-color: #FFFFFF;
  border-top-width: 0;
}

#jdrzqoxgdy .gt_bottom_border {
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
}

#jdrzqoxgdy .gt_col_headings {
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #D3D3D3;
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  border-left-style: none;
  border-left-width: 1px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 1px;
  border-right-color: #D3D3D3;
}

#jdrzqoxgdy .gt_col_heading {
  color: #333333;
  background-color: #FFFFFF;
  font-size: 100%;
  font-weight: normal;
  text-transform: inherit;
  border-left-style: none;
  border-left-width: 1px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 1px;
  border-right-color: #D3D3D3;
  vertical-align: bottom;
  padding-top: 5px;
  padding-bottom: 6px;
  padding-left: 5px;
  padding-right: 5px;
  overflow-x: hidden;
}

#jdrzqoxgdy .gt_column_spanner_outer {
  color: #333333;
  background-color: #FFFFFF;
  font-size: 100%;
  font-weight: normal;
  text-transform: inherit;
  padding-top: 0;
  padding-bottom: 0;
  padding-left: 4px;
  padding-right: 4px;
}

#jdrzqoxgdy .gt_column_spanner_outer:first-child {
  padding-left: 0;
}

#jdrzqoxgdy .gt_column_spanner_outer:last-child {
  padding-right: 0;
}

#jdrzqoxgdy .gt_column_spanner {
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  vertical-align: bottom;
  padding-top: 5px;
  padding-bottom: 6px;
  overflow-x: hidden;
  display: inline-block;
  width: 100%;
}

#jdrzqoxgdy .gt_group_heading {
  padding: 8px;
  color: #333333;
  background-color: #FFFFFF;
  font-size: 100%;
  font-weight: initial;
  text-transform: inherit;
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #D3D3D3;
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  border-left-style: none;
  border-left-width: 1px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 1px;
  border-right-color: #D3D3D3;
  vertical-align: middle;
}

#jdrzqoxgdy .gt_empty_group_heading {
  padding: 0.5px;
  color: #333333;
  background-color: #FFFFFF;
  font-size: 100%;
  font-weight: initial;
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #D3D3D3;
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  vertical-align: middle;
}

#jdrzqoxgdy .gt_from_md > :first-child {
  margin-top: 0;
}

#jdrzqoxgdy .gt_from_md > :last-child {
  margin-bottom: 0;
}

#jdrzqoxgdy .gt_row {
  padding-top: 8px;
  padding-bottom: 8px;
  padding-left: 5px;
  padding-right: 5px;
  margin: 10px;
  border-top-style: solid;
  border-top-width: 1px;
  border-top-color: #D3D3D3;
  border-left-style: none;
  border-left-width: 1px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 1px;
  border-right-color: #D3D3D3;
  vertical-align: middle;
  overflow-x: hidden;
}

#jdrzqoxgdy .gt_stub {
  color: #333333;
  background-color: #FFFFFF;
  font-size: 100%;
  font-weight: initial;
  text-transform: inherit;
  border-right-style: solid;
  border-right-width: 2px;
  border-right-color: #D3D3D3;
  padding-left: 12px;
}

#jdrzqoxgdy .gt_summary_row {
  color: #333333;
  background-color: #FFFFFF;
  text-transform: inherit;
  padding-top: 8px;
  padding-bottom: 8px;
  padding-left: 5px;
  padding-right: 5px;
}

#jdrzqoxgdy .gt_first_summary_row {
  padding-top: 8px;
  padding-bottom: 8px;
  padding-left: 5px;
  padding-right: 5px;
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #D3D3D3;
}

#jdrzqoxgdy .gt_grand_summary_row {
  color: #333333;
  background-color: #FFFFFF;
  text-transform: inherit;
  padding-top: 8px;
  padding-bottom: 8px;
  padding-left: 5px;
  padding-right: 5px;
}

#jdrzqoxgdy .gt_first_grand_summary_row {
  padding-top: 8px;
  padding-bottom: 8px;
  padding-left: 5px;
  padding-right: 5px;
  border-top-style: double;
  border-top-width: 6px;
  border-top-color: #D3D3D3;
}

#jdrzqoxgdy .gt_striped {
  background-color: rgba(128, 128, 128, 0.05);
}

#jdrzqoxgdy .gt_table_body {
  border-top-style: solid;
  border-top-width: 2px;
  border-top-color: #D3D3D3;
  border-bottom-style: solid;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
}

#jdrzqoxgdy .gt_footnotes {
  color: #333333;
  background-color: #FFFFFF;
  border-bottom-style: none;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  border-left-style: none;
  border-left-width: 2px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 2px;
  border-right-color: #D3D3D3;
}

#jdrzqoxgdy .gt_footnote {
  margin: 0px;
  font-size: 90%;
  padding: 4px;
}

#jdrzqoxgdy .gt_sourcenotes {
  color: #333333;
  background-color: #FFFFFF;
  border-bottom-style: none;
  border-bottom-width: 2px;
  border-bottom-color: #D3D3D3;
  border-left-style: none;
  border-left-width: 2px;
  border-left-color: #D3D3D3;
  border-right-style: none;
  border-right-width: 2px;
  border-right-color: #D3D3D3;
}

#jdrzqoxgdy .gt_sourcenote {
  font-size: 90%;
  padding: 4px;
}

#jdrzqoxgdy .gt_left {
  text-align: left;
}

#jdrzqoxgdy .gt_center {
  text-align: center;
}

#jdrzqoxgdy .gt_right {
  text-align: right;
  font-variant-numeric: tabular-nums;
}

#jdrzqoxgdy .gt_font_normal {
  font-weight: normal;
}

#jdrzqoxgdy .gt_font_bold {
  font-weight: bold;
}

#jdrzqoxgdy .gt_font_italic {
  font-style: italic;
}

#jdrzqoxgdy .gt_super {
  font-size: 65%;
}

#jdrzqoxgdy .gt_footnote_marks {
  font-style: italic;
  font-size: 65%;
}
</style>
<div id="jdrzqoxgdy" style="overflow-x:auto;overflow-y:auto;width:auto;height:auto;"><table class="gt_table">
  
  <thead class="gt_col_headings">
    <tr>
      <th class="gt_col_heading gt_columns_bottom_border gt_left" rowspan="1" colspan="1"></th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">open_stock1</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">close_stock1</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">intraday_pct_ch_stock1</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">open_stock2</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">close_stock2</th>
      <th class="gt_col_heading gt_columns_bottom_border gt_right" rowspan="1" colspan="1">intraday_pct_ch_stock2</th>
    </tr>
  </thead>
  <tbody class="gt_table_body">
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1095.00</td>
      <td class="gt_row gt_right">1089.63</td>
      <td class="gt_row gt_right">-0.4904110</td>
      <td class="gt_row gt_right">1208.71</td>
      <td class="gt_row gt_right">1183.983</td>
      <td class="gt_row gt_right">-2.0456995</td>
    </tr>
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1082.65</td>
      <td class="gt_row gt_right">1091.60</td>
      <td class="gt_row gt_right">0.8266753</td>
      <td class="gt_row gt_right">1196.36</td>
      <td class="gt_row gt_right">1185.953</td>
      <td class="gt_row gt_right">-0.8698527</td>
    </tr>
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1058.77</td>
      <td class="gt_row gt_right">1086.84</td>
      <td class="gt_row gt_right">2.6511896</td>
      <td class="gt_row gt_right">1172.48</td>
      <td class="gt_row gt_right">1181.193</td>
      <td class="gt_row gt_right">0.7431629</td>
    </tr>
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1062.75</td>
      <td class="gt_row gt_right">1055.69</td>
      <td class="gt_row gt_right">-0.6643237</td>
      <td class="gt_row gt_right">1176.46</td>
      <td class="gt_row gt_right">1150.043</td>
      <td class="gt_row gt_right">-2.2454376</td>
    </tr>
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1050.81</td>
      <td class="gt_row gt_right">1062.00</td>
      <td class="gt_row gt_right">1.0648832</td>
      <td class="gt_row gt_right">1164.52</td>
      <td class="gt_row gt_right">1156.353</td>
      <td class="gt_row gt_right">-0.7012905</td>
    </tr>
    <tr>
      <td class="gt_row gt_left gt_stub"></td>
      <td class="gt_row gt_right">1065.84</td>
      <td class="gt_row gt_right">1050.47</td>
      <td class="gt_row gt_right">-1.4420551</td>
      <td class="gt_row gt_right">1179.55</td>
      <td class="gt_row gt_right">1144.823</td>
      <td class="gt_row gt_right">-2.9440531</td>
    </tr>
    <tr>
      <td class="gt_row gt_stub gt_right gt_grand_summary_row gt_first_grand_summary_row">Week_Sum</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">6,415.82</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">6,436.23</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">0.32</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">7,098.08</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">7,002.35</td>
      <td class="gt_row gt_right gt_grand_summary_row gt_first_grand_summary_row">&minus;1.35</td>
    </tr>
  </tbody>
  
  
</table></div>

<sup>Created on 2021-04-21 by the [reprex package](https://reprex.tidyverse.org) (v2.0.0)</sup>
CaseyR
  • 55
  • 6

1 Answers1

1

I misunderstood your intention entirely about gt(), apologies for that.

You can add an additional summary_rows and calculate a the total sum separately:

intraday_pct_ch_total <- (sum(data$close) / sum(data$open)-1)*100 

data %>% 
  gt() %>%
  summary_rows(
    fns = list(Week_Sum = ~ sum(.)),
    columns = vars(open, close)) %>% 
  summary_rows(
    fns = list(Week_Sum = ~ return(intraday_pct_ch_total)),
    columns = vars(intraday_pct_ch)
  )

Let me know if this produces the table you expected.

Update I have been trying everything I can to make the answer scalable, but to no avail.

First I make the intraday_pct_ch which can contain any amount of columns:

pct_changes <- data %>% 
  summarise(
    across(contains('open'), sum),
    across(contains('close'), sum)
  ) %>% 
  pivot_longer(
    cols = everything(),
    names_to = c('open_close', 'no'),
    names_pattern = '(open|close)(.)',
    values_to = 'sum'
  ) %>% 
  pivot_wider(
    names_from = 'open_close',
    values_from = 'sum'
  ) %>% 
  mutate(diff = (close/open-1)*100, .keep='unused') %>% 
  pivot_wider(
    names_from = 'no',
    values_from = 'diff',
    names_prefix = 'intraday_pct_ch'
  )

Then I have to add them to the table:

table_info <- data %>% gt() %>%
  summary_rows(
    fns = list(Week_Sum = ~sum(.)),
    columns = starts_with(c("o", "c"))
  )

table_info %>%
  summary_rows(
    fns = list(Week_Sum = ~ return(as.numeric(pct_changes[1, 1]))),
    columns = names(tmp)[1]) %>%
  summary_rows(
    fns = list(Week_Sum = ~ return(as.numeric(pct_changes[1, 2]))),
    columns = names(tmp)[2]
  )

I tried making a dumb loop so this wouldn't have to be manual, but for some reason, at least on my end, it didn't work.

for (i in seq_along(pct_changes)) {
  table_info
  print(paste0('change: ', i, ': ', names(pct_changes)[i], ': ', pct_changes %>% pull(names(pct_changes)[i])))
  table_info <- table_info %>% 
    summary_rows(
      fns = list(Week_Sum = ~ pct_changes %>% pull(names(pct_changes)[i])),
      columns = names(pct_changes)[i]
    )
}
WilliamGram
  • 673
  • 3
  • 7
  • No, the date in this case is not really important. My actual use case is not S&P data; I just thought this would be easier to reproduce. Each observation is actually a single account balance. What I want is to be able to use the summary_rows() to calculate and display the percent change in the sum of the account balances in the rendered gt table. – CaseyR Apr 20 '21 at 17:11
  • Thanks, that is useful, but doesn't seem to extend to the case where the table has multiple sets of these three column types side by side (e.g. open_stock1, close_stock1, pct_ch_stock1, open_stock2, close_stock2, pct_ch_stock2...). I tried calculating a vector of intraday_pct_ch_totals, instead, hoping your result would fill in the missing column by position, but it did not work. Would it make sense to edit the reprex to clarify? – CaseyR Apr 20 '21 at 21:09
  • Could you provide an example of how your actual data looks / is extended? – WilliamGram Apr 21 '21 at 06:51
  • Thanks for your efforts. I will keep looking at it. It seems like we need a way for the function passed to summary_rows() to allow for mutate()-like syntax where we could call the columns in the immediate two positions that precede each column returned by the columns argument in the function. – CaseyR Apr 22 '21 at 16:09
  • 1
    Yeah, the problem seems to be that it wants to pass a function to the data already in the `gt()`, and the column chosen to be exact. I found another [thread](https://stackoverflow.com/questions/62541285/r-gt-summary-rows-ratio-total-row) which seems to attack your question too. I think this package just isn't designed to handle cases like yours. – WilliamGram Apr 22 '21 at 19:39