how to get the output of proc tabulate (SAS) in R

Viewed 338

Is there any R function which could give me directly the same output of proc tabulate ??

var1<-c(rep("A",4),rep("B",4))
var2<-c(rep("C",4),rep("D",4))
var3<-c(rep("E",2),rep("F",4),rep("G",2))
dataset<-data.frame(var1,var2,var3)
proc tabulate data=dataset;
class var1 var2 var3;
table var1*var2 ,var3 all (n rowpctn);
run;

The output that I want is like this:

enter image description here

3 Answers

Here is a way with R -

  1. Create a column of 1s - n
  2. Expand the data to fill the missing combinations - complete
  3. Reshape to 'wide' format - pivot_wider
  4. Create the 'Total' column by getting the row wise sum - rowSums
  5. Add the percentage by looping across the 'var3' columns
library(dplyr)
library(tidyr)
library(stringr)
dataset %>%
    mutate(n = 1, var3 = str_c('var3_', var3)) %>% 
    complete(var1, var2, var3, fill = list(n = 0)) %>% 
    pivot_wider(names_from = var3, values_from = n, values_fn = sum) %>% 
    mutate(Total = rowSums(across(where(is.numeric)))) %>% 
    group_by(var1) %>% 
    mutate(across(starts_with('var3'), 
     ~ case_when(. == 0 ~ '0(0%)', 
       TRUE ~ sprintf('%d(%d%%)', .,  100 * mean(. != 0))))) %>% 
    ungroup

-output

# A tibble: 4 × 6
  var1  var2  var3_E var3_F var3_G Total
  <chr> <chr> <chr>  <chr>  <chr>  <dbl>
1 A     C     2(50%) 2(50%) 0(0%)      4
2 A     D     0(0%)  0(0%)  0(0%)      0
3 B     C     0(0%)  0(0%)  0(0%)      0
4 B     D     0(0%)  2(50%) 2(50%)     4

Update

Based on the comments by @IceCreamToucan, there was a bug, which is corrected in the below code

dataset %>%
    mutate(n = 1, var3 = str_c('var3_', var3)) %>% 
    complete(var1, var2, var3, fill = list(n = 0)) %>% 
    pivot_wider(names_from = var3, values_from = n, values_fn = sum) %>% 
    mutate(Total = rowSums(across(where(is.numeric))),  
    100 * across(starts_with('var3'),  ~ . != 0, 
      .names = "{.col}_perc")/rowSums(across(starts_with('var3'), ~ .!= 0)), 
     across(matches('var3_[A-Z]$'), ~ case_when(. == 0 ~ '0(0%)', 
     TRUE ~ sprintf('%d(%.f%%)', ., get(str_c(cur_column(), '_perc')))))) %>% 
    select(-ends_with('perc'))

Here's a more generic version, where I define a function.

var1<-c(rep("A",4),rep("B",4))
var2<-c(rep("C",4),rep("D",4))
var3<-c(rep("E",2),rep("F",4),rep("G",2))
df<-data.frame(var1,var2,var3)

df_tabulate(df, id_cols = c(var1, var2), names_from = var3) 
#> # A tibble: 4 × 6
#>   var1  var2  var3_E   var3_F   var3_G   Total
#>   <chr> <chr> <chr>    <chr>    <chr>    <dbl>
#> 1 A     C     2(50.0%) 2(50.0%) 0(0.0%)      4
#> 2 A     D     0(0%)    0(0%)    0(0%)        0
#> 3 B     C     0(0%)    0(0%)    0(0%)        0
#> 4 B     D     0(0.0%)  2(50.0%) 2(50.0%)     4

You can define the function using janitor

library(janitor, warn.conflicts = FALSE)
library(dplyr, warn.conflicts = FALSE)
library(rlang)
library(tidyr)

df_tabulate <- function(df, id_cols, names_from){
  id_cols <- enquo(id_cols)
  if (quo_is_call(id_cols, 'c'))
    id_cols <- call_args(id_cols)
  else
    id_cols <- ensym(id_cols)
  names_from_chr <- as_label(enquo(names_from))
  
  counts <- df %>% 
      mutate(g = eval(call2(paste, !!!id_cols, sep = ',')),
             col = paste0(names_from_chr, '_', {{ names_from }})) %>% 
      tabyl(g, col) %>% 
      adorn_totals('col') 
  
  percs <- adorn_percentages(counts) %>% 
    adorn_pct_formatting()
  
  rbind(counts, percs) %>% 
    group_by(g) %>% 
    summarise(across(-Total, ~ paste0(first(.), '(', last(.), ')')), 
              Total = as.numeric(first(Total))) %>% 
    separate(g, into = as.character(id_cols)) %>% 
    complete(!!!id_cols) %>% 
    mutate(across(starts_with(names_from_chr), ~ coalesce(., '0(0%)')),
           across(Total, ~ coalesce(., 0)))
}

Here it is as a single pipeline with discrete simple steps. Long, to be sure, but if you wanted many tables like this you could store it as a function.

library(tidyverse)
library(janitor)

dataset %>%
  mutate(across(var1:var2, as.factor)) %>%
  count(var1, var2, var3, .drop = FALSE) %>%
  unite(vars, var1, var2) %>%
  pivot_wider(names_from = var3, values_from = n) %>%
  select(-`NA`) %>%
  replace(is.na(.), 0) %>%
  adorn_totals("col") %>%
  adorn_percentages(,,,,-c(vars, Total)) %>%
  adorn_pct_formatting(digits = 0,,,,-c(vars, Total)) %>%
  adorn_ns(position = "front",,,-c(vars, Total)) %>%
  separate(vars, into = c("var1", "var2"))

#> # A tibble: 4 x 6
#>   var1  var2  E       F       G       Total
#>   <chr> <chr> <chr>   <chr>   <chr>   <dbl>
#> 1 A     C     2 (50%) 2 (50%) 0  (0%)     4
#> 2 A     D     0   (-) 0   (-) 0   (-)     0
#> 3 B     C     0   (-) 0   (-) 0   (-)     0
#> 4 B     D     0  (0%) 2 (50%) 2 (50%)     4

This replaces the questionable 0/0 = 0% with simply - for a cleaner(IMO) result.

Related