How do you append 2 subnames to a variable in R? - r

It has to be possible but I can't find an answer (or think of the proper search terms).
Basically I'm stuck in a double loop and need to append 2 different subnames (1 for each separate iteration) to a variable.
Basic example:
var <- list()
i1 <- 0
i2 <- 0
while (i1 < 3) {
i1 <- i1 - 1
while (i2 < 3) {
i2 <- i2 - 1
var[[i1]][[i2]] <- c(1, 5, 8)
}
}
However, stringing two subnames together like that doesn't seem to work. I'd like to get 9 results (based on 3x3 iterations) names as var11, var12, var13, var21, etc.
Thanks!

In R, you can do this in a simple one liner, but I'll initialize some variables to be explicit about it.
i1start<-1
i1end<-3
i2start<-1
i2end<-3
result<-lapply(i1start:i1end, function(i1) lapply(i2start:i2end, function(i2) c(1,5,8)))
Which should return a list of lists, where each entry at position (i1,i2) is the vector (1,5,8).
Let's break this down. It'd be useful if you look up lapply (via the command ?lapply) to brush up on the function.
If we were to just run the inner lapply, what would happen?
lapply(i2start:i2end, function(i2) c(1,5,8))
#[[1]]
#[1] 1 5 8
#
#[[2]]
#[1] 1 5 8
#
#[[3]]
#[1] 1 5 8
lapply "applies" the vector 1,2,3 (i2start:i2end) to the function, which is essentially the following
#lapply does this
function(1) c(1,5,8)
function(2) c(1,5,8)
function(3) c(1,5,8)
and then stores all these results in a list (since it is l-apply)
We then use the same concept in the outer lapply call, except our function has changed. It is no longer
function(i) c(1,5,8)
but actually
#substituting 1:3 for i2start:i2end
function(i) lapply(1:3, function(i2) c(1,5,8))
so now we are calling
lapply(1:3, function(i1) lapply(1:3, function(i2) c(1,5,8)))
which essentially calls
function(1) lapply(1:3, function(i2) c(1,5,8))
function(2) lapply(1:3, function(i2) c(1,5,8))
function(3) lapply(1:3, function(i2) c(1,5,8))
and stores the results of those functions in a list. Each of those function calls then run the inner function, which I explained just prior, and when you put it all together, it leads to your result! A lot going on in one line

Seems like you need to initialize properly your i1 and i2 variables and increase them rather than decrease. Then, in the inner loop you initialize a sublist and assign that sublist to your var list. Try this:
var <- list()
i1 <- 0
while (i1 < 3) {
i2<-0
i1 <- i1 + 1
var2<-list()
while (i2 < 3) {
i2 <- i2 + 1
var2[[i2]] <- sample(1:10,3)
}
var[[i1]]<-var2
}
Another approach could be initialize your principal list and all the sublists:
var<-vector("list",3)
for (i in 1:3) var[[i]]<-vector("list",3)
At this point, you can assign values with the double subscript:
var[[i]][[j]]<-c(1,5,8)
Assuming that both i and j ranging from 1 to 3,

Related

lapply functions inside each other does not work as expected

I have two lists and I must use for and if condition for my functions over these lists. I then decide to use lapply function. I used lapply function but my code becomes so difficult and do not work. How can I make my code work in an easy way. Is there a good way to do not use many lapply functions.
The idea of my code:
First have some lists.
These lists does not need to be all the same lengths or even all > 0.
So, my code check each list. if it is > 0 or not.
If it is > 0 then:
check the values of the second list.
If the values equal specific values then this values will changes to new values.
The last steps must applied to all the lists that I have.
Here is my code:
the function gave me NULL
nx <- list(1, 1) ## if my list > 0 then check it
x.t <- list(c(2, 3, 4, 4), c(2, 4, 5, 6)) #the list to apply if statement on it.
lapply(nx, function(x) if (x > 0) {
do.t <- lapply(x.t, function(x) { which(x %in% c(2, 7:10))})
##check the values of my list.
lapply(nx, function(x){
lapply(1:length(x), function(i){ for (j in 1:x[[i]]){ ## here I would like j from 1 to length of x where x is a list of two elements.
if (x.t[[i]][do.t[[j]]] == 2) ## here I want to have a condition says that, if the element of each list is equal 2 then this element will have the value 2.5.
x.t[[i]] <- 2.5
}})})})
my function will includes many lists where the condition will be extend. For example,
if (x.t[[i]][do.t[[j]]] == 2){
x.t[[i]] <- 2.5
}else{ some condition}elese{other condtion}
and so on.
the result.
[[1]]
[[1]][[1]]
[[1]][[1]][[1]]
NULL
[[1]][[2]]
[[1]][[2]][[1]]
NULL
[[2]]
[[2]][[1]]
[[2]][[1]][[1]]
NULL
[[2]][[2]]
[[2]][[2]][[1]]
NULL
My function is so complicated and hence I provide this example very similar to my original function.
As a general function maybe it's better to divide the code into parts, each one doing just one thing.
Note that the lapply passes entire vectors, the elements of the list x.t to the function. Then, complicated loops through the elements of a vector, processing one at a time.
complicated <- function(x){
for(i in seq_along(x)){
if(x[i] > 0){
if(x[i] == 2)
x[i] <- 2.5
}
}
x
}
x.t.2 <- lapply(x.t, function(x){
x <- complicated(x)
x
})
x.t.2
#[[1]]
#[1] 2.5 3.0 4.0 4.0
#
#[[2]]
#[1] 2.5 4.0 5.0 6.0

Finding sum of number nearest to specific number

I have following vector of numbers in r
bay_no <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
bay_cont <- c(45,25,25,0,19,61,2,134,5,27,0,54,102,97,5,6,65,47,85,0)
count <- 3
bay_to_serve <- sum(bay_cont)/count
In above bay_cont vector I want to find sum which will be close to bay_to_serve in above case bay_to_serve = 268
Now, from (45 till 2) sum is 177 and (45 till 134) sum is 311,so 311 is closest to 268 then it should return the index of i.e 8 from bay_no
We will get one vector from bay_no = 1-8
Again starting from bay_cont from 5 till the sum close to 268
Desired output is
bay_no 1-8,9-14 and then remaining bay_nos
How can we do it in r?
Dunno if there is a smart way to do but I'd think of nested loops.
Your inner loop may look like this (Please note that I have no access to R right now, so I can't test it.):
old_sum = bay_count[1]
for(i in 2:length(by_cont)) {
new_sum <- sum (bay_count[1:i])
if (abs(bay_to_serve - new_sum) < abs(bay_to_serve - old_sum)) {
output <- paste("bay_no", paste(1,i, sep="-"), sep=" ") break
}else{
old_sum <- new_sum
}
}
This way, whenever the sum of the first X entries is smaller than the previous sum, it will break the loop and create an output string. Just add another loop around the first loop and one or to more if statements to run from j:length(by_cont), whereby j is first set to 1 and will be set to i+1 within the inner loop.
You can try:
res <- NULL
i = 1
while(i < length(bay_cont)){
tmp <- which.min(abs(cumsum(bay_cont[i:length(bay_cont)]) - bay_to_serve))
res <- append(res,tmp)
i = tmp + i
}
cumsum(res)
[1] 8 14 19
If you want to break ties specifically you can use rank together with which.min like follows:
which.min(rank(abs(cumsum(bay_cont[i:length(bay_cont)]) - bay_to_serve), ties.method = "last"))
Then I would create a matrix instead of pasting it together:
cbind(c(1, cumsum(res)[-length(cumsum(res))]+1), cumsum(res))
[,1] [,2]
[1,] 1 8
[2,] 9 14
[3,] 15 19
Of course you can paste it together as well:
apply(cbind(c(1, cumsum(res)[-length(cumsum(res))]+1), cumsum(res)), 1, paste, collapse="-")
[1] "1-8" "9-14" "15-19"
My solution uses a dirty for loop but yields the required indizes...
Hope that fits to you?
bay_no <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
bay_cont <- c(45,25,25,0,19,61,2,134,5,27,0,54,102,97,5,6,65,47,85,0)
count <- 3
bay_to_serve <- sum(bay_cont)/count
temp_sum=0
for (i in 1:(length(bay_cont)-1)) {
temp_sum=temp_sum+bay_cont[i]
if ( abs(bay_to_serve-temp_sum)<abs(bay_to_serve-(temp_sum +bay_cont[i+1]))) {
print(i)
temp_sum=0
}
}
I probably misunderstand the question, but it seems more easy to do this:
bay_no[ which.min(abs(cumsum(bay_cont) - bay_to_serve)) ]
To start at 5, omit elements 1:4 and add 4 to the which.min index
bay_no[ which.min(abs(cumsum(bay_cont[-(1:4)]) - bay_to_serve))+4 ]

Matching in list of vectors with differents lengths

I have two lists like that :
List1 <- list(c("toto", "titi"), c("tata"), c("toto", "tz", "tutu"))
List2 <- list(c("titi", "toto", "tutu"),
c("tata", "trtr", "to", "tututu"),
c("to", "titi", "tutu", "tyty"),
c("titi", "tu", "tyty", "tete"),
c("tktk", "ta"))
And I want to build a list (of the matchings) which has a similar structure as the List1 object, except that the character vectors are replaced by a list of the matching indices of first level elements of List2, this for each string of each character vector.
The matching list that I would to obtain with list1 and list2 examples is thus :
Matchings <- list(list(list(1), list(1,3,4)),
list(list(2)),
list(list(1), list(), list(1,3)))
I've built the following code solution (that works, but too slow) with loops :
Matching_list <- lapply(List1, function(x) sapply(x, function(y) return(list())))
for (i in 1:length(List1)) {
for (j in 1: length(List1[[i]])) {
Matchings = list()
for (k in 1: length(List2)) {
if(any(List1[[i]][j] %in% List2[[k]])) {
Matchings <- c(Matchings, k)
}
if(length(Matchings) != 0) {
Matching_list[[i]][[j]] <- Matchings
}
}
}
}
... but it's definitly too slow for large lists. Thus, I seek for a solution that would make that stuff without loops as far as possible.
Could you help me?
How about this:
inds <- rep(seq_along(List2), sapply(List2, length))
#[1] 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5
ls <- unlist(List2)
res <-
relist(sapply(unlist(List1), function(a) as.list(inds[which(ls %in% a)])), skeleton=List1)
all.equal(Matchings, res)
#[1] TRUE
Which will give your desired output. I doubt that its possible without, at least, looping over List1.

adding values to the vector inside for loop in R

I have just started learning R and I wrote this code to learn on functions and loops.
squared<-function(x){
m<-c()
for(i in 1:x){
y<-i*i
c(m,y)
}
return (m)
}
squared(5)
NULL
Why does this return NULL. I want i*i values to append to the end of mand return a vector. Can someone please point out whats wrong with this code.
You haven't put anything inside m <- c() in your loop since you did not use an assignment. You are getting the following -
m <- c()
m
# NULL
You can change the function to return the desired values by assigning m in the loop.
squared <- function(x) {
m <- c()
for(i in 1:x) {
y <- i * i
m <- c(m, y)
}
return(m)
}
squared(5)
# [1] 1 4 9 16 25
But this is inefficient because we know the length of the resulting vector will be 5 (or x). So we want to allocate the memory first before looping. This will be the better way to use the for() loop.
squared <- function(x) {
m <- vector("integer", x)
for(i in seq_len(x)) {
m[i] <- i * i
}
m
}
squared(5)
# [1] 1 4 9 16 25
Also notice that I have removed return() from the second function. It is not necessary there, so it can be removed. It's a matter of personal preference to leave it in this situation. Sometimes it will be necessary, like in if() statements for example.
I know the question is about looping, but I also must mention that this can be done more efficiently with seven characters using the primitive ^, like this
(1:5)^2
# [1] 1 4 9 16 25
^ is a primitive function, which means the code is written entirely in C and will be the most efficient of these three methods
`^`
# function (e1, e2) .Primitive("^")
Here's a general approach:
# Create empty vector
vec <- c()
for(i in 1:10){
# Inside the loop, make one or elements to add to vector
new_elements <- i * 3
# Use 'c' to combine the existing vector with the new_elements
vec <- c(vec, new_elements)
}
vec
# [1] 3 6 9 12 15 18 21 24 27 30
If you happen to run out of memory (e.g. if your loop has a lot of iterations or vectors are large), you can try vector preallocation which will be more efficient. That's not usually necessary unless your vectors are particularly large though.

Matching numbers by their order when in two different vectors

The title does not really do this question justice, but I could not think of any other way to phrase the question. I can best explain the problem with an example.
Let's say we have two vectors of numbers (each of which are always going to be ascending and unique):
vector1 <- c(1,3,10,11,24,26,30,31)
vector2 <- c(5,9,15,19,21,23,28,35)
What I am trying to do is create a function that will take these two vectors and match them in the following way:
1) Start with the first element of vector1 (in this case, 1)
2) Go to vector2 and match the element from #1 with the first element in vector 2 that is bigger than it (in this case, 5)
3) Go back to vector1 and skip all elements less than the value in #2 we found (in this case, we skip 3, and grab 10)
4) Go back to vector2 and skip all elements less than the value in #3 we found (in this case, we skip 9 and grab 15)
5) repeat until we are done with all elements.
The resulting two vectors we should have are:
result1 = c(1,10,24,30)
result2 = c(5,15,28,35)
My current solution goes something like this, but I believe it might be highly inefficient:
# establishes where we start from the vector2 numbers
# just in case we have vector1 <- c(5,8,10)
# and vector2 <- c(1,2,3,4,6,7). We would want to skip the 1,2,3,4 values
i <- 1
while(vector2[i]<vector1[1]){
i <- i+1
}
# starts the result1 vector with the first value from the vector1
result1 <- vector1[1]
# starts the result2 vector empty and will add as we loop through
result2 <- c()
# super complicated and probably hugely inefficient loop within a loop within a loop
# i really want to avoid doing this, but I cannot think of any other way to accomplish this
for(j in 1:length(vector1)){
while(vector1[j] > vector2[i] && (i+1) <= length(vector2)){
result1 <- c(result1,vector1[j])
result2 <- c(result2,vector2[i])
while(vector1[j] > vector2[i+1] && (i+2) <= length(vector2)){
i <- i+1
}
i <- i+1
}
}
## have to add on the last vector2 value cause while loop skips it
## if it doesn't exist (there are no more vector2 values bigger) we put in an NA
if(result1[length(result1)] < vector2[i]){
result2 <- c(result2,vector2[i])
}
else{
### we ran out of vector2 values that are bigger
result2 <- c(result2,NA)
}
This is really difficult to explain. Just call it magic :)
vector1 <- c(1,3,10,11,24,26,30,31)
vector2 <- c(5,9,15,19,21,23,28,35)
## another case
# vector2 <- c(0,9,15,19,21,23,28,35)
## handling the case where vector2 min value(s) are < vector1 min value
if (any(idx <- which(min(vector1) >= vector2)))
vector2 <- vector2[-idx]
## interleave the two vectors
tmp <- c(vector1,vector2)[order(c(order(vector1), order(vector2)))]
## if we sort the vectors, which pairwise elements are from the same vector
r <- rle(sort(tmp) %in% vector1)$lengths
## I want to "remove" all the pairwise elements which are from the same vector
## so I again interleave two vectors:
## the first will be all TRUEs because I want the first instance of each *new* vector
## the second will be all FALSEs identifying the elements I want to throw out because
## there is a sequence of elements from the same vector
l <- rep(1, length(r))
ord <- c(l, r - 1)[order(c(order(r), order(l)))]
## create some dummy TRUE/FALSE to identify the ones I want
res <- sort(tmp)[unlist(Map(rep, c(TRUE, FALSE), ord))]
setNames(split(res, res %in% vector2), c('result1', 'result2'))
# $result1
# [1] 1 10 24 30
#
# $result2
# [1] 5 15 28 35
obviously this will only work if both vectors are ascending and unique which you said
EDIT:
works with duplicates:
vector1 <- c(1,3,10,11,24,26,30,31)
vector2 <- c(5,9,15,19,21,23,28,35)
vector2 <- c(0,9,15,19,21,23,28,35)
vector2 <- c(1,3,3,5,7,9,28,35)
f <- function(v1, v2) {
if (any(idx <- which(min(vector1) >= vector2)))
vector2 <- vector2[-idx]
vector1 <- paste0(vector1, '.0')
vector2 <- paste0(vector2, '.00')
n <- function(x) as.numeric(x)
tmp <- c(vector1, vector2)[order(n(c(vector1, vector2)))]
m <- tmp[1]
idx <- c(TRUE, sapply(1:(length(tmp) - 1), function(x) {
if (n(tmp[x + 1]) > n(m)) {
if (gsub('^.*\\.','', tmp[x + 1]) == gsub('^.*\\.','', m))
FALSE
else {
m <<- tmp[x + 1]
TRUE
}
} else FALSE
}))
setNames(split(n(tmp[idx]), grepl('\\.00$', tmp[idx])), c('result1','result2'))
}
f(vector1, vector2)
# $result1
# [1] 1 10 30
#
# $result2
# [1] 3 28 35

Resources