With the help of people on this site I have a matrix y that looks similar to this (but much more simplified).
1,3
1,3
1,3
7,1
8,2
8,2
I have created a third column that generates random numbers (without replacement for each of the repeating chunks using this code j=cbind(y,sample(1:99999,y[,2],replace=FALSE)).
Matrix j looks like this:
1,3,4520
1,3,7980
1,3,950
7,1,2
8,3,4520
8,3,7980
8,3,950
How do I obtain truly random numbers for my third column such that for each of the repeating rows i.e. 3,then 1, then 2 I get a random number that is not replicated within that repeating part (replace = FALSE)?
Why this happens:
The problem is that sample command structure is:
sample(vector of values, how many?, replace = FALSE or TRUE)
here, "how many?" is supposed to be ONE value. Since you provide the whole of the second column of y, it just picks the first value which is 3 and so it reads as:
set.seed(45) # just for reproducibility
sample(1:99999, 3, replace = F)
And for this seed, the values are:
# [1] 63337 31754 24092
And since there are only 3 values are you're binding it to your matrix with 6 rows, it "recycles" the values (meaning, it repeats the values in the same order). So, you get:
# [,1] [,2] [,3]
# [1,] 1 3 63337
# [2,] 1 3 31754
# [3,] 1 3 24092
# [4,] 7 1 63337
# [5,] 8 2 31754
# [6,] 8 2 24092
See that the values repeat. For the matrix you've shown, I've no idea how the 7,1,2 occurs. As the first value of your matrix in y[,2] = 3.
What you should do instead:
y <- cbind(y, sample(1:99999, nrow(y), replace = FALSE))
This asks sample to generate nrow(y) = 6 (here) values without replacement. This would generate non-identical values of length 6 and that'll be binded to your matrix y.
This should get you what you want:
j <- cbind(y, unlist(sapply(unique(y[,2]), function(n) sample(1:99999, n))))
edit: There was an error in code. Function unique is of course needed.
I can't get this without a loop. Maybe someone else can get more elegant solution. For me the problem is to sample with repetition intra-group and without repetition inter-group
ll <- split(dat, paste(dat$V1,dat$V2,sep=''))
ll.length <- by(dat, paste(dat$V1,dat$V2,sep=''),nrow)
z <- rep(0,nrow(dat))
SET <- seq(1,100) ## we can change 100 by 99999 for example
v =1
for (i in seq_along(ll)){
SET <- SET[is.na(match(z,SET))]
nn <- nrow(ll[[i]])
z[v:(v+nn-1)] <- sample(SET,nn,rep=TRUE)
v <- v+nn
}
z
[1] 35 77 94 100 23 59
Related
In R, I have a 2xn matrix of data containing all integers.
The first column indicates the size of an item. Some of these sizes were due to merging, so the second column indicates the number of items that went into that size (including 1) (calling it 'index'). The sum of the indices indicate how many items were actually in the original data.
I now need to create a new data set that splits any merged sizes back out according to the number in the index, resulting in a 2xn vector (with a new length n according the the total number of indices) and a second column all 1's.
I need this split to happen in two ways.
"Homogeneously" where any merged sizes are assigned to the number of indices as homogeneously as possible. For instance, a size of 6 with index of 3 would now be c(2,2,2). Importantly, all number have to be integers, so it should be something like c(1,2) or c(2,1). It cant be c(1.5,1.5).
"Heterogeneously" where the number of sizes are skewed to assign 1 to all positions in the index except one, which would contain the reminder. For instance, of a size of 6 with index of 3, it would now be c(1,1,4) or any combination of 1, 1, and 4.
Below I am providing some sample data that gives an example of what I have, what I want, and what I have tried.
#Example data that I have
Y.have<-cbind(c(19,1,1,1,1,4,3,1,1,8),c(3,1,1,1,1,2,1,1,1,3))
The data show that three items went into the size of 19 for the first row, one item went into the size one in the second column, and so on. Importantly, in these data there were originally 15 items (i.e. sum(Y.have[,2])), some of which got merged, so the final data will need to be of length 15.
What I want the data to look like is:
####Homogenous separation - split values evenly as possible
#' The value of 19 in row 1 is now a vector of c(6,6,7) (or any combination thereof, i.e. c(6,7,6) is fine) since the position in the second column is a 3
#' Rows 2-5 are unchanged since they have a 1 in the second column
#' The value of 4 in row 6 is now a vecttor of c(2,2) since the position of the second column is a 2
#' Rows 7-9 are unchanged since they have a 1 in the second column
#' The value of 8 in row 10 is now a vector of c(3,3,2) (or any combination thereof) since the position in the second column is a 3
Y.want.hom<-cbind(c(c(6,6,7),1,1,1,1,c(2,2),3,1,1,c(3,3,2)),c(rep(1,times=sum(Y.have[,2]))))
####Heterogenous separation - split values with as many singles as possible,
#' The value of 19 in row 1 is now a vector of c(1,1,17) (or any combination thereof, i.e. c(1,17,1) is fine) since the position in the second column is a 3
#' Rows 2-5 are unchanged since they have a 1 in the second column
#' The value of 4 in row 6 is now a vecttor of c(1,3) since the position of the second column is a 2
#' Rows 7-9 are unchanged since they have a 1 in the second column
#' The value of 8 in row 10 is now a vector of c(1,1,6) (or any combination thereof) since the position in the second column is a 3
Y.want.het<-cbind(c(c(1,1,17),1,1,1,1,c(1,3),3,1,1,c(1,1,6)),c(rep(1,times=sum(Y.have[,2]))))
Note that the positions of the integers in the final data don't matter since they will all have one index case.
I have tried splitting the data (split) according to index case. This creates a list with a length according to the number of unique index values. I then iterated through that positions in that list and divided by the position.
a<-split(Y.have[,1],Y.have[,2]) #Split into a list according to the index
b<-list() #initiate new list
for (i in 1:length(a)){
b[[i]]<-a[[i]]/i #get homogenous values
b[[i]]<-rep(b[i],times=i) #repeat the values based on the number of indicies
}
Y.test<-cbind(unlist(b),rep(1,times=length(unlist(c)))) #create new dataset
This was a terrible approach. First, it will produce decimals. Second, the position in the list does not necessarily equal the index number (i.e. if there was no index of 2, the second position would be the next lowest index, but would divide by 2).
However, it at least allowed me to separate out the data by index, manipulate it, and recombine it to a proper length. I now need help in that middle part - manipulating the data for both homogeneous and heterogenous reassignment. I would prefer base r, but any approach would certainly be fine! Thank you in advance!
Here might be one approach.
Create two functions for homogeneous and heterogeneous splits:
get_hom_ints <- function(M, N) {
vec <- rep(floor(M/N), N)
for (i in seq_len(M - sum(vec))) {
vec[i] <- vec[i] + 1
}
vec
}
get_het_ints <- function(M, N) {
vec <- rep(1, N)
vec[1] <- M - sum(vec) + 1
vec
}
Then use apply to go through each row of the matrix:
het_vec <- unlist(apply(Y.have, 1, function(x) get_het_ints(x[1], x[2])))
unname(cbind(het_vec, rep(1, length(het_vec))))
hom_vec <- unlist(apply(Y.have, 1, function(x) get_hom_ints(x[1], x[2])))
unname(cbind(hom_vec, rep(1, length(het_vec))))
Output
(heterogeneous)
[,1] [,2]
[1,] 17 1
[2,] 1 1
[3,] 1 1
[4,] 1 1
[5,] 1 1
[6,] 1 1
[7,] 1 1
[8,] 3 1
[9,] 1 1
[10,] 3 1
[11,] 1 1
[12,] 1 1
[13,] 6 1
[14,] 1 1
[15,] 1 1
(homogeneous)
[,1] [,2]
[1,] 7 1
[2,] 6 1
[3,] 6 1
[4,] 1 1
[5,] 1 1
[6,] 1 1
[7,] 1 1
[8,] 2 1
[9,] 2 1
[10,] 3 1
[11,] 1 1
[12,] 1 1
[13,] 3 1
[14,] 3 1
[15,] 2 1
library(partitions) is created for this type of requirements check it out.
Apply below logics to your code it should work
ex:
hom <- restrictedparts(19,3) #where 19 is Y.have[,1][1] and 3 is Y.have[,2][1] as per your data
print(hom[,ncol(hom)])
#output : 7 6 6
het <- Reduce(intersect, list(which(hom[2,1:ncol(hom)] %in% 1),which(hom[3,1:ncol(hom)] %in% 1)))
hom[,het]
#output : 17 1 1
One option would be to use integer division (%/%) and modulus (%%). It may not give the exact results you specified ie. 8 and 3 give (2,2,4) rather than (3,3,2), but does generally do what you described.
Y.have<-cbind(c(19,1,1,1,1,4,3,1,1,8),c(3,1,1,1,1,2,1,1,1,3))
homoVec <- c()
for (i in 1:length(Y.have[,1])){
if (Y.have[i,2] == 1) {
a = Y.have[i,1]
homoVec <- append(homoVec, a)
} else {
quantNum <- Y.have[i,1]
indexNum <- Y.have[i,2]
b <- quantNum %/% indexNum
c <- quantNum %% indexNum
a <- c(rep(b, indexNum-1), b + c)
homoVec <- append(homoVec, a)
}
}
homoOut <- data.frame(homoVec, 1)
heteroVec <- c()
for (i in 1:length(Y.have[,1])){
if (Y.have[i,2] == 1) {
a = 1
heteroVec <- append(heteroVec, a)
} else {
quantNum <- Y.have[i,1]
indexNum <- Y.have[i,2]
firstNum <- quantNum - (indexNum - 1)
a <- c(firstNum, rep(1, indexNum - 1))
heteroVec <- append(heteroVec, a)
}
}
heteroOut <- data.frame(heteroVec, 1)
If it is really important to have the math exactly as you described in your example then this should work.
homoVec <- c()
for (i in 1:length(Y.have[,1])){
if (Y.have[i,2] == 1) {
a = Y.have[i,1]
homoVec <- append(homoVec, a)
} else {
quantNum <- Y.have[i,1]
indexNum <- Y.have[i,2]
b <- round(quantNum/indexNum)
roundSum <- b * (indexNum - 1)
c <- quantNum - roundSum
a <- c(rep(b, indexNum-1), c)
homoVec <- append(homoVec, a)
}
}
homoOut <- data.frame(homoVec, 1)
Error message pops up when assigning values in dataframe A to matrix B.
A is a dataframe contains 9000 observations of 3 variables. Data are simulated values of 1000 iterations. Each iteration contains 9 values, i.e. 9 * 1000 = 9000.
V1 is iteration ID, variable name(which not useful for now), V3 is the variable I need.
I create a matrix B to keep values from A[,3]. However, the first value in each iteration will be discarded. Therefore, only 8 values in each iter are kept.
B <- matrix(NA, nrow = 1000, ncol = 8)
for(i in 1:iter){
for(m in 1:8){
B[i,m] <- A[9*(i-1)+m+1,3]
}
}
Then I got the error message. Couldn't figure it out anyways. Any help or suggestions or idea are the most welcome!
So, if I understand well, you basically want to fill the matrix row by row with all values of A[,3] except the first value of each group of 9 values.
Instead of using two for loops, you can go straight by filling directly the matrix with A[,3] when creating the matrix object B. It will fill it column by column, so you just have to transpose the matrix and remove the first column to get your result. The code looks like this:
B <- t(matrix(A$V3, nrow = 9, ncol = 1000))
B <- B[,-1]
Example
We defined a dataframe A with 3 variables and 9000 observations
A = data.frame(V1 = rnorm(9000),
V2 = rnorm(9000),
V3 = rnorm(9000))
> head(A)
V1 V2 V3
1 1.0755625 2.82414180 1.76860717
2 0.3421535 0.85857695 0.05682035
3 1.3747495 -0.01151905 0.90259357
4 1.1589849 0.91009114 0.35132258
5 -0.1107268 1.38244412 0.76163226
6 -1.5551836 1.27199029 -0.56923898
Then we apply the code below to generate B and we can check that B is:
> head(B[,1:5])
[,1] [,2] [,3] [,4] [,5]
[1,] 0.05682035 0.9025936 0.35132258 0.7616323 -0.5692390
[2,] -0.75018285 -0.6160903 -1.43556979 -0.3983150 2.0722279
[3,] 0.97226064 1.5366989 0.06546405 -0.5666010 2.3127568
[4,] -0.66904980 -1.9877136 -0.49963116 0.9217295 -0.6338961
[5,] 0.42339924 -0.6077871 0.16467356 -0.3301223 -0.6031495
[6,] 0.82212429 0.3383385 -0.26872905 1.1513397 -0.2644223
You can notice that first row of B correspond to first values of A WITHOUT the first one. and if we check dimensions of B, you will see:
> dim(B)
[1] 1000 8
I'm working with multiple response questions in a survey, and I have a character column that contains values that look like "1,2,3" and "1,4,5". The participants click all values that apply, and I"m given this result.
What is the best solution to deal with this problem? Should I create new columns that tell me if a value in that list is present or not? Or can I create a column that has a list/vector class?
One can't say what is best without knowing the purpose but storing them as indicator columns, i.e. one 0/1 column per option, would let you perform a regression or tabulate them easily. Here we convert x into a 0/1 matrix m and then consider what fraction of respondents answered yes to each question and we also regress with them in various ways of which two are shown, take various correlations and plots.
We also show a plot based on applying stack from to the list representation so it might be useful to use more than one representation and convert among them.
x <- c("1,2,3", "1,4,5")
m <- t(+outer(1:5, lapply(strsplit(x, ","), as.numeric), Vectorize(`%in%`)))
colMeans(m)
y <- 1:2
lm(y ~ m+0)
lapply(1:5, function(i) glm(m[, i] ~ y, family = binomial()))
cor(m)
cor(t(m))
heatmap(m)
stk <- stack(setNames(lapply(strsplit(x, ","), as.numeric), seq_along(x)))
plot(stk)
Here is a data frame with 4 different possibilities:
library(dst) # encode/decode
DF <- data.frame(x, stringsAsFactors = FALSE)
DF$list <- strsplit(x, ",")
DF <- cbind(DF, m, code = apply(m, 1, decode, base = 2))
DF
## x list 1 2 3 4 5 code
## 1 1,2,3 1, 2, 3 1 1 1 0 0 28
## 2 1,4,5 1, 4, 5 1 0 0 1 1 19
Note that decode converts 0/1 values into a numeric value and encode can be used to reverse that:
t(encode(base = rep(2, 5), c(28, 19)))
## [,1] [,2] [,3] [,4] [,5]
## r 1 1 1 0 0
## 1 0 0 1 1
I have a two column dataframe of number pairs:
ODD <- c(1,1,1,3,3,3,5,7,7,9,9)
EVEN <- c(10,8,2,2,6,4,2,6,8,4,8)
dfPairs <- data.frame(ODD, EVEN)
> dfPairs
ODD EVEN
1 1 10
2 1 8
3 1 2
4 3 2
5 3 6
6 3 4
7 5 2
8 7 6
9 7 8
10 9 4
11 9 8
Each row of this dataframe is a pair of numbers, and I would like to a find the longest possible numerically increasing combination of pairs. Conceptually, this is analogous to making a chain link of number pairs; with the added conditions that 1) links can only be formed using the same number and 2) the final chain must increase numerically. Visually, the program I am looking for will accomplish this:
For instance, row three is pair (1,2), which increases left to right. The next link in the chain would need to have a 2 in the EVEN column and increase right to left, such as row four (3,2). Then the pattern repeats, so the next link would need to have a 3 in the ODD column, and increase left to right, such as rows 5 or 6. The chain doesn't have to start at 1, or end at 9 - this was simply a convenient example.
If you try to make all possible linked pairs, you will find that many unique chains of various lengths are possible. I would like to find the longest possible chain. In my real data, I will likely encounter a situation in which more than one chain tie for the longest, in which case I would like all of these returned.
The final result should return the longest possible chain that meets these requirements as a dataframe, or a list of dataframes if more than one solution is possible, containing only the rows in the chain.
Thanks in advance. This one has been perplexing me all morning.
Edited to deal with df that does not start at 1 and returns maximum chains rather than chain lengths
Take advantage of graph data structure using igraph
Your data, dfPairs
ODD <- c(1,1,1,3,3,3,5,7,7,9,9)
EVEN <- c(10,8,2,2,6,4,2,6,8,4,8)
dfPairs <- data.frame(ODD, EVEN)
New data, dfTest
ODD <- c(3,3,3,5,7,7,9,9)
EVEN <- c(2,6,4,2,6,8,4,8)
dfTest <- data.frame(ODD, EVEN)
Make graph of your data. A key to my solution is to rbind the reverse (rev(dfPairs)) of the data frame to the original data frame. This will allow for building directional edges from odd numbers to even numbers. Graphs can be used to construct directional paths fairly easily.
library(igraph)
library(dplyr)
GPairs <- graph_from_data_frame(dplyr::arrange(rbind(setNames(dfPairs, c("X1", "X2")), setNames(rev(dfPairs), c("X1", "X2"))), X1))
GTest <- graph_from_data_frame(dplyr::arrange(rbind(setNames(dfTest, c("X1", "X2")), setNames(rev(dfTest), c("X1", "X2"))), X1))
Here's the first three elements of all_simple_paths(GPairs, 1) (starting at 1)
[[1]]
+ 2/10 vertices, named, from f8e4f01:
[1] 1 2
[[2]]
+ 3/10 vertices, named, from f8e4f01:
[1] 1 2 3
[[3]]
+ 4/10 vertices, named, from f8e4f01:
[1] 1 2 3 4
I create a function to 1) convert all simple paths to list of numeric vectors, 2) filter each numeric vector for only elements that satisfy left->right increasing, and 3) return the maximum chain of left->right increasing numeric vector
max_chain_only_increasing <- function(gpath) {
list_vec <- lapply(gpath, function(v) as.numeric(names(unclass(v)))) # convert to list of numeric vector
only_increasing <- lapply(list_vec, function(v) v[1:min(which(v >= dplyr::lead(v, default=tail(v, 1))))]) # subset vector for only elements that are left->right increasing
return(unique(only_increasing[lengths(only_increasing) == max(lengths(only_increasing))])) # return maximum chain length
}
This is the output of the above function using all paths that start from 1
max_chain_only_increasing(all_simple_paths(GPairs, 1))
# [[1]]
# [1] 1 2 3 6 7 8 9
Now, I'll output (header) of max chains starting with each unique element in dfPairs, your original data
start_vals <- sort(unique(unlist(dfPairs)))
# [1] 1 2 3 4 5 6 7 8 9 10
max_chains <- sapply(seq_len(length(start_vals)), function(i) max_chain_only_increasing(all_simple_paths(GPairs, i)))
names(max_chains) <- start_vals
# $`1`
# [1] 1 2 3 6 7 8 9
# $`2`
# [1] 2 3 6 7 8 9
# $`3`
# [1] 3 6 7 8 9
# $`4`
# [1] 4 9
# $`5`
# [1] 5
# etc
And finally with dfTest, the newer data
start_vals <- sort(unique(unlist(dfTest)))
max_chains <- sapply(seq_len(length(start_vals)), function(i) max_chain_only_increasing(all_simple_paths(GTest, i)))
names(max_chains) <- start_vals
# $`2`
# [1] 2 3 6 7 8 9
# $`3`
# [1] 3 6 7 8 9
# $`4`
# [1] 4 9
# $`5`
# [1] 5
# $`6`
# [1] 6 7 8 9
In spite of Cpak's efforts I ended up writing my own function to solve this. In essence I realize I could make the right to left chain links left to right by using this section of code from Cpak's answer:
output <- arrange(rbind(setNames(dfPairs, c("X1", "X2")), setNames(rev(dfPairs), c("X1", "X2")))`, X1)
To ensure the resulting chains were sequential, I deleted all decreasing links:
output$increase <- with(output, ifelse(X2>X1, "Greater", "Less"))
output <- filter(output, increase == "Greater")
output <- select(output, -increase)
I realized that if I split the dataframe output by unique values in X1, I could join each of these dataframes sequentially by joining the last column of the first dataframe to the first column of the next dataframe, which would create rows of sequentially increasing chains. The only problem I needed to resolve was the issues of NAs in last column of the mered dataframe. So ended up splitting the joined dataframe after each merge, and then shifted the dataframe to remove the NAs, and rbinded the result back together.
This is the actual code:
out_split <- split(output, output$X1)
df_final <- Reduce(join_shift, out_split)
The function, join_shift, is this:
join_shift <- function(dtf1,dtf2){
abcd <- full_join(dtf1, dtf2, setNames(colnames(dtf2)[1], colnames(dtf1)[ncol(dtf1)]))
abcd[is.na(abcd)]<-0
colnames(abcd)[ncol(abcd)] <- "end"
# print(abcd)
abcd_na <- filter(abcd, end==0)
# print(abcd_na)
abcd <- filter(abcd, end != 0)
abcd_na <- abcd_na[moveme(names(abcd_na), "end first")]
# print(abcd_na)
names(abcd_na) <- names(abcd)
abcd<- rbind(abcd, abcd_na)
z <- length(colnames(abcd))
colnames(abcd)<- c(paste0("X", 1:z))
# print(abcd)
return(abcd)
}
Finally, I found there were a lot of columns that had only zeros in it, so I wrote this to delete them and trim the final dataframe:
df_final_trim = df_final[,colSums(df_final) > 0]
Overall Im happy with this. I imagine it could be a little more elegant, but it works on anything, and it works on some rather huge, and complicated data. This will produce ~ 241,700 solutions from a dataset of 700 pairs.
I also used a moveme function that I found on stackoverflow (see below). I employed it to move NA values around to achieve the shift aspect of the join_shift function.
moveme <- function (invec, movecommand) {
movecommand <- lapply(strsplit(strsplit(movecommand, ";")[[1]],
",|\\s+"), function(x) x[x != ""])
movelist <- lapply(movecommand, function(x) {
Where <- x[which(x %in% c("before", "after", "first",
"last")):length(x)]
ToMove <- setdiff(x, Where)
list(ToMove, Where)
})
myVec <- invec
for (i in seq_along(movelist)) {
temp <- setdiff(myVec, movelist[[i]][[1]])
A <- movelist[[i]][[2]][1]
if (A %in% c("before", "after")) {
ba <- movelist[[i]][[2]][2]
if (A == "before") {
after <- match(ba, temp) - 1
}
else if (A == "after") {
after <- match(ba, temp)
}
}
else if (A == "first") {
after <- 0
}
else if (A == "last") {
after <- length(myVec)
}
myVec <- append(temp, values = movelist[[i]][[1]], after = after)
}
myVec
}
I have Valence Category for word stimuli in my psychology experiment.
1 = Negative, 2 = Neutral, 3 = Positive
I need to sort the thousands of stimuli with a pseudo-randomised condition.
Val_Category cannot have more than 2 of the same valence stimuli in a row i.e. no more than 2x negative stimuli in a row.
for example - 2, 2, 2 = not acceptable
2, 2, 1 = ok
I can't sequence the data i.e. decide the whole experiment will be 1,3,2,3,1,3,2,3,2,2,1 because I'm not allowed to have a pattern.
I tried various packages like dylpr, sample, order, sort and nothing so far solves the problem.
I think there's a thousand ways to do this, none of which are probably very pretty. I wrote a small function that takes care of the ordering. It's a bit hacky, but it appeared to work for what I tried.
To explain what I did, the function works as follows:
Take the vector of valences and samples from it.
If sequences are found that are larger than the desired length, then, (for each such sequence), take the last value of that sequence at places it "somewhere else".
Check if the problem is solved. If so, return the reordered vector. If not, then go back to 2.
# some vector of valences
val <- rep(1:3,each=50)
pseudoRandomize <- function(x, n){
# take an initial sample
out <- sample(val)
# check if the sample is "bad" (containing sequences longer than n)
bad.seq <- any(rle(out)$lengths > n)
# length of the whole sample
l0 <- length(out)
while(bad.seq){
# get lengths of all subsequences
l1 <- rle(out)$lengths
# find the bad ones
ind <- l1 > n
# take the last value of each bad sequence, and...
for(i in cumsum(l1)[ind]){
# take it out of the original sample
tmp <- out[-i]
# pick new position at random
pos <- sample(2:(l0-2),1)
# put the value back into the sample at the new position
out <- c(tmp[1:(pos-1)],out[i],tmp[pos:(l0-1)])
}
# check if bad sequences (still) exist
# if TRUE, then 'while' continues; if FALSE, then it doesn't
bad.seq <- any(rle(out)$lengths > n)
}
# return the reordered sequence
out
}
Example:
The function may be used on a vector with or without names. If the vector was named, then these names will still be present on the pseudo-randomized vector.
# simple unnamed vector
val <- rep(1:3,each=5)
pseudoRandomize(val, 2)
# gives:
# [1] 1 3 2 1 2 3 3 2 1 2 1 3 3 1 2
# when names assigned to the vector
names(val) <- 1:length(val)
pseudoRandomize(val, 2)
# gives (first row shows the names):
# 1 13 9 7 3 11 15 8 10 5 12 14 6 4 2
# 1 3 2 2 1 3 3 2 2 1 3 3 2 1 1
This property can be used for randomizing a whole data frame. To achieve that, the "valence" vector is taken out of the data frame, and names are assigned to it either by row index (1:nrow(dat)) or by row names (rownames(dat)).
# reorder a data.frame using a named vector
dat <- data.frame(val=rep(1:3,each=5), stim=rep(letters[1:5],3))
val <- dat$val
names(val) <- 1:nrow(dat)
new.val <- pseudoRandomize(val, 2)
new.dat <- dat[as.integer(names(new.val)),]
# gives:
# val stim
# 5 1 e
# 2 1 b
# 9 2 d
# 6 2 a
# 3 1 c
# 15 3 e
# ...
I believe this loop will set the Valence Category's appropriately. I've called the valence categories treat.
#Generate example data
s1 = data.frame(id=c(1:10),treat=NA)
#Setting the first two rows
s1[1,"treat"] <- sample(1:3,1)
s1[2,"treat"] <- sample(1:3,1)
#Looping through the remainder of the rows
for (i in 3:length(s1$id))
{
s1[i,"treat"] <- sample(1:3,1)
#Check if the treat value is equal to the previous two values.
if (s1[i,"treat"]==s1[i-1,"treat"] & s1[i-1,"treat"]==s1[i-2,"treat"])
#If so draw one of the values not equal to that value
{
a = 1:3
remove <- s1[i,"treat"]
a=a[!a==remove]
s1[i,"treat"] <- sample(a,1)
}
}
This solution is not particularly elegant. There may be a much faster way to accomplish this by sorting several columns or something.