wanted to hide values with special character in table

General
1

I am trying to hide values with "--" within my function but its not working. please help me what i am doing wrong.

so the condition is if mean and median is less than 3 then replace the values with "--"
same as for 25perc and 75 perc


library(expss)
library(dplyr)

df <- mtcars
df <- head(df,3)
var <- "hp"
df$vs <- 1
banner1 <- list(df$vs)


fun1 <- function(data, var, Banner, hide_val = FALSE) {
  var1 <- rlang::parse_expr(var)
  
  perc_25 <- function(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[2]
  perc_75 <- function(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[4]
  Mean <- function(x) mean_col(x, na.rm = TRUE)
  Median <- function(x) median_col(x, na.rm = TRUE)
  valid_n <- function(x) sum(!is.na(x))
  
  t1 <- cross_fun(
    data,
    data[[var1]],
    col_vars = Banner,
    fun = combine_functions(
      "25th Perc" = perc_25,
      "Mean" = Mean,
      "Median" = Median,
      "75th Perc" = perc_75,
      "Valid N" = valid_n
    )
  )
  
  # Apply the masking conditions
  t1 <- apply_labels(t1, "Mean" = ifelse(hide_val & t1[["Valid N"]] <= 3, "--", t1[["Mean"]]))
  t1 <- apply_labels(t1, "Median" = ifelse(hide_val & t1[["Valid N"]] <= 3, "--", t1[["Median"]]))
  t1 <- apply_labels(t1, "25th Perc" = ifelse(hide_val & t1[["Valid N"]] <= 4, "--", t1[["25th Perc"]]))
  t1 <- apply_labels(t1, "75th Perc" = ifelse(hide_val & t1[["Valid N"]] <= 4, "--", t1[["75th Perc"]]))
  
  
  return(t1)
}

# Example usage with masking set to TRUE
result <- fun1(df, var = "hp", Banner = banner1, hide_val = TRUE)
print(result)

the required output should be look like

1
data[[var1]] 25th Perc.25% --
Mean --
Median --
75th Perc.75% --
Valid N 3.0
2

I think you would have to add it into your functions.


library(expss)
library(dplyr)

df <- mtcars
df <- head(df,3)
var <- "hp"
df$vs <- 1
banner1 <- list(df$vs)


fun1 <- function(data, var, Banner, hide_val = FALSE,cutoff=105) {
  var1 <- rlang::parse_expr(var)
  
  perc_25 <- function(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[2]
  perc_75 <- function(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[4]
  Mean <- function(x) {val <- mean_col(x, na.rm = TRUE)
                        hval <- val
                      if(hide_val==TRUE)
                        hval <- "--"
                      ifelse(val <=cutoff,hval,val)}
  Median <- function(x) {val <- median_col(x, na.rm = TRUE)
  hval <- val
  if(hide_val==TRUE)
    hval <- "--"
  ifelse(val <=cutoff,hval,val)}

  valid_n <- function(x) sum(!is.na(x))
  
  t1 <- cross_fun(
    data,
    data[[var1]],
    col_vars = Banner,
    fun = combine_functions(
      "25th Perc" = perc_25,
      "Mean" = Mean,
      "Median" = Median,
      "75th Perc" = perc_75,
      "Valid N" = valid_n
    )
  )

  
  return(t1)
}

# Example usage with masking set to TRUE
result <- fun1(df, var = "hp", Banner = banner1, hide_val = TRUE)
print(result)
3

should i change the same for Perc_25, Perc_75
because my conditions were:

  1. if valid_n is less than or equal to 4 then Perc_25 & Perc_75 should be "--"
    2)if valid_n is less than or equal to 3 then Mean and median bot should be "--"

but the solution you provided , its working for for Mean only

1
data[[var1]] 25th Perc.25% 93
Mean --
Median 110
75th Perc.75% 110
Valid N 3
4

Yes, its the same idea

5

This will make the function lengthy , do we have any other simple solution...??

6

you can make a function factory, like so


library(expss)
library(dplyr)

df <- mtcars
df <- head(df,3)
var <- "hp"
df$vs <- 1
banner1 <- list(df$vs)

#function with hiding maker >> fwhm
fwhm <- function(.f,do_hide,cutoff){
  function(x) {val <- .f(x)
  hval <- val
  if(do_hide==TRUE)
    hval <- "--"
  ifelse(val <= cutoff,hval,val)}
}

fun1 <- function(data, var, Banner, hide_val = FALSE,cutoff=105) {
  var1 <- rlang::parse_expr(var)
  
  perc_25 <- fwhm(\(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[2],TRUE,cutoff)
  perc_75 <- fwhm(\(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[4],TRUE,cutoff)
  Mean <- fwhm(\(x){ mean_col(x, na.rm = TRUE)},TRUE,cutoff)
  Median <-  fwhm(\(x) median_col(x, na.rm = TRUE),TRUE,cutoff)
  
  valid_n <- fwhm(\(x) sum(!is.na(x)),TRUE,cutoff)
  
  t1 <- cross_fun(
    data,
    data[[var1]],
    col_vars = Banner,
    fun = combine_functions(
      "25th Perc" = perc_25,
      "Mean" = Mean,
      "Median" = Median,
      "75th Perc" = perc_75,
      "Valid N" = valid_n
    )
  )
  
  
  return(t1)
}

# Example usage with masking set to TRUE
result <- fun1(df, var = "hp", Banner = banner1, hide_val = TRUE)
print(result)
7

what is .f here , and why we are putting it in parameter section
(x) means function (x) ...???

8

I have one more question, i always want to show valid_n, only hide values of 25thperc, mean,median, 75th perc. but this function is also hiding Valid_n

so sir the actual logic was , if valid_n is less than or equal to 3 then hide mean and median values, and if valid_n is less then or equal to 4 the hide 25th_perc and 75th Perc, median, mean

9

.f is intended to a be function that you want to add the hiding on cutoff behaviour to.

you can read about the idea of function factories and how they look in R here : 10 Function factories | Advanced R (hadley.nz)

\(x) is identical to function(x) in R; its a shorthand syntax that saves typing function.
It was introduceded in 2021 for R 4.10 along with the R native Pipe;

New features in R 4.1.0

10 

library(expss)
library(dplyr)

df <- mtcars
df <- head(df,3)
var <- "hp"
df$vs <- 1
banner1 <- list(df$vs)

#function with hiding maker >> fwhm
fwhm <- function(.f,do_hide,cutoff){
  function(x) {val <- .f(x)
  hval <- val
  if(do_hide==TRUE)
    hval <- "--"
  ifelse(val <= cutoff,hval,val)}
}

fun1 <- function(data, var, Banner, hide_val = FALSE,cutoff=105) {
  var1 <- rlang::parse_expr(var)
  
  
  perc_25_raw <- \(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[2]
  perc_75_raw <- \(x) quantile(x, type = 6, probs = seq(0, 1, 0.25), na.rm = TRUE)[4]
  Mean_raw <- \(x) mean_col(x, na.rm = TRUE)
  Median_raw <-  \(x) median_col(x, na.rm = TRUE)
  
  
  perc_25 <- perc_25_raw
  perc_75 <- perc_75_raw
  Mean <- Mean_raw
  Median <- Median_raw
  
  
  valid_n <- \(x) sum(!is.na(x))
  
  important_number <- valid_n(data[[var1]])
 
  print(important_number)
  if(important_number <= 4){
    perc_25 <- fwhm(perc_25_raw,TRUE,cutoff)
    perc_75 <- fwhm(perc_75_raw,TRUE,cutoff)
  }
  if(important_number <= 3){
    Mean <- fwhm(Mean_raw,TRUE,cutoff)
    Median <-  fwhm(Median_raw,TRUE,cutoff)
  }
  
  t1 <- cross_fun(
    data,
    data[[var1]],
    col_vars = Banner,
    fun = combine_functions(
      "25th Perc" = perc_25,
      "Mean" = Mean,
      "Median" = Median,
      "75th Perc" = perc_75,
      "Valid N" = valid_n
    )
  )
  
  
  return(t1)
}

# Example usage with masking set to TRUE
result <- fun1(df, var = "hp", Banner = banner1, hide_val = TRUE)
print(result)
11

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.