R - Controlling interaction order in model matrix - r

I would like to control the order of interaction dummy codes in a design matrix, separately from the order of main effects dummy codes. Specifically the order in which the terms that make the interaction are cycled through.
For example:
df <- expand.grid(X1 = letters[1:3],
X2 = LETTERS[24:26])
When writing the formula as ~X1+X2+X1:X2, the interaction design cycles through X2 and then through X1.
model.matrix(~X1+X2+X1:X2, df)
#> (Intercept) X1b X1c X2Y X2Z X1b:X2Y X1c:X2Y X1b:X2Z X1c:X2Z
#> 1 1 0 0 0 0 0 0 0 0
#> 2 1 1 0 0 0 0 0 0 0
#> 3 1 0 1 0 0 0 0 0 0
#> 4 1 0 0 1 0 0 0 0 0
#> 5 1 1 0 1 0 1 0 0 0
#> 6 1 0 1 1 0 0 1 0 0
#> 7 1 0 0 0 1 0 0 0 0
#> 8 1 1 0 0 1 0 0 1 0
#> 9 1 0 1 0 1 0 0 0 1
#> attr(,"assign")
#> [1] 0 1 1 2 2 3 3 3 3
#> attr(,"contrasts")
#> attr(,"contrasts")$X1
#> [1] "contr.treatment"
#>
#> attr(,"contrasts")$X2
#> [1] "contr.treatment"
When I flip the interaction term in the formula to ~X1+X2+X2:X1, the interaction design still cycles first through X2 and then through X1.
model.matrix(~X1+X2+X2:X1, df)
#> (Intercept) X1b X1c X2Y X2Z X1b:X2Y X1c:X2Y X1b:X2Z X1c:X2Z
#> 1 1 0 0 0 0 0 0 0 0
#> 2 1 1 0 0 0 0 0 0 0
#> 3 1 0 1 0 0 0 0 0 0
#> 4 1 0 0 1 0 0 0 0 0
#> 5 1 1 0 1 0 1 0 0 0
#> 6 1 0 1 1 0 0 1 0 0
#> 7 1 0 0 0 1 0 0 0 0
#> 8 1 1 0 0 1 0 0 1 0
#> 9 1 0 1 0 1 0 0 0 1
#> attr(,"assign")
#> [1] 0 1 1 2 2 3 3 3 3
#> attr(,"contrasts")
#> attr(,"contrasts")$X1
#> [1] "contr.treatment"
#>
#> attr(,"contrasts")$X2
#> [1] "contr.treatment"
What I would like end up with is the following design matrix:
#> (Intercept) X1b X1c X2Y X2Z X1b:X2Y X1b:X2Z X1c:X2Y X1c:X2Z
#> 1 1 0 0 0 0 0 0 0 0
#> 2 1 1 0 0 0 0 0 0 0
#> 3 1 0 1 0 0 0 0 0 0
#> 4 1 0 0 1 0 0 0 0 0
#> 5 1 1 0 1 0 1 0 0 0
#> 6 1 0 1 1 0 0 0 1 0
#> 7 1 0 0 0 1 0 0 0 0
#> 8 1 1 0 0 1 0 1 0 0
#> 9 1 0 1 0 1 0 0 0 1
Thanks!

Related

Add a new column generated from predict() to a list of dataframes

I have a logistic regression model. I would like to predict the morphology of items in multiple dataframes that have been put into a list.
I have lots of dataframes (most say working with a list of dataframes is better).
I need help with 1:
Applying the predict function to a list of dataframes.
Adding these predictions to their corresponding dataframe inside the list.
I am not sure whether it is better to have the 1000 dataframes separately and predict using loops etc, or to continue having them inside a list.
Prior to this code I have split my data into train and test sets. I then trained the model using:
library(nnet)
#Training the multinomial model
multinom_model <- multinom(Morphology ~ ., data=morph, maxit=500)
#Checking the model
summary(multinom_model)
This was then followed by validation etc.
My new dataset, consisting of multiple dataframes stored in a list, called rose.list was formatted by the following:
filesrose <- list.files(pattern = "_rose.csv")
#Rename all files of rose dataset 'rose.i'
for (i in seq_along(filesrose)) {
assign(paste("rose", i, sep = "."), read.csv(filesrose[i]))
}
#Make a list of the dataframes
rose.list <- lapply(ls(pattern="rose."), function(x) get(x))
I have been using this function to predict on a singular new dataframe
# Predicting the classification for individual datasets
rose.1$Morph <- predict(multinom_model, newdata=rose.1, "class")
Which gives me the dataframe, with the new prediction column 'Morph'
But how would I do this for multiple dataframes in my rose.list? I have tried:
lapply(rose.list, predict(multinom_model, "class"))
Error in eval(predvars, data, env) : object 'Area' not found
and, but also has the error:
lapply(rose.list, predict(multinom_model, newdata = rose.list, "class"))
Error in (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, :
arguments imply differing number of rows:
You can use an anonymous function (those with function(x) or abbreviated \(x)).
library(nnet)
multinom_model <- multinom(low ~ ., birthwt)
lapply(df_list, \(x) predict(multinom_model, newdata=x, type='class'))
# $rose_1
# [1] 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0
# [40] 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1
# [79] 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0
# [118] 1 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1
# [157] 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1
# Levels: 0 1
#
# $rose_2
# [1] 0 1 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1
# [40] 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1
# [79] 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0
# [118] 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0
# [157] 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0
# Levels: 0 1
#
# $rose_3
# [1] 0 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1
# [40] 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 0 1 1
# [79] 0 1 1 0 1 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1
# [118] 0 0 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0
# [157] 0 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0
# Levels: 0 1
update
To add the predictions as new column to each data frame in the list, modify the code like so:
res <- lapply(df_list, \(x) cbind(x, pred=predict(multinom_model, newdata=x, type="class")))
lapply(res, head)
# $rose_1
# low age lwt race smoke ptl ht ui ftv bwt pred
# 136 0 24 115 1 0 0 0 0 2 3090 0
# 154 0 26 133 3 1 2 0 0 0 3260 0
# 34 1 19 112 1 1 0 0 1 0 2084 1
# 166 0 16 112 2 0 0 0 0 0 3374 0
# 27 1 20 150 1 1 0 0 0 2 1928 1
# 218 0 26 160 3 0 0 0 0 0 4054 0
#
# $rose_2
# low age lwt race smoke ptl ht ui ftv bwt pred
# 167 0 16 135 1 1 0 0 0 0 3374 0
# 26 1 25 92 1 1 0 0 0 0 1928 1
# 149 0 23 119 3 0 0 0 0 2 3232 0
# 98 0 22 95 3 0 0 1 0 0 2751 0
# 222 0 31 120 1 0 0 0 0 2 4167 0
# 220 0 22 129 1 0 0 0 0 0 4111 0
#
# $rose_3
# low age lwt race smoke ptl ht ui ftv bwt pred
# 183 0 36 175 1 0 0 0 0 0 3600 0
# 86 0 33 155 3 0 0 0 0 3 2551 0
# 51 1 20 121 1 1 1 0 1 0 2296 1
# 17 1 23 97 3 0 0 0 1 1 1588 1
# 78 1 14 101 3 1 1 0 0 0 2466 1
# 167 0 16 135 1 1 0 0 0 0 3374 0
Data:
data('birthwt', package='MASS')
set.seed(42)
df_list <- replicate(3, birthwt[sample(nrow(birthwt), replace=TRUE), ], simplify=FALSE) |>
setNames(paste0('rose_', 1:3))

Write a for loop to create 5 randomly generated dataframes of length 100,200,500,800, and 1000, and print each of the dataframes

I've been trying to work through this small R prompt, but can't figure out what I'm doing wrong. I haven't used R in a few years, so I'm trying to get back into the flow of things. Here's my code:
y <- 5
loopValues <- c(100,200,500,800,1000)
dataframesq3 <- vector("list", y)
for (i in 1:y) {
for (j in loopValues){
dataframesq3[[i]] <- data.frame(replicate(10,sample(0:1,j,rep=TRUE)))
}
}
print(dataframesq3)
Currently, I get 5 data frames with 10 columns each and 1000 rows each instead of one of reach of the 5 above links.
You can just refer to the index of loopValues with i and use a single loop:
y <- 5
loopValues <- c(100,200,500,800,1000)
dataframesq3 <- vector("list", y)
for (i in 1:y) {
dataframesq3[[i]] <- data.frame(replicate(10,sample(0:1,loopValues[i],rep=TRUE)))
}
print(dataframesq3)
Here's an approach without a loop:
loopValues <- c(100,200,500,800,1000)
dataframesq3 <- lapply(loopValues, function(x) data.frame(replicate(10, rbinom(x, 1, .5))))
Since the probabilities for 0 and 1 across columns are equal, you could create m*n matrices.
n <- 10
loopValues <- c(100, 200, 500, 800, 1000)
set.seed(42)
r <- lapply(loopValues, \(m) data.frame(matrix(sample(0:1, m*n, replace=TRUE), m, n)))
stopifnot(all.equal(r, dataframesq3)) ## refers to #lhs's solution
Or, since you want a for loop:
r <- vector("list", y)
set.seed(42)
for (i in seq_along(loopValues)) {
r[[i]] <- data.frame(matrix(sample(0:1, loopValues[i]*n, replace=TRUE), loopValues[i], n))
}
stopifnot(all.equal(r, dataframesq3))
The problem with the code is in the inner loop :
for (j in loopValues){
dataframesq3[[i]] <- data.frame(replicate(10,sample(0:1,j,rep=TRUE)))
}
which makes 5 data.frames with sizes (100,10) , (200,10) , (500,10) , (800,10) , (1000,10) in each iteration but Unfortunately it binds the results to the same name "dataframesq3[['1]] for example" but returns the the last one with size (1000,10).
so we have here 25 data.frames 5 in each iteration
but the last one in each iteration binds to our list .
with respect to limey comment it not about lazy evaluation which appears in another situations
and heres another approach using for loop :
y <- 5
dataframesq3 <- vector("list", y)
loopValues <- c(100, 200, 500, 800, 1000)
j <- 1L
for (i in loopValues) {
dataframesq3[[j]] <-
data.frame(replicate(10, sample(0:1, i, rep = TRUE)))
j <- j + 1
}
print(dataframesq3)
#> [[1]]
#> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
#> 1 0 1 1 1 1 0 1 0 0 1
#> 2 0 1 0 1 0 0 1 1 1 0
#> 3 0 0 0 1 1 0 0 0 1 1
#> 4 0 0 0 1 0 0 0 1 0 1
#> 5 1 1 0 0 1 0 1 1 0 0
#> 6 1 1 0 0 0 0 1 0 0 0
#> 7 0 1 1 1 0 0 0 0 1 1
#> 8 1 1 1 0 0 0 1 1 0 1
#> 9 1 1 0 0 0 1 0 0 0 1
#> 10 0 1 1 0 0 1 1 0 0 1
#> 11 0 1 0 0 1 1 1 1 1 1
#> 12 0 1 1 0 0 1 1 0 1 1
#> 13 0 0 0 0 1 1 1 1 1 1
#> 14 1 1 1 1 1 1 0 0 1 0
#> 15 0 0 1 1 0 1 0 1 0 0
#> 16 1 0 1 0 1 0 1 1 0 0
#> 17 0 1 1 0 1 0 1 0 0 0
#> 18 1 1 1 1 0 0 0 0 0 1
#> 19 1 1 1 0 1 1 0 0 0 1
#> 20 1 1 1 1 0 0 1 1 0 0
#> 21 0 1 0 0 1 1 1 0 0 0
#> 22 1 0 0 1 0 1 1 1 0 1
#> 23 1 0 0 1 1 1 1 0 0 0
#> 24 0 1 0 0 1 1 1 0 1 1
#> 25 1 0 0 0 1 1 1 0 1 0
#> 26 1 1 0 0 1 1 0 0 1 0
#> 27 0 1 1 0 0 1 0 0 1 1
#> 28 0 0 1 0 1 0 0 1 0 1
#> 29 1 0 1 0 1 0 1 1 1 0
#> 30 0 0 1 0 1 1 0 0 1 1
#> 31 1 0 0 1 1 0 1 0 0 0
#> 32 0 1 1 1 1 1 0 0 1 0
#> 33 1 1 1 0 1 0 1 0 1 1
#> 34 0 0 1 0 0 1 0 1 1 1
#> 35 0 1 1 0 0 1 0 1 1 1
#> 36 0 1 0 0 1 1 1 1 1 0
#> 37 0 0 0 1 0 1 0 0 0 0
#> 38 1 1 1 0 0 1 0 0 1 0
#> 39 1 1 1 0 1 1 1 0 1 0
#> 40 0 0 1 1 0 1 1 1 0 1
#> 41 0 0 0 0 0 1 1 0 1 1
#> 42 0 0 1 0 0 1 0 0 0 1
#> 43 1 1 1 0 1 1 0 0 0 1
#> 44 0 0 0 0 0 0 1 1 1 1
#> 45 1 1 1 1 0 0 0 1 1 0
#> 46 0 0 1 0 0 1 1 1 0 1
#> 47 0 1 1 0 0 1 0 0 0 0
#> 48 1 1 0 0 0 1 0 1 1 1
#> 49 0 0 0 1 1 1 0 1 0 0
#> 50 1 1 0 0 1 0 1 1 0 1
#> 51 1 0 1 0 1 1 0 1 0 1
#> 52 1 0 0 1 1 0 0 1 0 0
#> 53 1 0 0 1 1 0 0 1 1 1
#> 54 1 0 1 1 1 1 0 1 1 1
#> 55 1 0 0 0 1 0 1 1 1 1
#> 56 0 1 0 0 0 1 1 1 1 0
#> 57 1 0 1 1 0 0 0 1 1 0
#> 58 0 1 1 1 1 1 1 0 0 1
#> 59 0 0 0 0 1 1 0 1 0 0
#> 60 0 0 1 1 1 1 1 1 0 0
#> 61 0 0 1 1 0 0 1 0 0 0
#> 62 1 1 0 0 1 1 0 0 1 1
#> 63 1 1 0 0 0 1 0 0 1 1
#> 64 1 1 0 1 0 0 0 1 1 0
#> 65 1 1 0 1 1 0 0 0 1 0
#> 66 1 1 0 1 0 0 1 1 0 1
#> 67 0 1 0 0 0 1 1 1 0 0
#> 68 0 1 0 0 1 0 1 0 0 1
#> 69 1 0 0 1 1 1 1 1 0 1
#> 70 0 1 0 1 0 1 1 0 1 1
#> 71 0 0 1 0 1 1 1 0 1 0
#> 72 0 1 0 1 1 1 0 0 1 1
#> 73 1 1 1 0 0 1 0 0 0 1
#> 74 0 0 1 0 1 1 0 0 1 1
#> 75 1 0 0 0 1 1 1 1 0 1
#> 76 0 1 1 0 0 1 0 1 1 1
#> 77 0 1 1 1 0 0 0 0 0 1
#> 78 0 0 1 1 0 0 0 1 0 1
#> 79 0 0 1 0 1 0 1 1 0 0
#> 80 0 0 1 0 0 0 0 0 0 1
#> 81 1 1 1 1 0 0 0 1 0 1
#> 82 0 1 1 0 0 1 0 1 1 1
#> 83 0 1 1 1 0 0 1 0 0 1
#> 84 1 1 1 0 0 0 0 0 0 1
#> 85 1 0 1 0 0 1 1 0 0 1
#> 86 1 0 1 1 1 1 1 0 1 0
#> 87 1 0 1 1 0 0 1 0 0 0
#> 88 1 0 1 0 0 1 1 1 0 0
#> 89 0 1 0 0 0 1 0 1 0 0
#> 90 0 1 1 0 0 0 1 0 0 0
#> 91 0 1 1 0 1 0 1 1 1 1
#> 92 0 0 0 0 0 1 1 1 0 1
#> 93 1 1 0 1 0 1 1 1 1 0
#> 94 0 0 0 0 0 0 0 1 0 0
#> 95 1 0 0 1 0 0 0 0 1 1
#> 96 0 1 0 1 0 1 1 1 0 1
#> 97 0 0 1 1 0 0 1 0 0 0
#> 98 0 0 1 0 0 0 1 0 1 0
#> 99 0 1 0 0 1 1 1 0 1 0
#> 100 1 1 1 1 1 1 1 1 1 0
#>
#> [[2]]
#> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
#> 1 1 1 0 0 1 1 0 0 0 0
#> 2 0 0 0 1 1 1 1 1 0 1
#> 3 0 1 1 0 0 0 1 0 1 0
#> 4 0 1 0 1 1 1 1 0 1 1
#> 5 1 0 0 0 1 1 0 0 1 0
#> 6 0 0 1 0 1 0 1 0 0 0
#> 7 0 0 1 0 1 0 1 0 0 1
#> 8 0 0 0 1 1 0 1 1 0 0
#> 9 1 0 0 1 1 1 0 0 1 1
#> 10 0 1 1 1 0 0 0 0 1 1
#> 11 1 0 0 0 0 0 1 0 1 0
#> 12 0 1 0 0 1 1 1 1 1 1
#> 13 0 1 0 0 1 1 1 0 0 1
#> 14 0 1 1 0 0 0 0 1 0 1
#> 15 1 0 0 1 0 0 1 0 0 1
#> 16 0 0 1 0 0 0 1 1 1 1
#> 17 0 0 0 0 0 0 1 0 0 1
#> 18 1 0 0 0 1 1 1 0 1 0
#> 19 0 0 0 1 0 0 0 0 1 0
#> 20 0 0 0 1 0 0 1 1 0 0
#> 21 1 0 0 0 1 1 1 1 1 1
#> 22 1 1 0 0 1 0 0 0 1 1
#> 23 0 1 1 0 1 1 1 0 1 0
#> 24 1 1 1 0 1 0 0 1 0 1
#> 25 0 1 0 0 0 1 1 0 0 0
#> 26 0 0 0 1 1 1 0 1 1 0
#> 27 1 1 0 1 1 0 0 1 1 0
#> 28 0 1 0 1 0 1 1 0 0 1
#> 29 1 0 1 1 0 1 0 1 1 1
#> 30 1 1 1 0 0 1 0 1 0 1
#> 31 1 0 0 0 1 1 0 1 1 1
#> 32 1 1 1 1 1 0 0 1 0 0
#> 33 0 1 0 1 0 0 0 1 0 1
#> 34 0 0 1 0 1 0 1 0 0 1
#> 35 1 1 1 0 1 0 1 0 1 0
#> 36 0 0 1 0 0 0 0 0 1 0
#> 37 1 1 0 1 0 0 1 0 0 1
#> 38 0 1 1 0 1 0 1 0 1 1
#> 39 0 0 1 1 1 0 0 0 1 1
#> 40 0 1 0 0 0 1 0 1 0 0
#> 41 1 1 1 1 1 0 0 1 0 1
#> 42 0 1 0 0 0 0 0 1 0 1
#> 43 1 0 1 1 0 1 1 1 0 0
#> 44 1 1 0 0 1 0 1 1 0 0
#> 45 1 1 1 0 0 0 1 0 0 1
#> 46 0 1 1 1 0 0 1 1 1 1
#> 47 1 1 1 0 1 1 1 1 0 1
#> 48 1 0 0 0 1 1 0 1 0 0
#> 49 0 1 0 0 0 0 0 1 0 1
#> 50 1 1 0 1 1 0 1 1 1 1
#> 51 0 0 1 1 1 1 1 1 1 0
#> 52 1 1 0 1 0 0 1 1 0 0
#> 53 0 1 1 1 1 0 1 0 0 1
#> 54 1 0 1 1 1 1 1 0 1 1
#> 55 0 0 0 0 0 0 0 0 0 0
#> 56 1 1 1 1 1 0 0 1 0 1
#> 57 1 0 1 1 1 1 1 0 1 0
#> 58 1 1 1 0 0 1 0 0 0 1
#> 59 1 1 1 1 1 1 1 0 0 1
#> 60 0 0 1 0 1 1 1 1 1 1
#> 61 0 0 1 1 1 0 1 1 0 0
#> 62 0 1 0 1 0 1 0 1 0 0
#> 63 1 1 1 1 0 1 0 0 1 1
#> 64 0 0 1 1 0 0 0 1 0 1
#> 65 1 1 0 1 0 0 1 0 1 1
#> 66 1 1 1 1 1 0 1 1 0 1
#> 67 1 0 0 1 0 1 1 1 0 1
#> 68 1 0 0 0 1 1 1 1 0 1
#> 69 1 1 1 0 1 0 0 1 1 0
#> 70 0 0 1 1 0 1 1 1 0 0
#> 71 1 0 0 1 1 1 0 0 1 1
#> 72 0 0 1 0 1 0 1 0 1 0
#> 73 0 1 0 1 0 0 1 1 1 0
#> 74 0 1 0 0 0 1 1 1 0 1
#> 75 1 0 1 1 0 1 1 1 1 0
#> 76 1 0 1 0 1 1 0 1 1 0
#> 77 1 0 0 0 1 0 1 0 0 0
#> 78 1 1 1 0 1 0 1 0 0 0
#> 79 1 0 0 1 1 0 0 0 1 0
#> 80 0 0 1 1 0 0 0 1 0 0
#> 81 1 0 1 0 0 1 0 1 1 1
#> 82 0 0 0 0 0 0 1 0 1 1
#> 83 0 0 1 0 0 1 0 1 0 0
#> 84 0 1 0 1 1 0 0 1 1 0
#> 85 1 1 0 0 1 1 1 1 1 1
#> 86 0 0 1 1 1 0 1 0 1 1
#> 87 1 1 0 1 0 0 1 0 0 1
#> 88 1 0 0 0 1 1 1 0 0 1
#> 89 0 0 0 0 0 0 0 1 0 0
#> 90 0 1 0 0 0 0 0 0 0 1
#> 91 1 1 0 1 1 0 0 1 0 1
#> 92 1 1 1 0 0 1 0 0 1 1
#> 93 1 0 1 0 1 0 1 1 0 1
#> 94 0 1 0 0 1 1 1 0 0 0
#> 95 0 1 1 1 0 1 1 1 1 0
#> 96 1 0 1 1 1 0 0 1 0 0
#> 97 0 0 0 0 0 1 1 1 0 0
#> 98 0 0 0 1 0 1 1 1 1 1
#> 99 0 0 0 1 1 0 0 0 1 1
#> 100 0 0 0 0 0 1 1 1 1 0
#> 101 0 1 1 1 0 0 1 0 0 0
#> 102 1 1 1 1 0 0 0 0 0 0
#> 103 1 0 1 1 0 1 1 0 1 1
#> 104 0 0 0 1 0 0 1 1 0 0
#> 105 0 0 1 0 1 0 0 1 0 0
#> 106 0 1 1 1 1 0 1 0 1 0
#> 107 0 0 0 0 0 0 0 0 0 1
#> 108 1 0 1 1 0 0 1 0 1 0
#> 109 0 0 0 1 1 1 1 1 1 0
#> 110 0 1 0 0 1 1 0 0 0 0
#> 111 1 1 1 0 0 0 1 1 1 0
#> 112 1 1 1 1 0 0 0 1 1 1
#> 113 0 1 1 0 1 0 1 1 0 0
#> 114 1 1 0 0 0 0 0 0 1 1
#> 115 1 0 0 1 1 1 1 0 0 0
#> 116 1 1 1 1 0 0 0 1 1 0
#> 117 0 1 0 1 1 1 0 0 1 0
#> 118 0 0 1 0 1 0 0 1 1 0
#> 119 1 0 0 0 0 1 0 1 1 1
#> 120 0 1 0 0 0 0 0 0 0 1
#> 121 1 0 0 0 0 0 1 1 1 0
#> 122 1 1 1 1 0 1 1 1 0 0
#> 123 1 0 0 1 0 0 0 1 1 0
#> 124 1 1 0 0 0 0 0 0 0 1
#> 125 0 0 1 1 1 0 1 0 1 0
#> 126 0 1 0 1 0 0 0 1 1 0
#> 127 1 0 1 0 0 0 0 0 1 0
#> 128 0 1 0 0 1 0 1 0 1 1
#> 129 0 1 0 1 0 1 1 0 1 0
#> 130 0 0 1 1 1 1 1 1 0 0
#> 131 1 1 0 1 0 0 1 1 0 0
#> 132 1 0 1 1 0 0 1 1 0 1
#> 133 1 1 1 1 0 1 1 0 1 1
#> 134 0 0 0 0 1 1 0 1 1 1
#> 135 0 0 0 0 1 1 0 1 0 0
#> 136 1 0 0 0 1 0 1 1 0 0
#> 137 1 1 0 1 0 1 0 0 1 0
#> 138 1 0 1 1 1 1 0 1 0 0
#> 139 1 1 0 1 0 1 0 0 0 1
#> 140 1 0 1 0 1 1 0 0 0 0
#> 141 0 0 0 0 0 0 0 0 1 1
#> 142 0 1 1 1 1 1 0 1 0 1
#> 143 1 0 0 0 0 0 0 1 0 0
#> 144 1 1 1 1 1 1 1 0 0 0
#> 145 1 0 0 0 1 0 1 0 0 1
#> 146 0 1 1 0 0 0 1 0 0 1
#> 147 0 1 0 0 0 0 0 0 0 0
#> 148 1 1 0 0 1 1 1 0 1 0
#> 149 1 0 0 1 1 1 0 1 0 1
#> 150 1 0 1 0 0 0 0 1 0 1
#> 151 0 0 1 0 1 0 0 1 1 0
#> 152 1 0 1 1 1 0 1 1 1 0
#> 153 1 1 0 1 1 0 1 0 1 0
#> 154 1 1 0 0 1 1 1 0 0 1
#> 155 0 0 1 1 0 0 0 0 1 1
#> 156 0 1 0 0 1 0 0 1 0 1
#> 157 1 0 1 1 0 1 1 0 0 0
#> 158 0 0 1 1 0 1 0 0 1 0
#> 159 1 0 1 0 0 0 1 1 0 1
#> 160 0 0 0 0 0 0 1 1 1 0
#> 161 1 1 0 0 1 1 1 0 0 0
#> 162 0 0 0 1 1 1 1 1 1 1
#> 163 1 1 1 1 0 0 0 0 1 0
#> 164 0 1 0 0 0 1 0 0 0 1
#> 165 1 1 0 1 0 1 0 0 1 1
#> 166 0 1 1 1 0 0 1 1 1 0
#> 167 1 1 1 1 0 0 1 0 0 1
#> 168 0 1 0 0 1 0 0 1 0 1
#> 169 1 1 0 0 1 0 1 1 1 0
#> 170 1 0 0 1 1 0 1 0 1 1
#> 171 0 0 1 0 0 0 1 1 0 0
#> 172 1 1 1 1 1 0 0 1 1 0
#> 173 1 1 1 1 0 1 0 1 0 0
#> 174 1 1 0 0 1 1 1 0 0 1
#> 175 0 0 1 0 0 0 0 0 1 0
#> 176 0 1 0 1 1 1 1 1 1 1
#> 177 1 0 1 0 1 1 0 0 1 0
#> 178 1 1 0 0 1 0 1 1 0 1
#> 179 0 0 1 1 0 1 0 1 0 1
#> 180 0 0 0 1 0 1 1 0 1 1
#> 181 1 1 0 0 0 1 1 0 1 0
#> 182 1 0 1 1 0 0 0 0 1 1
#> 183 0 1 1 0 1 0 1 1 1 0
#> 184 0 1 1 0 1 0 1 1 0 0
#> 185 0 1 0 0 1 1 1 0 0 0
#> 186 0 1 0 0 0 1 0 1 1 1
#> 187 0 1 0 0 1 1 1 1 0 1
#> 188 0 0 1 1 0 0 0 1 0 1
#> 189 1 1 0 1 1 1 1 0 0 0
#> 190 0 1 1 0 0 0 0 0 0 0
#> 191 0 1 1 1 0 1 0 1 0 1
#> 192 1 1 1 0 0 1 0 1 1 1
#> 193 0 0 1 0 0 1 1 1 1 0
#> 194 0 1 0 1 1 1 1 0 0 1
#> 195 0 0 1 0 1 1 1 0 1 1
#> 196 1 0 1 0 1 0 0 0 1 0
#> 197 1 0 0 1 0 0 1 0 0 1
#> 198 0 0 1 0 0 1 1 0 1 0
#> 199 1 0 1 0 0 0 0 0 0 0
#> 200 0 0 1 0 1 1 0 1 1 0
#>
#> [[3]]
#> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
#> 1 1 0 0 0 0 0 1 0 0 1
#> 2 0 1 0 0 0 0 1 0 0 1
#> 3 1 0 0 1 0 0 0 1 0 1
#> 4 1 0 1 0 1 1 0 0 1 1
#> 5 0 1 1 1 0 0 1 1 1 0
#> 6 0 0 0 0 1 0 0 1 1 0
#> 7 0 1 1 1 1 1 1 1 0 1
#> 8 0 1 1 1 1 1 1 1 0 1
#> 9 0 1 1 0 1 1 0 1 0 1
#> 10 1 1 1 1 1 0 0 1 0 0
#> 11 0 0 0 1 0 0 0 1 1 1
#> 12 1 1 1 1 1 1 0 1 1 0
#> 13 0 0 1 1 0 1 0 1 0 0
#> 14 1 1 0 1 0 0 0 1 1 1
#> 15 0 1 0 1 0 0 1 0 1 1
#> 16 0 1 0 1 0 0 1 1 0 0
#> 17 0 1 0 0 0 0 1 0 1 1
#> 18 1 1 0 1 0 1 1 1 0 1
#> 19 0 1 0 1 1 1 0 1 1 1
#> 20 1 1 0 1 1 0 1 1 0 0
#> 21 1 0 1 1 1 0 0 1 1 1
#> 22 0 1 0 1 1 0 0 0 0 1
#> 23 1 1 1 1 0 0 0 1 1 1
#> 24 0 0 0 1 0 0 0 1 1 1
#> 25 0 1 0 1 1 1 1 0 0 1
#> 26 0 1 0 1 0 1 1 1 1 1
#> 27 0 1 0 1 1 0 0 1 1 1
#> 28 1 1 1 0 0 1 0 1 0 0
#> 29 1 0 1 1 1 0 0 0 1 1
#> 30 0 0 1 1 1 0 1 0 1 0
#> 31 1 1 0 1 1 1 0 0 1 0
#> 32 1 0 0 1 0 1 1 0 1 1
#> 33 0 0 0 1 1 0 1 0 0 0
#> 34 1 0 0 0 0 1 1 1 1 0
#> 35 1 1 0 0 0 1 0 0 1 1
#> 36 1 1 0 1 0 1 1 0 0 1
#> 37 1 0 0 1 1 0 1 0 1 0
#> 38 0 1 1 1 1 1 0 1 0 0
#> 39 1 1 0 1 0 0 0 0 1 0
#> 40 0 0 1 0 0 0 0 0 1 1
#> 41 1 0 1 0 0 1 1 1 0 1
#> 42 1 1 0 1 0 0 1 1 0 1
#> 43 0 0 1 0 1 0 1 1 1 0
#> 44 1 0 1 0 1 1 1 1 1 1
#> 45 0 0 0 0 1 1 1 1 0 1
#> 46 1 1 1 0 1 0 0 1 1 1
#> 47 1 1 1 0 1 0 0 1 0 0
#> 48 0 1 1 0 0 1 0 1 1 0
#> 49 1 1 1 1 1 0 1 0 1 1
#> 50 0 0 0 0 1 1 0 0 0 1
#> 51 0 1 1 0 1 0 0 0 1 0
#> 52 1 0 1 1 0 0 0 1 0 0
#> 53 0 1 0 1 0 1 1 1 0 0
#> 54 0 0 0 0 0 1 0 0 1 0
#> 55 0 0 0 0 1 0 0 1 0 0
#> 56 1 0 1 0 0 0 1 0 1 1
#> 57 1 1 1 1 1 1 0 1 1 0
#> 58 1 0 1 0 1 0 1 0 1 1
#> 59 1 1 1 1 0 0 1 0 0 1
#> 60 1 1 0 0 1 0 1 0 0 1
#> 61 1 1 0 0 0 1 0 0 0 0
#> 62 1 1 1 0 0 0 1 1 1 1
#> 63 0 1 1 0 1 1 1 1 0 1
#> 64 0 1 0 1 0 1 1 1 1 0
#> 65 1 0 1 0 1 0 0 0 0 1
#> 66 0 1 1 0 1 0 1 1 1 0
#> 67 0 0 0 0 0 1 1 0 1 0
#> 68 0 0 1 1 1 0 1 0 0 1
#> 69 1 1 0 1 1 1 0 1 0 0
#> 70 1 0 1 1 1 0 0 0 0 1
#> 71 1 1 1 0 0 1 1 1 1 1
#> 72 0 0 1 1 0 1 0 0 1 0
#> 73 1 1 1 0 1 1 1 1 1 1
#> 74 1 0 1 1 1 1 0 0 0 0
#> 75 0 0 0 1 1 1 0 0 1 1
#> 76 0 0 1 0 1 0 1 1 0 0
#> 77 1 1 1 0 1 0 0 1 1 0
#> 78 0 1 0 0 1 0 0 0 0 0
#> 79 1 0 1 1 0 1 1 1 1 0
#> 80 1 0 0 1 1 0 1 0 1 0
#> 81 1 0 1 1 0 0 0 1 1 1
#> 82 1 1 0 1 1 0 0 1 0 1
#> 83 1 0 1 0 0 0 0 1 0 1
#> 84 0 1 0 1 1 0 1 0 0 1
#> 85 0 1 1 1 0 0 0 1 0 1
#> 86 1 1 1 0 1 1 0 1 1 0
#> 87 0 1 1 1 1 0 1 1 1 1
#> 88 0 0 1 0 0 0 1 1 1 0
#> 89 0 1 1 0 0 0 1 0 1 1
#> 90 0 0 1 0 0 1 0 1 0 1
#> 91 1 0 1 0 1 1 0 0 1 0
#> 92 1 0 0 1 0 0 1 1 0 1
#> 93 0 0 0 1 1 0 1 1 0 1
#> 94 0 0 1 1 1 0 0 0 1 1
#> 95 0 1 0 0 0 0 1 0 0 0
#> 96 0 0 1 1 0 0 1 1 1 1
#> 97 0 0 1 0 0 0 1 0 0 0
#> 98 1 0 1 1 0 0 0 0 1 1
#> 99 1 1 1 0 1 0 1 0 1 1
#> 100 0 1 0 0 1 0 1 0 1 1
#> 101 1 1 0 1 0 1 0 1 1 0
#> 102 0 0 0 1 1 0 0 1 0 1
#> 103 0 0 0 1 0 0 1 0 0 0
#> 104 1 0 0 0 0 1 0 1 0 1
#> 105 1 0 0 1 0 0 0 1 0 0
#> 106 0 1 1 1 1 1 0 0 0 1
#> 107 1 1 0 0 0 1 1 1 1 0
#> 108 0 0 0 0 0 1 1 0 1 0
#> 109 1 1 1 1 0 1 1 1 1 1
#> 110 0 0 1 1 1 0 1 0 0 0
#> 111 0 1 0 1 0 1 1 0 1 1
#> 112 0 0 1 0 0 1 0 1 0 1
#> 113 0 0 1 1 1 1 0 1 1 1
#> 114 1 1 0 1 1 1 0 1 0 0
#> 115 1 1 0 1 1 1 0 1 0 0
#> 116 1 1 0 1 1 1 1 0 0 0
#> 117 0 1 0 0 0 1 1 1 0 0
#> 118 0 1 0 0 1 1 0 0 0 1
#> 119 1 0 0 1 0 0 0 1 1 1
#> 120 0 0 0 1 0 1 1 1 0 1
#> 121 0 1 0 1 1 0 0 0 0 0
#> 122 0 0 1 1 1 0 0 1 0 0
#> 123 1 1 0 1 1 1 1 1 1 1
#> 124 0 1 0 0 1 0 1 0 1 0
#> 125 1 0 1 1 0 1 1 0 1 1
#> 126 1 1 0 0 0 1 0 0 1 0
#> 127 0 1 1 0 0 1 0 1 0 1
#> 128 0 0 1 0 0 1 1 1 0 0
#> 129 0 1 0 0 0 0 1 1 1 1
#> 460 1 0 0 0 0 0 0 1 1 0
#> 461 0 0 1 1 0 1 0 1 1 1
#> 462 1 1 0 1 0 1 0 0 0 0
#> 463 1 1 1 1 1 0 1 1 1 1
#> 464 0 0 1 0 1 0 0 1 1 0
#> 465 1 1 1 1 0 0 0 1 0 0
#> 466 0 0 0 0 1 1 0 0 1 0
#> 467 1 0 0 1 0 1 0 0 0 1
#> 468 1 1 0 0 0 0 0 0 1 1
#> 469 0 0 1 0 1 0 1 0 1 0
#> 470 0 1 1 1 1 0 0 1 0 0
#> 471 0 0 1 0 1 0 1 0 1 1
#> 472 1 1 0 1 0 0 1 1 0 1
#> 473 1 0 1 1 0 1 1 0 1 0
#> 474 1 1 1 1 1 0 1 1 0 0
#> 475 0 1 0 0 0 0 1 1 0 0
#> 476 1 1 1 0 1 0 0 0 1 1
#> 477 1 1 1 0 0 1 1 0 1 0
#> 478 1 0 1 1 1 1 0 0 0 0
#> 479 0 1 1 1 1 1 0 1 0 0
#> 480 0 0 1 1 0 1 1 1 1 0
#> 481 0 1 0 0 0 1 0 1 0 0
#> 482 0 1 1 1 1 1 1 1 1 0
#> 483 1 0 0 1 1 1 1 1 1 1
#> 484 0 0 1 0 1 1 1 1 0 0
#> 485 0 0 0 1 0 0 0 0 0 0
#> 486 1 1 1 1 0 0 0 0 1 1
#> 487 1 1 1 0 0 1 0 0 0 0
#> 488 0 0 0 0 1 1 1 0 0 1
#> 489 0 0 1 0 1 1 1 0 1 0
#> 490 0 1 1 1 1 0 0 0 0 1
#> 491 0 0 0 0 1 0 1 1 0 0
#> 492 1 1 1 1 1 0 1 0 1 0
#> 493 0 0 0 1 0 0 0 0 0 1
#> 494 1 1 0 0 0 0 0 1 1 0
#> 495 1 0 0 0 1 1 0 1 0 1
#> 496 0 1 1 1 0 1 0 1 1 1
#> 497 0 1 0 0 0 0 0 0 0 1
#> 498 1 0 1 1 0 0 0 1 1 0
#> 499 0 1 0 1 1 1 1 1 1 0
#> 500 0 0 0 1 0 1 0 1 1 1
#>
#> [[4]]
#> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
#> 1 1 1 1 1 0 0 1 1 0 1
#> 2 0 0 0 1 1 1 0 1 1 0
#> 3 0 0 0 0 1 0 0 1 1 1
#> 4 1 0 0 0 1 0 0 0 1 0
#> 5 1 1 1 0 1 0 0 1 1 1
#> 6 1 0 0 0 1 0 0 0 1 0
#> 7 0 0 0 1 1 1 1 0 0 0
#> 8 1 0 1 0 0 1 0 1 1 0
#> 9 1 0 1 1 1 1 1 1 0 0
#> 10 0 0 0 0 1 1 1 0 0 0
#> 11 0 0 1 1 0 1 0 0 0 1
#> 12 1 0 1 0 0 0 1 1 1 1
#> 13 0 0 1 1 1 0 0 1 0 0
#> 14 1 0 0 1 1 0 1 0 1 0
#> 15 1 0 1 0 0 0 0 1 1 0
#> 16 0 1 1 0 0 0 1 0 0 0
#> 17 0 0 0 0 1 1 0 0 1 0
#> 18 1 0 0 1 1 0 1 0 1 0
#> 19 1 1 0 1 1 1 0 0 0 0
#> 20 0 0 0 1 1 0 0 0 1 0
#> 21 0 1 0 0 0 0 0 0 1 0
#> 22 1 1 0 1 1 0 1 1 1 0
#> 23 1 0 0 0 1 0 0 0 0 0
#> 24 0 1 1 0 1 1 0 1 1 1
#> 25 1 1 0 1 1 0 0 1 1 1
#> 26 0 1 1 1 0 0 0 1 0 0
#> 27 0 1 1 0 1 1 1 1 1 0
#> 28 1 1 1 1 0 1 1 1 1 0
#> 29 0 1 0 0 0 1 1 1 0 0
#> 30 1 0 1 0 0 1 0 0 0 1
#> 31 0 1 0 0 0 1 1 1 1 1
#> 32 1 1 1 1 0 0 0 0 0 1
#> 33 0 0 0 0 0 0 0 0 1 1
#> 34 1 1 1 0 0 0 1 0 1 0
#> 35 1 1 0 1 0 0 0 1 0 1
#> 36 0 0 0 0 1 0 1 1 1 0
#> 37 0 0 1 0 0 1 0 1 1 1
#> 38 0 0 0 0 1 0 0 1 1 1
#> 39 1 0 1 1 0 0 1 0 0 1
#> 40 0 0 0 0 0 0 0 1 1 0
#> 41 1 0 1 1 1 0 1 0 0 1
#> 42 1 1 1 0 1 1 0 0 0 1
#> 43 0 0 0 0 0 1 1 1 1 1
#> 44 1 1 0 0 1 0 1 0 1 1
#> 45 0 1 1 0 0 0 1 0 1 0
#> 46 0 0 1 1 0 1 1 1 1 1
#> 47 0 0 0 0 1 1 1 1 1 1
#> 48 0 0 1 0 1 0 1 0 0 1
#> 49 0 1 1 0 0 0 0 0 0 1
#> 50 1 0 1 0 1 0 0 1 1 0
#> 51 0 1 1 0 0 1 1 0 1 0
#> 52 0 0 1 1 0 1 0 0 0 1
#> 53 1 0 1 0 0 0 1 0 0 1
#> 54 0 0 0 1 0 1 1 0 1 1
#> 55 0 0 1 0 0 1 0 0 1 1
#> 56 1 0 0 1 0 0 1 0 0 0
#> 57 1 0 0 0 0 0 0 1 0 0
#> 58 1 1 1 1 1 1 0 0 0 0
#> 59 1 0 1 1 1 0 1 1 1 0
#> 60 1 0 0 0 0 1 1 0 1 0
#> 61 0 0 0 0 0 1 1 0 1 0
#> 62 1 1 1 0 0 0 0 1 0 1
#> 63 1 1 0 0 0 0 0 1 0 1
#> 64 1 1 1 1 0 1 1 1 1 1
#> 65 1 0 1 1 0 1 1 1 1 0
#> 66 0 1 1 1 0 1 0 0 1 0
#> 67 1 0 1 0 1 1 0 1 0 0
#> 68 0 1 1 0 1 0 1 1 0 0
#> 69 0 1 1 1 0 1 1 0 0 1
#> 70 1 0 0 0 0 0 0 1 1 1
#> 71 1 1 0 0 1 0 1 0 1 1
#> 72 0 0 1 0 1 0 1 0 0 1
#> 73 1 1 1 0 1 0 1 0 1 1
#> 74 1 1 1 0 1 1 1 0 1 1
#> 75 1 1 0 1 1 1 0 0 0 1
#> 76 1 1 1 1 0 0 1 1 1 0
#> 77 0 1 1 0 1 0 1 0 1 1
#> 78 1 0 0 0 1 1 1 1 1 1
#> 79 0 0 1 0 0 0 1 1 0 0
#> 80 1 1 1 0 1 0 1 1 1 0
#> 81 1 1 1 0 1 1 1 0 0 0
#> 82 1 0 1 0 0 1 1 0 1 1
#> 83 1 1 0 0 1 1 1 0 1 1
#> 84 1 1 1 1 1 1 1 1 0 0
#> 85 0 0 0 0 0 1 1 0 1 1
#> 86 0 1 1 0 0 0 1 0 0 0
#> 87 0 1 1 1 1 1 1 0 1 1
#> 88 0 1 1 0 0 1 0 0 0 1
#> 89 0 0 1 1 1 0 1 0 1 1
#> 90 0 1 0 0 1 0 1 1 1 1
#> 91 0 0 1 0 1 0 1 1 0 0
#> 92 0 1 1 1 0 1 0 0 1 0
#> 93 0 1 1 0 1 1 1 1 0 0
#> 94 1 1 0 1 0 1 0 1 0 1
#> 95 0 1 0 1 0 1 1 1 0 0
#> 96 0 1 1 1 1 0 0 1 1 1
#> 97 0 0 1 0 1 1 1 0 1 1
#> 98 1 0 0 0 0 0 0 0 1 0
#> 99 1 0 0 0 1 1 1 0 0 1
#> 100 1 0 0 0 0 1 1 0 1 0
> 776 0 0 1 0 0 1 1 1 1 0
#> 777 0 1 0 1 1 1 1 0 0 0
#> 778 1 1 1 1 0 0 1 0 0 1
#> 779 1 1 1 0 0 1 0 0 1 1
#> 780 1 1 1 1 1 1 1 0 1 0
#> 781 0 0 0 0 0 1 0 0 1 1
#> 782 1 0 0 1 0 1 0 1 1 1
#> 783 1 1 0 0 1 0 0 1 0 1
#> 784 0 1 1 0 0 1 1 1 0 0
#> 785 0 0 1 1 1 1 0 1 1 1
#> 786 0 0 1 0 0 1 1 0 0 1
#> 787 0 0 0 0 0 1 1 0 0 1
#> 788 0 1 1 1 0 0 1 1 0 0
#> 789 0 1 1 0 1 0 0 1 1 0
#> 790 0 1 0 0 1 0 0 0 0 0
#> 791 0 0 0 0 1 0 1 1 1 0
#> 792 1 0 1 1 1 0 1 1 1 0
#> 793 0 1 1 1 1 0 0 1 1 1
#> 794 1 0 1 1 1 0 1 0 0 1
#> 795 1 1 1 1 1 1 1 1 0 0
#> 796 1 0 1 1 1 1 1 0 1 0
#> 797 0 1 1 1 1 1 1 1 0 1
#> 798 1 1 1 1 1 0 1 0 1 0
#> 799 1 0 0 1 1 0 0 0 0 0
#> 800 1 1 1 1 0 1 1 0 1 0
#>
#> [[5]]
#> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
#> 1 1 1 0 0 1 1 0 1 0 1
#> 2 1 1 1 1 0 0 1 0 1 0
#> 3 1 1 1 1 0 1 0 1 1 1
#> 4 0 1 0 1 1 1 1 1 0 1
#> 5 1 1 0 1 1 1 1 0 1 1
#> 6 1 0 0 0 0 1 1 0 0 1
#> 7 1 0 0 1 0 1 0 0 0 1
#> 8 0 0 0 0 0 0 1 0 0 0
#> 9 0 1 1 0 1 0 1 1 1 1
#> 10 1 1 0 1 0 1 1 1 1 1
#> 11 1 0 1 0 1 0 0 0 0 0
#> 12 0 1 0 1 1 1 0 1 1 1
#> 13 1 0 1 0 0 0 0 1 0 1
#> 14 1 0 1 1 1 0 0 0 1 1
#> 15 1 0 1 1 1 1 1 0 1 1
#> 16 1 0 1 1 1 0 1 1 1 1
#> 17 0 0 0 1 1 1 0 0 1 0
#> 18 0 1 1 0 0 1 1 1 0 0
#> 19 1 0 1 0 0 0 0 0 0 0
#> 20 1 0 1 0 0 1 0 1 1 1
#> 21 1 1 1 1 1 1 0 0 0 0
#> 22 1 1 1 0 1 1 0 1 0 1
#> 23 0 1 1 1 0 0 0 1 0 1
#> 24 1 1 1 1 0 1 0 0 1 1
#> 25 0 1 0 0 0 1 1 0 0 1
#> 26 0 0 1 0 1 0 0 1 0 1
#> 27 1 0 0 0 0 0 1 0 0 1
#> 28 0 1 1 0 1 0 1 1 0 1
#> 29 0 1 0 0 1 1 1 0 0 1
#> 30 1 1 1 1 0 1 0 1 0 1
#> 31 0 0 1 0 1 1 0 1 1 0
#> 32 0 1 0 0 0 0 1 1 1 1
#> 33 0 0 1 0 0 1 1 1 0 0
#> 34 1 1 1 1 0 0 1 1 1 1
#> 35 1 0 0 1 0 0 1 1 0 1
#> 36 0 1 0 1 0 1 1 1 1 1
#> 37 0 0 1 0 1 1 0 0 0 0
#> 38 1 0 1 1 1 1 1 0 1 1
#> 39 1 1 1 0 0 0 1 0 0 1
#> 40 0 0 1 1 1 0 0 1 1 1
#> 41 1 1 1 0 0 0 1 1 1 0
#> 42 0 0 1 0 0 0 1 0 1 0
#> 43 0 1 1 0 0 0 1 1 0 1
#> 44 0 0 1 0 0 0 0 1 1 1
#> 45 1 1 1 1 1 1 0 1 0 0
#> 46 0 0 1 0 0 0 1 0 0 0
#> 47 1 0 0 0 0 1 0 1 1 0
#> 48 0 1 0 1 1 0 1 0 0 1
#> 49 0 1 0 1 0 0 1 1 1 1
#> 50 1 0 1 1 1 0 0 0 0 1
#> 51 1 0 1 0 1 1 1 0 0 1
#> 52 0 1 0 1 1 0 0 1 0 1
#> 53 0 1 0 1 1 1 0 0 0 0
#> 54 0 0 0 1 1 0 0 1 1 0
#> 55 0 0 0 0 0 1 0 1 0 0
#> 56 1 1 0 1 1 0 1 0 1 0
#> 57 1 0 1 1 0 0 0 1 0 1
#> 58 0 1 1 1 1 0 1 0 0 0
#> 59 1 0 0 0 0 0 1 1 1 1
#> 60 0 1 0 1 0 1 0 1 0 0
#> 61 1 1 0 1 1 1 1 1 1 1
#> 62 0 1 0 0 0 1 0 0 1 0
#> 63 1 1 1 0 0 0 0 0 1 1
#> 64 1 1 0 1 0 1 0 0 1 0
#> 65 0 1 1 1 0 0 1 1 1 0
#> 66 1 1 1 0 1 0 1 1 1 1
#> 67 0 1 1 0 0 0 1 0 1 1
#> 68 0 1 1 1 1 1 1 1 0 1
#> 69 1 0 1 1 0 0 0 0 0 1
#> 70 1 0 1 1 0 1 1 1 1 1
#> 71 0 0 0 0 1 0 1 1 1 0
#> 72 1 0 1 0 0 1 1 0 1 0
#> 73 1 1 1 0 1 1 0 0 0 1
#> 74 0 0 0 0 1 0 0 1 0 1
#> 75 1 0 0 1 0 1 0 1 1 0
#> 76 1 1 0 1 1 1 0 1 1 0
#> 77 1 1 0 1 0 0 1 0 1 1
#> 78 0 1 1 0 1 0 0 0 0 1
#> 79 0 1 0 1 1 1 0 0 0 1
#> 80 0 1 1 0 1 1 0 0 1 0
#> 81 1 1 1 0 0 1 1 0 1 0
#> 82 0 1 0 0 1 0 1 0 0 1
#> 83 1 0 0 1 1 1 0 1 1 1
#> 84 1 1 1 1 0 1 0 1 0 1
#> 85 1 0 1 0 1 1 0 1 1 0
#> 86 1 1 1 0 0 1 0 0 0 0
#> 87 1 0 1 0 0 0 1 0 0 0
#> 88 1 1 1 1 1 0 1 0 1 1
#> 89 0 1 0 0 0 0 0 1 1 0
#> 90 0 1 0 0 0 1 0 0 0 0
#> 91 0 0 0 1 0 1 1 0 0 1
#> 92 0 1 0 1 1 1 0 1 1 0
#> 93 1 1 1 1 1 1 1 1 0 1
#> 94 0 0 1 1 1 1 1 0 1 1
#> 95 0 1 1 1 1 0 0 0 0 0
#> 96 1 0 1 0 0 1 1 0 1 0
#> 97 0 1 1 0 0 1 1 0 1 0
#> 98 0 1 1 1 0 1 1 1 1 0
#> 99 0 1 0 0 0 1 0 0 0 0
#> 100 1 0 1 0 1 0 1 0 0 0
#> 101 0 1 0 1 1 1 0 1 0 0
#> 644 1 0 1 0 0 0 0 1 0 1
#> 645 1 1 0 0 0 1 1 1 0 1
#> 646 0 0 0 0 1 1 1 0 0 1
#> 647 0 1 0 1 0 1 0 1 1 0
#> 648 1 1 0 1 0 1 1 0 0 1
#> 649 1 0 1 1 1 0 0 1 1 1
#> 650 1 0 1 1 1 0 0 1 0 1
#> 651 1 1 0 1 1 1 0 0 1 0
#> 652 1 1 0 1 1 1 1 1 1 0
#> 993 0 0 0 1 1 0 0 0 1 0
#> 994 0 1 0 1 0 1 1 0 1 1
#> 995 1 1 1 1 1 1 0 0 1 1
#> 996 1 1 1 1 1 1 0 1 1 0
#> 997 1 0 0 1 1 0 0 0 0 1
#> 998 1 1 0 0 0 0 1 0 0 1
#> 999 0 0 0 0 1 0 1 1 0 0
#> 1000 1 1 0 1 1 0 1 0 1 0
Created on 2022-05-27 by the reprex package (v2.0.1)

How to keep ID in dummyVars()

I would like to do transform Gender and Country using One-Hot-Encoding.
With the code below I can not create the new dataset including the ID
library(caret)
ID<-1:10
Gender<-c("F","F","F","M","M","F","M","M","F","M")
Country<-c("Mali","France","France","Guinea","Senegal",
"Mali","France","Mali","Senegal","France")
data<-data.frame(ID,Gender,Country)
#One hot encoding
dmy <- dummyVars(" ~Gender+Country", data = data, fullRank = T)
dat_transformed <- data.frame(predict(dmy, newdata = data))
dat_transformed
Gender.M Country.Guinea Country.Mali Country.Senegal
1 0 0 1 0
2 0 0 0 0
3 0 0 0 0
4 1 1 0 0
5 1 0 0 1
6 0 0 1 0
7 1 0 0 0
8 1 0 1 0
9 0 0 0 1
10 1 0 0 0
I want to get a dataset that include the ID without enconding it.
ID Gender.M Country.Guinea Country.Mali Country.Senegal
1 1 0 0 1 0
2 2 0 0 0 0
3 3 0 0 0 0
4 4 1 1 0 0
5 5 1 0 0 1
6 6 0 0 1 0
7 7 1 0 0 0
8 8 1 0 1 0
9 9 0 0 0 1
10 10 1 0 0 0
dat_transformed <- cbind(ID,dat_transformed)
dat_transformed
ID Gender.M Country.Guinea Country.Mali Country.Senegal
1 0 0 1 0
2 0 0 0 0
3 0 0 0 0
4 1 1 0 0
5 1 0 0 1
6 0 0 1 0
7 1 0 0 0
8 1 0 1 0
9 0 0 0 1
10 1 0 0 0

correlation with multiple variables and its mutiple combination

Here is the example of the data set to be calculated the correlation between O_data and possible multiple combinations of M_data.
O_data=runif(10)
M_a=runif(10)
M_b=runif(10)
M_c=runif(10)
M_d=runif(10)
M_e=runif(10)
M_data=data.frame(M_a,M_b,M_c,M_d,M_e)
I can calculate the correlation between O_data and individual M_data data.
correlation= matrix(NA,ncol = length(M_data[1,]))
for (i in 1:length(correlation))
{
correlation[,i]=cor(O_data,M_data[,i])
}
In addition to this, how can I get the correlation between O_data and possible multiple combinations of M_data set?
let's clarify the combination.
cor_M_ab=cor((M_a+M_b),O_data)
cor_M_abc=cor((M_a+M_b+M_c),O_data)
cor_M_abcd=...
cor_M_abcde=...
...
....
cor_M_bcd=..
..
cor_M_eab=...
....
...
I don't want combinations of M_a and M_c, I want the combination on a continuous basis, like, M_ab, or bc,bcd,abcde,ea,eab........
Generate the data using set.seed so you can reproduce:
set.seed(42)
O_data=runif(10)
M_a=runif(10)
M_b=runif(10)
M_c=runif(10)
M_d=runif(10)
M_e=runif(10)
M_data=data.frame(M_a,M_b,M_c,M_d,M_e)
The tricky part is just keeping things organized. Since you didn't specify, I made a matrix with 5 rows and 31 columns. The rows get the names of the variables in your M_data. Here's the matrix (motivated by: All N Combinations of All Subsets)
M_grid <- t(do.call(expand.grid, replicate(5, 0:1, simplify = FALSE))[-1,])
rownames(M_grid) <- names(M_data)
M_grid
#> 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
#> M_a 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
#> M_b 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1
#> M_c 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0
#> M_d 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1
#> M_e 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1
#> 28 29 30 31 32
#> M_a 1 0 1 0 1
#> M_b 1 0 0 1 1
#> M_c 0 1 1 1 1
#> M_d 1 1 1 1 1
#> M_e 1 1 1 1 1
Now when I do a matrix multiplication of M_data and any column of my M_grid I get a sum of the columns in M_data corresponding to which rows of M_grid have 1's. For example:
as.matrix(M_data) %*% M_grid[,4]
gives me the sum of M_a and M_b. I can calculate the correlation between O_data and any of these sums. Putting it all together in one line:
(final <- cbind(t(M_grid), apply(as.matrix(M_data) %*% M_grid, 2, function(x) cor(O_data, x))))
#> M_a M_b M_c M_d M_e
#> 2 1 0 0 0 0 0.066499681
#> 3 0 1 0 0 0 -0.343839423
#> 4 1 1 0 0 0 -0.255957896
#> 5 0 0 1 0 0 0.381614222
#> 6 1 0 1 0 0 0.334916617
#> 7 0 1 1 0 0 0.024198743
#> 8 1 1 1 0 0 0.059297654
#> 9 0 0 0 1 0 0.180676146
#> 10 1 0 0 1 0 0.190656099
#> 11 0 1 0 1 0 -0.140666930
#> 12 1 1 0 1 0 -0.094245439
#> 13 0 0 1 1 0 0.363591787
#> 14 1 0 1 1 0 0.363546012
#> 15 0 1 1 1 0 0.111435827
#> 16 1 1 1 1 0 0.142772457
#> 17 0 0 0 0 1 0.248640472
#> 18 1 0 0 0 1 0.178471959
#> 19 0 1 0 0 1 -0.117930168
#> 20 1 1 0 0 1 -0.064838097
#> 21 0 0 1 0 1 0.404258155
#> 22 1 0 1 0 1 0.348609692
#> 23 0 1 1 0 1 0.114267433
#> 24 1 1 1 0 1 0.131731971
#> 25 0 0 0 1 1 0.241561478
#> 26 1 0 0 1 1 0.229693510
#> 27 0 1 0 1 1 0.001390233
#> 28 1 1 0 1 1 0.030884234
#> 29 0 0 1 1 1 0.369212761
#> 30 1 0 1 1 1 0.354971839
#> 31 0 1 1 1 1 0.166132390
#> 32 1 1 1 1 1 0.182368955
The final column is the correlation of O_data with all 31 possible sums of columns in M_data. You can tell which column is included by seeing which has a 1 under it for that row.
I try not to resort to matrices too much but this was the first thing I thought of.

Force `table` to include all factors from both arrays in R

I am using the following R code to produce a confusion matrix comparing the true labels of some data to the output of a neural network.
t <- table(as.factor(test.labels), as.factor(nnetpredict))
However, sometimes the neural network doesn't predict any of a certain class, so the table isn't square (as, for example, there are 5 levels in the test.labels factor, but only 3 levels in the nnetpredict factor). I want to make the table square by adding in any factor levels necessary, and setting their counts to zero.
How should I go about doing this?
Example:
> table(as.factor(a), as.factor(b))
1 2 3 4 5 6 7 8 9 10
1 1 0 0 0 0 0 0 1 0 0
2 0 1 0 0 0 0 0 0 1 0
3 0 0 1 0 0 0 0 0 0 1
4 0 0 0 1 0 0 0 0 0 0
5 0 0 0 0 1 0 0 0 0 0
6 0 0 0 0 0 1 0 0 0 0
7 0 0 0 0 0 0 1 0 0 0
You can see in the table above that there are 7 rows, but 10 columns, because the a factor only has 7 levels, whereas the b factor has 10 levels. What I want to do is to pad the table with zeros so that the row labels and the column labels are the same, and the matrix is square. From the example above, this would produce:
1 2 3 4 5 6 7 8 9 10
1 1 0 0 0 0 0 0 1 0 0
2 0 1 0 0 0 0 0 0 1 0
3 0 0 1 0 0 0 0 0 0 1
4 0 0 0 1 0 0 0 0 0 0
5 0 0 0 0 1 0 0 0 0 0
6 0 0 0 0 0 1 0 0 0 0
7 0 0 0 0 0 0 1 0 0 0
8 0 0 0 0 0 0 0 0 0 0
9 0 0 0 0 0 0 0 0 0 0
10 0 0 0 0 0 0 0 0 0 0
The reason I need to do this is two-fold:
For display to users/in reports
So that I can use a function to calculate the Kappa statistic, which requires a table formatted like this (square, same row and col labels)
EDIT - round II to address the additional details in the question. I deleted my first answer since it wasn't relevant anymore.
This has produced the desired output for the test cases I've given it, but I definitely advise testing thoroughly with your real data. The approach here is to find the full list of levels for both inputs into the table and set that full list as the levels before generating the table.
squareTable <- function(x,y) {
x <- factor(x)
y <- factor(y)
commonLevels <- sort(unique(c(levels(x), levels(y))))
x <- factor(x, levels = commonLevels)
y <- factor(y, levels = commonLevels)
table(x,y)
}
Two test cases:
> #Test case 1
> set.seed(1)
> x <- factor(sample(0:9, 100, TRUE))
> y <- factor(sample(3:7, 100, TRUE))
>
> table(x,y)
y
x 3 4 5 6 7
0 2 1 3 1 0
1 1 0 2 3 0
2 1 0 3 4 3
3 0 3 6 3 2
4 4 4 3 2 1
5 2 2 0 1 0
6 1 2 3 2 3
7 3 3 3 4 2
8 0 4 1 2 4
9 2 1 0 0 3
> squareTable(x,y)
y
x 0 1 2 3 4 5 6 7 8 9
0 0 0 0 2 1 3 1 0 0 0
1 0 0 0 1 0 2 3 0 0 0
2 0 0 0 1 0 3 4 3 0 0
3 0 0 0 0 3 6 3 2 0 0
4 0 0 0 4 4 3 2 1 0 0
5 0 0 0 2 2 0 1 0 0 0
6 0 0 0 1 2 3 2 3 0 0
7 0 0 0 3 3 3 4 2 0 0
8 0 0 0 0 4 1 2 4 0 0
9 0 0 0 2 1 0 0 3 0 0
> squareTable(y,x)
y
x 0 1 2 3 4 5 6 7 8 9
0 0 0 0 0 0 0 0 0 0 0
1 0 0 0 0 0 0 0 0 0 0
2 0 0 0 0 0 0 0 0 0 0
3 2 1 1 0 4 2 1 3 0 2
4 1 0 0 3 4 2 2 3 4 1
5 3 2 3 6 3 0 3 3 1 0
6 1 3 4 3 2 1 2 4 2 0
7 0 0 3 2 1 0 3 2 4 3
8 0 0 0 0 0 0 0 0 0 0
9 0 0 0 0 0 0 0 0 0 0
>
> #Test case 2
> set.seed(1)
> xx <- factor(sample(0:2, 100, TRUE))
> yy <- factor(sample(3:5, 100, TRUE))
>
> table(xx,yy)
yy
xx 3 4 5
0 4 14 9
1 14 15 9
2 11 11 13
> squareTable(xx,yy)
y
x 0 1 2 3 4 5
0 0 0 0 4 14 9
1 0 0 0 14 15 9
2 0 0 0 11 11 13
3 0 0 0 0 0 0
4 0 0 0 0 0 0
5 0 0 0 0 0 0
> squareTable(yy,xx)
y
x 0 1 2 3 4 5
0 0 0 0 0 0 0
1 0 0 0 0 0 0
2 0 0 0 0 0 0
3 4 14 11 0 0 0
4 14 15 11 0 0 0
5 9 9 13 0 0 0

Resources