[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