Last active
September 3, 2016 05:43
-
-
Save KBlansit/6c3308a0dd7156fb17f2635e39d9c914 to your computer and use it in GitHub Desktop.
UCLA FSPH R Files
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# by: Kevin Blansit, MS | |
# <kevin dot blansit at gmail dot com> | |
mtx <- rbind( | |
c(0, 0, 0, 0, 1, 2, 3, 6, 0, 0, 0, 9), | |
c(0, 3, 0, 0, 1, 2, 3, 6, 0, 0, 2, 3), | |
c(0, 0, 3, 0, 1, 2, 3, 6, 0, 0, 2, 3), | |
c(0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 2, 3) | |
) | |
returnNonZeroRange <- function(mtx, bandwidth) { | |
# mtx: the matrix input | |
# bandwidth: the range of values to return | |
findStart <- function(mtx) { | |
# function to find the first non-zero of a matrix by row | |
loc <- which(mtx != 0, arr.ind = TRUE) | |
min_values <- aggregate(col ~ row, loc, min)$col | |
if(length(min_values) != dim(mtx)[1]){ | |
stop(paste("The following matrix rows had all 0:", | |
paste0(which(rowSums(mtx == 0) == dim(mtx)[2]), collapse = ", "))) | |
} else { | |
return(min_values) | |
} | |
} | |
if(bandwidth <= 0) { | |
stop("bandwidth must be above 1") | |
} | |
# gives col index of first non-zero number | |
start_vals <- findStart(mtx) | |
m <- length(start_vals) | |
add_mtx <- t(matrix(rep(0:(bandwidth-1), m), bandwidth)) | |
start_mtx <- matrix(rep(start_vals, bandwidth), m) | |
col_mtx <- add_mtx + start_mtx | |
if(max(col_mtx) > dim(mtx)[2]) { | |
err_msg <- paste("bandwidth is larger than the supplied matrix;", | |
"matrix cols: ", | |
dim(mtx)[2], | |
"; largest value requested: ", | |
max(col_mtx), | |
sep = "") | |
stop(err_msg) | |
} | |
row_mtx <- matrix(rep(1:dim(mtx)[1], bandwidth), bandwidth) | |
rslt_mtx <- cbind(row = c(row_mtx), col = c(col_mtx)) | |
# IGot99ProblemsButAnIndexAintOne | |
return(matrix(mtx[rslt_mtx], ncol = bandwidth)) | |
} | |
returnNonZeroRange(mtx, 5) # retunrs location matrix | |
returnNonZeroRange(mtx, 6) # this will not work since the last row doesn't have enough values to be valid |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
IGot99ProblemsButAnIndexAintOne