Related
I have a vector of months
m_vec <- c(3, 7, 11)
These months represent the start month of a season. All the months in each season are shown below:
season1 <- c(3,4,5,6)
season2 <- c(7,8,9,10)
season3 <- c(11,12,1,2)
I want to create a small function that takes a vector of start months and
generate the vector of months in each season. Some more examples are show below:
m_vec <- c(9,12,4,8)
season1 <- c(9,10,11)
season2 <- c(12,1,2,3)
season3 <- c(4,5,6,7,8)
m_vec <- c(12, 5, 9)
season1 <- c(12, 1, 2,3,4)
season2 <- c(5,6,7,8)
season3 <- c(9,10,11)
My for loop is not complete and I can't seem to even know where to get started with the logic
n_season <- length(m_vec)
temp_list <- list()
for(m in seq_along(m_vec)){
month_start <- m_vec[m]
month_start_next <- m_vec[m + 1]
month_start:month_start_next
}
First we can create some helper functions
cycle <- function(n) { function(x) (x-1) %% n + 1 }
split_at <- function(b) { function(x) split(x, cumsum(x %in% b)) }
The cycle() helper will return a function that will keep values in the range from 1 to the n you pass in. It does that using the modulus % operator. The split_at helper will return a function that takes a vector and splits it up when the values you pass in are found. It does that by using cumsum() to count when each of the break points are found.
Then we can take your input, create a vector of 12 months from your first starting month, wrap in in a cycler to keep it from 1-12, and then we can use split it up using your season breakpoints. Here's what that would look like:
month_cycle <- cycle(12)
season_splitter <- split_at(m_vec)
m_vec <- c(12, 5, 9)
seq(m_vec[1], length.out=12) |>
month_cycle() |>
season_splitter()
# $`1`
# [1] 12 1 2 3 4
# $`2`
# [1] 5 6 7 8
# $`3`
# [1] 9 10 11
m_vec <- c(12, 5, 9)
Map(function(x, y) head((((x:(x + ((y - x) %% 12))) - 1) %% 12) + 1, -1),
m_vec,
c(m_vec[-1], m_vec[1]))
#[[1]]
#[1] 12 1 2 3 4
#[[2]]
#[1] 5 6 7 8
#[[3]]
#[1] 9 10 11
One option is to convert to Date class, get the sequence and extract the months
library(lubridate)
fn1 <- function(mvec) {
new <- pmax(mvec-1, 1)
out <- Map(function(i, j) {
date1 <- mdy(i, truncated = 2)
date2 <- mdy(j, truncated = 2)
if(date1 > date2) {
date2 <- date2 + years(1)}
month(seq(date1, date2, by = "month"))
}, mvec, c(new[-1], new[1]))
if(length(out[[length(out)]]) < 2) {
out[[length(out)-1]] <- c(out[[length(out)-1]], out[[length(out)]])
out[[length(out)]] <- NULL
}
names(out) <- paste0("season", seq_along(out))
return(out)
}
-testing
> fn1(m_vec)
$season1
[1] 3 4 5 6
$season2
[1] 7 8 9 10
$season3
[1] 11 12 1 2
> fn1(c(9, 12, 4, 8))
$season1
[1] 9 10 11
$season2
[1] 12 1 2 3
$season3
[1] 4 5 6 7 8
> fn1(c(1, 5, 11))
$season1
[1] 1 2 3 4
$season2
[1] 5 6 7 8 9 10
$season3
[1] 11 12 1
I'm looking to iterate each value in the vector by 1 until a set value is reached and saving each iteration in a vector, and further iterations do not include values past the set value. So for instance say the set value is 3. Consider this vector, A <- c(1,1,2). Then the desired outcome should be:
Outcome:
1 1 2
2 2 3
3 3
Then I want to store each line in a vector so I can plot a histogram
so with each vector outcome including the original vector.
hist(c(1,1,2))
hist(c(2,2,3))
hist(c(3,3))
Potential code:
for (i in 1:length(A)) {
A[i] <- A + 1
}
# given values
A <- c(1, 1, 2)
value <- 3
# incrementations
out_lst <- lapply(A, function(x) x : 3)
# [[1]]
# [1] 1 2 3
#
# [[2]]
# [1] 1 2 3
#
# [[3]]
# [1] 2 3
# histograms
hist_lst <- list()
max_len <- max(sapply(out_lst, function(x) length(x)))
for(l in 1:max_len) {
hist_lst[[l]] <- sapply(out_lst, function(x) x[l])
}
hist_lst
# [[1]]
# [1] 1 1 2
#
# [[2]]
# [1] 2 2 3
#
# [[3]]
# [1] 3 3 NA
par(mfrow = c(1, length(hist_lst)))
invisible(lapply(hist_lst, hist))
You can use a while loop:
funfun=function(vec,max){
y=list()
i=1
while(length(vec)!=0){
y[[i]]=vec
vec=vec+1
vec=`attributes<-`(na.omit(replace(vec,vec>max,NA)),NULL)
i=i+1
}
y
}
funfun(c(1,1,2),3)
[[1]]
[1] 1 1 2
[[2]]
[1] 2 2 3
[[3]]
[1] 3 3
you can now do
sapply(funfun(c(1,1,2),3),hist)
I have a list with same structure for every member as the following
config <- NULL
config[["secA"]] <- NULL
config[["secA"]]$VAL <- 0
config[["secA"]]$ARR <- c(1,2,3,4,5)
config[["secA"]]$DF <- data.frame(matrix(c(1,5,3,8),2,2))
config[["secB"]] <- NULL
config[["secB"]]$VAL <- 1
config[["secB"]]$ARR <- c(1,3,2,4,9)
config[["secB"]]$DF <- data.frame(matrix(c(2,6,1,9),2,2))
config[["secC"]] <- NULL
config[["secC"]]$VAL <- 5
config[["secC"]]$ARR <- c(4,2,1,5,8)
config[["secC"]]$DF <- data.frame(matrix(c(4,2,1,7),2,2))
and I need to obtain 3 vectors VAL, ARR and DF, each with the concatenated elements of the corresponding member. such as
# VAL: 0,1,5
# ARR: 1,2,3,4,5,1,3,2,4,9,4,2,1,5,8
# DF: 1,5,3,8,2,6,1,9,4,2,1,7
Looking at similar situations, I have the feeling I need to use a combination of do.call and cbind or lapply but I have no clue. any suggestions?
config <- NULL
config[["secA"]] <- NULL
config[["secA"]]$VAL <- 0
config[["secA"]]$ARR <- c(1,2,3,4,5)
config[["secA"]]$DF <- data.frame(matrix(c(1,5,3,8),2,2))
config[["secB"]] <- NULL
config[["secB"]]$VAL <- 1
config[["secB"]]$ARR <- c(1,3,2,4,9)
config[["secB"]]$DF <- data.frame(matrix(c(2,6,1,9),2,2))
config[["secC"]] <- NULL
config[["secC"]]$VAL <- 5
config[["secC"]]$ARR <- c(4,2,1,5,8)
config[["secC"]]$DF <- data.frame(matrix(c(4,2,1,7),2,2))
sapply(names(config[[1]]), function(x)
unname(unlist(sapply(config, `[`, x))), USE.NAMES = TRUE)
# $VAL
# [1] 0 1 5
#
# $ARR
# [1] 1 2 3 4 5 1 3 2 4 9 4 2 1 5 8
#
# $DF
# [1] 1 5 3 8 2 6 1 9 4 2 1 7
Or you can use this clist function
Unfortunately there were no other answers.
(l <- Reduce(clist, config))
# $VAL
# [1] 0 1 5
#
# $ARR
# [1] 1 2 3 4 5 1 3 2 4 9 4 2 1 5 8
#
# $DF
# X1 X2 X1 X2 X1 X2
# 1 1 3 2 1 4 1
# 2 5 8 6 9 2 7
It merges data frames and matrices, so you need to unlist to get the vector you want
l$DF <- unname(unlist(l$DF))
l
# $VAL
# [1] 0 1 5
#
# $ARR
# [1] 1 2 3 4 5 1 3 2 4 9 4 2 1 5 8
#
# $DF
# [1] 1 5 3 8 2 6 1 9 4 2 1 7
Function
clist <- function (x, y) {
islist <- function(x) inherits(x, 'list')
'%||%' <- function(a, b) if (!is.null(a)) a else b
get_fun <- function(x, y)
switch(class(x %||% y),
matrix = cbind,
data.frame = function(x, y)
do.call('cbind.data.frame', Filter(Negate(is.null), list(x, y))),
factor = function(...) unlist(list(...)), c)
stopifnot(islist(x), islist(y))
nn <- names(rapply(c(x, y), names, how = 'list'))
if (is.null(nn) || any(!nzchar(nn)))
stop('All non-NULL list elements should have unique names', domain = NA)
nn <- unique(c(names(x), names(y)))
z <- setNames(vector('list', length(nn)), nn)
for (ii in nn)
z[[ii]] <- if (islist(x[[ii]]) && islist(y[[ii]]))
Recall(x[[ii]], y[[ii]]) else
(get_fun(x[[ii]], y[[ii]]))(x[[ii]], y[[ii]])
z
}
Another approach, with slightly less code.
un_config <- unlist(config)
un_configNAM <- names(un_config)
vecNAM <- c("VAL", "ARR", "DF")
for(n in vecNAM){
assign(n, un_config[grepl(n, un_configNAM)])
}
This will return 3 vectors as the OP requested. However, generally it is more advantageous to store results in a list as rawr suggests. You of course can adopt the above code so that results are stored within a list.
l <- rep(list(NA), length(vecNAM))
i = 1
for(n in vecNAM){
l[[i]] <- un_config[grepl(n, un_configNAM)]
i = i +1
}
I am working with a list in R that looks like this
[1] 0 0 4 4 0 4 0
now suppose that I want to generate a list of numbers corresponding to this list like this
[[1]]
[1] 1 1
[[2]]
[1] 2 2
[[3]]
[1] 3 6
[[4]]
[1] 7 10
[[5]]
[1] 11 11
[[6]]
[1] 12 15
[[7]]
[1] 16 16
So in other words, the first list gives the groups of a list of a sequence of numbers from 1 to 16 and the second list gives the start and end of each group.
This is probably easier to see if you consider the sequence
1 2 3-6 7-10 11 12-15 16
Is there an easy way to do this? I think I could do it using some sort of global index and lapply but I wanted to see if there were an easier way.
Here's one way
# alternate input suggested by #MichaelChirico
d = c(0,0,3,3,0,3,0)
# my preferred approach
library(data.table) # version 1.9.5+
Map(c,
seq_along(d)+shift(cumsum(d), type="lag", fill=0),
seq_along(d)+cumsum(d)
)
A similar variation by #akrun:
# alternate input, starting from OP's
d2 = c(0, 0, 4, 4, 0, 4, 0)
d2 = replace( d2, !d2, 1)
# #akrun's answer
Map(c, cumsum(d2)-d2+1, cumsum(d2))
And some more:
# my original answer
start = c(1,head(cumsum(d+1)+1,-1))
Map(c, start, start + d)
# another way
s = sequence(d+1)
Map(c, seq_along(s)[s==1], seq_along(s)[c(diff(s) < 1, TRUE)] )
Here's a slightly different approach:
x <- c(0,0,3,3,0,3,0)
f <- function(x) {
ee <- split(seq_len(sum(x+1)), rep.int(seq_along(x), x+1))
lapply(ee, range)
}
f(x)
Here's a function that'll do it, no way near as elegant as #Frank's answer:
mygenerator <- function(vec){
counter <- 1
outlist <- list()
for(i in 1:length(vec)){
if(vec[i] == 0){
outlist[[i]] <- c(counter, counter)
counter <- counter + 1
} else {
outlist[[i]] <- c(counter, counter + vec[i] - 1)
counter <- counter + vec[i]
}
}
outlist
}
mygenerator(c(0, 0, 4, 4, 0, 4, 0))
[[1]]
[1] 1 1
[[2]]
[1] 2 2
[[3]]
[1] 3 6
[[4]]
[1] 7 10
[[5]]
[1] 11 11
[[6]]
[1] 12 15
[[7]]
[1] 16 16
add <- c( 2,3,4)
for (i in add){
a <- i +3
b <- a + 3
z <- a + b
print(z)
}
# Result
[1] 13
[1] 15
[1] 17
In R, it can print the result, but I want to save the results for further computation in a vector, data frame or list
Thanks in advance
Try something like:
add <- c(2, 3, 4)
z <- rep(0, length(add))
idx = 1
for(i in add) {
a <- i + 3
b <- a + 3
z[idx] <- a + b
idx <- idx + 1
}
print(z)
This is simple algebra, no need in a for loop at all
res <- (add + 3)*2 + 3
res
## [1] 13 15 17
Or if you want a data.frame
data.frame(a = add + 3, b = add + 6, c = (add + 3)*2 + 3)
# a b c
# 1 5 8 13
# 2 6 9 15
# 3 7 10 17
Though in general, when you are trying to something like that, it is better to create a function, for example
myfunc <- function(x) {
a <- x + 3
b <- a + 3
z <- a + b
z
}
myfunc(add)
## [1] 13 15 17
In cases when a loop is actually needed (unlike in your example) and you want to store its results, it is better to use *apply family for such tasks. For example, use lapply if you want a list back
res <- lapply(add, myfunc)
res
# [[1]]
# [1] 13
#
# [[2]]
# [1] 15
#
# [[3]]
# [1] 17
Or use sapply if you want a vector back
res <- sapply(add, myfunc)
res
## [1] 13 15 17
For a data.frame to keep all the info
add <- c( 2,3,4)
results <- data.frame()
for (i in add){
a <- i +3
b <- a + 3
z <- a + b
#print(z)
results <- rbind(results, cbind(a,b,z))
}
results
a b z
1 5 8 13
2 6 9 15
3 7 10 17
If you just want z then use a vector, no need for lists
add <- c( 2,3,4)
results <- vector()
for (i in add){
a <- i +3
b <- a + 3
z <- a + b
#print(z)
results <- c(results, z)
}
results
[1] 13 15 17
It might be instructive to compare these two results with those of #dugar:
> sapply(add, function(x) c(a=x+3, b=a+3, z=a+b) )
[,1] [,2] [,3]
a 5 6 7
b 10 10 10
z 17 17 17
That is the result of lazy evaluation and sometimes trips us up when computing with intermediate values. This next one should give a slightly more expected result:
> sapply(add, function(x) c(a=x+3, b=(x+3)+3, z=(x+3)+((x+3)+3)) )
[,1] [,2] [,3]
a 5 6 7
b 8 9 10
z 13 15 17
Those results are the transpose of #dugar. Using sapply or lapply often saves you the effort off setting up a zeroth case object and then incrementing counters.
> lapply(add, function(x) c(a=x+3, b=(x+3)+3, z=(x+3)+((x+3)+3)) )
[[1]]
a b z
5 8 13
[[2]]
a b z
6 9 15
[[3]]
a b z
7 10 17