関数の説明

データフレームを貰ったときに、そのデータフレームの要約情報を
summaryやstrといった関数で取り出すと思いますが、
それだけでは色々な使い方をする際に、足りないと感じる部分があったので、
欲しいなと思う情報を取り出して、データフレームにして返す関数を作ってみた。

データフレームから取り出したい情報について

データフレームの概要を見る時に欲しい情報はかなり多岐に渡ると思いますが、
その中でもnaの数や、factorのユニークな値の数、
その変数がユニークキーとなり得るのか、そうした点を中心に関数を構成しました。

作成される変数一覧

変数名	量的変数時	カテゴリ変数時
colname	変数名	変数名
class_info	変数のクラス	変数のクラス
unique_flag	ユニークなキーとして使えるかどうか	ユニークなキーとして使えるかどうか
max	最大値	文字列にしたときの最大サイズ
min	最小値	文字列にしたときの最大サイズ
na	naの数	naの数
na_ratio	naの比率	naの比率
data	ユニークな値の数	ユニークな値の数
range	最大値-最小値
rec_n	レコード数＋naの数
mean	平均値
median	中央値
sd	標準偏差
lower_sd3	平均ー標準偏差×３
upper_sd3	平均＋標準偏差×３
lower_outlier	下側外れ値
upper_outlier	上側外れ値
co_var	変動係数
ch_var_index	平均と中央値の差の絶対値を標準偏差で割った数。対数変換をしたほうが良いのかの指標にできる

関数内容



df_info <- function(dataframe){
  require(tidyverse)
  dataframe_head <- head(dataframe) #クラス情報を取るのに軽くするために頭だけにする
  class_info <- sapply(dataframe_head, class) %>% 
    data.frame(.)
  
  DF <-  data.frame(colname = as.character(""), class_info = as.character(""), unique_flag = as.character(""),   max = 0, min = 0, 
                    na = 0,na_ratio = 0, data = 0, range = 0,rec_n = 0,
                    mean = 0, median = 0, sd = 0, lower_sd3 = 0, upper_sd3 = 0, lower_outlier = 0,  upper_outlier = 0,
                    co_var = 0, ch_var_index = 0,
                    stringsAsFactors = FALSE )
  for (c in 1:ncol(dataframe_head)){
    class_data <- ifelse(ncol(class_info) >1, class_info[[1,c]], as.character(class_info[c,]))
    #print(class_info[[1,c]])
    #print(colnames(dataframe_head)[c])
    #print(class_data)
    if (class_data == "integer" | class_data == "numeric"){
      unique <- length(unique(dataframe[,c]))
      counter<- plyr::count(is.na(dataframe[,c]))
      colnames(counter)[1] <- "x"
      na   <- filter(counter, x == TRUE)$freq 
      na   <- as.numeric(ifelse(length(na) == 0, 0, na))
      data   <- filter(counter, x == FALSE)$freq
      data   <- as.numeric(ifelse(length(data) == 0, 0, data))
      max_data <- max(dataframe[,c], na.rm = TRUE)
      min_data <- min(dataframe[,c], na.rm = TRUE)
      range_data <- max_data - min_data
      rec_n <- na + data
      unique_key <-  ifelse(rec_n == unique, "UNIQUE", "")
      na_ratio <- round(na/rec_n, 2)
      
      if(sum(dataframe[,c]) == 0) {
        median_df <- 0
        mean_df   <- 0
        sd_df     <- 0
        lower_outlier_line <- 0
        upper_outlier_line <- 0
        
        lower_outlier <- 0
        upper_outlier <- 0
        
        co_var <- 0
        ch_var_index <- 0
        
      }else{
        median_df <- median(dataframe[,c], na.rm = TRUE)
        mean_df <- mean(dataframe[,c], na.rm = TRUE)
        sd_df <- sd(dataframe[,c])
        lower_outlier_line <- mean_df-sd_df*3
        upper_outlier_line <- mean_df+sd_df*3
        
        lower_outlier <- sum(dataframe[,c]<=lower_outlier_line, na.rm = TRUE)
        upper_outlier <- sum(dataframe[,c]>=upper_outlier_line, na.rm = TRUE)
        
        co_var <- round(sd_df/mean_df,2) # coefficient of variance
        ch_var_index <- round(abs(mean_df -  median_df)/sd_df,2) # 対数変換したほうがいいかという指標
      }
      DF[c,] <- c(colnames(dataframe_head)[c], 
                  as.character(class_data),
                  unique_key,
                  max_data,
                  min_data, 
                  na,
                  na_ratio,
                  data,
                  range_data,
                  rec_n,
                  round(mean_df,2),
                  median_df,
                  round(sd_df,2),
                  round(lower_outlier_line,2),
                  round(upper_outlier_line,2),
                  lower_outlier,
                  upper_outlier,
                  co_var,
                  ch_var_index
      )
    }else if (class_data == "character" | class_data == "factor" | class_data == "ordered" ){
      counter<- plyr::count(is.na(dataframe[,c]))
      colnames(counter)[1] <- "x"
      na   <- filter(counter, x == TRUE)$freq
      na   <- as.numeric(ifelse(length(na) == 0, 0, na))
      data <- filter(counter, x == FALSE)$freq
      data <- as.numeric(ifelse(length(data) == 0, 0, data))
      rec_n <- na +data
      na_ratio <- round(na/rec_n, 2)
      char <- as.character(dataframe[,c])
      max_char <- max(nchar(char), na.rm = TRUE)
      min_char <- min(nchar(char), na.rm = TRUE)
      range <- nlevels(as.factor(dataframe[,c]))
      unique_key <-  ifelse(rec_n == range, "UNIQUE", "")
      DF[c,] <- c(colnames(dataframe_head)[c],
                  as.character(class_data),
                  unique_key,
                  max_char,
                  min_char, 
                  na,
                  na_ratio,
                  data,
                  range,
                  rec_n,
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  ""
      )
    } else{
      counter<- plyr::count(is.na(dataframe[,c]))
      colnames(counter)[1] <- "x"
      na   <- filter(counter, x == TRUE)$freq
      na   <- as.numeric(ifelse(length(na) == 0, 0, na))
      data <- filter(counter, x == FALSE)$freq
      data <- as.numeric(ifelse(length(data) == 0, 0, data))
      rec_n <- na +data
      na_ratio <- round(na/rec_n, 2)
      range <- nlevels(as.factor(dataframe[,c]))
      unique_key <-  ifelse(rec_n == range, "UNIQUE", "")
      DF[c,] <- c(colnames(dataframe_head)[c],
                  as.character(class_data),
                  "",
                  "",
                  "", 
                  na,
                  na_ratio,
                  data,
                  nlevels(as.factor(dataframe[,c])),
                  rec_n,
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  "",
                  ""
      )
    }
  }
  DF  
}

実際に関数にデータフレームを入れてみましょう

newdata <- esoph

test <- df_info(newdata)

結果は下記のようなデータフレーム型で帰ってきます。

|row_no|colname|class_info|unique_flag|max|min|na|na_ratio|data|range|rec_n|mean|median|sd|lower_sd3|upper_sd3|lower_outlier|upper_outlier|co_var|ch_var_index|
|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|-----|
|1|agegp|ordered||5|3|0|0|88|6|88||||||||||
|2|alcgp|ordered||9|4|0|0|88|4|88||||||||||
|3|tobgp|ordered||8|3|0|0|88|4|88||||||||||
|4|ncases|numeric||17|0|0|0|88|17|88|2.27|1|2.75|-5.99|10.53|0|1|1.21|0.46|
|5|ncontrols|numeric||60|1|0|0|88|59|88|11.08|6|12.72|-27.09|49.25|0|1|1.15|0.4|

更にここをこうした方がいいんじゃないか、という点などがあれば、ぜひご意見をください。