Parse a string to generate a data frame

parse2data.frame  <- function(x)
{ 
    ## Purpose: Parse a string to generate a data frame.
    ## Arguments:
    ##   x: a string with header and multiple rows of text that resembles a data frame.
    ##      Fields are separated by comma. 
    ## Return: a data frame
    ## Author: Feiming Chen, Date: 19 Jun 2017, 10:12
    ## ________________________________________________

    d <- read.csv(textConnection(x), as.is = T)
    i <- sapply(d, is.character)
    d[i] <- lapply(d[i], trimws)
    d
}
if (F) {                                # Unit Test
    a = 
"

  Test, ID, Name
  t1 ,  3,  Sun
  t2 ,  5,  Moon
  t3,   2,  Earth

"    
    b <- parse2data.frame(a)
    str(b)
    ## 'data.frame':    3 obs. of  2 variables:
    ##  $ ID  : int  3 5 2
    ##  $ Name: Factor w/ 3 levels " Earth"," Moon",..: 3 2 1
}

Tokenize a string into a vector of tokens

tokenize.string <- function(x, split = "[ ,:;]+")
{ 
    ## Purpose: Tokenize a string into a vector of tokens
    ## Arguments:
    ##   x: a string or a vector of strings
    ##   split: split characters (regular expression)
    ## Return: a character vector (if "x" is a string) or a list of character vectors. 
    ## Author: Feiming Chen, Date: 15 Jun 2017, 15:01
    ## ________________________________________________
    
    ans <- strsplit(x, split="[ ,:;]+", fixed=F)
    if (length(x) == 1) ans <- ans[[1]]
    ans
}
if (F) {                                # Unit Test
    x <- "IND,  UNR   INC ; TCU"
    tokenize.string(x)
    ## [1] "IND" "UNR" "INC" "TCU"
    tokenize.string(rep(x, 3))
    ## [[1]]
    ## [1] "IND" "UNR" "INC" "TCU"

    ## [[2]]
    ## [1] "IND" "UNR" "INC" "TCU"

    ## [[3]]
    ## [1] "IND" "UNR" "INC" "TCU"
}

Count the number of distinct values in a vector or distinct rows in a data frame

N.levels <- function(x)
{ 
    ## Purpose: Count the number of distinct values in a vector or distinct rows in a data frame
    ## Arguments:
    ##    x: a vector (numeric or string), or a data frame. 
    ## Return: a count for the distinct values/rows in the vector or data frame. 
    ## Author: Feiming Chen, Date: 20 Mar 2017, 10:58
    ## ________________________________________________

    sum(!duplicated(x))
}
if (F) {                                # Unit Test
    N.levels(c(1,2,1,3))                # 3
    N.levels(c("a", "b", "a"))          # 2
    x <- data.frame(a=c(1,2,1), b=c(1, 2, 1))
    N.levels(x) # 2
}

Write data tables to Excel (.xlsx) file

wxls <- function(x, file = "test", ...)
{ 
    ## Purpose: Write data tables to Excel (.xlsx) file.
    ##          Require package "openxlsx". 
    ## Arguments:
    ##   x: a data frame or a list of data frames. 
    ##   file: a naked file name with no extension.
    ##   ...: passed to "write.xlsx". 
    ## Return: Generate an Excel (.xlsx) file.
    ## Author: Feiming Chen, Date:  6 Jun 2017, 15:11
    ## ________________________________________________
    
    require(openxlsx)
    f <- paste0(file, ".xlsx")

    write.xlsx(x, file = f, asTable = TRUE,
               creator = "Feiming Chen", 
               tableStyle = "TableStyleMedium2",   ...)
}
if (F) {                                # Unit Test
    df <- data.frame("Date" = Sys.Date()-0:4,
                     "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE),
                     "Currency" = paste("$",-2:2),
                     "Accounting" = -2:2,
                     "hLink" = "https://CRAN.R-project.org/",
                     "Percentage" = seq(-1, 1, length.out=5),
                     "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE)
    class(df$Currency) <- "currency"
    class(df$Accounting) <- "accounting"
    class(df$hLink) <- "hyperlink"
    class(df$Percentage) <- "percentage"
    class(df$TinyNumber) <- "scientific"

    wxls(df)

    wxls(list(A = df, B = df, C= df))   # write to 3 separate tabs with corresponding list names. 
}

Plot "y" against "x" where "x" is a vector of labels

my.plot.vs.label <- function(x, y, ...)
{ 
    ## Purpose: Plot "y" against "x" where "x" is a vector of labels (string)
    ## Arguments:
    ##   x: a string vector (labels)
    ##   y: a numeric vector or matrix
    ##   ...: passed to "matplot"
    ## Return: a plot
    ## Author: Feiming Chen, Date:  5 Jun 2017, 14:46
    ## ________________________________________________

    s <- seq(x)
    matplot(s, y, type="b", axes = F, xlab ="", ylab="", ...)
    axis(side=2)
    axis(side=1, at=s, labels=x, las=2)

    yn <- ncol(y)
    yna <- names(y)
    if (!is.null(yn) && !is.null(yna)) {
        legend("topright", legend=yna, col=1:yn, lwd=1.5, lty=1:yn)
    }
}
if (F) {                                # Unit Test
    x <- LETTERS
    y <- matrix(rnorm(260), ncol=10)
    my.plot.vs.label(x, y)
    y2 <- as.data.frame(y)
    my.plot.vs.label(x, y2)
}

Read/Import all CSV files in a specified directory

batch.read.csv.files <- function(p)
{ 
    ## Purpose: Read/Import all CSV files in a specified directory.
    ##          Require package "readr". 
    ## Arguments:
    ##   p: a file directory with CSV files. 
    ## Return:
    ##   a list, each element is a data frame (imported from the file) and its name is the corresponding file name. 
    ## Author: Feiming Chen, Date:  2 Jun 2017, 11:09
    ## ________________________________________________

    file.list <- list.files(p, pattern=".csv", full.names = TRUE, ignore.case = TRUE)

    if (length(file.list) > 0) { 
        dat <- lapply(file.list, readr::read_csv)
        names(dat) <- sapply(file.list, basename)
    } else dat <- list()

    cat("Import", length(dat), "CSV Files.\n")
    dat
}

Feature Filtering with Natural B-Splines for Functional Modeling Application

feature.filtering.ns <- function(X, df = 10, graph = FALSE)
{ 
    ## Purpose: Feature Filtering with Natural B-Splines for Functional Modeling Application.
    ##          Preprocess the feature data (design matrix) to enforce a natural regularization.
    ##          In other words, project each observation to each of "df" axis represented by B-spline Basis. 
    ## Arguments:
    ##   X: a design matrix (predictors) of dimension N x p (N observations, p predictors).
    ##      If "X" is a vector, convert it to a matrix with one row. 
    ##   df: Degrees of Freedom (number of natural B-splines basis functions to approximate the (continuous) coefficient function.
    ##       Beta (p x 1) = H (p x df) Theta (df x 1), where H represents "df" number of continuous basis functions
    ##       in the coefficient space, and Theta represents the linear combination parameters for constructing Beta.
    ##   graph: if TRUE, plot each observation (each row of X) as a time series,
    ##          its projection to the reduced space (formed by the natural B-spline basis),
    ##          and the natural B-spline basis. 
    ## Return: Preprocessed Features (X H) of dimension N x df, which can be used as "df" input into a predictive model.
    ##         X Beta = X H Theta = (X H) Theta
    ## Author: Feiming Chen, Date:  3 May 2017, 12:12
    ## ________________________________________________

    if (is.vector(X)) X <- matrix(X, nrow = 1)

    p <- ncol(X)                        # number of predictors
    require(splines)
    ## B-splines for Natural Cubic Spline: a p x df  matrix.
    H <- ns(1:p, df=df)   

    ## Filtered Features.  Dimensions: N x p  p x df = N x df
    ## Project each observation "x" into one of "df" Basis (each column of H matrix) so that
    ## each "x" is represented by "df" coefficient (coordinates in the coordinate system defined by "H")
    ans <- X %*% H                             

    if (graph) {
        par(mfrow=c(3,1))
        matplot(t(X), type = "b", xlab = "Feature Index", ylab = "Observation Value",
                main = "Original Features (High-Dimensional Space)")
        matplot(H, type="b", xlab = "Index", ylab ="Value", main="Natural B-spline Basis")
        matplot(t(ans), type = "b", xlab = "Feature Index", ylab = "Observation Value",
                main = "Filtered Features (Low-Dimensional Space)")
        par(mfrow=c(1,1))
    }

    ans
}
if (F) {                                # Unit Test
    X <- matrix(rnorm(1000), 20, 50)
    y <- feature.filtering.ns(X)
    y <- feature.filtering.ns(X, df = 20)    

    x <- rnorm(100)
    y <- feature.filtering.ns(x, graph=T)
}