Extract a specific "pattern" from each element of a character vector

extract.pattern <- function(x, pattern = "([[:alnum:]]+)")
{ 
    ## Purpose: Extract a specific "pattern" from each element of a character vector.
    ## Arguments:
    ##   x: a character vector
    ##   pattern: a regular expression which specifies the pattern (inside brackets) to be extracted. 
    ## Return: a vector with the extracted pattern.  NA is filled in where no match is found. 
    ## Author: Feiming Chen, Date: 18 Apr 2017, 14:34
    ## ________________________________________________

    r <- paste0(".*", pattern, ".*")
    sub(r, "\\1", x)
}
if (F) {                                # Unit Test
    x = c(NA, "a-b", "a-d", "b-c", "d-e")
    extract.pattern(x)                  # extract alpha-numeric pattern
    ## [1] NA  "b" "d" "c" "e"

    x = c("ab(A)x", "dc(B)y")
    extract.pattern(x, "(\\(.*\\))")      # extract the string inside brackets
    ## [1] "(A)" "(B)"
    extract.pattern(x, "\\)(.*)")      # extract the string after ")"
    ## [1] "x" "y"

    x = c("V167.G56", "V166.R56", "V122.G41", "V163.R55", "V165.B55", "V175.R59")
    extract.pattern(x, "(R|G|B)")       # extract R or G or B character only. 
    ## [1] "G" "R" "G" "R" "B" "R"
    extract.pattern(x, "[RGB]{1}([0-9]+)") # extract the numbers following the R, G, B character. 
    ## [1] "56" "56" "41" "55" "55" "59"
}

Format a confusion matrix (removing zero entry for visual clarity)

format.confusion.matrix <- function(x)
{ 
    ## Purpose: Format a confusion matrix (removing zero entry for visual clarity)
    ##          Requires package "formattable". 
    ## Arguments:
    ##    x: a confusion matrix (nrow = ncol, with counts in each cell) 
    ## Return: a formated confusion matrix in html browser and in a CSV file. 
    ## Author: Feiming Chen, Date: 17 Apr 2017, 15:45
    ## ________________________________________________

    x1 <- as.character(as.matrix(x))
    x1[x1 == "0"] <- ""
    x2 <- matrix(x1, nrow(x), ncol(x), dimnames=dimnames((x)))
    write.csv(x2, file="Confusion-Matrix.csv")
    formattable::formattable(as.data.frame(x2))
}
if (F) {                                # Unit Test
    x <- matrix(c(3,1,0,1,4,0,0,1,6), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C")))
    format.confusion.matrix(x)
}

Sort a Data Frame

sort.df <-  function(d)
{ 
    ## Purpose: Sort a Data Frame along 1st column, ties along 2nd, ..., until its last column. 
    ## Arguments:
    ##   d: a data frame
    ## Return: a sorted data frame
    ## Author: Feiming Chen, Date: 18 Apr 2017, 13:49
    ## ________________________________________________
    d[ do.call(order, d), ]    
}
if (F) {                                # Unit Test
    df <- data.frame(X = c("b", "a", "a", "c"), Y = c(4, 2, 1, 3))
    sort.df(df)
    ##   X Y
    ## 3 a 1
    ## 2 a 2
    ## 1 b 4
    ## 4 c 3

    sort.df(df[2:1])
    ##   Y X
    ## 3 1 a
    ## 2 2 a
    ## 4 3 c
    ## 1 4 b
}

Check if a vector's values are all the same

is.constant  <- function(x)
{ 
    ## Purpose: Check if a vector's values are all the same. 
    ## Arguments:
    ##   x: a vector (numeric, character, logical, etc.)
    ## Return: a logical value tha is TRUE if and only if all the values are the same (constant). 
    ## Author: Feiming Chen, Date: 13 Apr 2017, 14:59
    ## ________________________________________________
    y <- rep.int(x[1], length(x))
    isTRUE(all.equal(x, y))
}
if (F) {                                # Unit Test
    is.constant(c(T, T, F))             # F
    is.constant(c(F, F, F))             # T
    is.constant(c(1, 1, 2))             # F
    is.constant(c(2, 2, 2))             # T
    is.constant(c("a", "a", "b"))       # F
    is.constant(c("b", "b", "b"))       # T
}

Find the value that is the maximum in absolute value

my.abs.max <- function(x)
{ 
    ## Purpose: Find the value that is the maximum in absolute value
    ## Arguments:
    ##   x: a numeric vector
    ## Return:  a value in the "x" vector that is the largest in absolute value (keep the sign). 
    ## Author: Feiming Chen, Date: 11 Apr 2017, 15:19
    ## ________________________________________________

    i <- which.max(abs(x))
    x[i]
}
if (F) {                                # Unit Test
    my.abs.max(c(1, -3, 2))             # -3
    my.abs.max(c(1, 3, -2))             # 3
}

Test Time Series Second Order Curvature Significance

test.ts.2nd.order.sig <- function(x, graph=F)
{ 
    ## Purpose: Test Time Series 2nd Order Significance. 
    ## Arguments:
    ##    x: a numeric vector (time series)
    ## Return:  P-value for testing the 2nd order significance. 
    ## Author: Feiming Chen, Date: 10 Apr 2017, 14:57
    ## ________________________________________________

    d <- data.frame(Response = x, Time = seq(x))
    m1 <- lm(Response ~ Time, d)
    m2 <- lm(Response ~ Time + I(Time^2), d)
    a <- anova(m1, m2)
    model.compare.P.value <- a[["Pr(>F)"]][2]
    
    if (graph) {
        plot(d$Time, d$Response, xlab="Time", ylab="Response", type="b")
        lines(d$Time, fitted(m1), col="red")
        lines(d$Time, fitted(m2), col="blue")
        title(main=paste("Model Comparison P-value =", round(model.compare.P.value, 3)))
    }

    model.compare.P.value
}
if (F) {                                # Unit Test
    x <- rnorm(100)
    test.ts.2nd.order.sig(x, graph = T)
    r <- replicate(10000, test.ts.2nd.order.sig(rnorm(20))) # should follow a uniform distribution. 
    ## summary(r)
    ##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    ## 0.00011 0.25800 0.50600 0.50500 0.75500 1.00000 
}

Convert RGB Color Value to Spherical Coordinates

rgb2sph <- function(rgb, nbits)
{ 
    ## Purpose: Convert RGB Color Value to Spherical Coordinates
    ## Arguments:
    ##   rgb: a (N X 3) matrix of RGB values (each row is a triplet of R, G, B).
    ##          Assume each integer value range from 0 to (2^nbits - 1).
    ##   nbits: number of bits used to code each of R, G, B channel. 
    ## Return: a (N X 3) matrix of Shperical Coordinates (each row is a triplet of M, Theta, Phi), which are scaled to be within (0, 1).
    ## Author: Feiming Chen, Date:  5 Apr 2017, 10:21
    ## ________________________________________________
    
    max.scale <- 2^nbits
    M.scale <- sqrt(3 * max.scale^2)  
    angle.scale <- pi / 2

    t(apply(rgb + 1, 1, function(x) {
        M <- sqrt(sum(x^2))             # Color Intensity/Luminosity (0-1) 
        Theta <- atan(x[2] / x[1])      # Azimuthal Angle
        Phi <- acos(x[3] / M)           # Zenith Angle 
        c(M / M.scale, Theta / angle.scale, Phi / angle.scale)
    }))
}
if (F) {                                # Unit Test
    rgb <- matrix(c(0, 0, 0,  4095,4095,4095, 3527, 3513, 3504, 2470, 3034,3218), ncol=3, byrow = T)
    rgb2sph(rgb, nbits = 12)
##            [,1]    [,2]    [,3]
## [1,] 0.00024414 0.50000 0.60817
## [2,] 1.00000000 0.50000 0.60817
## [3,] 0.85832017 0.49873 0.60954
## [4,] 0.71428036 0.56498 0.56181
}