Custom function to summarize dataframe based on variable class

Viewed 22

I am trying to write a custom function in R that takes the mean and standard deviation, if the variable is numeric; or counts the number of occurrences for each level, if the variable is categorical. As an additional twist, I would like the function to only count the number of "Yes" if the variable is categorical and its levels include "Yes". Ideally, I would like this to be an input parameter, which if called, only counts the number of "Yes".

To demonstrate, let's assume we have the following data:

Height <- round(rnorm(10, 175, 10), 0)
weight <- round(rnorm(10, 70, 10), 0)
smoke <- c(rep("Yes", 3), rep("No", 4), rep("Unknown", 3))
problem <- c(rep("depression", 3), rep("insomnia", 2), rep("IBS", 5))
data <- as.data.frame(cbind(Height, weight, smoke, problem))

data$Height <- as.numeric(data$Height)
data$weight <- as.numeric(data$weight)
data$smoke <- factor(data$smoke, levels = c("Yes", "No", "Unknown"))
data$problem <- factor(data$problem, levels = c("depression", "insomnia", "IBS"))

The function I have is:

sumfun <- function(x){
  if(is.numeric(x)){
    m = round(mean(x, na.rm = T), digits = 2)
    s = round(sd(x, na.rm = T), digits = 2)
    return(list(cbind("", paste0(m, " ", "(", s, ")", " ", "/", " ", sum(!is.na(x))))))
  } else
    # (is.factor(x) | is.character(x)){
    n = table(x)
  pro = round(prop.table(n), 2)
  return(list(cbind("", levels(x), paste0(n, " ", "(", pro*100, ")", " ", "/", sum(!is.na(x))))))
}

Because I want the output to be in a specific way, I wrote another function instead of using apply family. This function is:

tabsum <- function(table){
out <- data.frame()
  for(col in colnames(table)){
    # out <- rbind(out, list(col, "", ""))
    out[nrow(out) + 1, 1] <- col
    for(row in sumfun(table[, col])){
      if(is.numeric(table[,col])){
        out[nrow(out), 2:3] <- row
      } else {
        out[nrow(out), 2:3] <- c("", "")
        out <- rbind(out, as.data.frame(row))  
      }
    }
  }  
  colnames(out) <- c("Variable", "Levels", "Mean (SD) or N (%)")
  return(out)
}

Using these two function on the data set above produces:

tabsum(data)

Variable Levels Mean (SD) or N (%)
Height 174.5 (8) / 10
weight 71.7 (8.68) / 10
smoke
Yes 3 (30) /10
No 4 (40) /10
Unknown 3 (30) /10
problem
depression 3 (30) /10
insomnia 2 (20) /10
IBS 5 (50) /10

What I would like to happen is:

tabsum(sumfun(data, "smoke"))

Variable Levels Mean (SD) or N (%)
Height 174.5 (8) / 10
weight 71.7 (8.68) / 10
smoke
Yes 3 (30) /10
problem
depression 3 (30) /10
insomnia 2 (20) /10
IBS 5 (50) /10

Any ideas are highly appreciated. Kindly note that there may be less painful ways to do this, but I am learning how to write R functions and would like to do it via a custom function.

Thanks

1 Answers

Your code updated to only include factor level 'Yes' for the factor fields:

For the sumfun function:

  • I dropped the else statement altogether
  • I added another if statement because factor inclusion is conditional to containing a factor level "Yes"
    • Within this if statement, you used the function table. You used table as an object name in tabsum: I encourage you to use a different object name, so there is no confusion.
    • I modified the call to table to be conditional and remove empty levels.
    • I changed the return list quite a bit.
sumfun <- function(x){
  if(is.numeric(x)){
    m = round(mean(x, na.rm = T), digits = 2)
    s = round(sd(x, na.rm = T), digits = 2)
    return(list(cbind("", paste0(m, " ", "(", s, ")", " ", "/", " ", sum(!is.na(x))))))
  } 
  if(is.factor(x)){
    if(length(x[x == "Yes"]) > 0){
      n = table(droplevels(x[x == "Yes"]))
      return(list(cbind("", "Yes", paste0(n, " ", 
                                          "(" , n/sum(!is.na(x)) * 100, ")", 
                                          " ", "/ ", sum(!is.na(x))))))
    }
  }
}

In the tabsum function:

  • I removed out[nrow(out) + 1, 1] <- col, otherwise every column will be in the table. Column inclusion is conditional.
  • I added out[nrow(out) + 1, 1] <- col within the row loop, so that only names that return values from sumfun are included.
  • I changed the else statement to an if statement with conditions.
tabsum <- function(table){
  out <- data.frame()
  for(col in colnames(table)){
    for(row in sumfun(table[, col])){
      out[nrow(out) + 1, 1] <- col # moved this in row loop, col conditions**
      if(is.numeric(table[,col])){
        out[nrow(out), 2:3] <- row
      }
      if(is.factor(table[,col])){
        out[nrow(out), 2:3] <- c("", "")
        out <- rbind(out, as.data.frame(row)) 
      }
    }
  }
  colnames(out) <- c("Variable", "Levels", "Mean (SD) or N (%)")
  return(out)
}
tabsum(data)
#   Variable Levels Mean (SD) or N (%)
# 1   Height        174.2 (12.05) / 10
# 2   weight         71.3 (12.47) / 10
# 3    smoke                          
# 4             Yes        3 (30) / 10 

Now that smoke == 'Yes' is all that's included, you could put the information in one row.

To do this, in sumfun change the final return call by dropping the initial "":

return(list(cbind("Yes", paste0(n, " ", 
                                "(" , n/sum(!is.na(x)) * 100, ")",      
                                " ", "/ ", sum(!is.na(x))))))

And in tabsum, change the if(is.factor... to only have one call to out, like so:

if(is.factor(table[,col])){
  out[nrow(out), 1:3] <- c(col, row)
}

This modifies the table to the following:

tabsum(data)
#   Variable Levels Mean (SD) or N (%)
# 1   Height        174.2 (12.05) / 10
# 2   weight         71.3 (12.47) / 10
# 3    smoke    Yes        3 (30) / 10 
Related