'Display long table with hiding records

I want to show table which can display n number of top records and n number of bottom records if the table is very long.

df <- nycflights13::flights

funct <- function(data, var){
    var_lab(data[[var]])<-"Table 1" 
    t1<- expss::cro_cpct(data[[var]])
    t1
}

funct(data=df,var="distance")
# I tried like below but still doesn't work

t1<- expss::cro_cpct(df[["distance"]]) %>% filter(row_number() <= 10 | row_number() >= (n() - 10)) %>%
    add_row(.after = 10) 
t2 <- t1 %>%   mutate(across(everything(), as.character))
t3 <- t2 %>%   mutate(across(everything(), ~replace_na(t2, "...")))

I want to give a parameter like by which it can trim table like below, for example if i give new parameter n = 10 then it should show first 10 records and bottom 10 records and trim the rest of records without changing the original percentage values.

r


Solution 1:[1]

Not very nice, but works for me:

library(expss)
df <- nycflights13::flights

funct <- function(data, var){
    var_lab(data[[var]])<-"Table 1" 
    t1<- expss::cro_cpct(data[[var]])
    t1
}

res = funct(data=df,var="distance")


res = add_rows(
    head(res, 10),
    NA,
    
    tail(res, 10)
) 

# All row labels are located in the first column separated with '|'. 
# We need to replace the last label with '...'. 
# That's why we have this regular expression here.
res$row_labels[11] = gsub("\\|[^|]+$", "|...", res$row_labels[1]) 
# I don't recommend using the line below because it converts all numerics to characters. 
# It can complicate the further processing. 
# It's better to leave all columns except row_labels as is, e. g. filled with NA
res[11, -1] = '...'
res

# |         |              |               #Total |
# | ------- | ------------ | -------------------- |
# | Table 1 |           17 | 0.000296933273154857 |
# |         |           80 |    0.014549730384588 |
# |         |           94 |     0.28980687459914 |
# |         |           96 |    0.180238496804998 |
# |         |          116 |    0.131541440007601 |
# |         |          143 |    0.130353706914982 |
# |         |          160 |    0.111646910706226 |
# |         |          169 |    0.161828633869397 |
# |         |          173 |   0.0656222533672233 |
# |         |          184 |     1.63432073544433 |
# |         |          ... |                  ... |
# |         |         2475 |        3.34406252227 |
# |         |         2521 |   0.0843290495759793 |
# |         |         2565 |     1.52237689146495 |
# |         |         2569 |   0.0976910468679478 |
# |         |         2576 |   0.0926431812243153 |
# |         |         2586 |     2.43604057296244 |
# |         |         3370 |  0.00237546618523885 |
# |         |         4963 |    0.108380644701523 |
# |         |         4983 |    0.101551179418961 |
# |         | #Total cases |               336776 |

Solution 2:[2]

Filter and add_row in between the top and bottom rows:

df <- nycflights13::flights
df %>% 
  select(carrier, distance) %>% 
  arrange(desc(distance )) %>% 
  filter(row_number() <= 10 | row_number() >= (n() - 10)) %>% 
  mutate(across(everything(), as.character)) %>% 
  add_row(.after = 10, carrier = "...", distance = "...") %>% 
  writexl::write_xlsx(., "table.xlsx")

If you want an spss format style, you could do it with the janitor package manually, e.g.

df %>% 
  janitor::tabyl(distance ) %>% 
  select(-n) %>% 
  arrange(desc(distance )) %>% 
  janitor::adorn_totals() %>% 
  janitor::adorn_pct_formatting() %>% 
  filter(row_number() <= 10 | row_number() >= (n() - 10)) %>% 
  add_row(.after = 10) %>% 
  as_tibble() %>% 
  mutate(across(everything(), as.character)) %>% 
  mutate(across(everything(), ~replace_na(.x, "...")))

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1
Solution 2