Vectorize loop with repeating indices - r

I have a vector of indices that contains repeating values:
IN <- c(1, 1, 2, 2, 3, 4, 5)
I would like to uses these indices to subtract two vectors:
ST <- c(0, 0, 0, 0, 0, 0, 0)
SB <- c(1, 1, 1, 1, 1, 1, 1)
However, I would like to do the subtraction in "order" such that after subtraction of the first index values (0, 1), the second substraction would "build off" the first subtraction. I would like to end up with a vector FN that looks like this:
c(-2, -2, -1, -1, -1, 0, 0)
This is easy enough to do in a for loop:
for(i in seq_along(IN)){
ST[IN[i]] <- ST[IN[i]] - SB[IN[i]]
}
But I need to run this loop many times on long vectors and this can take many hours. Is there any way to vectorize this task and avoid a for loop? Maybe using a data.table technique?

Sure, with data.table, it's
library(data.table)
DT = data.table(ST)
mDT = data.table(IN, SB)[, .(sub = sum(SB)), by=.(w = IN)]
DT[mDT$w, ST := ST - mDT$sub ]
ST
1: -2
2: -2
3: -1
4: -1
5: -1
6: 0
7: 0
Or with base R:
w = sort(unique(IN))
ST[w] <- ST[w] - tapply(SB, IN, FUN = sum)
# [1] -2 -2 -1 -1 -1 0 0

Here is an option using aggregate in base R:
ag <- aggregate(.~IN, data.frame(IN, ST[IN]-SB[IN]), sum)
replace(ST, ag[,1], ag[,2])
#[1] -2 -2 -1 -1 -1 0 0
OR using xtabs:
d <- as.data.frame(xtabs(B~A, data.frame(A=IN, B=ST[IN]-SB[IN])))
replace(ST, d[,1], d[,2])

Related

How to solve a system of linear inequalities in R

Suppose I have a system of linear inequalities: Ax <= b. I'm trying to figure out how to solve this in R.
I know that the eliminate function from the package lintools performs variable elimination. The output is a list of the following information:
A: the A corresponding to the system with variables eliminated.
b: the constant vector corresponding to the resulting system
neq: the number of equations
H: The memory matrix storing how each row was derived
h: The number of variables eliminated from the original system.
I wrote a loop to try to perform variable elimination. However, I am not sure how to get the final solutions from this system of linear inequalities:
library(lintools)
A <- matrix(c(
4, -5, -3, 1,
-1, 1, -1, 0,
1, 1, 2, 0,
-1, 0, 0, 0,
0, -1, 0, 0,
0, 0, -1, 0),byrow=TRUE,nrow=6)
b <- c(0,2,3,0,0,0)
L <- vector("list", length = nrow(A))
L[[1]] <- list(A = A, b = b, neq = 0, nleq = nrow(A), variable = 1)
for(i in 1:(nrow(A) - 3)){
print(i)
L[[i + 1]] <- eliminate(A = L[[i]]$A, b = L[[i]]$b, neq = L[[i]]$neq, nleq = L[[i]]$nleq, variable = i + 1)
}
Presumably you will know what to do with this (I don't):
str(L) # the last two items in L are NULL
tail(L,n=3)[[1]] #Take the first of the last three.
$A
[1,] -0.5 0 0 0
[2,] 0.5 0 0 0
[3,] -1.0 0 0 0
$b
[1] 3.5 1.5 0.0
$neq
[1] 0
$nleq
[1] 3
$H
NULL
$h
[1] 0

R sapply new evaluation of function for each incidence in array

Thanks to lots of help, I've got an expression that substitutes the value from a rbinom into a vector, when certain conditions are met. My problem is that it always substitutes the same value, i.e. does not do a new evaluation for each instance of the conditions being met. I think I just need to wrap it in a sapply statement but haven't got the syntax correct. MWE:
arr1 <- c(8, 2, 5, 2, 3, 2, 2, 2, 8, 2, 4)
arr2 <- c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0)
arr1
arr1[Reduce("&", list(arr1 == 2, arr2 ==1))] <- rbinom(1,1,0.5) * 2
arr1
arr1
[1] 8 2 5 0 3 0 0 0 8 0 4
I would have hoped that it changed some of the values but not others, so evaluated the result again for each instance. Is this a good application of purrr::modify2 ? Thx. J
Probably, you mean to use :
inds <- arr1 == 2 & arr2 == 1
arr1[inds] <- rbinom(sum(inds), 1, 0.5) * 2

R - If statement function to set value of new column

I have 2 columns pos and neg, each with a integer value.
I would like to create a new column score, with each element of this column given a value of:
1 if pos > neg
0 if pos = neg
-1 if pos < neg
What would be the best way to do this? I am new to creating functions in R, so any help or direction is appreciated.
We can use ifelse instead of if/else as ifelse is vectorized
df1$score <- with(df1, ifelse(pos > neg, 1, ifelse(pos < neg, -1, 0)))
Or get the difference of 'pos' and 'neg' and apply sign which will give values -1, 0, 1 when the sign is negative, value 0 or positive
df1$score <- with(df1, sign(pos - neg ))
data
df1 <- data.frame(pos = c(5, 4, 3, 1, 2), neg = c(5, 3, 4, 1, 3))

Apply - creating a matrix by combining two other matrices, using value from a vector to select the one to combine column from

I have a task that I am doing with an ordinary for loop. I think it can be done by one of apply functions but can't find a way to do it. Can you please if it is possible to apply apply to the problem or if there is more efficient way of solving it ?
I am aware that I can make udf and do.call() but I think it would be the same as for loop.
The problem:
I have two matrices a and b, both (m x n) and a vector of length n. I want to create third matrix (m x n) which would recieve columns from a or b based on the values of a vector.
For example:
a=
[0, 0, 0, 0]
[0, 0, 0, 0]
[0, 0, 0, 0]
[0, 0, 0, 0]
b=
[1, 1, 1, 1]
[1, 1, 1, 1]
[1, 1, 1, 1]
[1, 1, 1, 1]
x=
[-1, -1, 1, 1]
if x[k] is -1, c recieves column from a, if x[k] is 1 then c recieves column from b, which yields:
c=
[0, 0, 1, 0]
[0, 0, 1, 0]
[0, 0, 1, 0]
[0, 0, 1, 0]
Reproducible example:
a <- matrix(rep(0, 16), nrow = 4, ncol = 4)
b <- matrix(rep(1, 16), nrow = 4, ncol = 4)
x <- c(-1,-1, 1,-1)
c <- matrix(NA, nrow = 4, ncol = 4)
for (i in 1:length(x)){
if (x[[i]] < 0){
c[,i] <- a[,i]
} else {
c[,i] <- b[,i]
}
}
Is there any more efficient solution ?
Regards,
P.
We can either use ifelse after making the 'x' as the same length as 'a/b' by replicating each of the 'x' elements. The col is a convenient function to do that.
c <- a
c[] <- ifelse(x[col(a)]==-1, a, b)
Or as in the previous step, we create a logical vector (x==1), coerce to binary with +, make the length the same as 'a', specify the ncol in the matrix.
matrix(+(x==1)[col(a)], ncol=ncol(a))
# [,1] [,2] [,3] [,4]
#[1,] 0 0 1 0
#[2,] 0 0 1 0
#[3,] 0 0 1 0
#[4,] 0 0 1 0

vector manipulation in R

Suppose I have a vector of dimension n and it is composed of 0 and 1. Then I divide this vector into m equal bins. A bin is called active if it contains at least one "1". I want to write a command that returns the place of active bins and how many "1" they contain.
For example, I have this vector: n=15, m=5
[1 0 0 | 0 1 1 | 0 0 0 | 0 1 0| 1 1 1]
I want to have matrix [1 2 4 5] (the active bins) and [1 2 1 3] (how many 1 they contain).
Can I write this in R without using for loops?
I would do it like this:
a <- c(1,0,0,0,1,1,0,0,0,0,1,0,1,1,1)
m <- 5
idx <- rep(1:m, each=length(a)/m)
# how many ones?
no <- sapply(1:5, function(x) sum(a[idx==x]))
# which bins contain ones?
bins <- 1:m
bins[no>0]
Another approach to obtain the vector with number of ones:
x <- c(1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 1)
n <- length(x)
m <- 5
size <- n/m
x.list <- split(x, cut(seq_along(x)/size, 0:m))
vapply(x.list, sum, 0)
From there, do as jigr does.

Resources