R/importTraitData.R

Defines functions importTraitData

Documented in importTraitData

#' Imports trait table
#'
#' @return
#' @export
#'
#' @importFrom readxl read_xlsx
#'
#'
importTraitData <- function() {

  require(readxl)


  traits <- list()


  dir <- "."
  done <- "nein"

  while(done != "ja") {

    print(list.files(dir))
    file <- list.files(dir)[as.numeric(readline("Choose file or folder: "))]
    dir <- paste(dir, file, sep = "/")

    #new directory
    if(file.info(dir)$isdir) {
      message("Open folder.")
    }

    #xlsx file
    else if(regexpr(".xlsx", file) != 0) {
      name <- readline("Name of dataset: ")
      traits[[length(traits) + 1]] <- as.data.frame(read_xlsx(dir, sheet = 1), stringsAsFactors = FALSE)
      names(traits)[length(traits)] <- name

      if(sum(regexpr("S", traits[[length(traits)]][1,]) != -1) == 1) {
        traits[[length(traits)]] <- traits[[length(traits)]][c(1, order(as.numeric(traits[[length(traits)]][-1,regexpr("S", traits[[length(traits)]][1,]) != -1]))+1),]
        row.names(traits[[length(traits)]]) <- c()
      }
      #names(proteinGroups[[length(proteinGroups)]]) <- readline("Name of dataset: ")
      dir <- "."
      done <- readline("Done? (ja/nein) ")
    }
  }




  info[[length(info) + 1]] <- traits
  names(info)[length(info)] <- "traits"


  #Process traits

  info[[length(info) + 1]] <- list()
  names(info)[length(info)] <- "id"

  info[[length(info) + 1]] <- list()
  names(info)[length(info)] <- "name"

  info[[length(info) + 1]] <- list()
  names(info)[length(info)] <- "group"

  info[[length(info) + 1]] <- list()
  names(info)[length(info)] <- "continousTraits"

  info[[length(info) + 1]] <- list()
  names(info)[length(info)] <- "rankedTraits"







  for(i in 1:length(info[["traits"]])) {

    #Add IDs
    info[["id"]][[i]] <- info[["traits"]][[i]]$id[-1]
    names(info[["id"]])[i] <- names(info[["traits"]])[i]

    #Add names
    info[["name"]][[i]] <- info[["traits"]][[i]]$name[-1]
    names(info[["name"]])[i] <- names(info[["traits"]])[i]

    #Add group/s as list
    info[["group"]][[i]] <- list()
    names(info[["group"]])[i] <- names(info[["traits"]])[i]

    for(j in 1:ncol(info[["traits"]][[i]])) {
      if(regexpr("G", info[["traits"]][[i]][1,j]) != -1) {

        info[["group"]][[i]][[length(info[["group"]][[i]]) + 1]] <- info[["traits"]][[i]][-1,j]
        names(info[["group"]][[i]][[length(info[["group"]][[i]])]]) <- info[["name"]][[i]]
        names(info[["group"]][[i]])[length(info[["group"]][[i]])] <- names(info[["traits"]][[i]])[j]

      }
    }

    #Add continous traits
    info[["continousTraits"]][[i]] <- list()
    names(info[["continousTraits"]])[i] <- names(info[["traits"]])[i]

    for(j in 1:ncol(info[["traits"]][[i]])) {
      if(regexpr("C", info[["traits"]][[i]][1,j]) != -1) {

        info[["continousTraits"]][[i]][[length(info[["continousTraits"]][[i]]) + 1]] <- as.numeric(info[["traits"]][[i]][-1,j])
        names(info[["continousTraits"]][[i]][[length(info[["continousTraits"]][[i]])]]) <- info[["name"]][[i]]
        names(info[["continousTraits"]][[i]])[length(info[["continousTraits"]][[i]])] <- names(info[["traits"]][[i]])[j]

      }
    }

    #Add ranked traits
    info[["rankedTraits"]][[i]] <- list()
    names(info[["rankedTraits"]])[i] <- names(info[["traits"]])[i]

    for(j in 1:ncol(info[["traits"]][[i]])) {
      if(regexpr("R", info[["traits"]][[i]][1,j]) != -1) {

        info[["rankedTraits"]][[i]][[length(info[["rankedTraits"]][[i]]) + 1]] <- as.numeric(info[["traits"]][[i]][-1,j])
        names(info[["rankedTraits"]][[i]][[length(info[["rankedTraits"]][[i]])]]) <- info[["name"]][[i]]
        names(info[["rankedTraits"]][[i]])[length(info[["rankedTraits"]][[i]])] <- names(info[["traits"]][[i]])[j]

      }
    }


  }



  assign("info", info, pos = .GlobalEnv)

}
nicohuttmann/htmnanalysis documentation built on Dec. 6, 2020, 3:02 a.m.