function to create percentage tables for many columns

user_16577173 0
Viewed 85

I am trying to create function to generate tables for frequency and percentage for multiple columns.

actually my data is labelled already, and i am trying the below approach and getting null data as output.

library(expss)

data<-data.frame(
  gender = c(1,2,1,2,1,2,1,2,2,2,2,1,1,2,2,2,2,1,1,1,1,1,2,1,2,1,2,2,2,1,2,1,2,1,2,1,2,2,2),
  sector = c(3,3,1,2,5,4,4,4,4,3,3,4,3,4,2,1,4,2,3,4,4,4,3,1,2,1,5,5,4,3,1,4,5,2,3,4,5,1,4),
  col1=c(1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,1,1,0,0,0,0,1,0,0,0,0,1,0,1),
  col2=c(1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,0,0,0),
  col3=c(1,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,0,0,1,1,1,1,1,0,0,1),
  col4=c(1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
  col5=c(1,2,1,1,1,2,1,2,2,1,2,1,1,1,2,2,2,1,1,1,2,1,2,1,1,1,2,2,2,1,1,2,2,1,1,1,2,2,2)
)

data$col1<-factor(data$col1, levels=c(1), labels=c("sale"))
data$col2<-factor(data$col2, levels=c(1), labels=c("Ops"))
data$col3<-factor(data$col3, levels=c(1), labels=c("MGMT"))
data$col4<-factor(data$col4, levels=c(1), labels=c("mark"))
data$col5<-factor(data$col5, levels=c(1), labels=c("National"))

data$gender<-factor(data$gender, levels=c(1,2), labels=c("Male","female"))
data$sector<-factor(data$sector, levels=c(1,2,3,4,5), labels=c("TX","CA","NY","LA","WA"))

data$gender1 <- ifelse(data$gender == "Male",1, NA)
data$total <- ifelse(data$col5 == "National",1, NA)

val_lab(data$gender1)<-c("GENDER"=1)
val_lab(data$total)<-c("All Market"=1)

lkl <- list(data$gender1,data$total)


my_fre <- function(curr_var) setNames(expss::fre(curr_var)[, 1:3],
                                      c("row_labels", "Count N", "Valid percent"))


cross_fun_df(data, list(as.category(col1 %to% col4)), lkl , fun = my_fre)

output is enter image description here

r
2 Answers

It's unclear what you're trying to do, since the count of NAs are different for each columns, but here's a starting point:

library(tidyverse)
data %>% 
  group_by(gender) %>% 
  summarise(Sales = sum(!is.na(col1)),
            OPS = sum(!is.na(col2)),
            Management = sum(!is.na(col3)),
            NAs = sum(is.na(across(col1:col3)))) %>% 
  mutate(Total = rowSums(select(., Sales:Management))) %>% 
  pivot_longer(-gender, values_to = "count") %>% 
  group_by(gender) %>% 
  mutate(percentage = sprintf("%0.f%%", count / count[name == "Total"] * 100),
         ValidPercentage = sprintf("%0.f%%", count / (count[name == "Total"] + count[name == "NAs"]) * 100)) %>% 
  pivot_wider(id_cols = everything(), names_from = gender, values_from = c(count, percentage, ValidPercentage)) %>% 
  select(name, ends_with(c("_Male", "_Female")))

output:

  name       count_Male percentage_Male ValidPercentage_Male count_female percentage_female ValidPercentage_female
  <chr>           <dbl> <chr>           <chr>                       <dbl> <chr>             <chr>                 
1 Sales               6 23%             12%                             6 24%               9%                    
2 OPS                15 58%             29%                            10 40%               15%                   
3 Management          5 19%             10%                             9 36%               14%                   
4 NAs                25 96%             49%                            41 164%              62%                   
5 Total              26 100%            51%                            25 100%              38%

And with some kable styling:

library(knitr)
library(kableExtra)

table %>% 
  kable(col.names = c("name",rep(c("count","percentage","validPercentage"), 2))) %>%
  kable_styling("striped", full_width = F, position = "left", font_size = 12) %>%
  add_header_above(c(" "= 1, "Male" = 3, "Female" = 3))

enter image description here

user_134606020 
library(expss)

data<-data.frame(
    gender = c(1,2,1,2,1,2,1,2,2,2,2,1,1,2,2,2,2,1,1,1,1,1,2,1,2,1,2,2,2,1,2,1,2,1,2,1,2,2,2),
    sector = c(3,3,1,2,5,4,4,4,4,3,3,4,3,4,2,1,4,2,3,4,4,4,3,1,2,1,5,5,4,3,1,4,5,2,3,4,5,1,4),
    col1=c(1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,1,1,0,0,0,0,1,0,0,0,0,1,0,1),
    col2=c(1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,1,1,0,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,0,0,0),
    col3=c(1,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1,0,0,1,1,1,1,1,0,0,1),
    col4=c(1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
    col5=c(1,2,1,1,1,2,1,2,2,1,2,1,1,1,2,2,2,1,1,1,2,1,2,1,1,1,2,2,2,1,1,2,2,1,1,1,2,2,2)
)


data$gender<-factor(data$gender, levels=c(1,2), labels=c("Male","female"))
data$sector<-factor(data$sector, levels=c(1,2,3,4,5), labels=c("TX","CA","NY","LA","WA"))

# you are using dichotomy encoding, so we need to set var_lab instead of val_lab
data$col1<-set_var_lab(data$col1, "Sales")
data$col2<-set_var_lab(data$col2, "OPS")
data$col3<-set_var_lab(data$col3, "Management")
data$col4<-set_var_lab(data$col4, "HR")
data$col5<-factor(data$col5, levels=c(1,2), labels=c("National","Overseas"))


# you need to NA instead of 0. NA will be hidden from table
data$gender1 <- ifelse(data$gender == "Male",1, NA)
data$total <- ifelse(data$col5 == "National",1, NA)

val_lab(data$gender1)<-c("GENDER"=1)
val_lab(data$total)<-c("All Market"=1)


my_fre <- function(curr_var) setNames(expss::fre(curr_var)[, 1:3],
                                      c("row_labels", "Count N", "Valid percent"))


cross_fun_df(data, list(as.category(col1 %to% col4), col5), list(total, gender1), fun = my_fre)

# |            | All Market |               |  GENDER |               |
# |            |    Count N | Valid percent | Count N | Valid percent |
# | ---------- | ---------- | ------------- | ------- | ------------- |
# |      Sales |          5 |            25 |       6 |          40.0 |
# |        OPS |         20 |           100 |      15 |         100.0 |
# | Management |          6 |            30 |       5 |          33.3 |
# |         HR |          2 |            10 |       2 |          13.3 |
# |     #Total |         20 |           100 |      15 |         100.0 |
# |       <NA> |          1 |               |       2 |               |
# |   National |         21 |           100 |      15 |          88.2 |
# |   Overseas |            |               |       2 |          11.8 |
# |     #Total |         21 |           100 |      17 |         100.0 |
# |       <NA> |          0 |               |       0 |               |
user_3874080
Related