How to do a simple pattern coding - r

If I want to have the numbers coded like this, could you give me some suggestion about the codes?
1
2 3
6 5 4
7 8 9 10
15 14 13 12 11
...........
Thanks!!

Another base R option
v <- choose((1:5) + 1, 2)
Map(function(x, y) {
ifelse(x %% 2, rev, I)((y - x + 1):y)
}, seq_along(v), v)
gives
[[1]]
[1] 1
[[2]]
[1] 2 3
[[3]]
[1] 6 5 4
[[4]]
[1] 7 8 9 10
[[5]]
[1] 15 14 13 12 11

Here is one option with split
lst1 <- split(1:15, rep(1:5, 1:5))
lst1[c(TRUE, FALSE)] <- lapply(lst1[c(TRUE, FALSE)], rev)
-output
lst1
#$`1`
#[1] 1
#$`2`
#[1] 2 3
#$`3`
#[1] 6 5 4
#$`4`
#[1] 7 8 9 10
#$`5`
#[1] 15 14 13 12 11
Or another option is
m1 <- matrix(NA, 5, 5)
m1[upper.tri(m1, diag = TRUE)] <- 1:15
m1 <- t(m1)
m1[c(TRUE, FALSE),] <- t(apply(m1[c(TRUE, FALSE),], 1,
function(x) c(rev(x[!is.na(x)]), x[is.na(x)])))

Related

how to find where the interval of continuous numbers starts and ends?

I have a vector
vec <- c(2, 3, 5, 6, 7, 8, 16, 19, 22, 23, 24)
The continuous numbers are:
c(2, 3)
c(5, 6, 7, 8)
c(22, 23, 24)
So the first vector starts at 2 and ends at 3;
for the second vector starts at 5 and ends at 8;
for the third vector starts at 22 and ends at 24;
There is a function to identify where the continuous numbers starts and ends?
By using diff to check the differences between each consecutive value, you can find where the difference is not +1.
diff(vec)
## [1] 1 2 1 1 1 8 3 3 1 1
c(1, diff(vec)) != 1
## [1] FALSE FALSE TRUE FALSE FALSE FALSE TRUE TRUE TRUE FALSE FALSE
Then use cumsum to make a group identifier:
cumsum(c(1, diff(vec))!=1)
## [1] 0 0 1 1 1 1 2 3 4 4 4
And use this to split your data up:
split(vec, cumsum(c(1, diff(vec))!=1))
##$`0`
##[1] 2 3
##
##$`1`
##[1] 5 6 7 8
##
##$`2`
##[1] 16
##
##$`3`
##[1] 19
##
##$`4`
##[1] 22 23 24
Which can be Filtered to consecutive values:
Filter(\(x) length(x) > 1, split(vec, cumsum(c(1, diff(vec))!=1)))
##$`0`
##[1] 2 3
##
##$`1`
##[1] 5 6 7 8
##
##$`4`
##[1] 22 23 24
Another one
vec=c( 2 , 3 , 5 , 6 , 7 , 8 , 16 , 19 , 22 , 23 , 24 )
x <- replace(NA, vec, vec)
# [1] NA 2 3 NA 5 6 7 8 NA NA NA NA NA NA NA 16 NA NA 19 NA NA 22 23 24
l <- split(x, with(rle(is.na(x)), rep(seq.int(length(lengths)), lengths)))
# l <- split(x, data.table::rleid(is.na(x))) ## same as above
l <- Filter(Negate(anyNA), l)
l
# $`2`
# [1] 2 3
#
# $`4`
# [1] 5 6 7 8
#
# $`6`
# [1] 16
#
# $`8`
# [1] 19
#
# $`10`
# [1] 22 23 24
If you have a length requirement:
l[lengths(l) > 1]
# $`2`
# [1] 2 3
#
# $`4`
# [1] 5 6 7 8
#
# $`10`
# [1] 22 23 24

I want r to arrange/merge my resamples in vector

I have a vector from 1 to 10 which I divided into blocks of size 2 each and then resample the blocks but I am not happy with the result arrangement in r. the below r code demonstrates my experience:
ts <- 1:10 # generate a number from 1 to 10
bs <- 2 # let block size equals 2
nb <- length(ts) / bs # number of blocks
blk <- split(ts, rep(1:nb, each=bs)) # split the generated numbers into "blk"
res<-sample(blk, replace=T, 20) # resample the blk 20 times with replacement
res # gives me the below result
#$`5`
#[1] 9 10
#$`5`
#[1] 9 10
#$`5`
#[1] 9 10
#$`3`
#[1] 5 6
#$`1`
#[1] 1 2
#$`2`
#[1] 3 4
#$`5`
#[1] 9 10
#$`1`
#[1] 1 2
#$`1`
#[1] 1 2
#$`1`
#[1] 1 2
#$`4`
#[1] 7 8
#$`4`
#[1] 7 8
#$`4`
#[1] 7 8
#$`4`
#[1] 7 8
#$`4`
#[1] 7 8
#$`3`
#[1] 5 6
#$`2`
#[1] 3 4
#$`1`
#[1] 1 2
#$`1`
#[1] 1 2
#$`1`
#[1] 1 2
I rather want the result like:
(9,10,9,10,9,10,5,6,1,2,3,4,9,10,1,2,1,2,1,2,7,8,7,8,7,8,7,8,7,8,5,6,3,4,1,2,1,2,1,2)
such that I can call "res" as a univariate and I should be able to write the result into either one line or one column .csv file like this:
write.csv(res, "resamples.csv")
You can use unlist() to flatten the list structure. You can also remove the auto-generated names if you don't want/need them:
ts <- 1:10 # generate a number from 1 to 10
bs <- 2 # let block size equals 2
nb <- length(ts) / bs # number of blocks
blk <- split(ts, rep(1:nb, each=bs)) # split the generated numbers into "blk"
res<-unlist(sample(blk, replace=TRUE, 20)) # resample the blk 20 times with replacement
names(res) <- NULL # optional
res
#> [1] 3 4 9 10 1 2 7 8 3 4 3 4 7 8 5 6 7 8 3 4 1 2 3
#> [24] 4 9 10 5 6 7 8 9 10 9 10 5 6 9 10 1 2
Created on 2019-09-23 by the reprex package (v0.3.0)

Split dataframe into a list with vectors of unequal lengths

Suppose I have a dataframe with 10 rows and 5 columns like this
df <- data.frame(matrix(rep(1:10, 5), ncol=5))
I want to split the dataframe into a list with 5 vectors of unequal length, where first vector begins with the first row of column one, second vector begins with the second row of column two, and so on. I will provide the index where each of the vectors shall end. For example, if this index vector is c(3, 5, 4, 8, 10) then I expect the list to be list(1:3, 2:5, 3:4, 4:8, 5:10). Thanks!
Map(function(x, a, b) x[a:b], df, seq_along(df), c(3, 5, 4, 8, 10))
# $X1
# [1] 1 2 3
# $X2
# [1] 2 3 4 5
# $X3
# [1] 3 4
# $X4
# [1] 4 5 6 7 8
# $X5
# [1] 5 6 7 8 9 10
An option is imap which by default have sequence as the .y when the vector of list is unnamed
library(purrr)
imap(v1, ~ .y:.x)
#[[1]]
#[1] 1 2 3
#[[2]]
#[1] 2 3 4 5
#[[3]]
#[1] 3 4
#[[4]]
#[1] 4 5 6 7 8
#[[5]]
#[1] 5 6 7 8 9 10
data
v1 <- c(3, 5, 4, 8, 10)
x = c(3, 5, 4, 8, 10)
lapply(seq_along(x), function(i) df[cbind(i:x[i], i)])
#[[1]]
#[1] 1 2 3
#[[2]]
#[1] 2 3 4 5
#[[3]]
#[1] 3 4
#[[4]]
#[1] 4 5 6 7 8
#[[5]]
#[1] 5 6 7 8 9 10
OR
x = c(3, 5, 4, 8, 10)
i = rep(seq_along(x), x - seq_along(x) + 1)
split(df[cbind(i + sequence(rle(i)$lengths) - 1, i)], names(df)[i])
#$X1
#[1] 1 2 3
#$X2
#[1] 2 3 4 5
#$X3
#[1] 3 4
#$X4
#[1] 4 5 6 7 8
#$X5
#[1] 5 6 7 8 9 10

Adding a vector to components of a list

I have the following list:
A <- c(11)
B <- c(7, 13)
C <- c(1, 10, 11, 12)
my_list <- list(A, B, C)
> my_list
[[1]]
[1] 11
[[2]]
[1] 7 13
[[3]]
[1] 1 10 11 12
I would like to add -2, -1, 0, 1, and 2 to each number in this list, and retain all of the unique values within each list element, to obtain the following resulting list:
> my_new_list
[[1]]
[1] 9 10 11 12 13
[[2]]
[1] 5 6 7 8 9 11 12 13 14 15
[[3]]
[1] -1 0 1 2 3 8 9 10 11 12 13 14
I tried the following code, but I did not get the result I was hoping for:
my_new_list <- lapply(res, `+`, -2:2)
> my_new_list
$`1`
[1] 9 10 11 12 13
$`2`
[1] 5 12 7 14 9
$`3`
[1] -1 9 11 13 3
Why is this happening, and how can I obtain the result I'd like? Thanks!
Assuming that we need the unique values
lapply(my_list, function(x) sort(unique(unlist(lapply(x, `+`, -2:2)))))
Or with outer
lapply(my_list, function(x) sort(unique(c(outer(x, -2:2, `+`)))))
Or with rep and recyling
lapply(my_list, function(x) sort(unique(rep(-2:2, each = length(x)) + x)))
#[[1]]
# [1] 9 10 11 12 13
#[[2]]
# [1] 5 6 7 8 9 11 12 13 14 15
#[[3]]
# [1] -1 0 1 2 3 8 9 10 11 12 13 14
How about this:
my_new_list <- lapply(my_list, function(x) unique(union(x,sapply(x, function(y) y +c(-2:2)) )))
my_new_list <- lapply(my_new_list, sort)
my_new_list
[[1]]
[1] 9 10 11 12 13
[[2]]
[1] 5 6 7 8 9 11 12 13 14 15
[[3]]
[1] -1 0 1 2 3 8 9 10 11 12 13 14

Filter different values in each list using vectorized functions

I have a list:
> list
[[1]]
[1] 5 3 7 9 3 8 3 4 5 7
[[2]]
[1] 2 8 7 8 7 9 6 3 1 4
[[3]]
[1] 7 2 1 7 9 8 9 8 8 2
[[4]]
[1] 5 2 2 1 8 8 2 1 10 7
And now I have a list of elements that I want to filter.
> filtering
[[1]]
[1] 11 10 12
[[2]]
[1] 7 3 9
[[3]]
[1] 3 7 8
[[4]]
[1] 2 6 9
I want to filter, without using any looping, list[[1]] with elements in filtering[[1]], then elements from list[[2]] with elements in filtering[[2]], etc...
Something like this (but mapply is still a loop):
# example data
mylist <- list(1:5, 11:15)
myfilter <- list(c(2,4), c(12, 13))
mapply(FUN = function(x, y){ x[ x %in% y] }, mylist, myfilter, SIMPLIFY = FALSE)
# [[1]]
# [1] 2 4
#
# [[2]]
# [1] 12 13
Or as suggested in the comments by #akrun, using purrr package:
library(purrr)
map2(mylist, myfilter, ~ .x[.x %in% .y])

Resources