'storing elements of a loop as tables

I have the following code:

# Example 1: Unlabeled Design
des <- rotation.design(attribute.names = list(
  Region = c("Reg_A", "Reg_B", "Reg_C"), 
  Eco = c("Conv.", "More", "Most"), 
  Price = c("1", "1.1", "1.2")), 
  nalternatives = 2, nblocks = 3, row.renames = FALSE, 
  randomize = TRUE, seed = 987)
des


#common = c("Reg_A","Conv","1")
choice.experiment.design<-des

cards<-list()
k<-1

questionnaire.mod<-function (choice.experiment.design, common = NULL, quote = TRUE) 
{
  nblocks <- choice.experiment.design$design.information$nblocks
  nquestions <- choice.experiment.design$design.information$nquestions
  nalternatives <- choice.experiment.design$design.information$nalternatives
  nattributes <- choice.experiment.design$design.information$nattributes
  attribute.names <- names(choice.experiment.design[[1]][[1]])[-(1:3)]
  my.design <- as.matrix(choice.experiment.design[[1]][[1]])
  if (nalternatives >= 2) {
    for (i in 2:nalternatives) {
      my.design <- rbind(my.design, as.matrix(choice.experiment.design$alternatives[[i]]))#
    }
  }
  if (is.null(common) == FALSE) {
    nalternatives <- nalternatives + 1
    common.base <- choice.experiment.design$alternatives[[1]]
    common.base[, 3] <- nalternatives
    common.base <- as.matrix(common.base)
    for (i in attribute.names) {
      common.base[, i] <- common[[i]]#
    }
    my.design <- rbind(my.design, common.base)
  }
  rownames(my.design) <- NULL
  my.design <- data.frame(my.design)
  my.design$BLOCK <- as.numeric(as.character(my.design$BLOCK))
  my.design$QUES  <- as.numeric(as.character(my.design$QES))
  my.design$ALT   <- as.numeric(as.character(my.design$ALT))
  my.design <- my.design[order(my.design$BLOCK, my.design$QES, 
                               my.design$ALT), ]
  #alternative.names <- paste("alt.", 1:nalternatives, sep = "")
  alternative.names <- paste("alt.", LETTERS[1:nalternatives], sep = "")
  
  cat("\n")
  for (i in 1:nblocks) {
    cat("Block", i, "\n", "\n")
    for (j in 1:nquestions) {
      cat("Question", j, "\n")
      temp <- subset(my.design, my.design$BLOCK == i & my.design$QES == j)#
      temp <- temp[, 4:(3 + nattributes)]
      if (nattributes == 1) {
        temp <- as.data.frame(temp)
        names(temp) <- attribute.names
        temp.dataframe<- t(temp)
        colnames(temp.dataframe) <- alternative.names
        # Save result
        cards[[i]][[j]] <- temp.dataframe#added to the code
        questionna   }
      
      temp <- t(temp)
      colnames(temp) <- alternative.names
      print(temp, quote = quote)
      cat("\n")
      
    }
  }
}


questionnaire.mod(des,common = NULL,quote = TRUE)

and this result:

Block 1 
 
Question 1 
       alt.A   alt.B  
Region "Reg_A" "Reg_A"
Eco    "Most"  "More" 
Price  "1.1"   "1.2"  

Question 2 
       alt.A   alt.B  
Region "Reg_A" "Reg_C"
Eco    "More"  "Most" 
Price  "1.2"   "1.2"  

Question 3 
       alt.A   alt.B  
Region "Reg_C" "Reg_C"
Eco    "Most"  "More" 
Price  "1.2"   "1"    

Block 2 
 
Question 1 
       alt.A   alt.B  
Region "Reg_C" "Reg_B"
Eco    "More"  "More" 
Price  "1"     "1.1"  

Question 2 
       alt.A   alt.B  
Region "Reg_B" "Reg_B"
Eco    "More"  "Conv."
Price  "1.1"   "1.2"  

Question 3 
       alt.A   alt.B  
Region "Reg_B" "Reg_A"
Eco    "Most"  "Conv."
Price  "1"     "1"    

Block 3 
 
Question 1 
       alt.A   alt.B  
Region "Reg_C" "Reg_A"
Eco    "Conv." "Most" 
Price  "1.1"   "1.1"  

Question 2 
       alt.A   alt.B  
Region "Reg_B" "Reg_C"
Eco    "Conv." "Conv."
Price  "1.2"   "1.1"  

Question 3 
       alt.A   alt.B  
Region "Reg_A" "Reg_B"
Eco    "Conv." "Most" 
Price  "1"     "1"   

I would like that each of the questions (i.e. question 1,2,3...) is stored as a dataframe within the list "cards" I created (at the beggining of the code). I am new to loops and so far I am unable to understand why my code is not working.

I changed a bit of the code and added this

        cards[[i]][[j]] <- temp.dataframe#added to the code

but still the results are not being stored in the loop



Solution 1:[1]

Here's how you could create a list cards containing i lists of j dataframes, where i corresponds to blocks and j corresponds to questions within blocks.

library(support.CEs)

des <- rotation.design(attribute.names = list(
  Region = c("Reg_A", "Reg_B", "Reg_C"), 
  Eco = c("Conv.", "More", "Most"), 
  Price = c("1", "1.1", "1.2")), 
  nalternatives = 2, nblocks = 3, row.renames = FALSE, 
  randomize = TRUE, seed = 987)

choice.experiment.design <- des
common = NULL
quote = TRUE
  
cards <- list()
blocks <- list()

nblocks <- choice.experiment.design$design.information$nblocks
nquestions <- choice.experiment.design$design.information$nquestions
nalternatives <- choice.experiment.design$design.information$nalternatives
nattributes <- choice.experiment.design$design.information$nattributes
attribute.names <- names(choice.experiment.design[[1]][[1]])[-(1:3)]
my.design <- as.matrix(choice.experiment.design[[1]][[1]])

if (nalternatives >= 2) {
  for (i in 2:nalternatives) {
    my.design <- rbind(my.design, as.matrix(choice.experiment.design$alternatives[[i]]))
  }
}

if (is.null(common) == FALSE) {
  nalternatives <- nalternatives + 1
  common.base <- choice.experiment.design$alternatives[[1]]
  common.base[, 3] <- nalternatives
  common.base <- as.matrix(common.base)
  for (i in attribute.names) {
    common.base[, i] <- common[[i]]
  }
  my.design <- rbind(my.design, common.base)
}

rownames(my.design) <- NULL
my.design <- data.frame(my.design)
my.design$block <- as.numeric(as.character(my.design$BLOCK)) #updated to all caps
my.design$task  <- as.numeric(as.character(my.design$QES)) #updated to all caps
my.design$alt   <- as.numeric(as.character(my.design$ALT)) #updated to all caps

my.design <- my.design[order(my.design$block, my.design$task, my.design$alt), ]
#alternative.names <- paste("alt.", 1:nalternatives, sep = "")
alternative.names <- paste("alt.", LETTERS[1:nalternatives], sep = "")

cat("\n")
for (i in 1:nblocks) {
  cat("Block", i, "\n", "\n")
  for (j in 1:nquestions) {
    cat("Question", j, "\n")
    temp <- subset(my.design, my.design$BLOCK == i & my.design$QES == j) #updated to all
    temp <- temp[, 4:(3 + nattributes)]
    if (nattributes == 1) {
      temp <- as.data.frame(temp)
      names(temp) <- attribute.names
      temp.dataframe<- t(temp)
      colnames(temp.dataframe) <- alternative.names
    } else {
      temp.dataframe <- t(temp)
      colnames(temp) <- alternative.names
    }
    # Print result
    print(temp.dataframe, quote = quote)
    cat("\n")
    # Save result
    blocks[[j]] <- temp.dataframe
  }
  cards[[i]] <- blocks
}

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1