generate permutation from partition of numeric - r

i will generate permutations of a partitions.
i generate partitions with this code:
library(partitions)
x <- c(2,4,6)
parts <- listParts(length(x))
out <- rapply(parts, function(ii) x[ii], how="replace")
and generate
out
[[1]]
[1] (2,4,6)
[[2]]
[1] (2,6)(4)
[[3]]
[1] (2,4)(6)
[[4]]
[1] (4,6)(2)
[[5]]
[1] (2)(4)(6)
take a element for example [1](2)(4)(6) i would generate all possible permutations. I tried with:
library(combinat)
permn(x)
but the return element is not in the same form of input,for example with element
[1](21,33,41,40,39,3,6)(13,37) return:
[[1]]
[[1]]$`1`
[1] 21 33 41 40 39 3 6
[[1]]$`2`
[1] 13 37
[[2]]
[[2]]$`2`
[1] 13 37
[[2]]$`1`
[1] 21 33 41 40 39 3 6
i do similar question some week ago, but the solution that was given to when generate partitions generate permutations for all possible partitions, but for problem of
efficiency i can't use it.
the solution this was it:
library(partitions)
permListParts <- function (x)
{
f <- function(pp) {
out <- split(seq_along(pp), pp)
myPerms <- perms(length(out))
apply(myPerms, 2, function(x) {
temp <- out[x]
class(temp) <- c(class(temp), "equivalence")
temp
})
}
apply(setparts(x), 2, f)}

Related

Random Numbers Are Too Similar To Each Other?

I am using this code that generates 3 random numbers that add to 72:
# https://stackoverflow.com/questions/24845909/generate-n-random-integers-that-sum-to-m-in-r
rand_vect <- function(N, M, sd = 1, pos.only = TRUE) {
vec <- rnorm(N, M/N, sd)
if (abs(sum(vec)) < 0.01) vec <- vec + 1
vec <- round(vec / sum(vec) * M)
deviation <- M - sum(vec)
for (. in seq_len(abs(deviation))) {
vec[i] <- vec[i <- sample(N, 1)] + sign(deviation)
}
if (pos.only) while (any(vec < 0)) {
negs <- vec < 0
pos <- vec > 0
vec[negs][i] <- vec[negs][i <- sample(sum(negs), 1)] + 1
vec[pos][i] <- vec[pos ][i <- sample(sum(pos ), 1)] - 1
}
vec
}
If I run this code 100 times:
results <- list()
for (i in 1:100)
{
r_i = rand_vect(3,72)
results[[i]] <- r_i
}
When I look at the numbers that came out:
[[1]]
[1] 23 24 25
[[2]]
[1] 25 24 23
[[3]]
[1] 24 25 23
[[4]]
[1] 23 24 25
[[5]]
[1] 25 24 23
[[6]]
[1] 24 24 24
[[7]]
[1] 24 25 23
[[8]]
[1] 24 25 23
[[9]]
[1] 24 25 23
[[10]]
[1] 24 23 25
In each iteration, all the numbers add to 72 as expected - but the numbers don't really "look that random". They all seem to be "clumped" around "24, 23, 25". I was hoping to see more "randomness" in these numbers. For example:
[[11]]
[1] 5 50 17
[[12]]
[1] 12 40 20
Why are the numbers in the code I am using "clumped" around 24, 23, 25 - and how can I change the above code so that there is more "randomness" in the numbers being generated?
Thank you!
If you just want three random integers that sum to 72 you could do something like
diff(c(0, sort(sample(72, 2)), 72))

sample sequence of successive integer of an interval

I have a question about sampling: I would like to sample successive number in a vector without replacement. Is there a simple way to do so?
For example,
sample(c(1:100), 10, replace = F)
76 99 94 53 12 34 5 82 75 30
gives me 10 number between 1 and 100. Now I would like to have 10 sequence of 3 successive integer without replacement: c(2,3,4), c(10,11,12), c(82,83,84) etc.
The different sequences can't overlap, that is if c(2,3,4) is my first sampling, then none of the following one can have these numbers.
I would even look for the possibility of sampling 10 sequences of different sizes, the sizes given by a vector like
sizevec <- sample(c(1:4),10,replace = T)
Thanks for the help
set.seed(42)
lapply(sample(1:10, 1) + cumsum(sample(4:10, 10, TRUE)), function(x) x + 1:3)
# [[1]]
# [1] 21 22 23
# [[2]]
# [1] 27 28 29
# [[3]]
# [1] 36 37 38
# [[4]]
# [1] 44 45 46
# [[5]]
# [1] 51 52 53
# [[6]]
# [1] 60 61 62
# [[7]]
# [1] 64 65 66
# [[8]]
# [1] 72 73 74
# [[9]]
# [1] 80 81 82
# [[10]]
# [1] 87 88 89
A solution using tow while loop to take samples. After running the code, x is a list of desired output.
# Set seed for reproduciblility
set.seed(123)
# Create a list to store values
x <- list()
# Create a vector to store values in x
y <- integer()
# Set the threshold to stop
threshold <- 4
# Set the condition
condition <- TRUE
while (length(x) < threshold){
while (condition){
# Sample a number between 1 to 98
s <- sample(c(1:98), 1)
# Create a sequence
se <- s:(s + 2)
# Check if the values in se is in y, save it to the condition
condition <- any(se %in% y)
}
# Save se to the list
x[[length(x) + 1]] <- se
# Update y
y <- unlist(x)
# Reset the condition
condition <- TRUE
}
# View the results
x
# [[1]]
# [1] 29 30 31
#
# [[2]]
# [1] 79 80 81
#
# [[3]]
# [1] 41 42 43
#
# [[4]]
# [1] 89 90 91
HI you are unclear if the vectors may overlap or not. assuming the may overlap this should work
lapply(sample(c(1:97), 10, replace = F),function(i){ 0:2 + i})
having a random length would then look like this
lapply(sample(c(1:97), 10, replace = F),function(i){ 0:sample(1:10,1) + i})

Calculate in deeper list levels R

Imagine, I have list of two levels:
lll <- list()
lll[[1]] <- list(1:10, 1:5, 1:2)
lll[[2]] <- list(10:20, 20:30)
lll
[[1]]
[[1]][[1]]
[1] 1 2 3 4 5 6 7 8 9 10
[[1]][[2]]
[1] 1 2 3 4 5
[[1]][[3]]
[1] 1 2
[[2]]
[[2]][[1]]
[1] 10 11 12 13 14 15 16 17 18 19 20
[[2]][[2]]
[1] 20 21 22 23 24 25 26 27 28 29 30
I want calculate means of these sequences. I have written a little function, which works fine:
func <- function(list.list){
lapply(1:length(list.list), function(i) mean(list.list[[i]]))
}
lapply(lll, func)
I don't like in this function, that I have to use anonymous function.
It gets even more complicated when I have list of 3 levels.
Maybe you know better ways to make calculations in which anonymous function would not be included? Should I use higher-order functions (Map, Reduce)?
I know how to write for cycle, but in this case it isn't an option.
Here's a possible solution (using rapply = recursive apply) working at any level of depth :
lll <- list()
lll[[1]] <- list(1:10, 1:5, 1:2)
lll[[2]] <- list(10:20, 20:30)
res <- rapply(lll,mean,how='replace')
> res
[[1]]
[[1]][[1]]
[1] 5.5
[[1]][[2]]
[1] 3
[[1]][[3]]
[1] 1.5
[[2]]
[[2]][[1]]
[1] 15
[[2]][[2]]
[1] 25
Setting argument how='unlist' you will get :
res <- rapply(lll,mean,how='replace')
> res
[1] 5.5 3.0 1.5 15.0 25.0

Percentile in list

I have the following list (h):
> h
[[1]]
[1] 0.9613971
[[2]]
[1] 0.9705882
[[3]]
[1] 0.9503676
[[4]]
[1] 0.9632353
[[5]]
[1] 0.9779412
[[6]]
[1] 0.9852941
[[7]]
[1] 0.9852941
[[8]]
[1] 0.9816176
I would like to add a new column that will calculate the percentile of each number in the list.
I tried to use the following and I get errors:
perc.rank <- function(x, xo) length(x[x <= xo])/length(x)*100
perc.rank <- function(x) trunc(rank(x))/length(x)
trunc(rank(h))/length(h)
In addition, I would to know given a number such as 0.9503676 (the third number) or its number (3) how can I know what is his percentile?
You can do this more efficiently by first converting your list into a vector as follows:
h <- unlist(h)
Next, create a function to find the percentile, which you can easily do by creating an empirical cdf function for your list as follow:
perc.rank <- ecdf(h)
To find the percentile for any number, example the third number, do the following:
perc.rank(0.9503676)
This will work even if the number isn't in your list. eg. perc.rank(0.91) should give you the percentile for 0.91 and you can also pass multiple numbers to the function like perc.rank(c(0.950,0.913,0.6))
Converting to dataframe will make things easier. Here is one solution
library(dplyr)
df<-data.frame(x=rnorm(10))
df%>%mutate(percrank=rank(x)/length(x)*100)
x percrank
1 1.56254900 100
2 -0.52554968 10
3 0.16410991 70
4 0.95150575 80
5 0.01960002 60
6 -0.22860395 30
7 1.43025012 90
8 -0.15836126 40
9 -0.01150753 50
10 -0.39064474 20
This adds two list elements to the current list h.
The second list element is the percentile as you have it.
The third list element is an ordinal rank number.
h <- list(.9613971, .9705882, .9503676, .9632353, .9779412, .9852941, .9852941, .9816176)
# create percentiles
rnk1 <- rank(unlist(h)) / length(h)
# ordinal rank
rnk2 <- rank(unlist(rnk1))
# combine the original lists with the two additional elements
res <- mapply(c, h, rnk1, rnk2, SIMPLIFY=FALSE)
res
[[1]]
[1] 0.9613971 0.2500000 2.0000000
[[2]]
[1] 0.9705882 0.5000000 4.0000000
[[3]]
[1] 0.9503676 0.1250000 1.0000000
[[4]]
[1] 0.9632353 0.3750000 3.0000000
[[5]]
[1] 0.9779412 0.6250000 5.0000000
[[6]]
[1] 0.9852941 0.9375000 7.5000000
[[7]]
[1] 0.9852941 0.9375000 7.5000000
[[8]]
[1] 0.9816176 0.7500000 6.0000000
Lookup function by ordinal rank
perc.rank <- function(x, xo) {
x[[match(xo, sapply(x, "[[", 1))]]
}
perc.rank(res, .9779412)
[1] 0.9779412 0.6250000 5.0000000
Which shows that .9779412 is ranked number 5

Fail to add elements in a list

I want to create the following list
myList[[1]][1] 10
myList[[1]][2] 20
myList[[1]][3] 30 40
So I write the following code but it seems that I am doing it wrong:
myList <- vector(mode = "list")
myList[[length(myList)+1]] <- 10
# myList[[length(myList)+1]][1] <- 10 # it seems more reasonable, but it does not work either
myList[[length(myList)]][2] <- 20
myList[[length(myList)]][3] <- c(30, 40)
print(myList)
Should the third element myList[[1]][3] be a list too ?
You cannot create this list:
myList[[1]][1] 10
myList[[1]][2] 20
myList[[1]][3] 30 40
This would imply that myList[[1]] would be equal to:
[1] 10
[2] 20
[3] 30 40
Which is not an acceptable variable in R, since you are implying that element 3 of the vector is a vector itself.
However, this is:
[[1]]
[1] 10
[[2]]
[1] 20
[[3]]
[1] 30 40
So you can do:
myList = list()
myList = c(myList, 10)
myList = c(myList, 20)
myList = c(myList, list(c(30, 40)))
Which results in
> myList
[[1]]
[1] 10
[[2]]
[1] 20
[[3]]
[1] 30 40

Resources