sub function to mask values in table

[ashley21]

I am trying to create a sub function but I am unable to create which checks N in the table and then mask the values in tables.

df <- mtcars
df <- df[1:4,]

sub function

  mask_func <- function(x,N,masking){
  mask_2= c(5,7)
  if(masking=="NA"){
    ifelse (N < mask_2[2] & N >= mask_2[1] ,"--",
            ifelse (N < mask_2[2] & N <= mask_2[1] ,"--",x))}
}      
 


tab<-function(dataset, var, Name_of_variable, Pref,masking,...)
{
  var <- rlang::parse_expr(var)
summ_tab1<- df %>% filter(!is.na(!!var)) %>% summarise(
  q25 = format(round_half_up(quantile(!!var,  type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[2])),
  Median = format(round_half_up(quantile(!!var, type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[3])),
  Mean = format(round_half_up( mean(!!var, na.rm=TRUE))),
  q75 = format(round_half_up(quantile(!!var, type=6, probs = seq(0, 1, 0.25), na.rm=TRUE)[4])),
  N = sum(!is.na(!!var)))

summ_tab<- summ_tab1 %>% mutate(" "= Name_of_variable,
                                       q25 = ifelse(mask_func(q25,N,masking)=="--","--",paste0(Pref,mask_func(q25,N,masking))),
                                       Median =ifelse(mask_func(Median,N,masking)=="--","--",paste0(Pref,mask_func(Median,N,masking))),
                                       Mean = ifelse(mask_func(Mean,N,masking)=="--","--",paste0(Pref,mask_func(Mean,N,masking))),
                                       q75 = ifelse(mask_func(q75,N,masking)=="--","--",paste0(Pref,mask_func(q75,N,masking))))

    
summ_tab

}

For example, if the input parameter is selected as masking="NA", then I am trying to create a sub function which checks the N for table summ_tab1, so that if N comes in mask_2= c(5,7). If N is less than 7, then it should mask values to "--" for q25 or q75. If N is less than 5, then it should mask values of median and mean to "--", which is the same as for masking="simple".

debug(tab)
tab(df, "cyl","col",masking="NA",Pref="$")

i want tables to mask like below

[technocrat]

This produces the result, but I'm not sure if it covers the case as described.

get_stats <- function(x,y,z) {
  s = summary(x[z,y])[2:5]
  N = dim(x[z,])[1]
  o = c(s,N)
  attributes(o)$names[1] <- "q25"
  attributes(o)$names[4] <- "q75"
  attributes(o)$names[5] <- "N"
  return(o)
}

make_tab <- function(x,y,z) {
  mask = "--"
  input = janitor::round_half_up(get_stats(x,y,z))
  output = input
  if(input[5] < 5) output[c(1:4)] = mask
  if(input[5] > 4 & input[5] < 7) output[c(1,4)] = mask
  return(output)
}

pander::pander(make_tab(mtcars,"mpg",1:4))

q25	Median	Mean	q75	N
–	–	–	–	4

pander::pander(make_tab(mtcars,"mpg",1:5))

q25	Median	Mean	q75	N
–	21	21	–	5

pander::pander(make_tab(mtcars,"mpg",1:7))

q25	Median	Mean	q75	N
18	21	20	21	7