Drag and Drop - Shape Pilot (N=30)

Drag and Drop

1. Descriptive Statistics of Respondent Effort in the Task

1.1 Drag-and-drop count

• Definition: The number of drag-and-drop actions (recorded with the RankCount) - only counts when the a drag-and-drop action results in an order change

### plot ###

plot_quiz <- function(data, column, title, item_n) {
  n_obs <- nrow(data)  # Total number of rows
  mean_val <- mean(data[[column]], na.rm = TRUE)  # Calculate mean
  median_val <- median(data[[column]], na.rm = TRUE)  # Calculate median
  subtitle_text <- paste0("Item.N = ", item_n, "; Subj.N = ", n_obs,
                          ", Mean = ", round(mean_val, 2),
                          ", Median = ", round(median_val, 2))
  
  ggplot(data, aes(x = "", y = !!sym(column))) + 
    geom_violin(fill = "lightblue", alpha = 0.5) + 
    geom_boxplot(width = 0.1, color = "black", alpha = 0.8) + 
    geom_jitter(width = 0.1, size = 1.5, color = "black", alpha = 0.6)+ 
    theme_minimal() + 
    labs(
      title = title,
      subtitle = subtitle_text,
      x = "",
      y = "Drag count"
    ) + 
    theme(plot.title = element_text(hjust = 0.5, face="bold"), plot.subtitle = element_text(hjust = 0.5)) +
    scale_y_continuous(breaks = seq(1, 7, by = 1), limits = c(1, 7))
}

# Create plots for each quiz
Quiz_WarmUp <- plot_quiz(dat, "RankCount_WarmUp", "Warm Up", item_n = 5)
Quiz_Color  <- plot_quiz(dat, "RankCount_Color", "Color Condition", item_n = 6)
Quiz_Corner <- plot_quiz(dat, "RankCount_Corner", "Corner Condition", item_n = 6)

# Combine all plots into one graph
combined_plot <- (Quiz_WarmUp | Quiz_Color | Quiz_Corner)
combined_plot

1.2 Correlation between initial and final rank

• RankProcess data format: {0, initial rank order}{timestamp, new rank order}, etc.
• low correlations between initial and final rank for all 6 items across quiz conditions.

# dat_A$RankProcess_A
# dat_A$TaskA_40 # while the final rank in the RankProcess variable is inaccurate for the reason mentioned above, the initial rank is. We will correct the issue pertaining to the final rank later in the notebook. 2024/11/26

process_task <- function(data, rank_column, task_label) {
  # Extract the initial order
  initial_order <- sub("^\\{([^}]*)\\}.*", "\\1", data[[rank_column]]) # captures the content within the first {} in the string; we will apply this to the RankProcess column; Using double bracket to capture a vector 

  initial_order <- gsub("0; ", "", initial_order) # remove the 0 timestamp
  initial_order_split <- strsplit(initial_order, ",") # separate the strings into list
  
  # Identify unique items
  unique_items <- unique(unlist(initial_order_split))
  
  # Create a data frame to store initial ranks
  initial_positions_df <- data.frame(matrix(ncol = length(unique_items), nrow = length(initial_order_split))) # nrow is the number of respondents 
  names(initial_positions_df) <- paste0("initial.items_", unique_items)
  
  # Fill initial ranks
  for (i in seq_along(initial_order_split)) {
    initial_order <- initial_order_split[[i]] # for each respondent, extract the string of initial order
    for (j in seq_along(initial_order)) {
      item <- initial_order[j]
      initial_positions_df[i, paste0("initial.items_", item)] <- j
    }
  }
  
  data <- cbind(data, initial_positions_df)
  assign(paste0("initial.dat_", task_label), data, envir = .GlobalEnv)
  
  cor_results <- data.frame(
    item = paste0("rank_", task_label, "_", unique_items),
    initial_item = paste0("initial.items_", unique_items),
    correlation = NA_real_,
    p_value = NA_real_
  )
  
  cor_results <- cor_results %>% # it is important to do this step by Task, because IDs are only unique and consistent within each quiz.
    rowwise() %>%
    mutate(
      correlation = cor.test(data[[item]], data[[initial_item]])$estimate,
      p_value = cor.test(data[[item]], data[[initial_item]])$p.value
    ) %>%
    mutate(sig = p_value < 0.05) 
  
  cor_results$task <- task_label
  cor_results
}

# List of datasets, rank columns, and task labels
tasks <- list(
  list(data = dat, rank_column = "RankProcess_Color", task_label = "color"),
  list(data = dat, rank_column = "RankProcess_Corner", task_label = "corner")
)

all_results <- bind_rows(lapply(tasks, function(t) {
  process_task(t$data, t$rank_column, t$task_label)
}))

summary_stats <- all_results %>%
  group_by(task) %>%
  summarise(
    Mean = round(mean(correlation, na.rm = TRUE), 2),
    Median = round(median(correlation, na.rm = TRUE), 2),
    N = n()
  )

# summary_stats

combined_plot <- ggplot(all_results, aes(x = task, y = correlation)) + 
  geom_violin(fill = "lightblue", alpha = 0.5) + 
  geom_jitter(aes(color = sig), width = 0.1, size = 1.5, alpha = 0.6) + 
  scale_color_manual(
    values = c("TRUE" = "red", "FALSE" = "black"), 
    labels = c("ns.", "p<.05"), 
    name = "p value"
  ) + 
  theme_minimal() + 
  labs(
    title = " Correlations for Initial and Final Ranks Across Tasks",
        subtitle = paste(
      " Color Task: Mean =", summary_stats$Mean[1], ", Median =", summary_stats$Median[1], ", N =", summary_stats$N[1], "\n",
      " Corner Task: Mean =", summary_stats$Mean[2], ", Median =", summary_stats$Median[2], ", N =", summary_stats$N[2], "\n"
    ),
    x = "Task",
    y = "Correlation"
  ) +
  theme(
    plot.title = element_text(hjust = 0.5),
    plot.subtitle = element_text(hjust = 0.5)
  )

# Print the plot
print(combined_plot)

# Examination
# initial_order <- sub("^\\{([^}]*)\\}.*", "\\1", dat_A[["RankProcess_A"]]) # captures the content within the first {} in the string; we will apply this to the RankProcess column
#   initial_order <- gsub("0; ", "", initial_order) # remove the 0 timestamp
#   initial_order_split <- strsplit(initial_order, ",")
# initial_order
# initial_order_split

1.3 Rank Quiz Page Duration (seconds)

# each extract a dataset for each task and then do the psych mean thing

summarize_task <- function(data, column_name, task_name) {
  data %>%
    summarise(
      Task = task_name,
      Mean_t = mean(.data[[column_name]], na.rm = TRUE),
      Median_t = median(.data[[column_name]], na.rm = TRUE),
      SD = sd(.data[[column_name]], na.rm = TRUE),
      Min = min(.data[[column_name]], na.rm = TRUE),
      Max = max(.data[[column_name]], na.rm = TRUE),
      N = sum(!is.na(.data[[column_name]]))
    )
}

# Apply the function to each dataset
summary_corner <- summarize_task(dat, "t_corner_Page.Submit", "Corner")
summary_color <- summarize_task(dat, "rank_color_t_Page.Submit", "Color")
summary_warmup <- summarize_task(dat, "t_warmup_Page.Submit", "WarmUp")



# Combine all summaries into one table
all_summaries <- bind_rows(summary_warmup,summary_corner, summary_color)


# t.test(dat$t_corner_Page.Submit,dat$rank_color_t_Page.Submit)
all_summaries

Pilot Data Special Edition

Warm Up Task

• All but one participants passed the warm-up test on their first attempt.
• Reminder: Each participant is given up to 4 attempts to pass.

ggplot(dat, aes(x = factor(WarmUpAttempt_N+1))) +
  geom_bar(fill = "steelblue", color = "black", alpha = 0.8) +
  scale_x_discrete(limits = as.character(1:4)) +
  labs(
    title = "Distribution of Warm-Up Attempts",
    x = "Number of Warm-Up Attempts",
    y = "Count"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5),
    axis.text = element_text(size = 12),
    axis.title = element_text(size = 13)
  )

ATTN and Dosage Question

• As an attention check, we asked participants to identify the tasks they had just completed
  • “After the warm-up quiz, you completed two tasks in which you ranked a set of shapes based on specific dimensions. Which of the following dimensions were you instructed to rank the shapes in those two tasks? (Select all that apply.)” [Color/Symmetry/Perimeter/Number of Corners/Aesthetic Appeal]
• Odd..

correct_answer <- "9,16"

dat <- dat %>%
  mutate(dose.coded = ifelse(Dose == correct_answer, "Correct", "Incorrect"))
# Recode attn1 (9 is correct)
dat$attn1.coded <- ifelse(dat$attn1 == 9, "Correct", "Incorrect")

dat$dose.coded <- as.factor(dat$dose.coded)
dat$attn1.coded <- as.factor(dat$attn1.coded)

dat_long <- dat %>%
  pivot_longer(cols = c(dose.coded, attn1.coded), names_to = "Question", values_to = "Response")

ggplot(dat_long, aes(x = Response, fill = Question)) +
  geom_bar(position = "dodge") +  # Bar plot using counts
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 5) +  # Add count labels
  facet_wrap(~Question, scales = "free_x") +  # Separate plots for dose.coded and attn1.coded
  labs(x = "Response", y = "Count", title = "Count of Correct & Incorrect Responses") +
  theme_bw() +
  ylim(0, 40)  # Set y-axis limit

dose.wrong.subj<-dat%>%filter(dose.coded=="Incorrect")%>%pull(ResponseId)

# Display the actual things people select

Brief Questions

• We asked participants four questions:
  • You were asked to rank various shapes in terms of their colors and the number of corners. Compared to other surveys you have completed, how much effort did you put into answering accurately? [1=Much less effort than average to 7=Much more effort than average]
  • Did you find the survey tedious.
  • Did you find the survey confusing.
  • Did you use any external sources to answer these questions?

print("Response to Effort Question:")

## [1] "Response to Effort Question:"

ggplot(dat, aes(x = "", y = effort)) +  # Empty x to get a single violin
  geom_violin(fill = "lightblue", alpha = 0.6) +  # Violin plot with transparency
  geom_jitter(width = 0.1, alpha = 0.5) +  # Add jittered points for visibility
  geom_hline(yintercept = 3.5, linetype = "dashed", color = "red", size = 1) +  # Dashed line at 3.5
  annotate("text", x = 1.2, y = 4, label = "Averaged Effort would be 3.5", color = "red", fontface = "bold") +  # Label for line
  scale_y_continuous(breaks = 1:7, limits = c(1, 7)) +  # Y-axis from 1 to 7 with integer marks
  labs(x = "", y = "Effort", title = "Distribution of Effort Responses") +
  theme_minimal()

dat$confuse.coded [dat$confuse== 1] = 'Yes'
dat$confuse.coded [dat$confuse== 2] = 'No'
dat$tedious.coded [dat$tedious == 1] = 'Yes'
dat$tedious.coded [dat$tedious == 2] = 'No'

dat$external.coded [dat$external == 1] = 'Yes'
dat$external.coded [dat$external == 2] = 'No'
dat$confuse.coded <-as.factor(dat$confuse.coded)
dat$tedious.coded <-as.factor(dat$tedious.coded)
dat$external.coded <-as.factor(dat$external.coded)

# Reshape data to long format
dat_long <- dat %>%
  pivot_longer(cols = c(confuse.coded, tedious.coded,external.coded), names_to = "Question", values_to = "Response")

ggplot(dat_long, aes(x = Response, fill = Question)) +
  geom_bar(position = "dodge") +  # Use counts instead of proportions
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 5) +  # Add count labels
  facet_wrap(~Question, scales = "free_x") +  # Separate plots for confuse and tedious
  labs(x = "Response", y = "Count", title = "Count of Responses for 'Confuse' and 'Tedious' Qs") +
  theme_bw()+
  ylim(0,40)

Guess Purpose

• If participants suspect that the study aims to investigate how they rank different options, such conscious awareness could influence how naturally they respond. Therefore, it is important that participants do not correctly infer the study’s purpose. The responses suggest that the majority of participants were unaware of the study’s objective. Most people say attention and logic. the following seems interesting:
  • “I really not sure of the purpose, but it was a fun exercise. Perhaps it was to see if I could follow directions. For instance, the first test I started putting the objects with fewer corners at the top. Then I re-read the directions and saw that they go at the bottom.”
    • Noise

Rank Task Approach

• We also asked participants how they have approached the ranking task.
  • “Rank in mind”: I ranked all the shapes in my mind first, then arranged them accordingly in the ranking task.
  • “Rank Sequentially”: I started by placing the item that best fit the instruction at the top, then repeated this process for the remaining shapes in order.
  • “Rank Extremes”: I started by placing the items that best fit the instruction at both the top and bottom, then sorted the remaining shapes in between.
  • “Rank Pairwise”: I arranged the shapes by comparing them in pairs, first swapping the most clearly distinguishable ones.
  • Other: None of the above alone describes how I approached the tasks.

Color Last Condition

dat$process_color [dat$process_color== 1] = 'Rank in mind.'
dat$process_color [dat$process_color== 2] = 'Rank Sequentially'
dat$process_color [dat$process_color == 3] = 'Rank Pairwise'
dat$process_color [dat$process_color == 4] = 'Other'
dat$process_color [dat$process_color == 5] = 'Rank Extreme'

dat$process_color <- factor(dat$process_color, levels = names(sort(table(dat$process_color), decreasing = TRUE)))

ggplot(dat%>%filter(!is.na(process_color)), aes(x = process_color)) +
  geom_bar() +  # Use counts instead of proportions
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 5) +  # Add count labels
  labs(x = "Ranking Approach", y = "Count", title = "Distribution of Ranking Approaches") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none") + # Tilt x-axis labels
ylim(c(0,20))

Corner Last Condition

dat$process_corner [dat$process_corner== 1] = 'Rank in mind.'
dat$process_corner [dat$process_corner== 2] = 'Rank Sequentially'
dat$process_corner [dat$process_corner == 3] = 'Rank Pairwise'
dat$process_corner [dat$process_corner == 4] = 'Other'
dat$process_corner [dat$process_corner == 5] = 'Rank Extreme'

dat$process_corner <- factor(dat$process_corner, levels = names(sort(table(dat$process_corner), decreasing = TRUE)))

ggplot(dat%>%filter(!is.na(process_corner)), aes(x = process_corner)) +
  geom_bar() +  # Use counts instead of proportions
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 5) +  # Add count labels
  labs(x = "Ranking Approach", y = "Count", title = "Distribution of Ranking Approaches") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none") + # Tilt x-axis labels
ylim(c(0,20))

• Responses from the 3 respondents who answered “other”:
  • Rank Sequentially: I looked for the darkest one first in the “order in the darkest to lightest” question, then went from there.
  • Taking-care-of-extreme-first: I placed the shape with the fewest corners at the bottom, then moved through the rest of the shapes from bottom to top.
  • Confirmation Stage?: “Honestly, its hard to say, I guess I sort of did a combination of sorting them in my head first and comparing pairs. I think I compared pairs to double check.”

Device Used During the Ranking Quiz

• Possible Answers:
  • Mouse (wired or wireless)
  • Trackpad (touchpad)
  • Touchscreen (finger or stylus)
  • Others

dat$device [dat$device== 1] = 'Mouse (Wired or Wireless)'
dat$device [dat$device== 2] = 'Trackpad (touchpad)'
dat$device [dat$device == 4] = 'Touchscreen (finger or stylus)'
dat$device [dat$device == 3] = 'Other'

dat$device <- factor(dat$device, levels = names(sort(table(dat$device), decreasing = TRUE)))

ggplot(dat%>%filter(!is.na(device)), aes(x = device)) +
  geom_bar() +  # Use counts instead of proportions
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5, size = 5) +  # Add count labels
  labs(x = "Ranking Approach", y = "Count", title = "Distribution of Ranking Approaches") +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none") + # Tilt x-axis labels
ylim(c(0,20))

• Other Response: “trackball (wireless)”

Technical Issue

• “Did you run into any technical issue during the survey?”
• None said yes

Accuracy in Ranking Task

• Corner condition: 90% (27/30) Tau = 1
• Color condition: 87% (27/31) Tau = 1

# Results remain the same, p value becomes even more favrable.; I need to check if the remaining data contains any wrongly formatted drag_Process - two ;; Those could mess up the data.

### The following focuses on quizes A and B, the two quizes with focal items

RankProcess_Color<-dat%>%
  select(ResponseId,RankProcess_Color)%>%
  separate_rows(RankProcess_Color, sep = "}") %>% #separate data into long format... 
  mutate(RankProcess_Color = gsub("[{}]", "", RankProcess_Color))%>% # Remove the remaining curly braces `{`
  filter(RankProcess_Color!="")%>% # an empty obs is generated for each subject, removed
  separate(RankProcess_Color, into = c("timing", "order"), sep = ";")%>%
# RankProcess%>%
#   filter(is.na(order)) #none
  group_by(ResponseId)%>%
  mutate(step=row_number()-1)%>% # first row records the initial position of items.
  select(step,everything())%>%
  ungroup()

### Check order column format ###

#### RankProcess Check #####
RankProcess_Color$order <- trimws(RankProcess_Color$order)
is_valid <- grepl("^\\d+(,\\d+){5}$", RankProcess_Color$order)
bug_respondent_Color <- RankProcess_Color %>%
  filter(!is_valid) %>%
  pull(ResponseId)# exclude 0 respondent with incorrect format data.

# RankProcess_A%>%
#   filter(ResponseId=="R_61SsQv6Vz0cWHQt") # this respondent has a duplicated row; needs to be removed; we tentatively remove this respondent entirely. But perhaps we only need to remove the duplicate row?

RankProcess_Color<-RankProcess_Color%>%
  filter(!ResponseId %in% c(bug_respondent_Color)) # remove data from respondents with NA item_moved columns entirely. - Other Data Recording Issue
#### RankProcess Check DONE #####

#### Done Addressing Incorrect Data Recording ####


RankProcess_all_Color<-dat%>%
  select(ResponseId,RankProcess_all_Color)%>%
  separate_rows(RankProcess_all_Color, sep = "}") %>%
  mutate(RankProcess_all_Color = gsub("[{}]", "", RankProcess_all_Color))%>% # Remove the remaining curly braces `{`
  filter(RankProcess_all_Color!="")%>%
  separate(RankProcess_all_Color, into = c("timing", "order_all"), sep = ";")


RankProcess_Color<-RankProcess_Color%>%
  left_join(RankProcess_all_Color,by=c("ResponseId","timing"))%>%
  mutate(item_moved= sub(",.*", "", order_all))%>% # # Retain only the value before the first comma. This is because the we are asking JavaScript to capture the order at the moment of mousedown, with RankProcess_all, prior to Qualtrics fully integrating the order. Additionally, the moved item consistently appears first in the recorded sequence (tested with the "inspect" function), a feature we use to identify the item taken. This behavior should be periodically checked to confirm if Qualtrics updates any underlying processes. # 10/25/2024 Xuwen.
  ungroup()%>%
  mutate(item_moved=as.numeric(item_moved),
         item.f=as.factor(case_when(
    item_moved==51 ~ "CR6_CL2",
    item_moved==50 ~ "CR5_CL3",
    item_moved==49 ~ "CR4_CL5",
    item_moved==48 ~ "CR3_CL6",
    item_moved==47 ~ "CR2_CL4",
    item_moved==46 ~ "CR1_CL1" # 2024/11/26; verified these with Qualtrics Quiz Preview and using the "Inspect Element" feature
  )))

#### Address Incorrect Data Recording ####

na_subj_Color<-RankProcess_Color%>%
  filter(is.na(item_moved))%>%
  pull(ResponseId)  # some respondents have missing item moved - menaing that there are items in  rank process that cannot be matched from Rank process all. This only occurs in rare cases and remove data from these responents.
# one participant identified

#### RankProcess ALL Check  #####
RankProcess_Color$order_all <- trimws(RankProcess_Color$order_all)
Invalid <- grepl("^\\d+(,\\d+){5}$", RankProcess_Color$order_all)
bug_respondent_Color <- RankProcess_Color %>%
  filter(Invalid & timing!=0) %>%
  pull(ResponseId)
#### RankProcess ALL Check DONE #####

RankProcess_Color<-RankProcess_Color%>%
  filter(!ResponseId %in% c(na_subj_Color,bug_respondent_Color))

# RankProcess_A%>%
#   filter(is.na(item_moved)) # order_all variable was somehow not recorded in these rows. 


drag_and_drop_count_Color<-RankProcess_Color%>%
  filter(step!=0)%>% # step=0 shows initial rank. Remove this.
  group_by(ResponseId)%>%
  summarize(item_50_moved.N=sum(item_moved==50),
            item_51_moved.N=sum(item_moved==51),
            item_49_moved.N=sum(item_moved==49),
            item_48_moved.N=sum(item_moved==48),
            item_47_moved.N=sum(item_moved==47),
            item_46_moved.N=sum(item_moved==46))%>%
  ungroup() 


# length(unique(na_subj_Color)) # 6
# length(unique(dat_Color$ResponseId)) # 149
# length(unique(RankProcess_Color$ResponseId)) # 149; 
# length(unique(drag_and_drop_count_Color$ResponseId)) # 143;  and 7 instances, 6 with missing data
# RankProcess_Color%>%
#   filter(is.na(item_moved)) #7
# RankProcess_Color%>%
#   filter(step!=0) #622


# Results remain the same, p value becomes even more favrable.; I need to check if the remaining data contains any wrongly formatted drag_Process - two ;; Those could mess up the data.

### The following focuses on quizes A and B, the two quizes with focal items

RankProcess_Corner<-dat%>%
  select(ResponseId,RankProcess_Corner)%>%
  separate_rows(RankProcess_Corner, sep = "}") %>% #separate data into long format... 
  mutate(RankProcess_Corner = gsub("[{}]", "", RankProcess_Corner))%>% # Remove the remaining curly braces `{`
  filter(RankProcess_Corner!="")%>% # an empty obs is generated for each subject, removed
  separate(RankProcess_Corner, into = c("timing", "order"), sep = ";")%>%
# RankProcess%>%
#   filter(is.na(order)) #none
  group_by(ResponseId)%>%
  mutate(step=row_number()-1)%>% # first row records the initial position of items.
  select(step,everything())%>%
  ungroup()

### Check order column format ###

#### RankProcess Check #####
RankProcess_Corner$order <- trimws(RankProcess_Corner$order)
is_valid <- grepl("^\\d+(,\\d+){5}$", RankProcess_Corner$order)
bug_respondent_Corner <- RankProcess_Corner %>%
  filter(!is_valid) %>%
  pull(ResponseId)# exclude 0 respondent with incorrect format data.

# RankProcess_A%>%
#   filter(ResponseId=="R_61SsQv6Vz0cWHQt") # this respondent has a duplicated row; needs to be removed; we tentatively remove this respondent entirely. But perhaps we only need to remove the duplicate row?

RankProcess_Corner<-RankProcess_Corner%>%
  filter(!ResponseId %in% c(bug_respondent_Corner)) # remove data from respondents with NA item_moved columns entirely. - Other Data Recording Issue
#### RankProcess Check DONE #####

#### Done Addressing Incorrect Data Recording ####


RankProcess_all_Corner<-dat%>%
  select(ResponseId,RankProcess_all_Corner)%>%
  separate_rows(RankProcess_all_Corner, sep = "}") %>%
  mutate(RankProcess_all_Corner = gsub("[{}]", "", RankProcess_all_Corner))%>% # Remove the remaining curly braces `{`
  filter(RankProcess_all_Corner!="")%>%
  separate(RankProcess_all_Corner, into = c("timing", "order_all"), sep = ";")


RankProcess_Corner<-RankProcess_Corner%>%
  left_join(RankProcess_all_Corner,by=c("ResponseId","timing"))%>%
  mutate(item_moved= sub(",.*", "", order_all))%>% # # Retain only the value before the first comma. This is because the we are asking JavaScript to capture the order at the moment of mousedown, with RankProcess_all, prior to Qualtrics fully integrating the order. Additionally, the moved item consistently appears first in the recorded sequence (tested with the "inspect" function), a feature we use to identify the item taken. This behavior should be periodically checked to confirm if Qualtrics updates any underlying processes. # 10/25/2024 Xuwen.
  ungroup()%>%
  mutate(item_moved=as.numeric(item_moved),
         item.f=as.factor(case_when(
    item_moved==51 ~ "CR6_CL2",
    item_moved==50 ~ "CR5_CL3",
    item_moved==49 ~ "CR4_CL5",
    item_moved==48 ~ "CR3_CL6",
    item_moved==47 ~ "CR2_CL4",
    item_moved==46 ~ "CR1_CL1"  # 2024/11/26; verified these with Qualtrics Quiz Preview and using the "Inspect Element" feature
  )))

#### Address Incorrect Data Recording ####

na_subj_Corner<-RankProcess_Corner%>%
  filter(is.na(item_moved))%>%
  pull(ResponseId)  # some respondents have missing item moved - menaing that there are items in  rank process that cannot be matched from Rank process all. This only occurs in rare cases and remove data from these responents.
# one participant identified

#### RankProcess ALL Check  #####
RankProcess_Corner$order_all <- trimws(RankProcess_Corner$order_all)
Invalid <- grepl("^\\d+(,\\d+){5}$", RankProcess_Corner$order_all)
bug_respondent_Corner <- RankProcess_Corner %>%
  filter(Invalid & timing!=0) %>%
  pull(ResponseId)
#### RankProcess ALL Check DONE #####

RankProcess_Corner<-RankProcess_Corner%>%
  filter(!ResponseId %in% c(na_subj_Corner,bug_respondent_Corner))

# RankProcess_A%>%
#   filter(is.na(item_moved)) # order_all variable was somehow not recorded in these rows. 


drag_and_drop_count_Corner<-RankProcess_Corner%>%
  filter(step!=0)%>% # step=0 shows initial rank. Remove this.
  group_by(ResponseId)%>%
  summarize(item_50_moved.N=sum(item_moved==50),
            item_51_moved.N=sum(item_moved==51),
            item_49_moved.N=sum(item_moved==49),
            item_48_moved.N=sum(item_moved==48),
            item_47_moved.N=sum(item_moved==47),
            item_46_moved.N=sum(item_moved==46))%>%
  ungroup() 

# length(unique(na_subj_Corner)) # 6
# length(unique(dat_Corner$ResponseId)) # 149
# length(unique(RankProcess_Corner$ResponseId)) # 149; 
# length(unique(drag_and_drop_count_Corner$ResponseId)) # 143;  and 7 instances, 6 with missing data
# RankProcess_Corner%>%
#   filter(is.na(item_moved)) #7
# RankProcess_Corner%>%
#   filter(step!=0) #622

Summary_data_corner<- expand_grid(
 ResponseId = unique(RankProcess_Corner$ResponseId),
 item.f = unique(RankProcess_Corner$item.f))
Summary_data_corner<-Summary_data_corner%>%
  mutate(rank.color=
           case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6),
         rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3
         ))%>%
  left_join(dat%>%select(ResponseId,rank_corner_46:rank_corner_51),by="ResponseId")%>%
  mutate(Subj.rank=case_when(
    item.f=="CR4_CL5" ~ rank_corner_49,
    item.f=="CR2_CL4" ~ rank_corner_47,
    item.f== "CR6_CL2" ~ rank_corner_51,
    item.f== "CR1_CL1" ~ rank_corner_46,
    item.f == "CR5_CL3" ~ rank_corner_50,
    item.f == "CR3_CL6" ~ rank_corner_48))%>%
  select(-c(rank_corner_46:rank_corner_51))%>%
  group_by(ResponseId) %>%
  mutate(Tau =- cor(Subj.rank, rank.corner, method = "kendall")) %>%
  ungroup()

dat

Summary_data_color<- expand_grid(
 ResponseId = unique(RankProcess_Color$ResponseId),
 item.f = unique(RankProcess_Color$item.f))

Summary_data_color<-Summary_data_color%>%
  mutate(rank.color=
           case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6),
         rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3
         ))%>%
  left_join(dat%>%select(ResponseId,rank_color_46:rank_color_51),by="ResponseId")%>%
  mutate(Subj.rank=case_when(
    item.f=="CR4_CL5" ~ rank_color_49,
    item.f=="CR2_CL4" ~ rank_color_47,
    item.f== "CR6_CL2" ~ rank_color_51,
    item.f== "CR1_CL1" ~ rank_color_46,
    item.f == "CR5_CL3" ~ rank_color_50,
    item.f == "CR3_CL6" ~ rank_color_48))%>%
  select(-c(rank_color_46:rank_color_51))%>%
  group_by(ResponseId) %>%
  mutate(Tau = -cor(Subj.rank, rank.color, method = "kendall")) %>%
  ungroup()


Summary_data <- data.frame(
  Tau = c(Summary_data_corner$Tau, Summary_data_color$Tau),
  Group = rep(c("Corner", "Color"), c(length(Summary_data_corner$Tau), length(Summary_data_color$Tau))),
  ResponseId = c(Summary_data_corner$ResponseId, Summary_data_color$ResponseId)  # Add ResponseId
) %>%
  filter(!duplicated(paste(ResponseId,Group)))

mean_values <- Summary_data %>%
  group_by(Group) %>%
  summarize(mean_Tau = mean(Tau, na.rm = TRUE))
ggplot(Summary_data, aes(x = Group, y = Tau, fill = Group)) +
  geom_violin(trim = FALSE, alpha = 0.5) +  # Violin plot with transparency
  geom_jitter(width = 0.1, alpha = 0.5, size = 1.5) +  # Add jitter points
  stat_summary(fun = mean, geom = "point", shape = 23, size = 4, fill = "white") +  # Show mean as point
  geom_text(data = mean_values, aes(x = Group, y = mean_Tau, label = sprintf("%.2f", mean_Tau)), 
            hjust=2, fontface = "bold", size = 5, color = "black") +  # Add mean text labels
  scale_fill_manual(values = c("steelblue", "darkorange")) +  # Custom colors
  labs(
       x = "Condition",
       y = "Tau") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none",  # Remove redundant legend
        axis.title = element_text(face = "bold"),
        axis.text = element_text(face = "bold"))

corner_reverse_subj<-Summary_data_corner%>%
  filter(Tau<0)%>%
  pull(ResponseId)
color_reverse_subj<-Summary_data_color%>%
  filter(Tau<0)%>%
  pull(ResponseId)

corner_incorrect_subj<-Summary_data_corner%>%
  filter(Tau>=0 & Tau<1)%>%
  pull(ResponseId)
color_incorrect_subj<-Summary_data_color%>%
  filter(Tau>=0 & Tau<1)%>%
  pull(ResponseId)

corner_correct_subj<-Summary_data_corner%>%
  filter(Tau==1)%>%
  pull(ResponseId)
color_correct_subj<-Summary_data_color%>%
  filter(Tau==1)%>%
  pull(ResponseId)



# 26/29
# 22/29

# dose.wrong.subj # only one overlap with corner reverse

# length(unique(corner_incorrect_subj)) # 3 subj
# length(unique(corner_reverse_subj))
# length(unique(corner_correct_subj))

# length(unique(color_incorrect_subj)) # 3 subj
# length(unique(color_reverse_subj))
# length(unique(color_correct_subj))

# unique(corner_incorrect_subj)

# Examine<-dat%>%
#   filter(ResponseId=="R_57czmZivmqFW7cd")
# Examine$RankProcess_Corner
# Examine$RankProcess_all_Corner

# tau <- Summary_data_color %>% filter(!duplicated(ResponseId)) %>% pull(Tau)
# t.test(tau)$conf.int
# mean(tau)

• Tau < 0: None

• 0 < Tau < 1: Four participants (13%) in the color condition and three participants (10%) in the corner condition.

• If we exclude responses with negative Taus:

Summary_data.trim <- Summary_data %>%
  filter(!( (Group == "Corner" & ResponseId %in% corner_reverse_subj) | 
            (Group == "Color" & ResponseId %in% color_reverse_subj) ))

mean_values <- Summary_data.trim %>%
  group_by(Group) %>%
  summarize(mean_Tau = mean(Tau, na.rm = TRUE))
ggplot(Summary_data.trim, aes(x = Group, y = Tau, fill = Group)) +
  geom_violin(trim = FALSE, alpha = 0.5) +  # Violin plot with transparency
  geom_jitter(width = 0.1, alpha = 0.5, size = 1.5) +  # Add jitter points
  stat_summary(fun = mean, geom = "point", shape = 23, size = 4, fill = "white") +  # Show mean as point
  geom_text(data = mean_values, aes(x = Group, y = mean_Tau, label = sprintf("%.2f", mean_Tau)), 
            hjust=2, fontface = "bold", size = 5, color = "black") +  # Add mean text labels
  scale_fill_manual(values = c("steelblue", "darkorange")) +  # Custom colors
  labs(
       x = "Condition",
       y = "Tau") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none",  # Remove redundant legend
        axis.title = element_text(face = "bold"),
        axis.text = element_text(face = "bold"))+
  ylim(0,1.25)

df_summary.Corner<-Summary_data_corner%>%
  filter(ResponseId%notin%corner_reverse_subj)%>%
  group_by(item.f)%>%
  summarize(Subj.rank=7-mean(Subj.rank),
            rank.corner=mean(rank.corner))

ggplot(data = df_summary.Corner, aes(x = rank.corner, y = Subj.rank)) +
  geom_abline(intercept = 0, slope = 1, color="red", linewidth = .5) + 
  geom_point(size = 2.5) +
  theme_bw() +
  geom_smooth(method = "lm", se = F, formula = y ~ x) +
  theme(plot.margin = margin(t = 0.5, r = 1, b = 0.5, l = 1, "cm"),
        plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5),
        legend.position = "none") +
   geom_text_repel(label = df_summary.Corner$item.f,
                  nudge_y = 0.5,   # Moves labels slightly upward
                  box.padding = 0.5,  # Adds space around labels
                  point.padding = 0.3,  # Space between label and point
                  max.overlaps = 10,  # Limits label overlap
                  segment.curvature = -0.3,  # Slight curve in leader lines
                  segment.ncp = 3,  # Smoother line segments
                  segment.alpha = 0.7) +
  ylab("Mean Subjective Rank") +
  scale_y_discrete(limits = factor(1:6), name = "Mean Subjective Rank") +
  scale_x_discrete(limits = factor(1:6), name = bquote("Objective Rank"), breaks = c(seq(0, 20, by = 1), seq(20, 40, by = 10), seq(80, 300, by = 40))) +
  coord_fixed(ratio = 1)+
  labs(title="Corner Condition")

df_summary.Color<-Summary_data_color%>%
  filter(ResponseId%notin%color_reverse_subj)%>%
  group_by(item.f)%>%
  summarize(Subj.rank=7-mean(Subj.rank),
            rank.color=mean(rank.color))

ggplot(data = df_summary.Color, aes(x = rank.color, y = Subj.rank)) +
  geom_abline(intercept = 0, slope = 1, color="red", linewidth = .5) + 
  geom_point(size = 2.5) +
  theme_bw() +
  geom_smooth(method = "lm", se = F, formula = y ~ x) +
  theme(plot.margin = margin(t = 0.5, r = 1, b = 0.5, l = 1, "cm"),
        plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5),
        legend.position = "none") +
   geom_text_repel(label = df_summary.Color$item.f,
                  nudge_y = 0.5,   # Moves labels slightly upward
                  box.padding = 0.5,  # Adds space around labels
                  point.padding = 0.3,  # Space between label and point
                  max.overlaps = 10,  # Limits label overlap
                  segment.curvature = -0.3,  # Slight curve in leader lines
                  segment.ncp = 3,  # Smoother line segments
                  segment.alpha = 0.7) +
  ylab("Mean Subjective Rank") +
  scale_y_discrete(limits = factor(1:6), name = "Mean Subjective Rank") +
  scale_x_discrete(limits = factor(1:6), name = bquote("Objective Rank"), breaks = c(seq(0, 20, by = 1), seq(20, 40, by = 10), seq(80, 300, by = 40))) +
  coord_fixed(ratio = 1)+
  labs(title="Color Condition")

In the analysis below, I focus only on respondents with Tau = 1 (N=27 and 27 in color and corner conditions, respectively), examining their ranking process. Those with Tau = -1 may be useful as well but are not analyzed here for now. Finally, I think our goal might be to have at least 80% accurarcy rate for both tasks? We can consider preregistering an analysis that includes only respondents with Tau = 1.

2. 3F Analysis (More Often, First, and Further )

• I think data generally supports the rank sequentially model (3F hypothesis), with some participants appearing to exhibit the rank extreme pattern.

### Data Wrangling for Drag distance - in order to identify data recording where a bug had appeared to occur ###

Distance_Color<-RankProcess_Color %>%
  group_by(ResponseId)%>%
  mutate(
    # Split the string into parts based on commas
    parts = str_split(order, ",")
  ) %>%
  mutate(
    Rank1 = sapply(parts, function(x) x[1]),  # Extract before 1st comma
    Rank2 = sapply(parts, function(x) x[2]),  # Extract before 2nd comma
    Rank3 = sapply(parts, function(x) x[3]),  # Extract before 3rd comma
    Rank4 = sapply(parts, function(x) x[4]),  # Extract before 4th comma
    Rank5 = sapply(parts, function(x) x[5]),  # Extract before 5th comma
    Rank6 = sapply(parts, function(x) ifelse(length(x) > 5, x[6], NA))  # Extract after 5th comma
  ) %>%
  select(-parts)

items_Color <- c("50", "51", "49", "48", "47", "46")
for (item in items_Color) {
  Distance_Color[[paste0("current_", item)]] <- NA_integer_
}


Distance_Color <- Distance_Color %>%
  rowwise() %>%
  mutate(
    across(
      starts_with("current_"),
      ~ {
        item_number <- str_remove(cur_column(), "current_")  # Extract the item number
        case_when(
          Rank1 == item_number ~ 1,
          Rank2 == item_number ~ 2,
          Rank3 == item_number ~ 3,
          Rank4 == item_number ~ 4,
          Rank5 == item_number ~ 5,
          Rank6 == item_number ~ 6,
          TRUE ~ 1 # Distance_A %>% mutate(NA_count = rowSums(is.na(select(., starts_with("current_"))))); this code somehow results in the first item always gets an NA, so manually fix this error
        )
      }
    )
  ) %>%
  ungroup()

### No rows should have any repeated 1 in the "current_" columns ###
# Distance_A %>%
#   rowwise() %>%
#   mutate(
#     more_than_one_1 = sum(select(., starts_with("current_")) == 1, na.rm = TRUE) > 1
#   ) %>%
#   ungroup()%>%
#   filter(more_than_one_1) # NONE; good.


for (item in items_Color) {
  Distance_Color[[paste0("last_", item)]] <- lag(Distance_Color[[paste0("current_", item)]])
}


Distance_Color<-Distance_Color%>%
  group_by(ResponseId)%>%
  rowwise() %>%
  mutate(
    current_item_moved = get(paste0("current_", item_moved)),  # Get the rank of the moved item from current columns
    last_item_moved = get(paste0("last_", item_moved)),        # Get the rank of the moved item from last columns
    # Determine the movement direction; we should not see any "no_change"
    move_direction = case_when(
      is.na(last_item_moved) ~ "no_change",  
      current_item_moved < last_item_moved ~ "up",
      current_item_moved > last_item_moved ~ "down",
      TRUE ~ "no_change"
    )
  ) %>%
  ungroup()


Distance_Color <- Distance_Color %>%
  group_by(ResponseId)%>%
  filter(step!=0) # need to retain step 0 for steps that come before

bug_respondent_Color<-Distance_Color%>%
  filter(move_direction=="no_change")%>%pull(ResponseId) # 0 respondent

# table(Distance_Color$move_direction) #73.3

### Data Wrangling for Drag distance - in order to identify data recording where a bug had appeared to occur ###

Distance_Corner<-RankProcess_Corner %>%
  group_by(ResponseId)%>%
  mutate(
    # Split the string into parts based on commas
    parts = str_split(order, ",")
  ) %>%
  mutate(
    Rank1 = sapply(parts, function(x) x[1]),  # Extract before 1st comma
    Rank2 = sapply(parts, function(x) x[2]),  # Extract before 2nd comma
    Rank3 = sapply(parts, function(x) x[3]),  # Extract before 3rd comma
    Rank4 = sapply(parts, function(x) x[4]),  # Extract before 4th comma
    Rank5 = sapply(parts, function(x) x[5]),  # Extract before 5th comma
    Rank6 = sapply(parts, function(x) ifelse(length(x) > 5, x[6], NA))  # Extract after 5th comma
  ) %>%
  select(-parts)

items_Corner <- c("50", "51", "49", "48", "47", "46")
for (item in items_Corner) {
  Distance_Corner[[paste0("current_", item)]] <- NA_integer_
}


Distance_Corner <- Distance_Corner %>%
  rowwise() %>%
  mutate(
    across(
      starts_with("current_"),
      ~ {
        item_number <- str_remove(cur_column(), "current_")  # Extract the item number
        case_when(
          Rank1 == item_number ~ 1,
          Rank2 == item_number ~ 2,
          Rank3 == item_number ~ 3,
          Rank4 == item_number ~ 4,
          Rank5 == item_number ~ 5,
          Rank6 == item_number ~ 6,
          TRUE ~ 1 # Distance_A %>% mutate(NA_count = rowSums(is.na(select(., starts_with("current_"))))); this code somehow results in the first item always gets an NA, so manually fix this error
        )
      }
    )
  ) %>%
  ungroup()

### No rows should have any repeated 1 in the "current_" columns ###
# Distance_A %>%
#   rowwise() %>%
#   mutate(
#     more_than_one_1 = sum(select(., starts_with("current_")) == 1, na.rm = TRUE) > 1
#   ) %>%
#   ungroup()%>%
#   filter(more_than_one_1) # NONE; good.


for (item in items_Corner) {
  Distance_Corner[[paste0("last_", item)]] <- lag(Distance_Corner[[paste0("current_", item)]])
}


Distance_Corner<-Distance_Corner%>%
  group_by(ResponseId)%>%
  rowwise() %>%
  mutate(
    current_item_moved = get(paste0("current_", item_moved)),  # Get the rank of the moved item from current columns
    last_item_moved = get(paste0("last_", item_moved)),        # Get the rank of the moved item from last columns
    # Determine the movement direction; we should not see any "no_change"
    move_direction = case_when(
      is.na(last_item_moved) ~ "no_change",  
      current_item_moved < last_item_moved ~ "up",
      current_item_moved > last_item_moved ~ "down",
      TRUE ~ "no_change"
    )
  ) %>%
  ungroup()


Distance_Corner <- Distance_Corner %>%
  group_by(ResponseId)%>%
  filter(step!=0) # need to retain step 0 for steps that come before

bug_respondent_Corner<-Distance_Corner%>%
  filter(move_direction=="no_change")%>%pull(ResponseId) # 0 respondent


# table(Distance_Corner$move_direction) #75.9

drag_and_drop_count_Color_long <- drag_and_drop_count_Color %>%
  pivot_longer(
    cols = starts_with("item_"),   # All columns starting with "item_"
    names_to = c("item_number", ".value"),  # Splits into item_number and value columns
    names_sep = "_moved."           # Splitting based on the "_moved." part
  )%>%
  mutate(
    condition = "Color",
    item_number = as.numeric(gsub("item_", "", item_number)), 
    item.f = as.factor(case_when(
    item_number==50 ~ "CR5_CL3",
    item_number==51 ~ "CR6_CL2",
    item_number==49 ~ "CR4_CL5",
    item_number==48 ~ "CR3_CL6",
    item_number==47 ~ "CR2_CL4",
    item_number==46 ~ "CR1_CL1"
    ))
  )
drag_and_drop_count_Corner_long<-drag_and_drop_count_Corner%>%
  pivot_longer(
    cols = starts_with("item_"),   # All columns starting with "item_"
    names_to = c("item_number", ".value"),  # Splits into item_number and value columns
    names_sep = "_moved."           # Splitting based on the "_moved." part
  )%>%
  mutate(condition="Corner",
         item_number = as.numeric(gsub("item_", "", item_number)),
    item.f=as.factor(case_when(
    item_number==50 ~ "CR5_CL3",
    item_number==51 ~ "CR6_CL2",
    item_number==49 ~ "CR4_CL5",
    item_number==48 ~ "CR3_CL6",
    item_number==47 ~ "CR2_CL4",
    item_number==46 ~ "CR1_CL1"
    ))
  )

2.1 DV1: Drag Count

• Drag Count Indicator is used here

2.1.0 Distribution of Drag Count by item

drag_drop_counts_Color <- drag_and_drop_count_Color_long %>%
  filter(ResponseId%in%color_correct_subj)%>%
  count(item.f,N) %>%
  group_by(item.f)%>%
  mutate(percentage = n / sum(n) * 100,
         condition="Color")%>%
  ungroup()


drag_drop_counts_Corner <- drag_and_drop_count_Corner_long %>%
  filter(ResponseId%in%corner_correct_subj)%>%
  count(item.f,N) %>%
  group_by(item.f)%>%
  mutate(percentage = n / sum(n) * 100,
         condition="Corner")%>%
  ungroup()

# drag_and_drop_count_Color_long%>%
#   group_by(item.f)%>%
#   summarise(subj_count=n()) 
# drag_and_drop_count_Corner_long%>%
#   group_by(item.f)%>%
#   summarise(subj_count=n()) 

drag_drop_counts_combined<-rbind(drag_drop_counts_Color,drag_drop_counts_Corner)

ggplot(drag_drop_counts_combined, aes(x = factor(N), y = n)) +
  geom_bar(
    stat = "identity",
    # aes(fill = ifelse(item.f %in% c("Carpool5", "WFH3"), "highlight", "default")),
    color = "black"
  ) +
  geom_text(
    aes(
      label = paste0(n, " (", round(percentage, 1), "%)")
      # color = ifelse(item.f %in% c("Carpool5", "WFH3"), "highlight", "default")
    ),
    vjust = -0.5,
    size = 5,
    fontface="bold"
  ) +
  # scale_fill_manual(
  #   values = c("highlight" = "darkorange", "default" = "grey"),
  #   guide = "none"
  # ) +
  # scale_color_manual(
  #   values = c("highlight" = "darkorange", "default" = "grey"),
  #   guide = "none"
  # ) +
  labs(
    title = "Drag Count by item and Quiz Condition",
    x = "Drag Count",
    y = "Frequency"
  ) +
  theme_minimal() +
  theme(
    strip.text = element_text(size = 12, face = "bold"),  # Increased size and bold text
    plot.title = element_text(hjust = 0.5),
    axis.title = element_text(size = 12),  # Adjust axis titles size if needed
    axis.text = element_text(size = 10)    # Adjust axis labels size if needed
  ) +
  facet_wrap(~ item.f * condition,ncol=2) +
  ylim(0, 50)

2.1.1 Model-free visualization

• The following plot illustrates the mean and se of drag counts for each item, grouped by condition.

Coding Drag Count as a binary indicator variable

summary_data_Color_ind<- drag_and_drop_count_Color_long %>%
  filter(ResponseId%in%color_correct_subj)%>%
  mutate(N=case_when(
    N==0~0,
    TRUE~1
  ))%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(drag_drop_mean = mean(N, na.rm = TRUE),
            drag_drop_sd = sd(N, na.rm = TRUE),
            n = n(),
            se = drag_drop_sd / sqrt(n),
            .groups = "drop")
summary_data_Corner_ind<- drag_and_drop_count_Corner_long %>%
  filter(ResponseId%in%corner_correct_subj)%>%
  mutate(N=case_when(
    N==0~0,
    TRUE~1
  ))%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(drag_drop_mean = mean(N, na.rm = TRUE),
            drag_drop_sd = sd(N, na.rm = TRUE),
            n = n(),
            se = drag_drop_sd / sqrt(n),
            .groups = "drop")

summary_data_combined_ind <- bind_rows(summary_data_Color_ind, summary_data_Corner_ind)

custom_colors_color <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)

summary_data_combined_ind$item.f = factor(summary_data_combined_ind$item.f, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE)


# Plot
ggplot(summary_data_combined_ind, aes(x = condition, y = drag_drop_mean, 
                                      group = item.f, color = item.f, shape = item.f)) +
  geom_line(linewidth = 1, position = position_dodge(0.3)) +
  geom_point(size = 6, position = position_dodge(0.3)) +
  geom_errorbar(
    aes(
      ymin = drag_drop_mean - se,
      ymax = drag_drop_mean + se
    ),
    width = 0.2,
    position = position_dodge(0.3)
  ) +
  labs(
    x = "Condition",
    y = "Mean ± SE Drag Count",
    title = "Mean Drag Count by Condition"
  ) +
  scale_color_manual(values = custom_colors_color) +  
  scale_shape_manual(values = c("CR6_CL2" = 21, "CR5_CL3" = 22, 
                                "CR4_CL5" = 23, "CR3_CL6" = 24, 
                                "CR2_CL4" = 25, "CR1_CL1" = 11)) +
  theme_minimal() +
  theme(
    legend.position = "top", # Place legend at the top
    legend.title = element_text(face = "bold"),
    axis.title = element_text(face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    plot.title = element_text(face = "bold", hjust = 0.5)
  )

2.1.3 Correlation with Attribute Rank

The Attribute are UNCORRELATED (r=.028)

• Note on attribute rank coding:
  • Across color and corner conditions, greater value indicates higher rank (i.e., 1=item in the bottom and 6=item at the top.)

drag_and_drop_count_Color_long<-drag_and_drop_count_Color_long%>%
  filter(ResponseId%in%color_correct_subj)%>%
  mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_color%>%select(ResponseId,initial.items_49:initial.items_51),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6),
  N_ind=case_when(
    N==0~0,
    TRUE~1)
  )%>%
  select(-c(initial.items_49:initial.items_51))



# dat_D is frequency judgment of the intensity items 
# <!--     item_moved==41 ~ "Remote", -->
# <!--     item_moved==42 ~ "WFH3", -->
# <!--     item_moved==40 ~ "Walk", -->
# <!--     item_moved==44 ~ "Hybrid", -->
# <!--     item_moved==45 ~ "Carpool5", -->
# <!--     item_moved==43 ~ "Public" # 2025/02/04; verified these with Qualtrics Quiz Preview and using the "Inspect Element" feature 

summary_data_Color <- drag_and_drop_count_Color_long%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(drag_mean = mean(N_ind, na.rm = TRUE),
            drag_sd = sd(N_ind, na.rm = TRUE),
            n = n(),
            se = drag_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))


ggplot(summary_data_Color, aes(x = rank.color, y = rank.corner, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Attributes of shapes",  x = "Color Ranking", y = "Corner Rankings") +
  theme(axis.title = element_text(face = "bold"), 
        plot.subtitle = element_text(hjust = 0.5), 
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed")

Color Condition

• Aggregate Stats

ggplot(summary_data_Color, aes(x = rank.color, y = drag_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Count and Color Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Count Indicator") +
  theme(axis.title = element_text(face = "bold"), 
        plot.subtitle = element_text(hjust = 0.5), 
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(0,1)

ggplot(summary_data_Color, aes(x = rank.corner, y = drag_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Count and Corner Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Count Indicator") +
  theme(axis.title = element_text(face = "bold"), 
        plot.subtitle = element_text(hjust = 0.5), 
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(0,1)

• Predict Drag Count (Indicator) with attribute ranks
  • Model Specification: Drag Count predicted by color and corner attribute ranks
  • within each condition, still wondering if it makes sense to add item random effect control here… Xuwen reading this paper recommended by Antonia to learn more

M1<-glmer(N_ind~rank.color+rank.corner+(1|ResponseId),drag_and_drop_count_Color_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
M2<-glmer(N_ind~rank.color+rank.corner+initial.rank+(1|ResponseId),drag_and_drop_count_Color_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
M3<-glmer(N_ind~rank.color+rank.corner++initial.rank+(1|ResponseId)+(1|item.f),drag_and_drop_count_Color_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Odds Ratios	CI	p	Odds Ratios	CI	p	Odds Ratios	CI	p
Intercept	0.10	0.03 – 0.32	<0.001	0.78	0.06 – 10.80	0.852	0.78	0.04 – 16.43	0.873
Color Rank	1.97	1.52 – 2.54	<0.001	2.34	1.62 – 3.39	<0.001	2.28	1.47 – 3.53	<0.001
Corner Rank	1.26	1.03 – 1.54	0.027	1.20	0.92 – 1.57	0.175	1.22	0.82 – 1.81	0.326
Initial Rank [1]				0.00	0.00 – 0.05	<0.001	0.00	0.00 – 0.04	<0.001
Initial Rank [2]				0.04	0.00 – 0.48	0.011	0.04	0.00 – 0.43	0.008
Initial Rank [3]				0.16	0.01 – 1.81	0.139	0.16	0.01 – 1.76	0.135
Initial Rank [4]				0.20	0.02 – 2.17	0.184	0.18	0.02 – 2.05	0.169
Initial Rank [5]				0.26	0.02 – 2.80	0.269	0.28	0.03 – 3.09	0.301
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.11 ResponseId			0.00 ResponseId
							0.36 item.f
ICC				0.03			0.10
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.317 / NA			0.645 / 0.657			0.627 / 0.664

library(sandwich)
library(miceadds)
library(glmmML)

# test <- miceadds::glm.cluster( data=drag_and_drop_count_Color_long, formula=N_ind~rank.color+rank.corner+initial.rank,
#                 cluster=c("ResponseId","item.f"), family="binomial")
# summary(test)

Corner Condition

• Aggregate Stats

drag_and_drop_count_Corner_long<-drag_and_drop_count_Corner_long%>%
  filter(ResponseId%in%corner_correct_subj)%>%
  mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_corner%>%select(ResponseId,initial.items_50:initial.items_47),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6),
    N_ind=case_when(
    N==0~0,
    TRUE~1)
  )%>%
  select(-c(initial.items_50:initial.items_47))



# dat_D is frequency judgment of the intensity items 
# <!--     item_moved==41 ~ "Remote", -->
# <!--     item_moved==42 ~ "WFH3", -->
# <!--     item_moved==40 ~ "Walk", -->
# <!--     item_moved==44 ~ "Hybrid", -->
# <!--     item_moved==45 ~ "Carpool5", -->
# <!--     item_moved==43 ~ "Public" # 2025/02/04; verified these with Qualtrics Quiz Preview and using the "Inspect Element" feature 


summary_data_corner <- drag_and_drop_count_Corner_long%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(drag_mean = mean(N_ind, na.rm = TRUE),
            drag_sd = sd(N_ind, na.rm = TRUE),
            n = n(),
            se = drag_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))

ggplot(summary_data_corner, aes(x = rank.color, y = drag_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Count and Color Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Count Indicator") +
  theme(axis.title = element_text(face = "bold"), 
        plot.subtitle = element_text(hjust = 0.5), 
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(0,1)

ggplot(summary_data_corner, aes(x = rank.corner, y = drag_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Count and Corner Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Count Indicator") +
  theme(axis.title = element_text(face = "bold"), 
        plot.subtitle = element_text(hjust = 0.5), 
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(0,1)

• Predict Drag Count (Indicator) with attribute ranks

M1<-glmer(N_ind~rank.color+rank.corner+(1|ResponseId),drag_and_drop_count_Corner_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
M2<-glmer(N_ind~rank.color+rank.corner+initial.rank+(1|ResponseId),drag_and_drop_count_Corner_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))
M3<-glmer(N_ind~rank.color+rank.corner+initial.rank+(1|ResponseId)+(1|item.f),drag_and_drop_count_Corner_long,family=binomial,  control=glmerControl(optimizer="bobyqa",optCtrl=list(maxfun=2e5)))

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Odds Ratios	CI	p	Odds Ratios	CI	p	Odds Ratios	CI	p
Intercept	0.18	0.06 – 0.53	0.002	0.24	0.06 – 0.90	0.034	0.24	0.06 – 0.90	0.034
Color Rank	1.15	0.94 – 1.41	0.164	1.18	0.93 – 1.49	0.163	1.18	0.93 – 1.49	0.163
Corner Rank	1.58	1.28 – 1.94	<0.001	1.81	1.40 – 2.32	<0.001	1.81	1.40 – 2.32	<0.001
Initial Rank [1]				0.04	0.01 – 0.16	<0.001	0.04	0.01 – 0.16	<0.001
Initial Rank [2]				0.43	0.11 – 1.63	0.213	0.43	0.11 – 1.63	0.213
Initial Rank [3]				0.64	0.17 – 2.43	0.517	0.64	0.17 – 2.43	0.517
Initial Rank [4]				0.77	0.20 – 3.00	0.711	0.77	0.20 – 3.00	0.711
Initial Rank [5]				1.14	0.29 – 4.57	0.848	1.14	0.29 – 4.57	0.848
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.172 / NA			0.425 / NA			0.425 / NA

# test <- miceadds::glm.cluster( data=drag_and_drop_count_Corner_long, formula=N_ind~rank.color+rank.corner+initial.rank,
#                 cluster=c("ResponseId"), family="binomial")
# summary(test)

Model with Combined Datasets

• Color and Corner Attribute Ranks are centered before being entered into the model.
• For condition, the reference level is Color
• Model Specification: Drag count (indicator) predicted by rank.color.c + rank.corner.c + condition + interaction between condition and attribute ranks

# 1. need to center things 
# 2. need to do a collinearity check.

drag_and_drop_count_Color_long$condition<-"Color"
drag_and_drop_count_Corner_long$condition<-"Corner"
  
drag_and_drop_count_long.combined<-rbind(drag_and_drop_count_Color_long, drag_and_drop_count_Corner_long)%>%
  mutate(rank.corner.c=rank.corner-mean(rank.corner),
         rank.color.c=rank.color-mean(rank.color))

M1<-glmer(N_ind~rank.color.c*condition+rank.corner.c*condition+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)
M2<-glmer(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)
M3<-glmer(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId)+(1|item.f),drag_and_drop_count_long.combined,family=binomial)
 
# M1<-lmer(N_ind~rank.color.c*condition+rank.corner.c*condition+(rank.color|ResponseId)+(rank.corner|ResponseId),drag_and_drop_count_long.combined)
# M2<-lmer(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank+(rank.color|ResponseId)+(rank.corner|ResponseId),drag_and_drop_count_long.combined)
# M3<-lmer(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank+(rank.color|ResponseId)+(rank.corner|ResponseId)+(rank.color|item.f)+(rank.corner|item.f),drag_and_drop_count_long.combined)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank","Condition [Corner]","Corner Rank", "Color Rank x Condition [Corner]","Corner Rank x Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Odds Ratios	CI	p	Odds Ratios	CI	p	Odds Ratios	CI	p
Intercept	2.35	1.59 – 3.49	<0.001	8.72	3.40 – 22.39	<0.001	8.79	3.34 – 23.08	<0.001
Color Rank	1.97	1.52 – 2.54	<0.001	2.17	1.61 – 2.92	<0.001	2.14	1.57 – 2.93	<0.001
Condition [Corner]	0.64	0.38 – 1.07	0.091	0.60	0.33 – 1.12	0.110	0.61	0.33 – 1.13	0.119
Corner Rank	1.26	1.03 – 1.54	0.027	1.26	0.98 – 1.60	0.068	1.26	0.97 – 1.64	0.087
Color Rank x Condition [Corner]	0.59	0.42 – 0.81	0.001	0.55	0.37 – 0.80	0.002	0.55	0.38 – 0.82	0.003
Corner Rank x Condition [Corner]	1.25	0.94 – 1.68	0.128	1.51	1.06 – 2.16	0.023	1.52	1.06 – 2.17	0.024
Ini. Rank [1]				0.02	0.00 – 0.06	<0.001	0.02	0.00 – 0.06	<0.001
Ini. Rank [2]				0.20	0.07 – 0.60	0.004	0.20	0.06 – 0.60	0.004
Ini. Rank [3]				0.46	0.15 – 1.38	0.168	0.46	0.15 – 1.39	0.169
Ini. Rank [4]				0.55	0.18 – 1.69	0.297	0.54	0.18 – 1.67	0.287
Ini. Rank [5]				0.77	0.25 – 2.36	0.645	0.74	0.23 – 2.31	0.599
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.04 item.f
ICC							0.01
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.259 / NA			0.536 / NA			0.532 / 0.538

# test <- miceadds::glm.cluster( data=drag_and_drop_count_long.combined, formula=N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank,
#                 cluster=c("ResponseId"), family="binomial")
# summary(test)

# test <- glmmML::glmmML(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank, data = drag_and_drop_count_long.combined, cluster = ResponseId)
# summary(test) # no variance?? then look into variance>

• Collinearity Check

  • Caution: The following preliminary tests assume independent observations and do not account for the multi-level structure of the data. Neds to dig in more.

  • VIF > 5 suggests high multicollinearity. Pass

  • GVIF extends VIF for categorical predictors. typically interpreted using GVIF^(1/(2×df)) < 2 as a guideline. Pass

library(car)
M1_lm<-lm(N_ind~rank.color.c*condition+rank.corner.c*condition,drag_and_drop_count_long.combined)
M2_lm<-lm(N_ind~rank.color.c*condition+rank.corner.c*condition+initial.rank,drag_and_drop_count_long.combined)
print("Model w/o ini. position")

## [1] "Model w/o ini. position"

vif_M1 <- vif(M1_lm)
vif_M1

##            rank.color.c               condition           rank.corner.c 
##                2.001634                1.000000                2.001634 
##  rank.color.c:condition condition:rank.corner.c 
##                2.001634                2.001634

print("Model w/ ini. position")

## [1] "Model w/ ini. position"

vif_M2 <- vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.071147  1        1.439148
## condition               1.000000  1        1.000000
## rank.corner.c           2.082317  1        1.443023
## initial.rank            1.113728  5        1.010829
## rank.color.c:condition  2.108391  1        1.452030
## condition:rank.corner.c 2.054097  1        1.433212

Nested Model

• Nested Model returned consistent results for the rank variables, and appears easier to interpret/write up.
• One question is how to interpre the coefficient of condition?

drag_and_drop_count_long.combined<-drag_and_drop_count_long.combined%>%
  mutate(CLR.Nested_color=case_when(
    condition == "Color" ~rank.color,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color
  ),
  CNR.Nested_color=case_when(
    condition == "Color" ~rank.corner,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner
  ),
  CLR.Nested_color.c=case_when(
    condition == "Color" ~rank.color.c,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color.c
  ),
  CNR.Nested_color.c=case_when(
    condition == "Color" ~rank.corner.c,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner.c
  ))

M1<-glmer(N_ind~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)
M2<-glmer(N_ind~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)

M3<-glmer(N_ind~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId)+(1|item.f),drag_and_drop_count_long.combined,family=binomial)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank [Nested in Color]","Color Rank [Nested in Corner]","Corner Rank [Nested in Color]","Color Rank [Nested in Corner]","Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Odds Ratios	CI	p	Odds Ratios	CI	p	Odds Ratios	CI	p
Intercept	0.10	0.03 – 0.32	<0.001	0.26	0.05 – 1.35	0.109	0.27	0.05 – 1.53	0.139
Color Rank [Nested in Color]	1.97	1.52 – 2.54	<0.001	2.17	1.61 – 2.92	<0.001	2.14	1.57 – 2.93	<0.001
Color Rank [Nested in Corner]	1.15	0.94 – 1.41	0.164	1.18	0.93 – 1.50	0.167	1.19	0.92 – 1.53	0.193
Corner Rank [Nested in Color]	1.26	1.03 – 1.54	0.027	1.26	0.98 – 1.60	0.068	1.26	0.97 – 1.64	0.086
Color Rank [Nested in Corner]	1.58	1.28 – 1.94	<0.001	1.90	1.47 – 2.46	<0.001	1.91	1.45 – 2.52	<0.001
Condition [Corner]	1.87	0.38 – 9.19	0.439	1.18	0.20 – 7.15	0.856	1.13	0.18 – 7.12	0.894
Ini. Rank [1]				0.02	0.00 – 0.06	<0.001	0.02	0.00 – 0.06	<0.001
Ini. Rank [2]				0.20	0.07 – 0.60	0.004	0.20	0.06 – 0.60	0.004
Ini. Rank [3]				0.46	0.15 – 1.38	0.168	0.46	0.15 – 1.39	0.169
Ini. Rank [4]				0.55	0.18 – 1.69	0.297	0.54	0.18 – 1.67	0.287
Ini. Rank [5]				0.77	0.25 – 2.36	0.645	0.74	0.23 – 2.31	0.600
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.04 item.f
ICC							0.01
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.259 / NA			0.536 / NA			0.532 / 0.538

• Collinearity Check

library(car)
M1_lm<-lm(N_ind~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank,drag_and_drop_count_long.combined)
M1_lm.2<-lm(N_ind~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank,drag_and_drop_count_long.combined)

print("Model w/o centering")

## [1] "Model w/o centering"

vif_M1 <- vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.210277  1        1.791725
## CLR.Nested_corner 3.199077  1        1.788596
## CNR.Nested_color  3.227591  1        1.796550
## CNR.Nested_corner 3.114885  1        1.764904
## condition         9.526716  1        3.086538
## initial.rank      1.113728  5        1.010829

print("Model w/ centering")

## [1] "Model w/ centering"

Vif_M1.2 <- vif(M1_lm.2)
Vif_M1.2

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.035573  1        1.017631
## CLR.Nested_corner.c 1.031960  1        1.015854
## CNR.Nested_color.c  1.041158  1        1.020372
## CNR.Nested_corner.c 1.004802  1        1.002398
## condition           1.000000  1        1.000000
## initial.rank        1.113728  5        1.010829

2.2 DV2: Drag Order

• Drag order is the sequence in which items are dragged and dropped. Items that are not dragged are assigned a value of (1 + the total number of dragged items). For example, if a participant moves item A three times, item B twice, and item C once, while items D, E, and F remain untouched, the drag order is:
  • A = 1, B = 2, C = 3, D = E = F = 4.
  • This coding approach simplifies cases where an item is touched multiple times (as in the example). However, as seen, it is relatively rare that participants drag the same item repeatedly, justifying this simplification.

touch_order_analysis_Color<-RankProcess_Color%>%
  filter(step!=0)%>%
  group_by(ResponseId)%>%
  arrange(step)%>%
  filter(!duplicated(item_moved))%>% # retains only the first instance
  mutate(order=row_number())%>%
  ungroup()%>%
  mutate(condition="Color")


touch_order_analysis.long_Color <- expand_grid(
  ResponseId = unique(touch_order_analysis_Color$ResponseId),
  item.f = unique(touch_order_analysis_Color$item.f)
)

order_max.SUBJ_Color<-touch_order_analysis.long_Color%>%
  left_join(touch_order_analysis_Color%>%select(ResponseId,item.f,order),by=c("ResponseId","item.f"))%>%
  left_join(touch_order_analysis_Color%>%select(ResponseId,condition)%>%filter(!duplicated(ResponseId)),by=c("ResponseId"))%>%
  group_by(ResponseId)%>%
  summarize(max_order=max(order,na.rm = T))

touch_order_analysis.long_Color<-touch_order_analysis.long_Color%>%
  left_join(touch_order_analysis_Color%>%select(ResponseId,item.f,order),by=c("ResponseId","item.f"))%>%
  left_join(touch_order_analysis_Color%>%select(ResponseId,condition)%>%filter(!duplicated(ResponseId)),by=c("ResponseId"))%>%left_join(order_max.SUBJ_Color,by="ResponseId")%>%
  mutate(order = case_when(!is.na(order)~order,
                           TRUE~max_order+1))



touch_order_analysis_Corner<-RankProcess_Corner%>%
  filter(step!=0)%>%
  group_by(ResponseId)%>%
  arrange(step)%>%
  filter(!duplicated(item_moved))%>%
  mutate(order=row_number())%>%
  ungroup()%>%
  mutate(condition="Corner")


touch_order_analysis.long_Corner <- expand_grid(
  ResponseId = unique(touch_order_analysis_Corner$ResponseId),
  item.f = unique(touch_order_analysis_Corner$item.f)
)


order_max.SUBJ_Corner<-touch_order_analysis.long_Corner%>%
  left_join(touch_order_analysis_Corner%>%select(ResponseId,item.f,order),by=c("ResponseId","item.f"))%>%
  left_join(touch_order_analysis_Corner%>%select(ResponseId,condition)%>%filter(!duplicated(ResponseId)),by=c("ResponseId"))%>%
  group_by(ResponseId)%>%
  summarize(max_order=max(order,na.rm = T))

touch_order_analysis.long_Corner<-touch_order_analysis.long_Corner%>%
  left_join(touch_order_analysis_Corner%>%select(ResponseId,item.f,order),by=c("ResponseId","item.f"))%>%
  left_join(touch_order_analysis_Corner%>%select(ResponseId,condition)%>%filter(!duplicated(ResponseId)),by=c("ResponseId"))%>%left_join(order_max.SUBJ_Corner,by="ResponseId")%>%
  mutate(order = case_when(!is.na(order)~order,
                           TRUE~max_order+1))

# length(unique(touch_order_analysis.long_A$ResponseId)) #142, good.
# touch_order_analysis.long_A%>%
#   group_by(ResponseId)%>%
#   summarize(n_6=n_distinct(item.f))%>%
#    filter(n_6!=6) # none, good
# psych::describe(drag_order_analysis.long$order) # between 1 and 6, good.

2.2.0 Distribution of Drag Order by item

touch_order_Color <- touch_order_analysis.long_Color %>%
  filter(ResponseId%in%color_correct_subj)%>%
  count(item.f,order,condition) %>%
  group_by(item.f)%>%
  mutate(percentage = n / sum(n) * 100)%>%
  ungroup()

touch_order_Corner <- touch_order_analysis.long_Corner %>%
  filter(ResponseId%in%corner_correct_subj)%>%
  count(item.f,order,condition) %>%
  group_by(item.f)%>%
  mutate(percentage = n / sum(n) * 100)%>%
  ungroup()
touch_order_combined<-rbind(touch_order_Corner,touch_order_Color)

# drag_drop_counts%>%
#   group_by(item.f)%>%
#   summarise(subj_count=sum(n)) # all 389, good.

ggplot(touch_order_combined, aes(x = factor(order), y = n)) +
  geom_bar(
    stat = "identity",
    color = "black"
  ) +
  geom_text(
    aes(
      label = paste0(n, " (", round(percentage, 1), "%)")
    ),
    vjust = -0.5,
    size = 5,
    fontface="bold"
  ) +
  labs(
    title = "Drag Order by item and Condition",
    x = "Drag Order",
    y = "Frequency"
  ) +
  theme_minimal() +
  theme(
    strip.text = element_text(size = 12, face = "bold"),  # Facet label adjustments
    plot.title = element_text(hjust = 0.5, face = "bold"),
    axis.title = element_text(size = 12),
    axis.text = element_text(size = 10)
  ) +
  facet_wrap(~ item.f * condition,ncol = 2) +
  ylim(0, 30)

2.2.0 (Descriptive Cont.) Distribution of Mean Drag Order

mean_order.subj_Corner <- touch_order_analysis.long_Corner %>%
  filter(ResponseId%in%corner_correct_subj)%>%
  group_by(ResponseId)%>%
  mutate(mean_order = mean(order),
         condition="Corner")%>%
  ungroup()
mean_order.subj_Color<- touch_order_analysis.long_Color %>%
  filter(ResponseId%in%color_correct_subj)%>%
  group_by(ResponseId)%>%
  mutate(mean_order = mean(order),
         condition="Color")%>%
  ungroup()
# mean_order.subj%>%
#   filter(is.na(mean_order)) # none, good
# drag_drop_counts%>%
#   group_by(item.f)%>%
#   summarise(subj_count=sum(n)) # all 389, good.

mean_order.subj_combined<-rbind(mean_order.subj_Color,mean_order.subj_Corner)

ggplot(mean_order.subj_combined, aes(x = mean_order)) +
  geom_density(fill = "lightblue", color = "black", alpha = 0.5) +
  geom_rug(sides = "b", color = "blue") +  # Rug plot along the bottom (x-axis) for individual data points
  labs(
    title = "Density Plot of Mean Drag Order",
    x = "Mean Drag Order",
    y = "Density"
  ) +
  facet_grid(~condition)

2.2.1 Model-free visualization

summary_data_Color<- touch_order_analysis.long_Color%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(order_mean = mean(order, na.rm = TRUE),
            order_sd = sd(order, na.rm = TRUE),
            n = n(),
            se = order_sd / sqrt(n),  # Standard error
            .groups = "drop")


summary_data_Corner <- touch_order_analysis.long_Corner%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(order_mean = mean(order, na.rm = TRUE),
            order_sd = sd(order, na.rm = TRUE),
            n = n(),
            se = order_sd / sqrt(n),  # Standard error
            .groups = "drop")


summary_data_combined <- bind_rows(summary_data_Color, summary_data_Corner)


custom_colors_color <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)

summary_data_combined_ind$item.f = factor(summary_data_combined_ind$item.f, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE)



ggplot(summary_data_combined, aes(x = condition, y = order_mean, 
                                      group = item.f, color = item.f, shape = item.f)) +
  geom_line(linewidth = 1, position = position_dodge(0.3)) +
  geom_point(size = 6, position = position_dodge(0.3)) +
  geom_errorbar(
    aes(
      ymin = order_mean - se,
      ymax = order_mean + se
    ),
    width = 0.2,
    position = position_dodge(0.3)
  ) +
  labs(
    x = "Condition",
    y = "Mean ± SE Drag Order",
    title = "Mean Drag Order by Condition"
  ) +
  scale_color_manual(values = custom_colors_color) +  
  scale_shape_manual(values = c("CR6_CL2" = 21, "CR5_CL3" = 22, 
                                "CR4_CL5" = 23, "CR3_CL6" = 24, 
                                "CR2_CL4" = 25, "CR1_CL1" = 11)) +
  theme_minimal() +
  theme(
    legend.position = "top", # Place legend at the top
    legend.title = element_text(face = "bold"),
    axis.title = element_text(face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    plot.title = element_text(face = "bold", hjust = 0.5)
  )+
  ylim(5,1)

2.2.3 Correlation with Attribute Rank

Color Condition

• Aggregate Stats

touch_order_analysis.long_Color<-touch_order_analysis.long_Color%>%
    filter(ResponseId%in%color_correct_subj)%>%
  mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_color%>%select(ResponseId,initial.items_49:initial.items_51),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_49:initial.items_51))


summary_data_Color <- touch_order_analysis.long_Color%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(order_mean = mean(order, na.rm = TRUE),
            order_sd = sd(order, na.rm = TRUE),
            n = n(),
            se = order_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))

ggplot(summary_data_Color, aes(x = rank.color, y = order_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Order and Color Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Order") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(6,1)

ggplot(summary_data_Color, aes(x = rank.corner, y = order_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Order and Corner Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Order") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(6,1)

• Predict Drag Order with attribute ranks

  • Model Specification: Drag Count predicted by color and corner attribute rank

  • Note: A negative sign was added to the order DV. So a positive coefficient indicates that a higher value of the predictor contributes to the item being ranked first

M1<-lmer(-order~rank.color+rank.corner+(1|ResponseId),touch_order_analysis.long_Color)
M2<-lmer(-order~rank.color+rank.corner+initial.rank+(1|ResponseId),touch_order_analysis.long_Color)
M3<-lmer(-order~rank.color+rank.corner+initial.rank+(1|ResponseId)+(1|item.f),touch_order_analysis.long_Color)
tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-5.43	-5.88 – -4.98	<0.001	-4.75	-5.30 – -4.19	<0.001	-4.75	-5.30 – -4.19	<0.001
Color Rank	0.68	0.59 – 0.76	<0.001	0.64	0.56 – 0.71	<0.001	0.64	0.56 – 0.71	<0.001
Corner Rank	-0.06	-0.15 – 0.03	0.180	-0.09	-0.17 – -0.01	0.026	-0.09	-0.17 – -0.01	0.026
Initial Rank [1]				-1.48	-1.94 – -1.01	<0.001	-1.48	-1.94 – -1.01	<0.001
Initial Rank [2]				-0.57	-1.04 – -0.11	0.016	-0.57	-1.04 – -0.11	0.016
Initial Rank [3]				-0.29	-0.75 – 0.17	0.211	-0.29	-0.75 – 0.17	0.211
Initial Rank [4]				-0.09	-0.54 – 0.37	0.709	-0.09	-0.54 – 0.37	0.709
Initial Rank [5]				-0.16	-0.63 – 0.30	0.482	-0.16	-0.63 – 0.30	0.482
Random Effects
σ2	0.92			0.70			0.70
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.593 / NA			0.695 / NA			0.695 / NA

# M1_robust <- lm_robust(-order ~ rank.color + rank.corner, data = touch_order_analysis.long_Color, clusters = ResponseId)
# M2_robust <- lm_robust(-order ~ rank.color + rank.corner + initial.rank, data = touch_order_analysis.long_Color, clusters = ResponseId)
# M3_robust <- lm_robust(-order ~ rank.color + rank.corner + initial.rank, data = touch_order_analysis.long_Color, clusters = interaction(ResponseId, item.f))
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

Corner Condition

• Aggregate Stats

touch_order_analysis.long_Corner<-touch_order_analysis.long_Corner%>%
  filter(ResponseId%in%corner_correct_subj)%>%
  mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_corner%>%select(ResponseId,initial.items_50:initial.items_47),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_50:initial.items_47))



# dat_D is frequency judgment of the intensity items
# <!--     item_moved==41 ~ "Remote", -->
# <!--     item_moved==42 ~ "WFH3", -->
# <!--     item_moved==40 ~ "Walk", -->
# <!--     item_moved==44 ~ "Hybrid", -->
# <!--     item_moved==45 ~ "Carpool5", -->
# <!--     item_moved==43 ~ "Public" # 2025/02/04; verified these with Qualtrics Quiz Preview and using the "Inspect Element" feature


summary_data_Corner <- touch_order_analysis.long_Corner%>%
  dplyr::group_by(condition, item.f) %>%
  summarize(order_mean = mean(order, na.rm = TRUE),
            order_sd = sd(order, na.rm = TRUE),
            n = n(),
            se = order_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))


ggplot(summary_data_Corner, aes(x = rank.color, y = order_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Order and Color Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Order") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(6,1)

ggplot(summary_data_Corner, aes(x = rank.corner, y = order_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Order and Corner Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Order") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)+
  ylim(6,1)

M1<-lmer(-order~rank.color+rank.corner+(1|ResponseId),touch_order_analysis.long_Corner)
M2<-lmer(-order~rank.color+rank.corner+initial.rank+(1|ResponseId),touch_order_analysis.long_Corner)
M3<-lmer(-order~rank.color+rank.corner+initial.rank+(1|ResponseId)+(1|item.f),touch_order_analysis.long_Corner)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-4.46	-4.99 – -3.93	<0.001	-4.09	-4.67 – -3.50	<0.001	-4.09	-4.84 – -3.33	<0.001
Color Rank	-0.10	-0.20 – 0.00	0.055	-0.09	-0.18 – 0.01	0.077	-0.09	-0.22 – 0.05	0.206
Corner Rank	0.48	0.38 – 0.58	<0.001	0.49	0.40 – 0.58	<0.001	0.49	0.36 – 0.62	<0.001
Initial Rank [1]				-1.42	-1.98 – -0.86	<0.001	-1.42	-1.98 – -0.87	<0.001
Initial Rank [2]				-0.60	-1.16 – -0.05	0.034	-0.59	-1.14 – -0.04	0.036
Initial Rank [3]				-0.24	-0.80 – 0.31	0.388	-0.25	-0.80 – 0.31	0.378
Initial Rank [4]				-0.51	-1.07 – 0.05	0.074	-0.55	-1.11 – 0.01	0.055
Initial Rank [5]				0.04	-0.52 – 0.60	0.893	0.06	-0.51 – 0.62	0.844
Random Effects
σ2	1.28			1.07			1.05
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.04 item.f
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.352 / NA			0.467 / NA			0.473 / NA

# M1_robust <- lm_robust(-order ~ rank.color + rank.corner, data = touch_order_analysis.long_Corner, clusters = ResponseId)
# M2_robust <- lm_robust(-order ~ rank.color + rank.corner + initial.rank, data = touch_order_analysis.long_Corner, clusters = ResponseId)
# M3_robust <- lm_robust(-order ~ rank.color + rank.corner + initial.rank, data = touch_order_analysis.long_Corner, clusters = interaction(ResponseId, item.f))
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

Model with Combined Datasets

• Color and Corner Attribute Ranks are centered before being entered into the model.

touch_order_analysis.long_Color$condition<-"Color"
touch_order_analysis.long_Corner$condition<-"Corner"
  
touch_order_analysis.long.combined<-rbind(touch_order_analysis.long_Corner, touch_order_analysis.long_Color)%>%
  mutate(rank.corner.c=rank.corner-mean(rank.corner),
         rank.color.c=rank.color-mean(rank.color))

M1<-lmer(-order~rank.color.c*condition+rank.corner.c*condition+(1|ResponseId),touch_order_analysis.long.combined)
M2<-lmer(-order~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId),touch_order_analysis.long.combined)
M3<-lmer(-order~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId)+(1|item.f),touch_order_analysis.long.combined)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank","Condition [Corner]","Corner Rank", "Color Rank x Condition [Corner]","Corner Rank x Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-3.27	-3.43 – -3.11	<0.001	-2.83	-3.10 – -2.55	<0.001	-2.83	-3.11 – -2.55	<0.001
Color Rank	0.68	0.58 – 0.77	<0.001	0.64	0.56 – 0.73	<0.001	0.64	0.55 – 0.73	<0.001
Condition [Corner]	0.14	-0.09 – 0.37	0.245	0.14	-0.07 – 0.34	0.193	0.14	-0.07 – 0.34	0.193
Corner Rank	-0.06	-0.15 – 0.04	0.218	-0.09	-0.18 – -0.00	0.040	-0.09	-0.18 – 0.00	0.052
Color Rank x Condition [Corner]	-0.78	-0.91 – -0.64	<0.001	-0.73	-0.86 – -0.61	<0.001	-0.73	-0.86 – -0.61	<0.001
Corner Rank x Condition [Corner]	0.54	0.40 – 0.67	<0.001	0.58	0.46 – 0.70	<0.001	0.58	0.46 – 0.70	<0.001
Ini. Rank [1]				-1.44	-1.80 – -1.08	<0.001	-1.44	-1.80 – -1.08	<0.001
Ini. Rank [2]				-0.59	-0.95 – -0.23	0.001	-0.59	-0.95 – -0.23	0.001
Ini. Rank [3]				-0.27	-0.63 – 0.09	0.143	-0.27	-0.63 – 0.09	0.142
Ini. Rank [4]				-0.30	-0.66 – 0.06	0.104	-0.30	-0.66 – 0.06	0.101
Ini. Rank [5]				-0.06	-0.42 – 0.30	0.747	-0.06	-0.42 – 0.31	0.762
Random Effects
σ2	1.10			0.88			0.88
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.482 / NA			0.589 / NA			0.589 / NA

# M1_robust <- lm_robust(-order~rank.color.c*condition+rank.corner.c*condition,touch_order_analysis.long.combined, clusters = ResponseId)
# M2_robust <- lm_robust(-order ~ rank.color.c*condition+rank.corner.c*condition+initial.rank, data = touch_order_analysis.long.combined, clusters = ResponseId)
# M3_robust <- lm_robust(-order ~ rank.color.c*condition+rank.corner.c*condition+initial.rank, data = touch_order_analysis.long.combined, clusters = interaction(ResponseId, item.f))
# 
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

• Collinearity Check

  • Caution: The following preliminary tests assume independent observations and do not account for the multi-level structure of the data. Neds to dig in more.

  • VIF > 5 suggests high multicollinearity. Pass

  • GVIF extends VIF for categorical predictors. typically interpreted using GVIF^(1/(2×df)) < 2 as a guideline. Pass

M1_lm<-lm(-order~rank.color.c*condition+rank.corner.c*condition,touch_order_analysis.long.combined)
M2_lm<-lm(-order~rank.color.c*condition+rank.corner.c*condition+initial.rank,touch_order_analysis.long.combined)

print("Model w/o ini. position")

## [1] "Model w/o ini. position"

vif_M1 <- vif(M1_lm)
vif_M1

##            rank.color.c               condition           rank.corner.c 
##                2.001634                1.000000                2.001634 
##  rank.color.c:condition condition:rank.corner.c 
##                2.001634                2.001634

print("Model w/ ini. position")

## [1] "Model w/ ini. position"

vif_M2 <- vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.071147  1        1.439148
## condition               1.000000  1        1.000000
## rank.corner.c           2.082317  1        1.443023
## initial.rank            1.113728  5        1.010829
## rank.color.c:condition  2.108391  1        1.452030
## condition:rank.corner.c 2.054097  1        1.433212

# examine<-Distance_Color%>%filter(ResponseId%in%color_correct_subj)
# table(examine$move_direction) #79/(29+79), 73%
# examine<-Distance_Corner%>%filter(ResponseId%in%corner_correct_subj)
# table(examine$move_direction) # 88/(28+88) 76%

Nested Models

##### Nested Model
touch_order_analysis.long.combined<-touch_order_analysis.long.combined%>%
  mutate(CLR.Nested_color=case_when(
    condition == "Color" ~rank.color,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color
  ),
  CNR.Nested_color=case_when(
    condition == "Color" ~rank.corner,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner
  ),
  CLR.Nested_color.c=case_when(
    condition == "Color" ~rank.color.c,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color.c
  ),
  CNR.Nested_color.c=case_when(
    condition == "Color" ~rank.corner.c,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner.c
  ))

M1<-lmer(-order~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+(1|ResponseId),touch_order_analysis.long.combined)
M2<-lmer(-order~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId),touch_order_analysis.long.combined)
M3<-lmer(-order~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId)+(1|item.f),touch_order_analysis.long.combined)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank [Nested in Color]","Color Rank [Nested in Corner]","Corner Rank [Nested in Color]","Color Rank [Nested in Corner]","Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-5.43	-5.92 – -4.94	<0.001	-4.76	-5.30 – -4.23	<0.001	-4.76	-5.32 – -4.21	<0.001
Color Rank [Nested in Color]	0.68	0.58 – 0.77	<0.001	0.64	0.56 – 0.73	<0.001	0.64	0.55 – 0.73	<0.001
Color Rank [Nested in Corner]	-0.10	-0.20 – -0.01	0.038	-0.09	-0.18 – -0.00	0.040	-0.09	-0.18 – 0.00	0.052
Corner Rank [Nested in Color]	-0.06	-0.15 – 0.04	0.218	-0.09	-0.18 – -0.00	0.040	-0.09	-0.18 – 0.00	0.052
Color Rank [Nested in Corner]	0.48	0.38 – 0.57	<0.001	0.49	0.40 – 0.57	<0.001	0.49	0.40 – 0.58	<0.001
Condition [Corner]	0.97	0.28 – 1.67	0.006	0.67	0.04 – 1.30	0.038	0.67	0.04 – 1.30	0.037
Ini. Rank [1]				-1.44	-1.80 – -1.08	<0.001	-1.44	-1.80 – -1.08	<0.001
Ini. Rank [2]				-0.59	-0.95 – -0.23	0.001	-0.59	-0.95 – -0.23	0.001
Ini. Rank [3]				-0.27	-0.63 – 0.09	0.143	-0.27	-0.63 – 0.09	0.142
Ini. Rank [4]				-0.30	-0.66 – 0.06	0.104	-0.30	-0.66 – 0.06	0.101
Ini. Rank [5]				-0.06	-0.42 – 0.30	0.747	-0.06	-0.42 – 0.31	0.762
Random Effects
σ2	1.10			0.88			0.88
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.482 / NA			0.589 / NA			0.589 / NA

• Collinearity Check

M1_lm<-lm(order~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank,touch_order_analysis.long.combined)
M1_lm.2<-lm(order~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank,touch_order_analysis.long.combined)

print("Model w/o centering")

## [1] "Model w/o centering"

vif_M1 <- vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.210277  1        1.791725
## CLR.Nested_corner 3.199077  1        1.788596
## CNR.Nested_color  3.227591  1        1.796550
## CNR.Nested_corner 3.114885  1        1.764904
## condition         9.526716  1        3.086538
## initial.rank      1.113728  5        1.010829

print("Model w/ centering")

## [1] "Model w/ centering"

Vif_M1.2 <- vif(M1_lm.2)
Vif_M1.2

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.035573  1        1.017631
## CLR.Nested_corner.c 1.031960  1        1.015854
## CNR.Nested_color.c  1.041158  1        1.020372
## CNR.Nested_corner.c 1.004802  1        1.002398
## condition           1.000000  1        1.000000
## initial.rank        1.113728  5        1.010829

2.3 DV3: Drag Distance

• Replication of Drag Direction Pattern: 66% and 78% of drag and drops resulted in the item being ranked higher in the color and corner condition respectively.

• Focuses exclusively on the first drag: While it is possible to calculate and model the distance for each instance an item is dragged and dropped, we simplify the analysis by retaining only the first drag-and-drop instance for each respondent. This is is justified by prior analyses showing that multiple drag-and-drop instances are rare. I also did an alternative analysis using the mean distance across all drag-and-drop instances. The results below were consistent.

• Coding of Distance:

  • After each dragging item, the distance is calculated as Last Position - Current Position of the dragged item. Positive values indicate that the item was ranked up (e.g., moved from 2nd place to the 1st place), and positive values indicate that the item is ranked down (e.g., moved from 1st place to the second place). items that are not dragged for each respondent are assigned a distance of 0

2.3.1 Distribution of Drag Distance

# length(unique(Distance_A$ResponseId))
# table(Distance_A$move_direction)
# 443/(126+443) # 0.7785589

Distance_Color.cleanup<-Distance_Color%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(distance_50=current_50-last_50,
         distance_51=current_51-last_51,
         distance_49=current_49-last_49,
         distance_48=current_48-last_48,
         distance_47=current_47-last_47,
         distance_46=current_46-last_46,
         DD_diff=drop_time-drag_time,
         condition="Color")%>%
  select(drag_time,DD_diff,distance_50,distance_51,distance_49,distance_48,distance_47,distance_46,order,item.f,step,ResponseId,condition)

Distance_Color.cleanup<-Distance_Color.cleanup%>%
  group_by(ResponseId)%>%
  arrange(step)%>%
  filter(!duplicated(item.f))%>%
  ungroup()

unique_ResponseIds_Color <- Distance_Color %>%
  distinct(ResponseId) %>%
  pull(ResponseId) # Extract as a vector


Distance_Color.cleanup.df <- expand.grid(ResponseId = unique_ResponseIds_Color,
                                    item.f = c("CR3_CL6","CR4_CL5","CR2_CL4","CR5_CL3","CR6_CL2", "CR1_CL1")) 


Distance_Color.cleanup.df<-Distance_Color.cleanup.df%>%
  left_join(Distance_Color.cleanup%>%select(ResponseId,item.f,distance_50,distance_51,distance_49,distance_48,distance_47,distance_46,drag_time,DD_diff),by=c("ResponseId","item.f"))

Distance_Color.cleanup.df<-Distance_Color.cleanup.df%>%
  arrange(ResponseId)%>%
  mutate(distance=case_when(item.f=="CR4_CL5" ~ distance_49,
                            item.f=="CR2_CL4" ~ distance_47,
                            item.f=="CR6_CL2" ~ distance_51,
                            item.f=="CR1_CL1" ~ distance_46,
                            item.f=="CR5_CL3" ~ distance_50,
                            item.f=="CR3_CL6" ~ distance_48,
                            ),
         distance=case_when(is.na(distance)~0, # items that are not moved get a distance of 0
                            TRUE ~ distance),
         distance.abs=abs(distance))

summary_stats <- Distance_Color.cleanup.df %>%
  group_by(item.f) %>%
  summarize(
    mean_distance = mean(distance, na.rm = TRUE),
    median_distance = median(distance, na.rm = TRUE)
  )

custom_colors_color <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)

Distance_Color.cleanup.df$item.f<- factor(Distance_Color.cleanup.df$item.f, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE)

ggplot(Distance_Color.cleanup.df ,
       aes(x = -distance, fill = item.f)) +
  geom_histogram(binwidth = 1, alpha = 0.3, position = "identity") +
  labs(
    title = "Distribution of Drag Distance - Color Condition",
    x = "Distance",
    y = "Count",
    fill = "item"
  ) +
  theme_minimal()+
  facet_grid(~item.f)+
  xlim(6,-6)+
    scale_fill_manual(values = custom_colors_color)

Distance_Corner.cleanup<-Distance_Corner%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(distance_50=current_50-last_50,
         distance_51=current_51-last_51,
         distance_49=current_49-last_49,
         distance_48=current_48-last_48,
         distance_47=current_47-last_47,
         distance_46=current_46-last_46,
         DD_diff=drop_time-drag_time,
         condition="Color")%>%
  select(drag_time,DD_diff,distance_50,distance_51,distance_49,distance_48,distance_47,distance_46,order,item.f,step,ResponseId,condition)

Distance_Corner.cleanup<-Distance_Corner.cleanup%>%
  group_by(ResponseId)%>%
  arrange(step)%>%
  filter(!duplicated(item.f))%>%
  ungroup()

unique_ResponseIds_Corner <- Distance_Corner %>%
  distinct(ResponseId) %>%
  pull(ResponseId) # Extract as a vector


Distance_Corner.cleanup.df <- expand.grid(ResponseId = unique_ResponseIds_Corner,
                                    item.f = c("CR4_CL5","CR2_CL4","CR6_CL2","CR1_CL1","CR5_CL3", "CR3_CL6")) 


Distance_Corner.cleanup.df<-Distance_Corner.cleanup.df%>%
  left_join(Distance_Corner.cleanup%>%select(ResponseId,item.f,distance_50,distance_51,distance_49,distance_48,distance_47,distance_46,drag_time,DD_diff),by=c("ResponseId","item.f"))


Distance_Corner.cleanup.df<-Distance_Corner.cleanup.df%>%
  arrange(ResponseId)%>%
  mutate(distance=case_when(item.f=="CR4_CL5" ~ distance_49,
                            item.f=="CR2_CL4" ~ distance_47,
                            item.f=="CR6_CL2" ~ distance_51,
                            item.f=="CR1_CL1" ~ distance_46,
                            item.f=="CR5_CL3" ~ distance_50,
                            item.f=="CR3_CL6" ~ distance_48,
                            ),
         distance=case_when(is.na(distance)~0, # items that are not moved get a distance of 0
                            TRUE ~ distance),
         distance.abs=abs(distance))

summary_stats <- Distance_Corner.cleanup.df %>%
  group_by(item.f) %>%
  summarize(
    mean_distance = mean(distance, na.rm = TRUE),
    median_distance = median(distance, na.rm = TRUE)
  )



custom_colors_corner <- c(
  "CR6_CL2" = "#a6cee3",  # Light Blue
  "CR5_CL3" = "#6baed6",  # Medium Light Blue
  "CR4_CL5" = "#3182bd",  # Medium Blue
  "CR3_CL6" = "#08519c",  # Dark Blue
  "CR2_CL4" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)

 Distance_Corner.cleanup.df$item.f<- factor(Distance_Corner.cleanup.df$item.f, levels = rev(c(  "CR1_CL1","CR2_CL4", "CR3_CL6","CR4_CL5", "CR5_CL3","CR6_CL2")), ordered = TRUE)

ggplot(Distance_Corner.cleanup.df ,
       aes(x = -distance, fill = item.f)) +
  geom_histogram(binwidth = 1, alpha = 0.3, position = "identity") +
  labs(
    title = "Distribution of Drag Distance - Corner Condition",
    x = "Distance",
    y = "Count",
    fill = "item"
  ) +
  theme_minimal()+
  facet_grid(~item.f)+
    scale_fill_manual(values = custom_colors_corner)+
  xlim(6,-6)

2.3.2 Model-Free Visualization

Distance_Color_cleanup.df.test<-Distance_Color.cleanup.df%>%
  select(ResponseId, item.f,distance,distance.abs)%>%
  mutate(condition="Color")
Distance_Corner_cleanup.df.test<-Distance_Corner.cleanup.df%>%
  select(ResponseId, item.f,distance,distance.abs)%>%
  mutate(condition="Corner")

Distance_cleanup.df.combined<-rbind(Distance_Color_cleanup.df.test,Distance_Corner_cleanup.df.test)

summary_distance_data <- Distance_cleanup.df.combined %>%
  mutate(condition=as.factor(condition),
         distance.abs=(distance))%>%
  group_by(condition, item.f) %>%
  summarize(
    distance_mean = -mean(distance, na.rm = TRUE),
    distance_sd = sd(distance, na.rm = TRUE),
    n = n(),
    se = distance_sd / sqrt(n),
    .groups = "drop"
  )

custom_colors_color <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)



summary_data_combined_ind$item.f = factor(summary_data_combined_ind$item.f, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE)


ggplot(summary_distance_data, aes(x = condition, y = distance_mean, group = item.f, color = item.f,shape=item.f)) +
  geom_line(linewidth = 1, position = position_dodge(0.3)) +
  geom_point(size = 6, position = position_dodge(0.3)) +
  geom_errorbar(
    aes(
      ymin = distance_mean - se,
      ymax = distance_mean + se
    ),
    width = 0.2,
    position = position_dodge(0.3)
  ) +
  labs(
    x = "Condition",
    y = "Mean ± SE Drag Distance",
    title = "Mean Drag Distance by Condition"
  ) +
  theme_minimal() +
  theme(
    legend.position = "top", # Place legend at the top
    legend.title = element_text(face = "bold"),
    axis.title = element_text(face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    plot.title = element_text(face = "bold", hjust = 0.5)
  )+
  scale_shape_manual(values = c("CR6_CL2" = 21, "CR5_CL3" = 22, 
                                "CR4_CL5" = 23, "CR3_CL6" = 24, 
                                "CR2_CL4" = 25, "CR1_CL1" = 11)) +
    scale_color_manual(values = custom_colors_color)

• If we plot the ABSOLUTE VALUE of Distance:

summary_distance_data <- Distance_cleanup.df.combined %>%
  mutate(condition=as.factor(condition),
         distance.abs=abs(distance))%>%
  group_by(condition, item.f) %>%
  summarize(
    distance_mean = mean(distance.abs, na.rm = TRUE),
    distance_sd = sd(distance.abs, na.rm = TRUE),
    n = n(),
    se = distance_sd / sqrt(n),
    .groups = "drop"
  )

custom_colors_color <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)



summary_data_combined_ind$item.f = factor(summary_data_combined_ind$item.f, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE)

ggplot(summary_distance_data, aes(x = condition, y = distance_mean, group = item.f, color = item.f,shape=item.f)) +
  geom_line(linewidth = 1, position = position_dodge(0.3)) +
  geom_point(size = 6, position = position_dodge(0.3)) +
  geom_errorbar(
    aes(
      ymin = distance_mean - se,
      ymax = distance_mean + se
    ),
    width = 0.2,
    position = position_dodge(0.3)
  ) +
  labs(
    x = "Condition",
    y = "Mean ± SE Drag Order",
    title = "Mean Drag Order by Condition"
  ) +
  theme_minimal() +
  theme(
    legend.position = "top", # Place legend at the top
    legend.title = element_text(face = "bold"),
    axis.title = element_text(face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    plot.title = element_text(face = "bold", hjust = 0.5)
  )+
  scale_shape_manual(values = c("CR6_CL2" = 21, "CR5_CL3" = 22, 
                                "CR4_CL5" = 23, "CR3_CL6" = 24, 
                                "CR2_CL4" = 25, "CR1_CL1" = 11)) +
    scale_color_manual(values = custom_colors_color)

2.3.3 Correlation with Attribute Rank

Color Condition

• Aggregate Stats

Distance_Color.cleanup.df<-Distance_Color.cleanup.df%>%
    filter(ResponseId%in%color_correct_subj)%>%
 mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_color%>%select(ResponseId,initial.items_49:initial.items_51),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_49:initial.items_51))



summary_data_Color <- Distance_Color.cleanup.df%>%
  dplyr::group_by(item.f) %>%
  summarize(distance_mean = mean(distance, na.rm = TRUE),
            distance_sd = sd(distance, na.rm = TRUE),
            n = n(),
            se = distance_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))

• Model Specification: Drag Count predicted by color and corner attribute rank
• Note: A negative sign was added to the distance DV. So a positive coefficient indicates that a higher value of the predictor contributes to the item being ranked further up

ggplot(summary_data_Color, aes(x = rank.color, y = -distance_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Distance and Color Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Distance") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)

ggplot(summary_data_Color, aes(x = rank.corner, y = -distance_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Distance and Corner Attribute", subtitle = "Color Condition", x = "Objective Rank", y = "Avg. Drag Distance") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)

• Predict Drag Count (Indicator) with attribute ranks

M1<-lmer(-distance~rank.color+rank.corner+(1|ResponseId),Distance_Color.cleanup.df)
M2<-lmer(-distance~rank.color+rank.corner+initial.rank+(1|ResponseId),Distance_Color.cleanup.df)
M3<-lmer(-distance~rank.color+rank.corner+initial.rank+(1|ResponseId)+(1|item.f),Distance_Color.cleanup.df)
tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-0.77	-1.28 – -0.25	0.004	1.06	0.62 – 1.50	<0.001	1.05	0.58 – 1.53	<0.001
Color Rank	0.48	0.39 – 0.58	<0.001	0.47	0.41 – 0.52	<0.001	0.47	0.40 – 0.53	<0.001
Corner Rank	0.08	-0.02 – 0.17	0.103	-0.03	-0.08 – 0.02	0.269	-0.03	-0.10 – 0.04	0.369
Initial Rank [1]				-2.38	-2.70 – -2.06	<0.001	-2.37	-2.69 – -2.06	<0.001
Initial Rank [2]				-2.19	-2.51 – -1.87	<0.001	-2.17	-2.49 – -1.85	<0.001
Initial Rank [3]				-1.70	-2.02 – -1.39	<0.001	-1.71	-2.02 – -1.39	<0.001
Initial Rank [4]				-1.24	-1.55 – -0.92	<0.001	-1.24	-1.55 – -0.92	<0.001
Initial Rank [5]				-0.86	-1.18 – -0.54	<0.001	-0.85	-1.16 – -0.53	<0.001
Random Effects
σ2	1.08			0.33			0.32
τ00	0.20 ResponseId			0.32 ResponseId			0.32 ResponseId
							0.01 item.f
ICC	0.15			0.49			0.50
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.356 / 0.456			0.672 / 0.834			0.671 / 0.836

# M1_robust <- lm_robust(-distance ~ rank.color + rank.corner, data = Distance_Color.cleanup.df, clusters = ResponseId)
# M2_robust <- lm_robust(-distance ~ rank.color + rank.corner + initial.rank, data = Distance_Color.cleanup.df, clusters = ResponseId)
# M3_robust <- lm_robust(-distance ~ rank.color + rank.corner + initial.rank, data = Distance_Color.cleanup.df, clusters = interaction(ResponseId, item.f))
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

Corner Condition

• Aggregate Stats

Distance_Corner.cleanup.df<-Distance_Corner.cleanup.df%>%
  filter(ResponseId%in%corner_correct_subj)%>%
 mutate(rank.color=case_when(
    item.f=="CR4_CL5" ~5,
    item.f=="CR2_CL4" ~ 4,
    item.f== "CR6_CL2" ~ 2,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 3,
    item.f == "CR3_CL6" ~6
  ),
  rank.corner=case_when(
    item.f=="CR4_CL5" ~4,
    item.f=="CR2_CL4" ~ 2,
    item.f== "CR6_CL2" ~ 6,
    item.f== "CR1_CL1" ~ 1,
    item.f == "CR5_CL3" ~ 5,
    item.f == "CR3_CL6" ~ 3))%>%
  left_join(initial.dat_corner%>%select(ResponseId,initial.items_50:initial.items_47),by="ResponseId")%>%
  mutate(initial.rank=case_when(
    item.f=="CR4_CL5" ~ initial.items_49,
    item.f=="CR2_CL4" ~ initial.items_47,
    item.f=="CR6_CL2" ~ initial.items_51,
    item.f=="CR1_CL1" ~ initial.items_46,
    item.f=="CR5_CL3" ~ initial.items_50,
    item.f=="CR3_CL6" ~ initial.items_48
  ),
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_50:initial.items_47))



summary_data_Corner <- Distance_Corner.cleanup.df%>%
  dplyr::group_by(item.f) %>%
  summarize(distance_mean = mean(distance, na.rm = TRUE),
            distance_sd = sd(distance, na.rm = TRUE),
            n = n(),
            se = distance_sd / sqrt(n),  # Standard error
            .groups = "drop",
            rank.color=mean(rank.color),
            rank.corner=mean(rank.corner))

ggplot(summary_data_Corner, aes(x = rank.color, y = -distance_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Distance and Color Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Distance") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)

ggplot(summary_data_Corner, aes(x = rank.corner, y = -distance_mean, label = item.f)) +
  geom_point(size = 3, color = "black") +
  geom_text(vjust = -1, hjust = 1) +
  theme_minimal() +
  labs(title = "Drag Distance and Corner Attribute", subtitle = "Corner Condition", x = "Objective Rank", y = "Avg. Drag Distance") +
  theme(axis.title = element_text(face = "bold"),
        plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(face = "bold", hjust = 0.5))+
  geom_smooth(method = "lm", se = FALSE, color = "blue", linetype = "dashed") +
  xlim(0,6)

M1<-lmer(-distance~rank.color+rank.corner+(1|ResponseId),Distance_Corner.cleanup.df)
M2<-lmer(-distance~rank.color+rank.corner+initial.rank+(1|ResponseId),Distance_Corner.cleanup.df)
M3<-lmer(-distance~rank.color+rank.corner+initial.rank+(1|ResponseId)+(1|item.f),Distance_Corner.cleanup.df)
tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank", "Corner Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-0.94	-1.53 – -0.34	0.002	0.33	-0.11 – 0.77	0.140	0.33	-0.11 – 0.77	0.140
Color Rank	0.01	-0.09 – 0.12	0.787	0.01	-0.05 – 0.07	0.827	0.01	-0.05 – 0.07	0.827
Corner Rank	0.51	0.40 – 0.62	<0.001	0.53	0.47 – 0.59	<0.001	0.53	0.47 – 0.59	<0.001
Initial Rank [1]				-2.57	-2.92 – -2.22	<0.001	-2.57	-2.92 – -2.22	<0.001
Initial Rank [2]				-2.23	-2.58 – -1.88	<0.001	-2.23	-2.58 – -1.88	<0.001
Initial Rank [3]				-1.64	-1.99 – -1.30	<0.001	-1.64	-1.99 – -1.30	<0.001
Initial Rank [4]				-0.93	-1.28 – -0.58	<0.001	-0.93	-1.28 – -0.58	<0.001
Initial Rank [5]				-0.45	-0.80 – -0.10	0.012	-0.45	-0.80 – -0.10	0.012
Random Effects
σ2	1.44			0.42			0.42
τ00	0.24 ResponseId			0.41 ResponseId			0.41 ResponseId
							0.00 item.f
ICC	0.14			0.49
N	27 ResponseId			27 ResponseId			27 ResponseId
							6 item.f
Observations	162			162			162
Marginal R2 / Conditional R2	0.317 / 0.413			0.666 / 0.831			0.797 / NA

# M1_robust <- lm_robust(-distance ~ rank.color + rank.corner, data = Distance_Corner.cleanup.df, clusters = ResponseId)
# M2_robust <- lm_robust(-distance ~ rank.color + rank.corner + initial.rank, data = Distance_Corner.cleanup.df, clusters = ResponseId)
# M3_robust <- lm_robust(-distance ~ rank.color + rank.corner + initial.rank, data = Distance_Corner.cleanup.df, clusters = interaction(ResponseId, item.f))
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

Model with Combined Datasets

• Color and Corner Attribute Ranks are centered before being entered into the model.

Distance_Color.cleanup.df$condition<-"Color"
Distance_Corner.cleanup.df$condition<-"Corner"
Distance.cleanup.combined<-rbind(Distance_Color.cleanup.df,Distance_Corner.cleanup.df)%>%
  mutate(rank.corner.c=rank.corner-mean(rank.corner),
         rank.color.c=rank.color-mean(rank.color))


M1<-lmer(-distance~rank.color.c*condition+rank.corner.c*condition+(1|ResponseId),Distance.cleanup.combined)
M2<-lmer(-distance~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId),Distance.cleanup.combined)
M3<-lmer(-distance~rank.color.c*condition+rank.corner.c*condition+initial.rank+(1|ResponseId)+(1|item.f),Distance.cleanup.combined)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank","Condition [Corner]","Corner Rank", "Color Rank x Condition [Corner]","Corner Rank x Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	1.19	0.98 – 1.40	<0.001	2.54	2.27 – 2.81	<0.001	2.54	2.27 – 2.81	<0.001
Color Rank	0.48	0.37 – 0.59	<0.001	0.47	0.39 – 0.54	<0.001	0.47	0.39 – 0.54	<0.001
Condition [Corner]	-0.29	-0.55 – -0.03	0.030	-0.31	-0.48 – -0.14	<0.001	-0.31	-0.48 – -0.14	<0.001
Corner Rank	0.08	-0.03 – 0.19	0.153	-0.03	-0.10 – 0.04	0.421	-0.03	-0.10 – 0.04	0.421
Color Rank x Condition [Corner]	-0.47	-0.62 – -0.31	<0.001	-0.45	-0.55 – -0.35	<0.001	-0.45	-0.55 – -0.35	<0.001
Corner Rank x Condition [Corner]	0.44	0.28 – 0.59	<0.001	0.56	0.46 – 0.66	<0.001	0.56	0.46 – 0.66	<0.001
Ini. Rank [1]				-2.48	-2.77 – -2.18	<0.001	-2.48	-2.77 – -2.18	<0.001
Ini. Rank [2]				-2.21	-2.51 – -1.91	<0.001	-2.21	-2.51 – -1.91	<0.001
Ini. Rank [3]				-1.67	-1.97 – -1.38	<0.001	-1.67	-1.97 – -1.38	<0.001
Ini. Rank [4]				-1.09	-1.38 – -0.79	<0.001	-1.09	-1.38 – -0.79	<0.001
Ini. Rank [5]				-0.66	-0.96 – -0.36	<0.001	-0.66	-0.96 – -0.36	<0.001
Random Effects
σ2	1.41			0.60			0.60
τ00	0.06 ResponseId			0.15 ResponseId			0.15 ResponseId
							0.00 item.f
ICC	0.04			0.20
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.340 / 0.369			0.666 / 0.733			0.714 / NA

# Robustness check: consistent
# M1_robust <- lm_robust(-distance~rank.color.c*condition+rank.corner.c*condition,Distance.cleanup.combined, clusters = ResponseId)
# M2_robust <- lm_robust(-distance ~ rank.color.c*condition+rank.corner.c*condition+initial.rank, data = Distance.cleanup.combined, clusters = ResponseId)
# M3_robust <- lm_robust(-distance ~ rank.color.c*condition+rank.corner.c*condition+initial.rank, data = Distance.cleanup.combined, clusters = interaction(ResponseId, item.f))
# 
# tab_model(M1_robust, M2_robust, M3_robust,
#           pred.labels = c("Intercept", "Color Rank", "Corner Rank", "Initial Rank [1]", "Initial Rank [2]", "Initial Rank [3]", "Initial Rank [4]", "Initial Rank [5]"),
#           dv.labels = c("Subj. Robust", "Add Ini. Position", "Add Item Robust"))

• Collinearity Check

  • Caution: The following preliminary tests assume independent observations and do not account for the multi-level structure of the data. Neds to dig in more.

  • VIF > 5 suggests high multicollinearity. Pass

  • GVIF extends VIF for categorical predictors. typically interpreted using GVIF^(1/(2×df)) < 2 as a guideline. Pass

M1_lm<-lm(-distance~rank.color.c*condition+rank.corner.c*condition,Distance.cleanup.combined)
M2_lm<-lm(-distance~rank.color.c*condition+rank.corner.c*condition+initial.rank,Distance.cleanup.combined)

print("Model w/o ini. position")

## [1] "Model w/o ini. position"

vif_M1 <- vif(M1_lm)
vif_M1

##            rank.color.c               condition           rank.corner.c 
##                2.001634                1.000000                2.001634 
##  rank.color.c:condition condition:rank.corner.c 
##                2.001634                2.001634

print("Model w/ ini. position")

## [1] "Model w/ ini. position"

vif_M2 <- vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.071147  1        1.439148
## condition               1.000000  1        1.000000
## rank.corner.c           2.082317  1        1.443023
## initial.rank            1.113728  5        1.010829
## rank.color.c:condition  2.108391  1        1.452030
## condition:rank.corner.c 2.054097  1        1.433212

Nested Models

##### Nested Model
Distance.cleanup.combined<-Distance.cleanup.combined%>%
  mutate(CLR.Nested_color=case_when(
    condition == "Color" ~rank.color,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color
  ),
  CNR.Nested_color=case_when(
    condition == "Color" ~rank.corner,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner
  ),
  CLR.Nested_color.c=case_when(
    condition == "Color" ~rank.color.c,
    condition == "Corner" ~ 0
  ),
  CLR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.color.c
  ),
  CNR.Nested_color.c=case_when(
    condition == "Color" ~rank.corner.c,
    condition == "Corner" ~ 0
  ),
  CNR.Nested_corner.c=case_when(
    condition == "Color" ~ 0,
    condition == "Corner" ~ rank.corner.c
  ))

M1<-lmer(-distance~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+(1|ResponseId),Distance.cleanup.combined)
M2<-lmer(-distance~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId),Distance.cleanup.combined)
M3<-lmer(-distance~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank+(1|ResponseId)+(1|item.f),Distance.cleanup.combined)

tab_model(M1,M2,M3,pred.labels = c("Intercept", "Color Rank [Nested in Color]","Color Rank [Nested in Corner]","Corner Rank [Nested in Color]","Corner Rank [Nested in Corner]","Condition [Corner]", "Ini. Rank [1]","Ini. Rank [2]","Ini. Rank [3]","Ini. Rank [4]","Ini. Rank [5]"), dv.labels = c("Subj. Random_eff","Add Ini. Position","Add Item Random_eff"))

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-0.77	-1.33 – -0.21	0.008	1.01	0.55 – 1.48	<0.001	1.01	0.55 – 1.48	<0.001
Color Rank [Nested in Color]	0.48	0.37 – 0.59	<0.001	0.47	0.39 – 0.54	<0.001	0.47	0.39 – 0.54	<0.001
Color Rank [Nested in Corner]	0.01	-0.09 – 0.12	0.784	0.01	-0.06 – 0.09	0.684	0.01	-0.06 – 0.09	0.684
Corner Rank [Nested in Color]	0.08	-0.03 – 0.19	0.153	-0.03	-0.10 – 0.04	0.421	-0.03	-0.10 – 0.04	0.421
Corner Rank [Nested in Corner]	0.51	0.41 – 0.62	<0.001	0.53	0.46 – 0.60	<0.001	0.53	0.46 – 0.60	<0.001
Condition [Corner]	-0.18	-0.97 – 0.60	0.651	-0.69	-1.22 – -0.17	0.010	-0.69	-1.22 – -0.17	0.010
Ini. Rank [1]				-2.48	-2.77 – -2.18	<0.001	-2.48	-2.77 – -2.18	<0.001
Ini. Rank [2]				-2.21	-2.51 – -1.91	<0.001	-2.21	-2.51 – -1.91	<0.001
Ini. Rank [3]				-1.67	-1.97 – -1.38	<0.001	-1.67	-1.97 – -1.38	<0.001
Ini. Rank [4]				-1.09	-1.38 – -0.79	<0.001	-1.09	-1.38 – -0.79	<0.001
Ini. Rank [5]				-0.66	-0.96 – -0.36	<0.001	-0.66	-0.96 – -0.36	<0.001
Random Effects
σ2	1.41			0.60			0.60
τ00	0.06 ResponseId			0.15 ResponseId			0.15 ResponseId
							0.00 item.f
ICC	0.04			0.20
N	29 ResponseId			29 ResponseId			29 ResponseId
							6 item.f
Observations	324			324			324
Marginal R2 / Conditional R2	0.340 / 0.369			0.666 / 0.733			0.714 / NA

• Collinearity Check

M1_lm<-lm(distance~CLR.Nested_color+CLR.Nested_corner+CNR.Nested_color+CNR.Nested_corner+condition+initial.rank,Distance.cleanup.combined)
M1_lm.2<-lm(distance~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank,Distance.cleanup.combined)

print("Model w/o centering")

## [1] "Model w/o centering"

vif_M1 <- vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.210277  1        1.791725
## CLR.Nested_corner 3.199077  1        1.788596
## CNR.Nested_color  3.227591  1        1.796550
## CNR.Nested_corner 3.114885  1        1.764904
## condition         9.526716  1        3.086538
## initial.rank      1.113728  5        1.010829

print("Model w/ centering")

## [1] "Model w/ centering"

Vif_M1.2 <- vif(M1_lm.2)
Vif_M1.2

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.035573  1        1.017631
## CLR.Nested_corner.c 1.031960  1        1.015854
## CNR.Nested_color.c  1.041158  1        1.020372
## CNR.Nested_corner.c 1.004802  1        1.002398
## condition           1.000000  1        1.000000
## initial.rank        1.113728  5        1.010829

2.4 Correlation Between Measures

• Note on Coding: Drag count, order, and distance variables are coded such that greater values indicator drag and dropped more often, first, and further up.
  • Drag_Count: An indicator variable for whether an item is dragged and dropped
  • Order (coded so that the sign is flipped (adding a negative value)): greater value means dragged and dropped ealier
  • Distance: greater value means dragged and dropped further (up)
• Feel free to pause for a second to think about what to expect…

Color Condition

Distance_Color.cleanup.df$item.f<-factor(Distance_Color.cleanup.df$item.f,ordered = F)
Correlation.examine_Color<-drag_and_drop_count_Color_long%>%
  left_join(touch_order_analysis.long_Color%>%select(ResponseId,order,item.f),by=c("ResponseId","item.f"))%>%
  left_join(Distance_Color.cleanup.df%>%select(ResponseId,distance,item.f),by=c("ResponseId","item.f"))%>%
  mutate(Drag_Count.Ind=N_ind,
         order=-order,
         distance=-distance)

• Ploting below the the correlation between drag measures by item.

• Here is a summary plot

#--- Define a function to extract correlations for a given item ---#
get_item_correlations <- function(item_name) {
  # Filter data for the current item
  df_item <- Correlation.examine_Color %>% filter(item.f == item_name)

  # Compute correlations: OC (Order ~ Drag_Count.Ind), OD (Order ~ Distance), CD (Drag_Count.Ind ~ Distance)
  oc_test <- cor.test(df_item$order, df_item$Drag_Count.Ind)
  od_test <- cor.test(df_item$order, df_item$distance)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance)

  # Create a tibble summarizing the results for this item
  tibble(
    item = item_name,
    measure = c("OC", "OD", "CD"),
    correlation = c(oc_test$estimate, od_test$estimate, cd_test$estimate),
    p_value = c(oc_test$p.value, od_test$p.value, cd_test$p.value)
  )
}


items <- c("CR4_CL5", "CR2_CL4", "CR6_CL2", "CR1_CL1", "CR5_CL3", "CR3_CL6")

results <- map_df(items, get_item_correlations) %>%
  mutate(
    # Convert item to factor and manually set levels based on numeric order
    item = as.factor(item),
    item = factor(item, levels = rev(c(  "CR1_CL1","CR6_CL2", "CR5_CL3","CR2_CL4", "CR4_CL5","CR3_CL6")), ordered = TRUE),
    correlation = round(correlation, 2),
    p_value = round(p_value, 3),
    signif = if_else(p_value < 0.05, "Significant", "Not Significant")
    )%>%
mutate(Correlation = case_when(
      measure=="OC" ~ "Drag Order & Count",
      measure=="OD" ~ "Drag Order &  Distance",
      measure=="CD" ~ "Drag Count  &  Distance"))

custom_colors <- c(
  "CR3_CL6" = "#a6cee3",  # Light Blue
  "CR4_CL5" = "#6baed6",  # Medium Light Blue
  "CR2_CL4" = "#3182bd",  # Medium Blue
  "CR5_CL3" = "#08519c",  # Dark Blue
  "CR6_CL2" = "#08306b",  # Very Dark Blue
  "CR1_CL1" = "#041e42"   # Darkest Navy
)


Color_p2<-ggplot(results, aes(x = Correlation, y = correlation, group = item, color = item, shape = signif)) +
  geom_line(size = 1) +
  geom_point(size = 4) +
  theme_minimal() +
  labs(
    title = "Correlation Between Drag Measures by Item",
    x = "Variables",
    y = "Correlation Coefficient",
    color = "Item",
    shape = "Significance (<.05)"
  ) +
  scale_color_manual(values = custom_colors)+
    theme(
    axis.title.x = element_text(size = 16, face = "bold"),  # Bold and increase x-axis title
    axis.text.x = element_text(size = 14, face = "bold")    # Bold and increase x-axis text
  )

Color_p2

• CR3_CL6

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR3_CL6"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR4_CL5

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR4_CL5"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR2_CL4

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR2_CL4"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR5_CL3

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR5_CL3"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR6_CL2

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR6_CL2"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR1_CL1

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR1_CL1"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

Corner Condition

Distance_Corner.cleanup.df$item.f<-factor(Distance_Corner.cleanup.df$item.f,ordered = F)
Correlation.examine_Corner<-drag_and_drop_count_Corner_long%>%
  left_join(touch_order_analysis.long_Corner%>%select(ResponseId,order,item.f),by=c("ResponseId","item.f"))%>%
  left_join(Distance_Corner.cleanup.df%>%select(ResponseId,distance,item.f),by=c("ResponseId","item.f"))%>%
  mutate(Drag_Count.Ind=N_ind,
         order=-order,
         distance=-distance)

• Plotting below the the correlation between drag measures by item.

• Here is a summary plot

#--- Define a function to extract correlations for a given item ---#
get_item_correlations <- function(item_name) {
  # Filter data for the current item
  df_item <- Correlation.examine_Corner %>% filter(item.f == item_name)

  # Compute correlations: OC (Order ~ Drag_Count.Ind), OD (Order ~ Distance), CD (Drag_Count.Ind ~ Distance)
  oc_test <- cor.test(df_item$order, df_item$Drag_Count.Ind)
  od_test <- cor.test(df_item$order, df_item$distance)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance)

  # Create a tibble summarizing the results for this item
  tibble(
    item = item_name,
    measure = c("OC", "OD", "CD"),
    correlation = c(oc_test$estimate, od_test$estimate, cd_test$estimate),
    p_value = c(oc_test$p.value, od_test$p.value, cd_test$p.value)
  )
}

items <- c("CR4_CL5", "CR2_CL4", "CR6_CL2", "CR1_CL1", "CR5_CL3", "CR3_CL6")

results <- map_df(items, get_item_correlations) %>%
  mutate(
    # Convert item to factor and manually set levels based on numeric order
    item = as.factor(item),
    item = factor(item, levels = rev(c( "CR1_CL1", "CR2_CL4","CR3_CL6","CR4_CL5","CR5_CL3","CR6_CL2")), ordered = TRUE),
    correlation = round(correlation, 2),
    p_value = round(p_value, 3),
    signif = if_else(p_value < 0.05, "Significant", "Not Significant")
    )%>%
mutate(Correlation = case_when(
      measure=="OC" ~ "Drag Order & Count",
      measure=="OD" ~ "Drag Order &  Distance",
      measure=="CD" ~ "Drag Count  &  Distance"))

custom_colors <- c(
  "CR1_CL1" = "#a6cee3",  # Light Blue
  "CR2_CL4" = "#6baed6",  # Medium Light Blue
  "CR3_CL6" = "#3182bd",  # Medium Blue
  "CR4_CL5" = "#08519c",  # Dark Blue
  "CR5_CL3" = "#08306b",  # Very Dark Blue
  "CR6_CL2" = "#041e42"   # Darkest Navy
)

Corner<-ggplot(results, aes(x = Correlation, y = correlation, group = item, color = item, shape = signif)) +
  geom_line(size = 1) +
  geom_point(size = 4) +
  theme_minimal() +
  labs(
    title = "Correlation Between Drag Measures by Item",
    x = "Variables",
    y = "Correlation Coefficient",
    color = "Item",
    shape = "Significance (<.05)"
  ) +
  scale_color_manual(values = custom_colors)+
    theme(
    axis.title.x = element_text(size = 16, face = "bold"),  # Bold and increase x-axis title
    axis.text.x = element_text(size = 14, face = "bold")    # Bold and increase x-axis text
  )
Corner

• CR6_CL2

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR6_CL2"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR5_CL3

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR5_CL3"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR4_CL5

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR4_CL5"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR3_CL6

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR3_CL6"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR2_CL4

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR2_CL4"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR1_CL1

ggpairs(Correlation.examine_Color%>%filter(item.f=="CR1_CL1"),
                   c("Drag_Count.Ind","order","distance"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

2.5 Time Analysis

TimeAnalysis.Color<-Distance_Color%>%
  filter(ResponseId%in%color_correct_subj)%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(DD_diff=drop_time-drag_time,
         condition="Color")%>%
  select(step,ResponseId,condition,item.f,drag_time,drop_time,DD_diff,current_50:current_46)


duplicated.n<-nrow(TimeAnalysis.Color)
item<-c("CR1_CL1", "CR2_CL4","CR3_CL6","CR4_CL5","CR5_CL3","CR6_CL2")


TimeAnalysis.Color <- TimeAnalysis.Color %>%
  uncount(weights = 6) 
TimeAnalysis.Color$item.f<- rep(item, times = duplicated.n)
TimeAnalysis.Color<-TimeAnalysis.Color%>%
  mutate(current_rank=case_when(
    item.f=="CR4_CL5" ~ current_49,
    item.f=="CR2_CL4" ~ current_47,
    item.f=="CR6_CL2" ~ current_51,
    item.f=="CR1_CL1" ~ current_46,
    item.f=="CR5_CL3" ~ current_50,
    item.f=="CR3_CL6" ~ current_48
  ))%>%
  select(-c(current_50:current_46))

item_colors <- c("CR4_CL5" = "#1b9e77", "CR2_CL4" = "#d95f02", 
                 "CR6_CL2" = "#7570b3", "CR1_CL1" = "#e7298a", 
                 "CR5_CL3" = "#66a61e", "CR3_CL6" = "#e6ab02")

item_shapes <- c("CR4_CL5" = 21, "CR2_CL4" = 22, 
                 "CR6_CL2" = 23, "CR1_CL1" = 24, 
                 "CR5_CL3" = 25, "CR3_CL6" = 11)

Summary.Color <- TimeAnalysis.Color %>%
  group_by(step, item.f) %>%
  summarize(mean.current_rank = 7-mean(current_rank),
            sd.current_rank = sd(current_rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")



initial.rank<-touch_order_analysis.long_Color%>%
  filter(ResponseId%in%color_correct_subj)%>%
  group_by(item.f)%>%
  mutate(initial.rank=as.numeric(initial.rank))%>%
  summarize(mean.current_rank = 7-mean(initial.rank),
            sd.current_rank = sd(initial.rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")%>%
  mutate(step=0)

Summary.Color<-rbind(Summary.Color,
                     initial.rank)

ggplot(Summary.Color, aes(x = step, y = mean.current_rank, 
                          color = item.f,  shape = item.f)) +
  geom_line(size = 1) +  
  geom_point(size = 6, fill = "white") +  
  geom_errorbar(aes(ymin = mean.current_rank - se, ymax = mean.current_rank + se), 
                width = 0.3, size = 1.2, alpha = 0.8) + 
  scale_color_manual(values = item_colors) +  
  scale_shape_manual(values = item_shapes) +  
  labs(title = "Mean Rank by Step (Color Condition)",
       x = "Step",
       y = "Mean Current Rank",
       color = "Item",
       linetype = "Item",
       shape = "Item") +
  theme_minimal() +  # Clean theme
  theme(legend.position = "right",
    axis.title.x = element_text(face = "bold", size = 14),  # Bold x-axis label
    axis.title.y = element_text(face = "bold", size = 14),  # Bold y-axis label
    axis.text.x = element_text(face = "bold", size = 12),   # Bold x-axis text
    axis.text.y = element_text(face = "bold", size = 12)    # Bold y-axis text
  )+
  scale_y_continuous(breaks = 6:1) +
  scale_x_continuous(breaks = 0:6) 

# this dataset contains observation of items being moved multiple times!
TimeAnalysis.Corner<-Distance_Corner%>%
  filter(ResponseId%in%corner_correct_subj)%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(DD_diff=drop_time-drag_time,
         condition="Corner")%>%
  select(step,ResponseId,condition,item.f,drag_time,drop_time,DD_diff,current_50:current_46)

duplicated.n<-nrow(TimeAnalysis.Corner)
item<-c("CR6_CL5","CR5_CL4","CR4_CL2","CR3_CL1","CR2_CL3","CR1_CL6")

TimeAnalysis.Corner <- TimeAnalysis.Corner %>%
  uncount(weights = 6) 
TimeAnalysis.Corner$item.f<- rep(item, times = duplicated.n)
TimeAnalysis.Corner<-TimeAnalysis.Corner%>%
  mutate(current_rank=case_when(
    item.f=="CR4_CL5" ~ current_49,
    item.f=="CR2_CL4" ~ current_47,
    item.f=="CR6_CL2" ~ current_51,
    item.f=="CR1_CL1" ~ current_46,
    item.f=="CR5_CL3" ~ current_50,
    item.f=="CR3_CL6" ~ current_48
  ))%>%
  select(-c(current_50:current_46))

item_colors <- c("CR4_CL5" = "#1b9e77", "CR2_CL4" = "#d95f02", 
                 "CR6_CL2" = "#7570b3", "CR1_CL1" = "#e7298a", 
                 "CR5_CL3" = "#66a61e", "CR3_CL6" = "#e6ab02")

item_shapes <- c("CR4_CL5" = 21, "CR2_CL4" = 22, 
                 "CR6_CL2" = 23, "CR1_CL1" = 24, 
                 "CR5_CL3" = 25, "CR3_CL6" = 11)

Summary.Corner <- TimeAnalysis.Corner %>%
  group_by(step, item.f) %>%
  summarize(mean.current_rank = 7-mean(current_rank),
            sd.current_rank = sd(current_rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")


initial.rank<-touch_order_analysis.long_Corner%>%
  filter(ResponseId%in%corner_correct_subj)%>%
  group_by(item.f)%>%
  mutate(initial.rank=as.numeric(initial.rank))%>%
  summarize(mean.current_rank = 7- mean(initial.rank),
            sd.current_rank = sd(initial.rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")%>%
  mutate(step=0)

Summary.Corner<-rbind(Summary.Corner,
                     initial.rank)

ggplot(Summary.Corner, aes(x = step, y = mean.current_rank, 
                          color = item.f,  shape = item.f)) +
  geom_line(size = 1) +  
  geom_point(size = 6, fill = "white") +  
  geom_errorbar(aes(ymin = mean.current_rank - se, ymax = mean.current_rank + se), 
                width = 0.3, size = 1.2, alpha = 0.8) + 
  scale_color_manual(values = item_colors) +  
  scale_shape_manual(values = item_shapes) +  
  labs(title = "Mean Rank by Step (Corner Condition)",
       x = "Step",
       y = "Mean Current Rank",
       color = "Item",
       linetype = "Item",
       shape = "Item") +
  theme_minimal() +  # Clean theme
  theme(legend.position = "right",
    axis.title.x = element_text(face = "bold", size = 14),  # Bold x-axis label
    axis.title.y = element_text(face = "bold", size = 14),  # Bold y-axis label
    axis.text.x = element_text(face = "bold", size = 12),   # Bold x-axis text
    axis.text.y = element_text(face = "bold", size = 12)    # Bold y-axis text
  )+
  scale_y_continuous(breaks = 6:1) +
  scale_x_continuous(breaks = 0:6) 

• If the number of items being actively considered reduce over the course of the ranking process

• We might expect a decreasing trend in “Comparison time”

  • Comparison time = time difference between mousedown and mouseup.

• Model Specification: Comparison time predicted by step, controlling for condition, abs(drag distance), initial rank, and respondent and item random effects.

# this dataset contains observation of items being moved multiple times!
TimeAnalysis.Color.model<-Distance_Color%>%
  filter(ResponseId%in%color_correct_subj)%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(DD_diff=drop_time-drag_time,
         condition="Color")%>%
  select(step,ResponseId,condition,item.f,drag_time,drop_time,DD_diff)
  
TimeAnalysis.Corner.model<-Distance_Corner%>%
  filter(ResponseId%in%corner_correct_subj)%>%
  separate(timing, into = c("drag_time", "drop_time"), sep = ", ", convert = TRUE)%>%
  mutate(DD_diff=drop_time-drag_time,
         condition="Corner")%>%
  select(step,ResponseId,condition,item.f,drag_time,drop_time,DD_diff)

Distance.cleanup.combined$item.f<-factor(Distance.cleanup.combined$item.f,ordered = F)

TimeAnalysis.combined.model<-rbind(TimeAnalysis.Color.model,TimeAnalysis.Corner.model)%>%
  left_join(Distance.cleanup.combined%>%select(initial.rank,ResponseId,condition,item.f,distance),by=c("ResponseId","item.f","condition"))


# summary_examine <- examine %>%
#   group_by(step, condition) %>%
#   summarize(mean_DD_diff = mean(DD_diff, na.rm = TRUE),
#             n=n(),
#             se_DD_diff = sd(DD_diff, na.rm = TRUE) / sqrt(n),
#             .groups = "drop")
# 
# ggplot(summary_examine, aes(x = step, y = mean_DD_diff, color = condition)) +
#   geom_line(size = 1) +  # Mean DD_diff trend line
#   geom_point(size = 3) +  # Data points
#   geom_errorbar(aes(ymin = mean_DD_diff - se_DD_diff, ymax = mean_DD_diff + se_DD_diff), 
#                 width = 0.2, size = 1) +  # Error bars for SE
#   facet_wrap(~ condition) +  # Separate plots for each condition
#   labs(
#     x = "Step",
#     y = "Mean ± SE DD_diff",
#     title = "DD_diff as a Function of Step, Separated by Condition"
#   ) +
#   theme_minimal() +
#   theme(
#     legend.position = "top",  # Place legend at the top
#     axis.title = element_text(face = "bold"),
#     strip.text = element_text(face = "bold"),  # Bold facet titles
#     plot.title = element_text(face = "bold", hjust = 0.5)
#   )

M1<-lmer(DD_diff~step+condition+abs(distance)+initial.rank+(1|ResponseId)+(1|item.f),TimeAnalysis.combined.model)


tab_model(M1,pred.labels = c("Intercept", "Step", "Condition [Corner] Rank", "abs(Drag Distance)","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("DV = Comparison Time"))

	DV = Comparison Time
Predictors	Estimates	CI	p
Intercept	955.67	604.95 – 1306.39	<0.001
Step	-37.92	-83.10 – 7.27	0.100
Condition [Corner] Rank	-16.50	-126.34 – 93.33	0.767
abs(Drag Distance)	144.57	75.92 – 213.21	<0.001
Initial Rank [1]	-319.79	-642.94 – 3.35	0.052
Initial Rank [2]	-21.84	-247.47 – 203.78	0.849
Initial Rank [3]	-76.59	-275.58 – 122.41	0.449
Initial Rank [4]	-72.64	-250.43 – 105.15	0.422
Initial Rank [5]	-187.02	-355.26 – -18.79	0.030
Random Effects
σ2	157439.91
τ00 ResponseId	181459.34
τ00 item.f	0.00
N ResponseId	29
N item.f	6
Observations	229
Marginal R2 / Conditional R2	0.247 / NA

• If the number of items being actively considered reduce over the course of the ranking process
• We might also expect a trend in “Browsing time”
  • Browsing time = interval between a mouseup timestamp and the subsequent mousedown timestamp.
  • The browsing duration before the first item move is unknown. We have a data point confounded with the instruction reading time.
• Model Specification: Browse time predicted by step, controlling for condition, initial rank, and respondent and item random effects.

TimeAnalysis.combined.model<-TimeAnalysis.combined.model%>%
  group_by(condition,ResponseId)%>%
  mutate(drop_time.lag=lag(drop_time),
         browse.t=drag_time-drop_time.lag)

# summary_data <- TimeAnalysis.combined.model %>%
#   group_by(step, condition) %>%
#   summarize(mean_browse.t = mean(browse.t, na.rm = TRUE),
#             se_browse.t = sd(browse.t, na.rm = TRUE) / sqrt(n()),
#             .groups = "drop")

# ggplot(summary_data, aes(x = step, y = mean_browse.t, color = condition)) +
#   geom_line(size = 1) +  # Mean deliberation time trend line
#   geom_point(size = 3) +  # Data points
#   geom_errorbar(aes(ymin = mean_browse.t - se_browse.t, ymax = mean_browse.t + se_browse.t),
#                 width = 0.2, size = 1) +  # Error bars for SE
#   facet_wrap(~ condition) +  # Separate plots for each condition
#   labs(
#     x = "Step",
#     y = "Mean ± SE Deliberation Time",
#     title = "Deliberation Time as a Function of Step, Separated by Condition"
#   ) +
#   theme_minimal() +
#   theme(
#     legend.position = "top",  # Place legend at the top
#     axis.title = element_text(face = "bold"),
#     strip.text = element_text(face = "bold"),  # Bold facet titles
#     plot.title = element_text(face = "bold", hjust = 0.5)
#   )


M1<-lmer(browse.t~step+condition+initial.rank+(1|ResponseId)+(1|item.f),TimeAnalysis.combined.model)

tab_model(M1,pred.labels = c("Intercept", "Step", "Condition [Corner] Rank","Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("DV = Browse Time"))

	DV = Browse Time
Predictors	Estimates	CI	p
Intercept	1664.75	599.71 – 2729.79	0.002
Step	-126.62	-343.88 – 90.65	0.252
Condition [Corner] Rank	413.25	-137.34 – 963.83	0.140
Initial Rank [1]	346.54	-1203.79 – 1896.88	0.660
Initial Rank [2]	238.60	-817.68 – 1294.87	0.656
Initial Rank [3]	545.19	-292.81 – 1383.19	0.201
Initial Rank [4]	731.32	-75.83 – 1538.48	0.075
Initial Rank [5]	342.65	-467.43 – 1152.74	0.405
Random Effects
σ2	2957458.58
τ00 ResponseId	1226399.11
τ00 item.f	46693.83
ICC	0.30
N ResponseId	29
N item.f	6
Observations	175
Marginal R2 / Conditional R2	0.032 / 0.323

• We might expect a decreasing trend in drag distance across time (vs. if participants primarily swap items pairwise while reviewing options, drag distance may remain stable instead of showing a clear trend.)
• Model Specification: abs(Drag distance) predicted by step, controlling for condition, initial rank, and respondent and item random effects.

M1<-lmer(abs(distance)~step+condition+initial.rank+(1|ResponseId)+(1|item.f),TimeAnalysis.combined.model)
tab_model(M1,pred.labels = c("Intercept", "Step", "Condition [Corner]", "Initial Rank [1]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]"),dv.labels = c("DV = abs(Drag Distance)"))

	DV = abs(Drag Distance)
Predictors	Estimates	CI	p
Intercept	3.93	3.57 – 4.29	<0.001
Step	-0.37	-0.44 – -0.29	<0.001
Condition [Corner]	0.06	-0.16 – 0.28	0.578
Initial Rank [1]	-1.59	-2.17 – -1.01	<0.001
Initial Rank [2]	-1.91	-2.27 – -1.54	<0.001
Initial Rank [3]	-1.59	-1.92 – -1.25	<0.001
Initial Rank [4]	-1.08	-1.40 – -0.75	<0.001
Initial Rank [5]	-0.57	-0.90 – -0.25	0.001
Random Effects
σ2	0.64
τ00 ResponseId	0.08
τ00 item.f	0.02
ICC	0.14
N ResponseId	29
N item.f	6
Observations	229
Marginal R2 / Conditional R2	0.495 / 0.566

# Number1<-c(1,2,3,4,5,6)
# Number2<-c(2,3,5,6,4,1)
# cor(Number1,Number2)