R/autocor.R

Defines functions plot.autocor autocor

autocor <- function(formula, data,
                    OOmethod = "Kendall",
                    OFmethod = "Kruskal-Wallis",
                    FFmethod = "Fisher"
                    ){

  #データを解析用に変換
  x <- model.frame(formula, data)
  y <- x[,1] #説明変数
  x <- x[,-1] #目的変数

  #名義尺度か判断
  #factorかcharacterの場合のみnominalと判断
  is.nominal <- function(x){
    if(is.factor(x) || is.character(x)){ return(TRUE) }else{ return(FALSE) }
  }

  #順序尺度として扱えるか判断
  #numericかintegerの場合のみorderと判断。
  is.order <- function(x){
    if(is.numeric(x) || is.integer(x)){ return(TRUE) }else { return(FALSE) }
  }

  #名義尺度か順序尺度のどちらかとして扱えるか判断
  is.nominal.order <- function(x){
    if(is.nominal(x) || is.order(x)){ return(TRUE)}else{ return(FALSE)}
  }


  #順序尺度と順序尺度
  #p値を返す。
  OOtest <- function(x1, x2){
    if(OOmethod == "Kendall"){
      result <- cor.test(x1, x2, method = "kendall")
      return(result$p.value)
    }
    if(OOmethod == "Spearman"){
      result <- cor.test(x1, x2, method = "spearman")
      return(result$p.value)
    }
    stop("The verification method between order scale and ordinal scale is incorrect.")
  }


  #順序尺度と名義尺度
  #p値を返す。
  OFtest <- function(x1, x2){
    if(OFmethod == "Kruskal-Wallis"){
      if(is.order(x1)){
        df <- data.frame(x1 = x1, x2 = x2)
      }else{
        df <- data.frame(x1 = x2, x2 = x1)
      }
      result <- kruskal.test(x1 ~ x2, df)
      return(result$p.value)
    }
    stop("The verification method between the order scale and the nominal scale is incorrect.")
  }

  #名義尺度と名義尺度
  FFtest <- function(x1, x2){
    tab <- table(x1, x2)

    if(FFmethod == "Fisher"){
      result <- fisher.test(tab)
      return(result$p.value)
    }

    if(FFmethod == "chisq"){
      result <- chisq.test(tab)
      return(result$p.value)
    }
    stop("The verification method between the nominal scale and the nominal scale is incorrect.")
  }


  #データに適用
  #目的変数のチェック
  if(!is.nominal.order(y)){
    stop("Evaluation target is neither numeric, integer, order nor character.")
  }

  #初期設定
  xl <- length(x[1, ])
  df <- NULL

  #dfを追加
  adddf <- function(df, name, OO, OF, FF){
    df0 <- data.frame(name, OO, OF, FF)
    if(is.null(df)){df <- df0}else{df <- rbind(df, df0)}
    return(df)
  }

  #yが順序尺度の場合
  if(is.order(y)){
    for(i in 1:xl){
      if(is.order(x[, i])){ OO <- OOtest(x1 = y, x2 = x[, i])}else{ OO <- NA}
      if(is.nominal(x[, i])){ OF <- OFtest(x1 = y, x2 = x[, i])}else{ OF <- NA}
      FF <- NA
      df <- adddf(df, name = names(x)[i], OO = OO, OF = OF, FF = FF)
    }
  }


  #yが名義尺度の場合
  if(is.nominal(y)){
    for(i in 1:xl){
      OO <- NA
      if(is.order(x[, i])){ OF <- OFtest(x1 = x[, i], x2 = y)}else{ OF <- NA}
      if(is.nominal(x[, i])){ FF <- FFtest(x1 = y, x2 = x[, i])}else{ FF <- NA}
      df <- adddf(df, name = names(x)[i], OO = OO, OF = OF, FF = FF)
    }
  }

  #ベクトルに数値を代入
  #名前をつけ、NAを除去し、降順に並べ替え
  vec_sort <- function(data, names){
    names(data) <- names
    data1 <- data[!is.na(data)]
    data_sort <- data1[order(data1, decreasing = TRUE)]
    return(data_sort)
  }

  #データを成形
  vec_OO <- vec_sort(data = df$OO, names = df$name)
  vec_OF <- vec_sort(data = df$OF, names = df$name)
  vec_FF <- vec_sort(data = df$FF, names = df$name)

  #返り値
  ret <- list()
  ret$df <- df
  ret$OO <- vec_OO
  ret$OF <- vec_OF
  ret$FF <- vec_FF

  class(ret) <- "autocor"
  return(ret)
}


plot.autocor <- function(data, significance = 0.05){
  num_check <- function(x1, x2, x3){
    num <- 0
    if(is.numeric(x1)){num <- num + 1}
    if(is.numeric(x2)){num <- num + 1}
    if(is.numeric(x3)){num <- num + 1}
    return(num)
  }

  num <- num_check(x1 = data$OO, x2 = data$OF, x3 = data$FF)
  par(mfrow = c(1, num))

  check_plot <- function(data){
    if(is.numeric(data)){barplot(data, horiz = TRUE, las = 1, xlab = "p-value")}
  }
  par(plt = c(0.5,0.9,0.3,0.8))

  check_plot(data$OO)
  check_plot(data$OF)
  check_plot(data$FF)

  par(mfrow = c(1, 1))
}
ToshihiroIguchi/autocor documentation built on July 10, 2017, 12:02 a.m.