Mix cases & stats in same table

[gdemin]

Mix cases & stats in same table

[gdemin]

Hi,
Zero decimals are set only on rows which labels have '#' sign. For all other rows number of decimals is set with expss_digits function.
However it is quite easy to write function for desired format:

#' @param tbl table, result of cro_*, tab_*
#' @param zero_digits_labels function/value which return TRUE on row labels for which we want zero-digits formatting
#' @param digits integer number of digits after decimal separator
tab_format_digits = function(tbl, 
                        zero_digits_labels = fixed("#"), 
                        digits = get_expss_digits()
                        ){
        zero_digits_rows = tbl[[1]] %has% zero_digits_labels
        for(i in seq_along(tbl)[-1]){
            tbl[[i]] = ifelse(zero_digits_rows, 
                              formatC(tbl[[i]], format = "f", digits = 0),
                              formatC(tbl[[i]], format = "f", digits = digits)
                              )
        }
        tbl
}


P28 <- sample(c(1:10,98,99), 625, replace=TRUE)
P32 <- sample(1:5, 625, replace=TRUE)
data <- data.frame(P28, P32)
data %>%
    tab_cells(P28) %>%
    tab_cols(total(), P32) %>%
    tab_stat_cases() %>%
    tab_cells(P28=na_if(P28, gt(10))) %>%
    tab_stat_fun("Media" = w_mean, "Sd" = w_sd) %>%
    tab_pivot(stat_position = "inside_rows") %>% 
    tab_format_digits(zero_digits_labels = !perl("Media|Sd")) # zero decimals for all rows except Media and Sd

[robertogilsaura]

Successful & wonderful ...

Thanks a lot; extraordinary work, this package every day leaves me more surprised and impressed ... in spanish words, "flipando". Happy 2019, Mr Demin [@gdemin] !!!!

[robertogilsaura]

Hi @gdemin .

I have a new question about this issue. If I can mix cases (0 digits) , pct (I would like 1 digit) and statistic measures (2 digits). Can I distinguish between cases and percentages in the same table and use different numbers of digits?

For example

#' @param tbl table, result of cro_*, tab_*
#' @param zero_digits_labels function/value which return TRUE on row labels for which we want zero-digits formatting
#' @param digits integer number of digits after decimal separator
tab_format_digits = function(tbl, 
                        zero_digits_labels = fixed("#"), 
                        digits = get_expss_digits()
                        ){
        zero_digits_rows = tbl[[1]] %has% zero_digits_labels
        for(i in seq_along(tbl)[-1]){
            tbl[[i]] = ifelse(zero_digits_rows, 
                              formatC(tbl[[i]], format = "f", digits = 0),
                              formatC(tbl[[i]], format = "f", digits = digits)
                              )
        }
        tbl
}

P28 <- sample(c(1:10,98,99), 625, replace=TRUE)
P32 <- sample(1:5, 625, replace=TRUE)
data <- data.frame(P28, P32)
data %>%
    tab_cols(total(), P32) %>%
    tab_cells(P28) %>%
    tab_stat_cases() %>%
    tab_stat_cpct() %>% 
    tab_cells(P28=na_if(P28, gt(10))) %>%
    tab_stat_fun("Mean" = w_mean, "Std. dev." = w_sd) %>%
    tab_pivot(stat_position = "inside_rows") %>% 
    tab_format_digits(zero_digits_labels = !perl("Mean|Std. dev.")) # zero decimals for all rows except mean and sd

Thanks in advance ...

[gdemin]

Now tab_format_digits has semantic similair to 'recode'. So it can accept any number of conditions for digits.

#' @param tbl table, result of cro_*, tab_*
#' @param ... formulas LHS is criteria which will be applied to first column of
#'   the table, RHS is desired number of digits. Each item will be formatted
#'   only once.
tab_format_digits = function(tbl, 
                             ...
){
    digit_formatter = function(digits) function(column) formatC(column, format = "f", digits = digits)
    all_args = list(...)
    from = lapply(all_args, function(frmla) {
        cond = eval.parent(frmla[[2]])
        cond(tbl[[1]])
        })
    to = lapply(all_args, function(frmla) digit_formatter(eval.parent(frmla[[3]])))
    recode(tbl[,-1]) = from_to(from, to)
    tbl
}

is_odd_item = function(x) seq_along(x) %% 2 != 0

P28 <- sample(c(1:10,98,99), 625, replace=TRUE)
P32 <- sample(1:5, 625, replace=TRUE)
data <- data.frame(P28, P32)
data %>%
    tab_cols(total(), P32) %>%
    tab_cells(P28) %>%
    tab_stat_cases() %>%
    tab_stat_cpct() %>% 
    tab_cells(P28=na_if(P28, gt(10))) %>%
    tab_stat_fun("Mean" = w_mean, "Std. dev." = w_sd) %>%
    tab_pivot(stat_position = "inside_rows") %>% 
    tab_format_digits(
        perl("#") ~ 0, # totals - zero digits
        perl("Mean|Std. dev.") ~ 2, # summary statistics - two digits
        is_odd_item ~ 0, # odd rows will be formatted with zero digits because it is number of cases
        other ~ 1 # all other values will be formatted with one digit

    ) 

[robertogilsaura]

Thank you very much @gdemin. The output is what I needed.

[blam3]

Hi there,

I have a problem similar to this one, except I would like my last column to have zero decimals while my mean and SD are columns that have two decimals.

Right now, my table looks like this:

I would like my last column to be rounded to the nearest whole number. I've tried modifying the above solution to fit my needs, but I'm new to programming and I'm having trouble understanding the syntax. Thank you.

[gdemin]

@blam3 Could you provide code for reproducing your table?

[blam3]

@gdemin Yes. Here it is:

expss_digits(digits = 2)

subscales %>%
tab_cells(male_subscore, female_subscore, POC_subscore, white_subscore,
white_women_subscale, white_men_subscale, POC_women_subscore,
POC_men_subscore, data.Overall_Reconition_Mean) %>%
tab_cols(total(label = '')) %>%
tab_stat_fun("Mean Subscale" = w_mean, "SD" = w_sd, "Median Subscale" = w_median, method = list) %>%
tab_pivot(stat_position = "inside_rows")

[gdemin]

Try this:

expss_digits(digits = 2)

subscales %>%
tab_cells(male_subscore, female_subscore, POC_subscore, white_subscore,
white_women_subscale, white_men_subscale, POC_women_subscore,
POC_men_subscore, data.Overall_Reconition_Mean) %>%
tab_cols(total(label = '')) %>%
tab_stat_fun("Mean Subscale" = w_mean, "SD" = w_sd, "Median Subscale" = w_median, method = list) %>%
tab_pivot(stat_position = "inside_rows")  %>% 
compute(
     "Median Subscale" = as.character(round( `Median Subscale`))
)

[blam3]

It works! Thanks for your help!

[zelihay]

Hi Mr. Demin,

The codes work very well, but I couldn't see the same result in the Excel file. I think it is about the openxlsx package. I've tried to add style (style = createStyle(numFmt = "0")) to overcome the problem, but it gives the numbers with one digit in any case.

col1=A %>%
  tab_prepend_all %>%
  tab_cols(Index1) %>%
  tab_cells(mrset(S1,T2BS1)) %>% 
  tab_stat_cases(total_row_position = "none") %>%
  tab_cells(S1) %>% 
  tab_stat_fun("Mean" = w_mean) %>%
  tab_stat_unweighted_valid_n(label = "Total") %>%
  
  tab_pivot()%>%
  tab_format_digits(zero_digits_labels = !perl("Mean"))


wb = createWorkbook()
sh1 = addWorksheet(wb, "Count")

xl_write(col1, wb, sh1,
         # remove '#' sign from totals
         col_symbols_to_remove = "#",
         row_symbols_to_remove = "#",
         # format total column as bold
         other_col_labels_formats = list("#" = createStyle(textDecoration = "bold")),
         other_cols_formats = list("#" = createStyle(textDecoration = "bold"))
)

saveWorkbook(wb, "file.xlsx", overwrite = TRUE)

Do you know how to solve this problem?

Many thanks

[gdemin]

Hi, @zelihay

This should work:

xl_write(col1, wb, sh1,
         # remove '#' sign from totals
         col_symbols_to_remove = "#",
         row_symbols_to_remove = "#",
         # format total column as bold
         other_col_labels_formats = list("#" = createStyle(textDecoration = "bold")),
         other_cols_formats = list("#" = createStyle(textDecoration = "bold")),
         main_format = openxlsx::createStyle(halign = "right", numFmt = format(0, nsmall = 0)),
         other_rows_formats = list("Mean" = openxlsx::createStyle(halign = "right", numFmt = format(0, nsmall = 1)))
)

[zelihay]

Thanks a lot! That works :)

[JhalokTalukdar]

Hi @gdemin

Thank you for the above solutions regarding decimal places. I am trying to get different decimal places for different rows and columns. For example, I want a complete number for Unv. valid N, 2 decimal places for "#Total" variable but 3 decimal places for "Sex" and "Age" variables

. Could you please help how can I do that? Thank you so much for your help.

options(scipen=999)
expss_digits(digits = 3)
dat %>%
tab_cells(PhysicalFrailty, PsychologicalFrailty, SocialFrailty) %>%
tab_cols(total(), Sex, Age) %>%
tab_stat_mean_sd_n() %>%
tab_pivot() %>%
set_caption("Table with summary statistics and significance marks.") %>%
compute(
"Unw. valid N" = as.character(round( Unw. valid N))
)

[gdemin]

@JhalokTalukdar

You can use the following code:

library(expss)

#' @param tbl table, result of cro_*, tab_*
#' @param special_digits_labels function/value which return TRUE on row labels for which we want special-digits formatting
#' @param special_digits integer number of digits after decimal separator for special rows
#' @param digits integer number of digits after decimal separator
tab_format_digits = function(tbl, 
                             special_digits_labels = fixed("#"), 
                             special_digits = 0,
                             digits = get_expss_digits()
){
    special_digits_rows = tbl[[1]] %has% special_digits_labels
    for(i in seq_along(tbl)[-1]){
        tbl[[i]] = ifelse(special_digits_rows, 
                          formatC(tbl[[i]], format = "f", digits = special_digits),
                          formatC(tbl[[i]], format = "f", digits = digits)
        )
    }
    tbl
}

options(scipen=999)
expss_digits(digits = 3)
mtcars %>%
    tab_cells(cyl, gear) %>%
    tab_cols(total(), am, vs) %>%
    tab_stat_mean_sd_n() %>%
    tab_pivot() %>%
    set_caption("Table with summary statistics and significance marks.") %>%
    tab_format_digits(
        special_digits_labels = fixed("Unw. valid N"),
        special_digits = 2
    )

[JhalokTalukdar]

Hi @gdemin,

Thank you for getting back to me so quickly. I ran the codes you gave me but I didn't get the expected results (screenshot attached). Did I miss anything?

[gdemin]

@JhalokTalukdar
I have the desired output both in the console, in the viewer and after knitting:

[JhalokTalukdar]

Hi @gdemin,

Thank you so much. It is working in my console now. I highly appreciate you help.