[R] matrix values linked to vector index
arun
smartpink111 at yahoo.com
Sat Oct 12 19:28:16 CEST 2013
Apologies, in case it is double posting (I think my previous message didn't make it to the list)
Hope the new version of `makeMat3` is bug free:
makeMat3 <- function(x,n){
if(is.numeric(x)){
x <- as.integer(round(x))
x}
stopifnot(is.integer(x))
if(length(x)>=n & max(x)<=n){
indx<-rep(rep(c(1,0),max(length(x),n)),rbind(x,n-x))
m1<- matrix(indx,nc=n,byr=TRUE)
}
else if(length(x) < n) {
indx<-rep(rep(c(1,0),n),c(as.vector(rbind(x,n-x)),rep(c(0,n),n-length(x))))
m1<-matrix(indx[seq_len(length(indx)-(n*(n-length(x))))],nc=n,byr=TRUE)
}
else print(paste("Not possible: Number of columns less than the maximum value of ", max(x), "or length of vector"))
m1
}
system.time(res3<- makeMat3(xtest,9))
# user system elapsed
# 1.908 0.328 2.237
identical(res3,res2)
#[1] TRUE
identical(makemx(x3,4),makeMat3(x3,4))
#[1] TRUE
identical(makemx(x2,5),makeMat3(x2,5))
#[1] TRUE
identical(makemx(x2,14),makeMat3(x2,14))
#[1] TRUE
makemx(x2,3)
#Error in out[ix] <- 1 : subscript out of bounds
makeMat3(x2,3)
#[1] "Not possible: Number of columns less than the maximum value of 4 or length of vector"
#Error in makeMat3(x2, 3) : object 'm1' not found
A.K.
On Saturday, October 12, 2013 12:28 PM, arun <smartpink111 at yahoo.com> wrote:
Some speed comparison:
set.seed(124)
xtest<- sample(0:9,1e7,replace=TRUE)
system.time({res1 <- makemx(xtest,9)})
# user system elapsed
# 51.124 0.812 52.039
system.time({res2 <- makeMatrix2(xtest,9)})
# user system elapsed
# 3.460 0.168 3.631
identical(res1,res2)
#[1] TRUE
Also, it looks like there is some bugs still in the "makeMat3"
system.time({res3 <- makeMat3(xtest,9)})
#Error in rep(c(0, n), n - length(x)) : invalid 'times' argument
#Timing stopped at: 0.616 0 0.616
A.K.
On Saturday, October 12, 2013 12:06 PM, arun <smartpink111 at yahoo.com> wrote:
This looks better. My previous solution (makeMatrix2) also did the matrix indexing without using sapply() route. Replacing the max(x) by n for non-symmetric matrix:
makeMatrix2<- function(x,n){ #including "n"
if(is.numeric(x)){
x <- as.integer(round(x))
x}
stopifnot(is.integer(x))
m1<- matrix(0,length(x),n) #change max(x) to n
indx <- cbind(rep(seq_along(x),x),seq_len(sum(x))-rep(cumsum(c(0L,x[-length(x)])),x))
m1[indx]<- 1
m1}
identical(makeMatrix2(x3,4),makemx(x3,4))
#[1] TRUE
identical(makeMatrix2(x1,5),makemx(x1,5))
#[1] TRUE
identical(makeMatrix2(x2,7),makemx(x2,7))
#[1] TRUE
A.K.
On Saturday, October 12, 2013 11:37 AM, Bert Gunter <gunter.berton at gene.com> wrote:
This seems to do it, but as I mentioned in my original post, my
"solution" was tricky. Thinking about it some more, I now realize that
it was too tricky and has the additional flaw of using underlying
representations of objects rather than their exposed interfaces -- i.e
it treats a matrix as a vector.
Here is, I think, a much better solution that treats a matrix as a
matrix by making use of a not-often-enough-used technique (mea culpa!)
of matrix indexing. It obviously needs to be cleaned up to check
inputs, etc. , but I think it should work. Feel free to publish and
clean up bugs.
makemx <- function(x,n)
{
out <- matrix(0, nr=length(x), nc=n)
ix <- cbind(rep(seq_along(x),x),unlist(sapply(x,seq_len)))
out[ix]<- 1
out
}
> makemx(c(3,2,1,4),4)
[,1] [,2] [,3] [,4]
[1,] 1 1 1 0
[2,] 1 1 0 0
[3,] 1 0 0 0
[4,] 1 1 1 1
> makemx(c(3,2,1,4),5)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 0 0
[2,] 1 1 0 0 0
[3,] 1 0 0 0 0
[4,] 1 1 1 1 0
Cheers,
Bert
On Sat, Oct 12, 2013 at 1:02 AM, arun <smartpink111 at yahoo.com> wrote:
>
>
> Modified Bert's solution for non-square matrices. For the tested vectors, it worked. There, could still be some bugs.
>
> x1<- c(3,2,1,4)
> x2<- c(2,0,4,3,1)
> x3 <- c(2, 1, 2.2)
> x4 <- c("a",1,3)
>
> makeMat3 <- function(x,n){
> if(is.numeric(x)){
> x <- as.integer(round(x))
> x}
> stopifnot(is.integer(x))
> indx<-rep(rep(c(1,0),n),c(as.vector(rbind(x,n-x)),rep(c(0,n),n-length(x))))
> matrix(indx[seq_len(length(indx)-(n*(n-length(x))))],nc=n,byr=TRUE)
> }
> makeMat3(x1,4)
> makeMat3(x1,5)
> makeMat3(x1,6)
> makeMat3(x1,7)
>
>
> makeMat3(x2,7)
> makeMat3(x2,6)
> makeMat3(x2,4) # as length of vector > n
> #Error in rep(c(0, n), n - length(x)) : invalid 'times' argument
>
> makeMat3(x3,4)
> makeMat3(x3,5)
>
> makeMat3(x4,4)
> #Error: is.integer(x) is not TRUE
>
> makeMat3(c(4,0,1,0,6),6)
>
> A.K.
>
>
>
> On Saturday, October 12, 2013 1:40 AM, Bert Gunter <gunter.berton at gene.com> wrote:
> Your examples are the problem:
>
> On Fri, Oct 11, 2013 at 2:43 PM, arun <smartpink111 at yahoo.com> wrote:
>> Seems like a bug in the code:
>> x<- c(3,4,1)
>> n<- 3
>> matrix(rep(rep(c(1,0),n),rbind(x,n-x)),nc=n,byr=TRUE)
>> #Error in rep(rep(c(1, 0), n), rbind(x, n - x)) : invalid 'times' argument
>
> ## This can't work since x specifies 4 1's in the second row but you
> have specified a 3 column matrix with n.
>
>> n<- 4
>> matrix(rep(rep(c(1,0),n),rbind(x,n-x)),nc=n,byr=TRUE)
>> #Error in rep(rep(c(1, 0), n), rbind(x, n - x)) : invalid 'times' argument
>
> Yes, this shows that my claim that non-square matrices also work is
> false. I leave it as an exercise to fix it so that it works for
> non-square matrices.
>
> Cheers,
> Bert
>
>
>
>> x2
>> [1] 2 0 4 3 1
>>> matrix(rep(rep(c(1,0),n),rbind(x2,n-x2)),nc=n,byr=TRUE)
>> Error in rep(rep(c(1, 0), n), rbind(x2, n - x2)) :
>> invalid 'times' argument
>>
>>
>> A.K.
>>
>>
>>
>>
>> On Friday, October 11, 2013 5:17 PM, Bert Gunter <gunter.berton at gene.com> wrote:
>> simpler (and sloppier) but with **no looping or apply's **
>>
>> **IFF* the matrix is structured as in the OP's example, then lower.tri
>> (or upper.tri) should be used:
>>
>> n <- 4 ## number of columns in matrix -- note that I changed it from
>> the example; does not have to be square
>>
>> x <- 1:3 ## the number of 1's per row
>> lower.tri(matrix(0,nr=length(x),nc=n),diagA=TRUE)+0
>>
>> A general, fast, but **tricky** way to do it that depends on knowing
>> that a matrix is just a vector in column major order is to generate
>> the vector using rep and then structure it as a matrix. eg.
>>
>> x <- c(3,2,1,4) ## your vector of indices
>> n <- 4 ## number of columns in matrix ## does not have to be square
>> matrix(rep(rep(c(1,0),n),rbind(x,n-x)),nc=n,byr=TRUE)
>>
>> [,1] [,2] [,3] [,4]
>> [1,] 1 1 1 0
>> [2,] 1 1 0 0
>> [3,] 1 0 0 0
>> [4,] 1 1 1 1
>>
>>
>> Cheers,
>> Bert
>>
>> On Fri, Oct 11, 2013 at 1:41 PM, Dennis Murphy <djmuser at gmail.com> wrote:
>>> Attempting to follow the OP's conditions and assuming I understood
>>> them correctly, here is one way to wrap this up into a function:
>>>
>>> makeMat <- function(x)
>>> {
>>> stopifnot(is.integer(x))
>>> nr <- length(x)
>>> nc <- max(x)
>>>
>>> # Initialize a matrix of zeros
>>> m <- matrix(0, nr, nc)
>>> # Conditionally replace with ones
>>> for(i in seq_len(nr)) if(x[i] != 0) m[i, 1:x[i]] <- 1
>>> m
>>> }
>>>
>>> ## Examples:
>>> x1 <- 1:3
>>> x2 <- as.integer(c(2, 0, 4, 3, 1))
>>> x3 <- c(2, 1, 2.2)
>>>
>>> makeMat(x1)
>>> makeMat(x2)
>>> makeMat(x3)
>>> makeMat(4:6)
>>>
>>>
>>> On Fri, Oct 11, 2013 at 9:49 AM, arun <smartpink111 at yahoo.com> wrote:
>>>> Hi,
>>>>
>>>> In the example you showed:
>>>>
>>>> m1<- matrix(0,length(vec),max(vec))
>>>> 1*!upper.tri(m1)
>>>>
>>>> #or
>>>> m1[!upper.tri(m1)] <- rep(rep(1,length(vec)),vec)
>>>>
>>>> #But, in a case like below, perhaps:
>>>> vec1<- c(3,4,5)
>>>>
>>>> m2<- matrix(0,length(vec1),max(vec1))
>>>> indx <- cbind(rep(seq_along(vec1),vec1),unlist(tapply(vec1,list(vec1),FUN=seq),use.names=FALSE))
>>>> m2[indx]<- 1
>>>> m2
>>>> # [,1] [,2] [,3] [,4] [,5]
>>>> #[1,] 1 1 1 0 0
>>>> #[2,] 1 1 1 1 0
>>>> #[3,] 1 1 1 1 1
>>>>
>>>>
>>>>
>>>>
>>>> A.K.
>>>>
>>>>
>>>> Hi-
>>>>
>>>> I'd like to create a matrix of 0's and 1's where the number of
>>>> 1's in each row defined by the value indexed in another vector, and
>>>> where the (value-1) is back-filled by 0's.
>>>>
>>>> For example, given the following vector:
>>>> vec= c(1,2,3)
>>>>
>>>> I'd like to produce a matrix with dimensions (length(vec), max(vec)):
>>>>
>>>> 1,0,0
>>>> 1,1,0
>>>> 1,1,1
>>>>
>>>> Thank you!
>>>>
>>>> ______________________________________________
>>>> R-help at r-project.org mailing list
>>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>>> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
>>>> and provide commented, minimal, self-contained, reproducible code.
>>
>>>
>>> ______________________________________________
>>> R-help at r-project.org mailing list
>>> https://stat.ethz.ch/mailman/listinfo/r-help
>>> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
>>> and provide commented, minimal, self-contained, reproducible code.
>>
>>
>>
>> --
>>
>> Bert Gunter
>> Genentech Nonclinical Biostatistics
>>
>> (650) 467-7374
>
>>
>
>
>
> --
>
> Bert Gunter
> Genentech Nonclinical Biostatistics
>
> (650) 467-7374
>
--
Bert Gunter
Genentech Nonclinical Biostatistics
(650) 467-7374
______________________________________________
R-help at r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
______________________________________________
R-help at r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
More information about the R-help
mailing list