Probably this would be easy. I have a Matrix:
testM <- matrix(1:40, ncol = 4, byrow = FALSE)
testM
[,1] [,2] [,3] [,4]
[1,] 1 11 21 31
[2,] 2 12 22 32
[3,] 3 13 23 33
[4,] 4 14 24 34
[5,] 5 15 25 35
[6,] 6 16 26 36
[7,] 7 17 27 37
[8,] 8 18 28 38
[9,] 9 19 29 39
[10,] 10 20 30 40
and I want to "reduce" the matrix summing column pairs by row. Expected result:
[,1] [,2]
[1,] 12 52
[2,] 14 54
[3,] 16 56
[4,] 18 58
[5,] 20 60
[6,] 22 62
[7,] 24 64
[8,] 26 66
[9,] 28 68
[10,] 30 70
I tried this but doesn't work
X <- apply(1:(ncol(testM)/2), 1, function(x) sum(testM[x], testM[x+1]) )
Error in apply(1:(ncol(testM)/2), 1, function(x) sum(testM[x], testM[x + :
dim(X) must have a positive length
testM[,c(T,F)]+testM[,c(F,T)];
## [,1] [,2]
## [1,] 12 52
## [2,] 14 54
## [3,] 16 56
## [4,] 18 58
## [5,] 20 60
## [6,] 22 62
## [7,] 24 64
## [8,] 26 66
## [9,] 28 68
## [10,] 30 70
Here's a solution using rowSums()
sapply( list(1:2,3:4) , function(i) rowSums(testM[,i]) )
if the number of columns should be arbitrary, it gets more complicated:
li <- split( 1:ncol(testM) , rep(1:(ncol(testM)/2), times=1 , each=2))
sapply( li , function(i) rowSums(testM[,i]) )
We can do a matrix multiplication:
M <- matrix(c(1,1,0,0, 0,0,1,1), 4, 2)
testM %*% M
another solution with tapply():
g <- gl(ncol(testM)/2, 2)
t(apply(testM, 1, FUN=tapply, INDEX=g, sum))
How about:
matrix(c(testM[, 1] + testM[, 2], testM[, 2] + testM[, 4]), nrow = 10)
a solution around your initial idea:
sapply(seq(2, ncol(testM), 2), function(x) apply(testM[, (x-1):x], 1, sum))
Related
I am trying to split a matrix along the rows but not sure how to do it. For example if I have a NxM matrix but want to split the matrix such that I get n (N/n)xM matrices, how would I do that?
So if I had a matrix X:
[,1] [,2]
[1,] 1 21
[2,] 2 22
[3,] 3 23
[4,] 4 24
[5,] 5 25
[6,] 6 26
[7,] 7 27
[8,] 8 28
[9,] 9 29
[10,] 10 30
[11,] 11 31
[12,] 12 32
[13,] 13 33
[14,] 14 34
[15,] 15 35
[16,] 16 36
[17,] 17 37
[18,] 18 38
[19,] 19 39
[20,] 20 40`
The output of a function block(X,n) if n = 2 would be
[[1]]
[,1] [,2]
[1,] 1 21
[2,] 2 22
[3,] 3 23
[4,] 4 24
[5,] 5 25
[6,] 6 26
[7,] 7 27
[8,] 8 28
[9,] 9 29
[10,] 10 30
[[2]]
[,1] [,2]
[1,] 11 31
[2,] 12 32
[3,] 13 33
[4,] 14 34
[5,] 15 35
[6,] 16 36
[7,] 17 37
[8,] 18 38
[9,] 19 39
[10,] 20 40
Thanks for any help in advance!
We create a grouping column to split
n <- 10
grp <- (seq_len(nrow(X)) - 1) %/% n + 1
split(as.data.frame(X), grp)
Or use index to subset the rows
lapply(seq(1, nrow(X), by = n), function(i) X[i:(i+n -1), ])
data
X <- matrix(1:40, ncol = 2)
I have a number of subarrays, say 2 (for simplicity), each with the same number of rows and columns. Each spot in the subarrays is occupied by a number in [1, 10].
What I would like to do is move rows randomly between subarrays according to some rate of movement m = [0, 1]. m = 0 corresponds to no movement, while m = 1 means that any rows across all subarrays can be moved.
I take inspiration from:
How to swap a number of the values between 2 rows in R
but my problem is a bit different than this. I do know that sample() would be needed here.
Is there an easy way to go about accomplishing this?
This doesn't do it, but I believe I'm on the right track anyway.
m <- 0.2
a <- array(dim = c(5, 5, 2)) # 5 rows, 5 columns, 2 subarrays
res <- rep(sample(nrow(a), size = ceiling(nrow(a)*m), replace = FALSE)) # sample 20% of rows from array a.
Any assistance is appreciated.
It is significantly easier if you can use a matrix (2-dim array).
set.seed(2)
m <- 0.2
d <- c(10, 4)
a <- array(sample(prod(d)), dim = d)
a
# [,1] [,2] [,3] [,4]
# [1,] 8 17 14 1
# [2,] 28 37 40 26
# [3,] 22 38 16 29
# [4,] 7 35 3 32
# [5,] 34 11 23 4
# [6,] 36 33 19 31
# [7,] 5 24 30 13
# [8,] 39 6 27 25
# [9,] 15 10 12 9
# [10,] 18 2 21 20
(I'm going to set the seed again to something that conveniently gives me something "interesting" to show.)
set.seed(2)
ind <- which(runif(d[1]) < m)
ind
# [1] 1 4 7
The first randomness, runif, is compared against m and generates the indices that may change. The second randomness, sample below, takes those indices and possibly reorders them. (In this case, it reorders "1,4,7" to "4,1,7", meaning the third of the rows-that-may-change will be left unchanged.)
a[ind,] <- a[sample(ind),]
a
# [,1] [,2] [,3] [,4]
# [1,] 7 35 3 32 # <-- row 4
# [2,] 28 37 40 26
# [3,] 22 38 16 29
# [4,] 8 17 14 1 # <-- row 1
# [5,] 34 11 23 4
# [6,] 36 33 19 31
# [7,] 5 24 30 13 # <-- row 7, unchanged
# [8,] 39 6 27 25
# [9,] 15 10 12 9
# [10,] 18 2 21 20
Note that this is probabilistic, which means a probability of 0.2 does not guarantee you 20% (or even any) of the rows will be swapped.
(Since I'm guessing you'd really like to preserve your 3-dim (or even n-dim) array, you might be able to use aperm to transfer between array <--> matrix.)
EDIT 1
As an alternative to a probabilitic use of runif, you can use:
ind <- head(sample(d[1]),size=d[1]*m)
to get closer to your goal of "20%". Since d[1]*m will often not be an integer, head silently truncates/floors the number, so you'll get the price-is-right winner: closest to but not over your desired percentage.
EDIT 2
A reversible method for transforming an n-dimensional array into a matrix and back again. Caveat: though the logic appears solid, my testing has only included a couple arrays.
array2matrix <- function(a) {
d <- dim(a)
ind <- seq_along(d)
a2 <- aperm(a, c(ind[2], ind[-2]))
dim(a2) <- c(d[2], prod(d[-2]))
a2 <- t(a2)
attr(a2, "origdim") <- d
a2
}
The reversal uses the "origdim" attribute if still present; this will work as long as your modifications to the matrix do not clear its attributes. (Simple row-swapping does not.)
matrix2array <- function(m, d = attr(m, "origdim")) {
ind <- seq_along(d)
m2 <- t(m)
dim(m2) <- c(d[2], d[-2])
aperm(m2, c(ind[2], ind[-2]))
}
(These two functions should probably do some more error-checks, such as is.null(d).)
A sample run:
set.seed(2)
dims <- 5:2
a <- array(sample(prod(dims)), dim=dims)
Quick show:
a[,,1,1:2,drop=FALSE]
# , , 1, 1
# [,1] [,2] [,3] [,4]
# [1,] 23 109 61 90
# [2,] 84 15 27 102
# [3,] 68 95 83 24
# [4,] 20 53 117 46
# [5,] 110 62 43 8
# , , 1, 2
# [,1] [,2] [,3] [,4]
# [1,] 118 25 14 93
# [2,] 65 21 16 77
# [3,] 87 82 3 38
# [4,] 92 12 78 17
# [5,] 49 4 75 80
The transformation:
m <- array2matrix(a)
dim(m)
# [1] 30 4
head(m)
# [,1] [,2] [,3] [,4]
# [1,] 23 109 61 90
# [2,] 84 15 27 102
# [3,] 68 95 83 24
# [4,] 20 53 117 46
# [5,] 110 62 43 8
# [6,] 67 47 1 54
Proof of reversability:
identical(matrix2array(m), a)
# [1] TRUE
EDIT 3, "WRAP UP of all code"
Creating fake data:
dims <- c(5,4,2)
(a <- array(seq(prod(dims)), dim=dims))
# , , 1
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
# , , 2
# [,1] [,2] [,3] [,4]
# [1,] 21 26 31 36
# [2,] 22 27 32 37
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 25 30 35 40
(m <- array2matrix(a))
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
# [6,] 21 26 31 36
# [7,] 22 27 32 37
# [8,] 23 28 33 38
# [9,] 24 29 34 39
# [10,] 25 30 35 40
# attr(,"origdim")
# [1] 5 4 2
The random-swapping of rows. I'm using 50% here.
pct <- 0.5
nr <- nrow(m)
set.seed(3)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 2 8 4 3 9
(ind2 <- sample(ind1))
# [1] 3 2 9 8 4
m[ind1,] <- m[ind2,]
m
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 3 8 13 18
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 5 10 15 20
# [6,] 21 26 31 36
# [7,] 22 27 32 37
# [8,] 2 7 12 17
# [9,] 4 9 14 19
# [10,] 25 30 35 40
# attr(,"origdim")
# [1] 5 4 2
(Note that I pre-made ind1 and ind2 here, mostly to see what was going on internally. You can replace m[ind2,] with m[sample(ind1),] for the same effect.)
BTW: if we had instead used a seed of 2, we would notice that 2 rows are not swapped:
set.seed(2)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 2 7 5 10 6
(ind2 <- sample(ind1))
# [1] 6 2 5 10 7
Because of this, I chose a seed of 3 for demonstration. However, this may give the appearance of things not working. Lacking more controlling code, sample does not ensure that positions change: it is certainly reasonable to expect that "randomly swap rows" could randomly choose to move row 2 to row 2. Take for example:
set.seed(267)
(ind1 <- sample(nr, size = ceiling(nr * pct)))
# [1] 3 6 5 7 2
(ind2 <- sample(ind1))
# [1] 3 6 5 7 2
The first randomly chooses five rows, and then reorders them randomly into an unchanged order. (I suggest that if you want to force that they are all movements, you should ask a new question asking about just forcing a sample vector to change.)
Anyway, we can regain the original dimensionality with the second function:
(a2 <- matrix2array(m))
# , , 1
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 3 8 13 18
# [3,] 23 28 33 38
# [4,] 24 29 34 39
# [5,] 5 10 15 20
# , , 2
# [,1] [,2] [,3] [,4]
# [1,] 21 26 31 36
# [2,] 22 27 32 37
# [3,] 2 7 12 17
# [4,] 4 9 14 19
# [5,] 25 30 35 40
In the first plane of the array, rows 1 and 5 are unchanged; in the second plane, rows 1, 2, and 5 are unchanged. Five rows the same, five rows moved around (but otherwise unchanged within each row).
I want to know the command in R to lag a matrix.
I have defined x as:
> (x <- matrix(1:50, 10, 5))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 11 21 31 41
[2,] 2 12 22 32 42
[3,] 3 13 23 33 43
[4,] 4 14 24 34 44
[5,] 5 15 25 35 45
[6,] 6 16 26 36 46
[7,] 7 17 27 37 47
[8,] 8 18 28 38 48
[9,] 9 19 29 39 49
[10,] 10 20 30 40 50
I want create l.x:
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
lag will coerce your object to a time-series (ts class to be specific) and only shifts the time index. It does not change the underlying data.
You need to manually lag the matrix yourself by adding rows of NA at the beginning and removing the same number of rows at the end. Here's an example of a function that does just that:
lagmatrix <- function(x, k) {
# ensure 'x' is a matrix
stopifnot(is.matrix(x))
if (k == 0)
return(x)
na <- matrix(NA, nrow=abs(k), ncol=ncol(x))
if (k > 0) {
nr <- nrow(x)
# prepend NA and remove rows from end
rbind(na, x[-((nr-k):nr),])
} else {
# append NA and remove rows from beginning
rbind(x[-1:k,], na)
}
}
Or you can use a lag function that does what you expect. For example, xts::lag.xts.
> xts::lag.xts(x)
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
> is.matrix(xts::lag.xts(x))
[1] TRUE
Here is one manual method in base R with head and rbind:
rbind(NA, head(x, 9))
[,1] [,2] [,3] [,4] [,5]
[1,] NA NA NA NA NA
[2,] 1 11 21 31 41
[3,] 2 12 22 32 42
[4,] 3 13 23 33 43
[5,] 4 14 24 34 44
[6,] 5 15 25 35 45
[7,] 6 16 26 36 46
[8,] 7 17 27 37 47
[9,] 8 18 28 38 48
[10,] 9 19 29 39 49
More generally, as noted by #akrun, head(., -1) will work for any sized matrix:
rbind(NA, head(x, -1))
We can use apply
library(dplyr)
apply(x, 2, lag)
# [,1] [,2] [,3] [,4] [,5]
# [1,] NA NA NA NA NA
# [2,] 1 11 21 31 41
# [3,] 2 12 22 32 42
# [4,] 3 13 23 33 43
# [5,] 4 14 24 34 44
# [6,] 5 15 25 35 45
# [7,] 6 16 26 36 46
# [8,] 7 17 27 37 47
# [9,] 8 18 28 38 48
#[10,] 9 19 29 39 49
0r
rbind(NA, x[-nrow(x),])
# [,1] [,2] [,3] [,4] [,5]
# [1,] NA NA NA NA NA
# [2,] 1 11 21 31 41
# [3,] 2 12 22 32 42
# [4,] 3 13 23 33 43
# [5,] 4 14 24 34 44
# [6,] 5 15 25 35 45
# [7,] 6 16 26 36 46
# [8,] 7 17 27 37 47
# [9,] 8 18 28 38 48
#[10,] 9 19 29 39 49
Below is a pure dplyr solution without the need for apply. Only annoyance here is that it needs to be converted to a data.frame to work.
library(dplyr)
x %>% as.data.frame %>% mutate_each( funs(lag))
I have a list of numbers (example bellow):
[[178]]
NULL
[[179]]
[1] 179 66
[[180]]
[1] 180 67
[[181]]
[1] 181 123
[[182]]
[1] 182
This list contains columns (179, 66, 180, 67, 181, 123) I want to exclude from a matrix.
I tried commands bellow, but they didn't work:
MyMatrix[, !(unlist(MyList))]
MyMatrix[, -(unlist(MyList))]
MyMatrix[, !unlist(MyList)]
MyMatrix[, -unlist(MyList)]
My question: what is a right way to exclude specific columns from a matrix?
Here's my small replication of your problem.
listOfColumns<-list(NULL, c(2,3), 5, NULL)
listOfColumns #print for viewing
#output
#[[1]]
#NULL
#[[2]]
#[1] 2 3
#[[3]]
#[1] 5
#[[4]]
#NULL
MyMatrix<-matrix(1:50, nrow=10, ncol=5)
MyMatrix #print for viewing
#output
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 11 21 31 41
#[2,] 2 12 22 32 42
#[3,] 3 13 23 33 43
#[4,] 4 14 24 34 44
#[5,] 5 15 25 35 45
#[6,] 6 16 26 36 46
#[7,] 7 17 27 37 47
#[8,] 8 18 28 38 48
#[9,] 9 19 29 39 49
#[10,] 10 20 30 40 50
First, the way you're going to want to subset your matrix so that you omit the given column numbers is to do
MyMatrix[-columnNumbers]
In R, negative numbers used to subset correspond to entries that should be omitted.
The following call output's what you want
MyMatrix[,-unlist(listOfNumbers)]
#output
# [,1] [,2]
# [1,] 1 31
# [2,] 2 32
# [3,] 3 33
# [4,] 4 34
# [5,] 5 35
# [6,] 6 36
# [7,] 7 37
# [8,] 8 38
# [9,] 9 39
# [10,] 10 40
If you want to keep this result for later use, you'll need to store it (As David Robinson got at)
MySmallerMatrix<-MyMatrix[,-unlist(listOfNumbers)]
I'm a beginner R user and I need to write a function that sums the rows of a data frame over a fixed interval (every 4 rows).
I've tried the following code
camp<-function(X){
i<-1
n<-nrow(X)
xc<-matrix(nrow=36,ncol=m)
for (i in 1:n){
xc<-apply(X[i:(i+4),],2,sum)
rownames(xc[i])<-rownames(X[i])
i<-i+5
}
return(xc)
}
the result is "Error in X[i:(i + 4), ] : index out of range".
How can I solve? Any suggestion?
Thanks.
The zoo package has rollapply which is pretty handy for stuff like this...
# Make some data
set.seed(1)
m <- matrix( sample( 10 , 32 , repl = TRUE ) , 8 )
# [,1] [,2] [,3] [,4]
#[1,] 3 7 8 3
#[2,] 4 1 10 4
#[3,] 6 3 4 1
#[4,] 10 2 8 4
#[5,] 3 7 10 9
#[6,] 9 4 3 4
#[7,] 10 8 7 5
#[8,] 7 5 2 6
# Sum every 4 rows
require( zoo )
tmp <- rollapply( m , width = 4 , by = 4 , align = "left" , FUN = sum )
# [,1] [,2] [,3] [,4]
#[1,] 23 13 30 12
#[2,] 29 24 22 24
You can also use rowSums() on the result if you actually wanted to aggregate the columns into a single value for each of the 4 rows...
rowSums( tmp )
#[1] 78 99
Here is a way to do it :
## Sample data
m <- matrix(1:36, nrow=12)
## Create a "group" index
fac <- (seq_len(nrow(m))-1) %/% 4
## Apply sum
apply(m, 2, function(v) tapply(v, fac, sum))
Sample data :
[,1] [,2] [,3]
[1,] 1 13 25
[2,] 2 14 26
[3,] 3 15 27
[4,] 4 16 28
[5,] 5 17 29
[6,] 6 18 30
[7,] 7 19 31
[8,] 8 20 32
[9,] 9 21 33
[10,] 10 22 34
[11,] 11 23 35
[12,] 12 24 36
Result :
[,1] [,2] [,3]
0 10 58 106
1 26 74 122
2 42 90 138