[R] spreading the risk
markleeds at verizon.net
markleeds at verizon.net
Sat Jul 19 00:17:36 CEST 2008
This is for ACroske but I can't find his email so I'll just send it to
the list. Hi ACroske: The code below takes a zeros and ones matrix and
puts ones
in the places you wanted. It can be made shorter ( maybe ?. i haven't
thought about that ) but first let me know if that's what you wanted ?
The original matrix is called binary.matrix and the final matrix is
called tempbinmat. it should work for any size matrix but i didn't check
for speed so it might be slow if the original matrix is large.
# CREATE PROBABILITY MATRIX
prob.matrix<-matrix(runif(36,0,0.5),ncol=6)
#print(prob.matrix)
# CREATE BINARY MATRIX BASED ON PROB MATRIX
binary.matrix<-matrix(rbinom(length(prob.matrix),prob=prob.matrix,size=1),nrow=nrow(prob.matrix))
print(binary.matrix)
# CREATE DUMMY ROW AND COL AND
# ADD THEM TO THE MATRIX SO THAT
# LATER ON, WE DON"T HAVE TO WORRY
# ABOUT FILLING AN ELEMENT THAT
# ISN"T THERE
zerorow <- numeric(ncol(binary.matrix)+2)
zerocol <- numeric(nrow(binary.matrix))
#ADD COL TO BEGINNING AND END
tempbinmat <- cbind(zerocol,binary.matrix,zerocol)
# ADD RO TO TOP AND BOTTOM
tempbinmat <- rbind(zerorow,tempbinmat,zerorow)
# GET RID OF NAMES
colnames(tempbinmat) <- NULL
rownames(tempbinmat) <- NULL
# FIND OUT WHERE ALL THE ONES ARE.
# ARR.IND = TRUE GIVES THEM BACK IN MATRIX FORM
whichres <- which(tempbinmat == 1, arr.ind=TRUE)
# THIS LAPPLY GOES THROUGH THE LOCATIONS WHERE
# THERE ARE ONES AND FINDS LOCATIONS WHERE
# ONES NEED TO BE ADDED
onespositions <- lapply(1:nrow(whichres),function(.rownum) {
rightspot <- c(whichres[.rownum,1], whichres[.rownum,2]+1)
leftspot <- c(whichres[.rownum,1], whichres[.rownum,2]-1)
belowspot <-c(whichres[.rownum,1]-1, whichres[.rownum,2])
abovespot <- c(whichres[.rownum,1]+1, whichres[.rownum,2])
temp <- rbind(rightspot,leftspot,belowspot,abovespot)
})
# THIS SETS THE CONSTRUCTED INDICES TO 1
for ( i in 1:length(onespositions) ) {
tempbinmat[onespositions[[i]]] <- 1
}
#print(tempbinmat)
# NOW GET RID OF THE ROWS AND COLUMNS THAT WERE ARTIFICALLY
ADDED AT THE START TO MAKE THINGS EASIER
tempbinmat <- tempbinmat[2:(nrow(tempbinmat)-1),2:(ncol(tempbinmat)-1)]
print(tempbinmat)
More information about the R-help
mailing list