# -----------------------------------------------------------------------------
# Copyright © 2018 Samuel Badion, Stefan Laurent.
#
# This file is part of Rsurvival.
#
# Rsurvival is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or any later version.
#
# Rsurvival is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# Rsurvival. If not, see <https://www.gnu.org/licenses/>
# -----------------------------------------------------------------------------
#' A function to turn a file into a logical vector. Useful for making a
#' survivals vector to split your data in two parts.
#'
#' @param file.path The path to the VCF file you want to analyse
#' @param type The type of the content of your file, can be "number" (default)
#' or "character"
#'
#' @return
#' A logical vector representing the content of your file. If \code{type} is
#' set to "number" (default), for each line of your file, a "0" will result in
#' a FALSE and any other number will result in a TRUE. If \code{type} is set to
#' "character", "TRUE" or "T" or "true" or "True" will return TRUE, "FALSE" or
#' "F" or "False" or "false" will return a FALSE.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' ConvertFileToLogic("myFile.txt")
#' ConvertFileToLogic("myFile.txt", type = "character")
#' }
ConvertFileToLogic <- function(file.path, type = "number") {
result <- NULL
if (file.exists(file.path)) {
if (type == "number") {
result <- as.logical(scan(file.path, what = integer()))
} else if (type == "character") {
result <- as.logical(scan(file.path, what = character()))
} else {
stop("Parameter type is not recognised")
}
}
else {
stop("Parameter file.path leads to a non-existing file")
}
if (length(result) < 1) {
warning('Result is empty')
}
if (sum(is.na(result))) {
warning("Result contains NAs")
}
return(result)
}
#' A function to check if the ratio of NA in a vector is over a threshold.
#'
#' @param vect A vector to analyse
#' @param min.ratio A threshold ratio of NA values in vect (from 0 to 1)
#' @param verbose Logical. If TRUE (default), report status of the process
#' along the executions
#'
#' @return
#' Logical. TRUE if the ratio of NA in vect is at least minRatio, else FALSE.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' vector.true <- c(NA, 1:3)
#' vector.false <- c(NA, 1:5)
#' IsAtLeastNARatio(vector.true, 0.2)
#' }
IsAtLeastNARatio <- function(vect, min.ratio, verbose = TRUE) {
if (!(is.numeric(min.ratio))) {
stop("Parameter min.ratio must be a number")
} else if (length(min.ratio) != 1){
stop("Parameter min.ratio must be of length 1")
} else if((min.ratio < 0 || min.ratio > 1) && verbose){
warning("Parameter min.ratio should be in range [0:1]")
}
if (length(vect) < 1){
result <- NA
} else if ((sum(is.na(vect)) / length(vect)) >= min.ratio) { #if too much NAs
result <- TRUE
} else {
result <- FALSE
}
return(result)
}
#' A function to split a vector into two vectors according to a survival
#' logical vector
#'
#' @param vect The original vector to split
#' @param survival A logical vector for splitting the data into two vectors.
#' The length of \code{survival} must match the length of \code{vector}
#' @param verbose Logical. If TRUE (default), report status of the process
#' along the execution.
#'
#' @return
#' A list of vectors.
#' \code{list$alive} is the vector containing the samples which position
#' corresponds with a TRUE in the \code{survival} vector.
#' The other samples are contained in \code{list$dead} as an other vector
#'
#' @export
#'
#' @examples
#' \dontrun{
#' SplitGt(gt, c(TRUE, TRUE, FALSE, ...))
#' SplitGt(gt, survival.vector, verbose = FALSE)
#' }
SplitVect <- function(vect, survival, verbose = TRUE){
if ((length(vect) > length(survival)) && verbose) {
warning("Parameter survival is shorter than parameter vect.")
}
if ((length(vect) < length(survival))) {
stop("Parameter survival is longer than parameter vect.")
}
alive <- vect[survival]
dead <- vect[!survival]
result <- list("alive" = alive, "dead" = dead)
return(result)
}
#' A function to slice data frames without loosing row names
#'
#' @param df A dataframe to slice
#' @param rows A integer vector. The ids of the rows to return.
#'
#' @return
#' A dataframe containing only the rows number \code{rows} from \code{df}.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' SliceDfRows(df, 1)
#' SliceDfRows(df, 1:5)
#' SliceDfRows(df, c(1,3,5))
#' }
SliceDfRows <- function(df, rows){
if (length(rows) > 1){
result <- df[rows, ]
} else {
df <- data.frame(df)
df <- tibble::rownames_to_column(df, var = "rowname")
df <- dplyr::slice(df, rows)
result <- tibble::column_to_rownames(df, var = "rowname")
}
return(result)
}
#' A function to slice data frames without loosing column names
#'
#' @param df A dataframe to slice
#' @param columns A integer vector. The ids of the columns to return.
#'
#' @return
#' A dataframe containing only the columns number \code{columns} from
#' \code{df}.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' SliceDfColumns(df, 1)
#' SliceDfColumns(df, 1:5)
#' SliceDfColumns(df, c(1,3,5))
#' }
SliceDfColumns <- function(df, columns){
if (length(columns) > 1) {
result <- df[, columns]
} else {
colnames <- colnames(df)
rownames <- rownames(df)
colnames <- colnames[columns]
result <- data.frame(t(SliceDfRows(t(df), columns)))
colnames(result) <- colnames
rownames(result) <- rownames
}
return(result)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.