I'm learning to use R and I'm trying to extract cont, p0 and pf variables from nested loop as 3 different vectors from this code.
v<-c("a","b","c","d","e","f","g","h")
n<-length(v)
mv<-5
a<-n-(mv-1)
cont<-0
for (num in (a-1):0){
for (i in 0:num){
cont<-cont+1
p0<-v[a-num]
pf<-v[n-i]
}
}
The expected result should be:
> print(cont)
[1] 1 2 3 4 5 6 7 8 9 10
> print (p0)
[1] "a" "a" "a" "a" "b" "b" "b" "c" "c" "d"
> print (pf)
[1] "h" "g" "f" "e" "h" "g" "f" "h" "g" "h"
I would keep cont as an index variable and store the other variables in vectors.
v<-c("a","b","c","d","e","f","g","h")
n<-length(v)
mv<-5
a<-n-(mv-1)
cont = 0
cont_stored = vector();
p0 = vector();
pf = vector();
for (num in (a-1):0){
for (i in 0:num){
cont <- cont+1
cat("cont = ", cont, "\n"); ## useful function for printing stuff out in loops
cont_stored[cont] = cont;
p0[cont] = v[a-num]
pf[cont] = v[n-i]
}
}
cont_stored
p0
pf
You can do this without explicit for loop :
v <- c("a","b","c","d","e","f","g","h")
n <- length(v)
mv <- 5
a <- n-(mv-1)
cont <- 0
p0 <- rep(v[1:a], a:1)
pf <- v[unlist(sapply((n-a + 1):n, function(x) n:x))]
p0
# [1] "a" "a" "a" "a" "b" "b" "b" "c" "c" "d"
pf
# [1] "h" "g" "f" "e" "h" "g" "f" "h" "g" "h"
If you need cont you could use p0 or pf with seq_along.
cont <- seq_along(p0)
cont
#[1] 1 2 3 4 5 6 7 8 9 10
Related
I want to randomize/shuffle a vector. Some of the vector elements are identical. After shuffling, identical elements should have a minimum distance of three (i.e. two other elements should be between identical elements).
Consider the following example vector in R:
x <- rep(LETTERS[1:5], 3) # Create example vector
x
# [1] "A" "B" "C" "D" "E" "A" "B" "C" "D" "E" "A" "B" "C" "D" "E"
If I shuffle my vector using the sample function, some of the identical elements may be too close together. For instance, if I use the following R code, the element "C" appears directly after each other at positions 5 and 6:
set.seed(53135)
sample(x) # sample() function puts same elements too close
# [1] "B" "A" "E" "D" "C" "C" "E" "A" "B" "C" "D" "E" "A" "D" "B"
How could I ensure that identical elements have a minimum distance of three?
So basically we need to conditionally sample one element from the x vector that have not been selected in the min.dist-1 runs. Using purrr's reduce we can achieve this:
min.dist <- 2
reduce(integer(length(x)-1), ~c(.x, sample(x[!x %in% tail(.x, min.dist)], 1)), .init=sample(x,1))
[1] "A" "E" "D" "B" "A" "D" "E" "C" "D" "A" "C" "E" "B" "A" "E"
Bundled in a function
shuffle <- function(x, min.dist=2){
stopifnot(min.dist < length(unique(x)))
reduce(integer(length(x)-1), ~c(.x, sample(x[!x %in% tail(.x, min.dist)], 1)), .init=sample(x,1))
}
> shuffle(x, 3)
[1] "A" "C" "B" "D" "E" "A" "B" "C" "E" "D" "A" "B" "C" "E" "A"
> shuffle(x, 3)
[1] "A" "B" "D" "E" "C" "A" "B" "D" "E" "C" "A" "D" "E" "C" "A"
> shuffle(x, 4)
[1] "C" "E" "D" "A" "B" "C" "E" "D" "A" "B" "C" "E" "D" "A" "B"
> shuffle(x, 4)
[1] "A" "B" "D" "E" "C" "A" "B" "D" "E" "C" "A" "B" "D" "E" "C"
> shuffle(x, 2)
[1] "E" "A" "D" "E" "B" "D" "A" "E" "C" "D" "A" "E" "C" "A" "B"
> shuffle(x, 2)
[1] "B" "A" "D" "C" "B" "A" "E" "B" "A" "E" "B" "C" "D" "A" "E"
after #27ϕ9 comment:
shuffle <- function(x, min.dist=2){
stopifnot(min.dist < length(unique(x)))
reduce(integer(length(x)-1), ~ c(.x, sample(x[!x %in% tail(.x, min.dist) &( x %in% names(t <- table(x[x%in%.x]) > table(.x))[t] | !x %in% .x)], 1)), .init=sample(x,1))
}
> table(shuffle(rep(LETTERS[1:5], 3),2))
A B C D E
3 3 3 3 3
> table(shuffle(rep(LETTERS[1:5], 3),2))
Error in sample.int(length(x), size, replace, prob) :
invalid first argument
UPDATE
After some trial and error, looking at the fact that not always you're gonna have enough elements to space out the min.dist I came up with a solution this code is the most explained from the ones above :
shuffle <- function(x, min.dist=2){
stopifnot(min.dist < length(unique(x)))
reduce(integer(length(x)-1), function(.x, ...){
# whether the value is in the tail of the aggregated vector
in.tail <- x %in% tail(.x, min.dist)
# whether a value still hasn't reached the max frequency
freq.got <- x %in% names(t<-table(x[x%in%.x]) > table(.x))[t]
# whether a value isn't in the aggregated vector
yet <- !x %in% .x
# the if is there basically to account for the cases when we don't have enough vars to space out the vectors
c(.x, if(any((!in.tail & freq.got) | yet )) sample(x[(!in.tail & freq.got) | yet ], 1) else x[which(freq.got)[1]] )
}, .init=sample(x,1))
}
now running the table(shuffle(rep(LETTERS[1:5], 3),2)) will always return 3 for all vars and we can say with some certainty that in the vector the variables are spaced with a minimum distance of 2. the only way to guarantee that no elements are duplicated is by using min.dist=length(unique(x))-1 otherwise there will be instances where at maximum r < min.dist elements are not min.dist distanced from their last occurrences, and if such elements exist they're going to be in the length(x) + 1 - 1:min.dist subset of the resulting vector.
Just to be completely certain using a loop to check whether tail of the output vector has unique values: (remove the print statement I used it just for demonstration purposes)
shuffler <- function(x, min.dist=2){
while(!length(unique(print(tail(l<-shuffle(x, min.dist=min.dist), min.dist+1))))==min.dist+1){}
l
}
table(print(shuffler(rep(LETTERS[1:5], 3),2)))
[1] "A" "B" "C" "E" "B" "C" "D" "A" "C" "D" "A" "E" "B" "D" "E"
A B C D E
3 3 3 3 3
table(print(shuffler(rep(LETTERS[1:5], 3),2)))
[1] "D" "C" "C"
[1] "C" "C" "E"
[1] "C" "A" "C"
[1] "D" "B" "D"
[1] "B" "E" "D"
[1] "C" "A" "E" "D" "A" "B" "C" "E" "A" "B" "D" "C" "B" "E" "D"
A B C D E
3 3 3 3 3
Update:
shuffler <- function(x, min.dist=2){
while(any(unlist(lapply(unique(tl<-tail(l<-shuffle(x, min.dist=min.dist), 2*min.dist)), function(x) diff(which(tl==x))<=min.dist)))){}
l
}
this new version does a rigorous test on whether the elements in the tail of the vector are min.distanced, the previous version works for min.dist=2, however this new version does better testing.
If your data is large, then it may be (way) faster to rely on probability to do that kind of task.
Here's an example:
prob_shuffler = function(x, min.dist = 2){
n = length(x)
res = sample(x)
OK = FALSE
# We loop until we have a solution
while(!OK){
OK = TRUE
for(i in 1:min.dist){
# We check if identical elements are 'i' steps away
pblm = res[1:(n-i)] == res[-(1:i)]
if(any(pblm)){
if(sum(pblm) >= (n - i)/2){
# back to square 1
res = sample(x)
} else {
# we pair each identical element with
# an extra one
extra = sample(which(!pblm), sum(pblm))
id_reshuffle = c(which(pblm), extra)
res[id_reshuffle] = sample(res[id_reshuffle])
}
# We recheck from the beginning
OK = FALSE
break
}
}
}
res
}
Even though the while loop looks scary, in practice convergence is fast. Of course, the lower the probability to have two characters at min.dist away, the faster the convergence.
The current solutions by #Abdessabour Mtk and #Carles Sans Fuentes work but, depending on the size of the input data, quickly become prohibitively slow. Here's a benchmark:
library(microbenchmark)
x = rep(c(letters, LETTERS), 10)
length(x)
#> [1] 520
microbenchmark(prob_shuffler(x, 1), shuffler_am(x, 1), shuffler_csf(x, 1), times = 10)
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> prob_shuffler(x, 1) 87.001 111.501 155.071 131.801 192.401 264.401 10
#> shuffler_am(x, 1) 17218.100 18041.900 20324.301 18740.351 22296.301 26495.200 10
#> shuffler_csf(x, 1) 86771.401 88550.501 118185.581 95582.001 98781.601 341826.701 10
microbenchmark(prob_shuffler(x, 2), shuffler_am(x, 2), shuffler_csf(x, 2), times = 10)
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> prob_shuffler(x, 2) 140.1 195.201 236.3312 245.252 263.202 354.101 10
#> shuffler_am(x, 2) 18886.2 19526.901 22967.6409 21021.151 26758.800 29133.400 10
#> shuffler_csf(x, 2) 86078.1 92209.901 97151.0609 97612.251 99850.101 107981.401 10
microbenchmark(prob_shuffler(x, 3), shuffler_am(x, 3), shuffler_csf(x, 3), times = 10)
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> prob_shuffler(x, 3) 318.001 450.402 631.5312 573.352 782.2 1070.401 10
#> shuffler_am(x, 3) 19003.501 19622.300 23314.4808 20784.551 28281.5 32885.101 10
#> shuffler_csf(x, 3) 87692.701 96152.202 101233.5411 100925.201 108034.7 113814.901 10
We can remark two things: a) in all logic, the speed of prob_shuffler depends on min.dist while the other methods not so much, b) prob_shuffler is about 100-fold faster for just 520 observations (and it scales).
Of course if the probability to have two identical characters at min.dist away is extremely high, then the recursive methods should be faster. But in most practical cases, the probability method is faster.
I hope this answer works fine for you. It is done with base R, but it works. I leave the printing if you want to check line by line:
x <- rep(LETTERS[1:5], 3) # Create example vector
shuffle <- function(x, min_dist=3){
#init variables
result<-c() # result vector
count<-0
vec_use<-x
vec_keep<-c()
for(i in 1:length(x)){
# print(paste0("iteration =", i))
if (count>min_dist){
valback<-vec_keep[1]
# print(paste0("value to be returned:", valback))
ntimes_valback<-(table(vec_keep)[valback])
vec_use<- c(vec_use,rep(valback,ntimes_valback))
# print(paste0("vec_use after giving back valbak =", valback))
# print(paste0(vec_use,","))
vec_keep <- vec_keep[!vec_keep %in% valback]
# print(paste0("vec_keep after removing valback =", valback))
# print(paste0(vec_keep,","))
}
val<-sample(vec_use,1)
# print(paste0("val = ",val))#remove value
vec_keep<- c(vec_keep,x[x %in% val])
vec_keep<-vec_keep[1:(length(vec_keep)-1)]#removing 1 letter
# print(paste0("vec_keep ="))
# print(paste0(vec_keep,","))
vec_use <- vec_use[!vec_use %in% val]
# print(paste0("vec_use ="))
# print(paste0(vec_use,","))
result[i]<-val
count<-count+1
}
return(result)
}
shuffle(x)
"C" "D" "B" "E" "C" "A" "B" "D" "E" "A" "C" "D" "B" "E" "C"
Using the variables alpha and key, encrypt ptext into a variable named ctext. Using substitution cipher
So I have a text file separated in a vector
ptext <- strsplit(ptext,split = "", fixed = TRUE)
ptext <- unlist(ptext)
I also created a key for this cipher
key <- "ZGYHXIWJVKULTMSARBQCPDOENF"
key <- unlist(strsplit(key,""))
and an Alphabet vector for the key
alpha <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
alpha <= toupper(alpha)
alpha <- unlist(strsplit(alpha,""))
Now my goal is to try to replace all the character in the ptext vector corresponding to the letters in the key in relation to alpha (Example: A in alpha in relation to Z in the key. So all A's in the text would be replaced by a Z)
I know I am supposed to match the alpha in key
cipher <- match(key,alpha)
Now my issue is, the ptext file is over 1000 characters in it. How would I be able to replace all the letters in that vector?
You could use chartr which will avoid splitting the string and pasting back.
ptext <- 'REQWDSFFFSLK'
alpha <- 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
key <- 'ZGYHXIWJVKULTMSARBQCPDOENF'
chartr(alpha, key, ptext)
#[1] "BXROHQIIIQLU"
Here, all R is replaced with B, E with X and so on for every character value.
Basically, you need to do what you are doing with the cipher but apply that to each letter of ptext. You can either leave as a vector of single strings or put back together as desired, for example using paste0 below.
set.seed(123)
ptext <- strsplit(LETTERS[sample(26, 100, T)],split = "", fixed = TRUE)
ptext <- unlist(ptext)
key <- "ZGYHXIWJVKULTMSARBQCPDOENF"
key <- unlist(strsplit(key,""))
alpha <- unlist(strsplit(LETTERS,""))
encoded <- sapply(ptext, function(x) key[match(x, alpha)])
encoded
#> O S N C J R V K E T N V Y Z E S Y Y I C
#> "S" "Q" "M" "Y" "K" "B" "D" "U" "X" "C" "M" "D" "N" "F" "X" "Q" "N" "N" "V" "Y"
#> H Z G J I S D N Q K G U L O J M G I I J
#> "J" "F" "W" "K" "V" "Q" "H" "M" "R" "U" "W" "P" "L" "S" "K" "T" "W" "V" "V" "K"
#> W U G U F Y B E H L M R A Y Y F U O I O
#> "O" "P" "W" "P" "I" "N" "G" "X" "J" "L" "T" "B" "Z" "N" "N" "I" "P" "S" "V" "S"
#> Z P T F K H V V G P Q V R Q B D M E V S
#> "F" "A" "C" "I" "U" "J" "D" "D" "W" "A" "R" "D" "B" "R" "G" "H" "T" "X" "D" "Q"
#> Y T V Y N Y W C H P L Y N C N G C W V Z
#> "N" "C" "D" "N" "M" "N" "O" "Y" "J" "A" "L" "N" "M" "Y" "M" "W" "Y" "O" "D" "F"
paste0(encoded, collapse = "")
#> [1] "SQMYKBDUXCMDNFXQNNVYJFWKVQHMRUWPLSKTWVVKOPWPINGXJLTBZNNIPSVSFACIUJDDWARDBRGHTXDQNCDNMNOYJALNMYMWYODF"
My apologies for the somewhat confusing title (any suggestion for improvement are welcome)..
Suppose I have a list which contains several (e.g. four) lists in which I would like to store 20 objects later on:
mylist <- vector(mode="list",length=4)
names(mylist) <- c("One","Two","Three","Four")
mylist$One <- mylist$Two <- mylist$Three <- mylist$Four <- vector(mode="list",
length=20)
I would like to define the names of those objects beforehand. Of course, I can do that as following:
names(mylist$One) <- c("A","B","C","D","E","F","G","H","I","J",
"K","L","M","N","O","P","Q","R","S","T")
names(mylist$Two) <- names(mylist$Three) <- names(mylist$Four) <- names(mylist$One)
But if the number of the lists would increase (as is the case in my actual data), this becomes rather cumbersome, so I was trying to do this with a function such as lapply :
mylist <- lapply(mylist,FUN=function(x) {names(x) <-
c("A","B","C","D","E","F","G","H","I","J",
"K","L","M","N","O","P","Q","R","S","T")})
This, however, does not give me the same result, but I can not seem to figure out what I am overlooking here. Any suggestions?
Thanks!
You need to return a value in your lapply call:
mylist <- lapply(mylist,FUN=function(x) {names(x) <-
c("A","B","C","D","E","F","G","H","I","J",
"K","L","M","N","O","P","Q","R","S","T")
x ## <- note the x here; you could also use return(x)
})
mylist
# $One
# A B C D E F G H I J K L M N O P Q R S T
# "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
#
# $Two
# A B C D E F G H I J K L M N O P Q R S T
# "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
#
# $Three
# A B C D E F G H I J K L M N O P Q R S T
# "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
#
# $Four
# A B C D E F G H I J K L M N O P Q R S T
# "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
This is my implementation, which I think it produces the results you are expecting
mylist <- vector(mode="list",length=4)
names(mylist) <- c("One","Two","Three","Four")
mylist$One <- mylist$Two <- mylist$Three <- mylist$Four <- vector(mode="list",length=20)
renameList <- function(mylist,k){
names(mylist) <- LETTERS[1:k]
return(mylist)
}
mylist2 <- lapply(mylist, function(x) renameList(x,20))
# > str(mylist2)
# List of 4
# $ One :List of 20
# ..$ A: NULL
# ..$ B: NULL
# ..$ C: NULL
I have the following
cells = c(3, 5, 8, 6)
names(cells) = c('A', 'B', 'C', 'D')
I want to randomly choose half the cells, and assign then to a new vector m1, and the other half of the cells will be assigned to m2 = cells - m1. I'm new to R, and the sample function only allows me choose all the cells of one type, instead of an individual cell at a time, so I'm unsure of where to go from here.
My code currently looks like this
y = ceiling(sum(cells)/2)
for(i in 1:y){
z = sample(cells[cells>0], 1, replacement = FALSE, prob = NULL)
if(z == cells[1]){
cells[1] = cells[1] - 1
m1[1] = m1[1] + 1
}
if(z == cells[2]){
cells[2] = cells[2] - 1
m1[2] = m1[2] + 1
}
if(z == cells[3]){
cells[3] = cells[3] - 1
m1[3] = m1[3] + 1
}
if(z == cells[4]){
cells[4] = cells[4] - 1
m1[4] = m1[4] + 1
}
}
I know this is wrong as it only chooses the cell type randomly, instead of choosing each cell randomly. Any help would be appreciated.
Why not define cells = c(rep('A',3),rep('B',5), rep('C',8), rep('D',6)) and then
> cells
[1] "A" "A" "A" "B" "B" "B" "B" "B" "C" "C" "C" "C" "C" "C" "C" "C" "D" "D" "D"
[20] "D" "D" "D"
x <- sample(1:length(cells), ceiling(length(cells)/2))
m1 <- cells[x]
[1] "D" "B" "C" "A" "B" "A" "B" "D" "D" "C" "C"
m2 <- cells[setdiff(1:length(cells), x)]
[1] "A" "B" "B" "C" "C" "C" "C" "C" "D" "D" "D"
Or you could use parameter prob in sample function
x <- sample(letters[1:4], 22, replace = T, prob = c(3,5,8,6))
x
[1] "d" "c" "a" "c" "b" "a" "b" "b" "b" "c" "b" "c" "d" "c" "c" "b" "c" "b" "c" "d" "c" "b"
m1 <- x[1:11]; m2 <- x[12:22]
Instead of sampling from cells directly, sample indexes and use those to choose your elements.
cells = c(3, 5, 8, 6)
categories = c('A', 'B', 'C', 'D')
n = length(cells)
cells_long = unlist(sapply(1:n
, function(i){ rep(categories[i],cells[i]) }
))
n = length(cells_long)
ix = sample(1:n, floor(n/2))
m1 = cells_long[ix]
m2 = cells_long[-ix]
This is a useful trick for sampling from complex objects or collections of related objects as well.
fn <- function(D, e) {
for(i in 1:nrow(D)) {
if(D[i,1] == e) {
print("y")
}
}
}
fn(events, "a")
Problem: events is a 2-by-n matrix. If instead of "a", I want to pass c("a","b","c") in e, then how to check if(D[i,1]==e) condition?
This is simple:
if any((D[i, 1] %in% e))
I would approach it like this:
x <- matrix(sample(letters, 25), ncol = 5)
> x
[,1] [,2] [,3] [,4] [,5]
[1,] "k" "v" "n" "l" "f"
[2,] "w" "c" "y" "r" "i"
[3,] "u" "p" "o" "q" "j"
[4,] "g" "s" "d" "t" "x"
[5,] "a" "z" "b" "h" "m"
e <- c("r", "e", "d")
apply(x, 1, function(x, e) any(x %in% e), e = e)
[1] FALSE TRUE FALSE TRUE FALSE