Drag and Drop Official Study (N=100)

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(0, 10, by = 1), limits = c(0, 10))
}

# 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

# dat.final_Color<-dat%>%filter(ResponseId%in%drag_and_drop_count_Color_long$ResponseId)
# dat.final_Corner<-dat%>%filter(ResponseId%in%drag_and_drop_count_Corner_long$ResponseId)
# summarize_task(dat.final_Color, "t_corner_Page.Submit", "Corner")
# summarize_task(dat.final_Corner, "rank_color_t_Page.Submit", "Color")
# psych::describe(dat.final_Color$RankCount_Color)
# psych::describe(dat.final_Corner$RankCount_Corner)

# write.csv(dat.final_Color,"dat.final_Color_1A.csv")
# write.csv(dat.final_Corner,"dat.final_Corner_1A.csv")

Preliminaries

Gender

dat <- dat %>%
  mutate(gender_label = case_when(
    gender == 4 ~ "Female",
    gender == 8 ~ "Male",
    TRUE ~ NA_character_ 
  ))
table(dat$gender_label)

## 
## Female   Male 
##     45     49

# 4= Female
# 8= Male

Age

psych::describe(dat$age)

Warm Up Task

• The majority of 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

• ATTN: I work 28 hours a day (TRUE/FALSE/UNSURE)
• DOSAGE: We asked participants to identify the tasks they had just completed (rank by color darkness and the number of corners)

correct_answer <- "2,3"

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 %>%
    # filter(ResponseId%in%drag_and_drop_count_Corner_long$ResponseId)%>%
  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, 100)  # 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 three questions:
  • Did you find the survey tedious.
  • Did you find the survey confusing.
  • Did you use any external sources to answer these questions?

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,101)

Guess Purpose

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,50))

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,50))

• Responses from the 3 respondents who answered “other”:

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,100))

Technical Issue

• “Did you run into any technical issue during the survey?”
• Two said yes, but when prompted about what technical issue they encountered in open-ended question, they said “no”.

# table(dat$technical)
# dat$technical_open

Accuracy in Ranking Task

Corner condition: 87% (88/101) Tau = 1
Color condition: 83% (84/101) 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()

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_NoneNeg_subj<-Summary_data_corner%>%
  filter(Tau>=0)%>%
  pull(ResponseId)
color_NoneNeg_subj<-Summary_data_color%>%
  filter(Tau>=0)%>%
  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(Summary_data_corner$ResponseId))
# length(unique(corner_incorrect_subj)) # 3 subj
# length(unique(corner_reverse_subj))
# length(unique(corner_correct_subj))

# length(unique(Summary_data_color$ResponseId))
# 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)

# write.csv(Summary_data,"Summary_data.Org_Order.csv")

# Summary_data_corner.unique_final<-Summary_data_corner%>%
#   filter(ResponseId%in%drag_and_drop_count_Corner_long$ResponseId & !duplicated(ResponseId) & ResponseId%notin%corner_reverse_subj)
# Summary_data_color.unique_final<-Summary_data_color%>%
#   filter(ResponseId%in%drag_and_drop_count_Color_long$ResponseId & !duplicated(ResponseId)& ResponseId%notin%color_reverse_subj)
# table(Summary_data_color.unique_final$Tau)
# table(Summary_data_corner.unique_final$Tau)
# nrow(Summary_data_color.unique_final)
# nrow(Summary_data_corner.unique_final)
# psych::describe(Summary_data_color.unique_final$Tau)
# psych::describe(Summary_data_corner.unique_final$Tau)
# write.csv(Summary_data_corner.unique_final,"dat.AccuracyCorner_1A.csv")
# write.csv(Summary_data_color.unique_final,"dat.AccuracyColor_1A.csv")

• Tau <= 0: 3 participants (3%) in the color condition and 2 participants (2%) in the corner condition.

As preregistered, we exclude respondents with Tau <= 0 for the analysis below.

Summary_data.trim <- Summary_data %>%
  filter(( (Group == "Corner" & ResponseId %in% corner_NoneNeg_subj) | 
            (Group == "Color" & ResponseId %in% color_NoneNeg_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%in%corner_NoneNeg_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%in%color_NoneNeg_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")

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

• Note on rank coding: throughout the note book, 6 refers to the highest rank (at the top) and 1 refers to the lowest (at the bottom)

• 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_NoneNeg_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_NoneNeg_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_NoneNeg_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_NoneNeg_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_NoneNeg_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_48:initial.items_46),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6),
  N_ind=case_when(
    N==0~0,
    TRUE~1)
  )%>%
  select(-c(initial.items_48:initial.items_46))



# 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.09	0.04 – 0.17	<0.001	0.00	0.00 – 0.00	<0.001	0.00	0.00 – 0.01	<0.001
Color Rank	1.82	1.59 – 2.08	<0.001	2.44	2.01 – 2.97	<0.001	2.39	1.87 – 3.06	<0.001
Corner Rank	1.26	1.13 – 1.42	<0.001	1.27	1.11 – 1.46	0.001	1.28	1.04 – 1.59	0.021
Initial Rank [1]				168.28	53.33 – 530.95	<0.001	154.88	49.06 – 488.99	<0.001
Initial Rank [2]				106.25	35.54 – 317.67	<0.001	93.99	31.59 – 279.65	<0.001
Initial Rank [3]				75.98	26.42 – 218.54	<0.001	68.24	23.87 – 195.07	<0.001
Initial Rank [4]				48.19	17.72 – 131.08	<0.001	41.86	15.35 – 114.13	<0.001
Initial Rank [5]				20.93	7.98 – 54.88	<0.001	18.34	7.03 – 47.82	<0.001
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.14 ResponseId			0.13 ResponseId
							0.11 item.f
ICC				0.04			0.07
N	87 ResponseId			87 ResponseId			87 ResponseId
							6 item.f
Observations	522			522			522
Marginal R2 / Conditional R2	0.272 / NA			0.622 / 0.637			0.606 / 0.633

# 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_NoneNeg_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_48:initial.items_50),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6),
    N_ind=case_when(
    N==0~0,
    TRUE~1)
  )%>%
  select(-c(initial.items_48:initial.items_50))



# 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.22	0.13 – 0.39	<0.001	0.00	0.00 – 0.01	<0.001	0.00	0.00 – 0.01	<0.001
Color Rank	1.07	0.96 – 1.19	0.232	1.14	0.99 – 1.31	0.062	1.14	0.99 – 1.31	0.062
Corner Rank	1.65	1.47 – 1.86	<0.001	2.20	1.84 – 2.62	<0.001	2.20	1.84 – 2.62	<0.001
Initial Rank [1]				60.79	22.83 – 161.87	<0.001	60.79	22.83 – 161.87	<0.001
Initial Rank [2]				101.17	36.75 – 278.53	<0.001	101.17	36.75 – 278.53	<0.001
Initial Rank [3]				98.26	35.35 – 273.12	<0.001	98.26	35.35 – 273.12	<0.001
Initial Rank [4]				37.32	14.68 – 94.87	<0.001	37.32	14.68 – 94.87	<0.001
Initial Rank [5]				16.84	6.95 – 40.79	<0.001	16.84	6.95 – 40.79	<0.001
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.08 ResponseId			0.08 ResponseId
							0.00 item.f
ICC				0.02
N	89 ResponseId			89 ResponseId			89 ResponseId
							6 item.f
Observations	534			534			534
Marginal R2 / Conditional R2	0.186 / NA			0.551 / 0.562			0.557 / 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	1.61	1.31 – 1.96	<0.001	0.06	0.03 – 0.11	<0.001	0.06	0.03 – 0.11	<0.001
Color Rank	1.82	1.59 – 2.08	<0.001	2.37	2.00 – 2.82	<0.001	2.37	2.00 – 2.82	<0.001
Condition [Corner]	1.01	0.77 – 1.34	0.929	1.05	0.74 – 1.49	0.782	1.05	0.74 – 1.49	0.782
Corner Rank	1.26	1.13 – 1.42	<0.001	1.27	1.11 – 1.45	<0.001	1.27	1.11 – 1.45	<0.001
Color Rank x Condition [Corner]	0.59	0.50 – 0.70	<0.001	0.47	0.38 – 0.59	<0.001	0.47	0.38 – 0.59	<0.001
Corner Rank x Condition [Corner]	1.30	1.11 – 1.54	0.001	1.70	1.38 – 2.09	<0.001	1.70	1.38 – 2.09	<0.001
Ini. Rank [1]				93.19	44.78 – 193.95	<0.001	93.25	44.80 – 194.09	<0.001
Ini. Rank [2]				96.82	46.77 – 200.44	<0.001	96.85	46.78 – 200.51	<0.001
Ini. Rank [3]				81.63	39.63 – 168.13	<0.001	81.67	39.65 – 168.22	<0.001
Ini. Rank [4]				40.44	20.60 – 79.39	<0.001	40.46	20.61 – 79.45	<0.001
Ini. Rank [5]				18.21	9.54 – 34.76	<0.001	18.22	9.54 – 34.78	<0.001
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.02 ResponseId			0.02 ResponseId
							0.00 item.f
ICC				0.01			0.01
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.231 / NA			0.585 / 0.588			0.585 / 0.588

# 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 <- car::vif(M1_lm)
vif_M1

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

print("Model w/ ini. position")

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

vif_M2 <- car::vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.029603  1        1.424641
## condition               1.000000  1        1.000000
## rank.corner.c           2.039343  1        1.428056
## initial.rank            1.030226  5        1.002982
## rank.color.c:condition  2.033717  1        1.426084
## condition:rank.corner.c 2.038398  1        1.427725

Nested Model

• Nested Model returned consistent results for the rank variables, and appears easier to interpret/write up.
  • We created nested versions of the rank variables by coding them as follows: – When the condition matches the nested variable (e.g., condition == “color” for color/corner rank [nested within color] ), we used rank - 3.5 (instead of raw rank. This helps reduce multicollearity with the condition variable, see Collinearity Check below). – When the condition does not match, the value was set to 0.
• One question is how to interpret 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.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)
M2<-glmer(N_ind~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+(1|ResponseId),drag_and_drop_count_long.combined,family=binomial)

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

tab_model(M1,M2,M3.DragCount,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	Odds Ratios	CI	p	Odds Ratios	CI	p	Odds Ratios	CI	p
Intercept	1.61	1.31 – 1.96	<0.001	0.06	0.03 – 0.11	<0.001	0.06	0.03 – 0.11	<0.001
Color Rank [Nested in Color]	1.82	1.59 – 2.08	<0.001	2.37	2.00 – 2.82	<0.001	2.37	2.00 – 2.82	<0.001
Color Rank [Nested in Corner]	1.07	0.96 – 1.19	0.232	1.12	0.98 – 1.29	0.090	1.12	0.98 – 1.29	0.090
Corner Rank [Nested in Color]	1.26	1.13 – 1.42	<0.001	1.27	1.11 – 1.45	<0.001	1.27	1.11 – 1.45	<0.001
Corner Rank [Nested in Corner]	1.65	1.47 – 1.86	<0.001	2.16	1.84 – 2.54	<0.001	2.16	1.84 – 2.54	<0.001
Condition [Corner]	1.01	0.77 – 1.34	0.929	1.05	0.74 – 1.49	0.782	1.05	0.74 – 1.49	0.781
Ini. Rank [1]				93.19	44.78 – 193.95	<0.001	93.20	44.78 – 193.96	<0.001
Ini. Rank [2]				96.81	46.76 – 200.43	<0.001	96.81	46.76 – 200.42	<0.001
Ini. Rank [3]				81.63	39.63 – 168.13	<0.001	81.63	39.63 – 168.12	<0.001
Ini. Rank [4]				40.44	20.60 – 79.39	<0.001	40.44	20.60 – 79.39	<0.001
Ini. Rank [5]				18.20	9.54 – 34.76	<0.001	18.21	9.54 – 34.76	<0.001
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.02 ResponseId			0.02 ResponseId
							0.00 item.f
ICC				0.01
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.231 / NA			0.585 / 0.588			0.587 / NA

print("Models showing Beta rather than Odds Ratio:")

## [1] "Models showing Beta rather than Odds Ratio:"

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"),
  transform = NULL
)

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Log-Odds	CI	p	Log-Odds	CI	p	Log-Odds	CI	p
(Intercept)	0.47	0.27 – 0.68	<0.001	-2.81	-3.37 – -2.24	<0.001	-2.81	-3.37 – -2.24	<0.001
CLR.Nested_color.c	0.60	0.47 – 0.73	<0.001	0.86	0.69 – 1.04	<0.001
CLR.Nested_corner.c	0.07	-0.04 – 0.18	0.232	0.12	-0.02 – 0.25	0.090
CNR.Nested_color.c	0.23	0.12 – 0.35	<0.001	0.24	0.11 – 0.37	<0.001
CNR.Nested_corner.c	0.50	0.38 – 0.62	<0.001	0.77	0.61 – 0.93	<0.001
conditionCorner	0.01	-0.27 – 0.29	0.929	0.05	-0.30 – 0.40	0.782	0.05	-0.30 – 0.40	0.782
initial.rank1				4.53	3.80 – 5.27	<0.001	4.54	3.80 – 5.27	<0.001
initial.rank2				4.57	3.85 – 5.30	<0.001	4.57	3.85 – 5.30	<0.001
initial.rank3				4.40	3.68 – 5.12	<0.001	4.40	3.68 – 5.13	<0.001
initial.rank4				3.70	3.03 – 4.37	<0.001	3.70	3.03 – 4.38	<0.001
initial.rank5				2.90	2.25 – 3.55	<0.001	2.90	2.26 – 3.55	<0.001
rank.color.c							0.86	0.69 – 1.04	<0.001
rank.corner.c							0.24	0.11 – 0.37	<0.001
rank.color.c:conditionCorner							-0.75	-0.97 – -0.53	<0.001
conditionCorner:rank.corner.c							0.53	0.32 – 0.74	<0.001
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.02 ResponseId			0.02 ResponseId
							0.00 item.f
ICC				0.01			0.01
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.231 / NA			0.585 / 0.588			0.585 / 0.588

# M_robust <- lm_robust(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, clusters = ~ResponseId+item.f)
# tab_model(M_robust)
# summary(M3.DragCount)

• 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("Nested Variable w/ rank - 3.5 (mean)")

## [1] "Nested Variable w/ rank - 3.5 (mean)"

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

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.003270  1        1.001633
## CLR.Nested_corner.c 1.009770  1        1.004873
## CNR.Nested_color.c  1.008084  1        1.004034
## CNR.Nested_corner.c 1.011794  1        1.005880
## condition           1.000000  1        1.000000
## initial.rank        1.030226  5        1.002982

print("Nested Variable w raw rank")

## [1] "Nested Variable w raw rank"

vif_M1 <- car::vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.134078  1        1.770333
## CLR.Nested_corner 3.106191  1        1.762439
## CNR.Nested_color  3.149118  1        1.774576
## CNR.Nested_corner 3.112417  1        1.764204
## condition         9.240622  1        3.039839
## initial.rank      1.030226  5        1.002982

# drag_and_drop_count_long.combined%>%
#   filter(N>1)
# sum(drag_and_drop_count_long.combined$N >=1)

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_NoneNeg_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_NoneNeg_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_NoneNeg_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_NoneNeg_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_NoneNeg_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_48:initial.items_46),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_48:initial.items_46))


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	4.99	4.71 – 5.27	<0.001	6.11	5.82 – 6.40	<0.001	6.11	5.81 – 6.40	<0.001
Color Rank	-0.53	-0.59 – -0.48	<0.001	-0.53	-0.57 – -0.48	<0.001	-0.53	-0.58 – -0.48	<0.001
Corner Rank	0.01	-0.05 – 0.06	0.806	0.03	-0.02 – 0.08	0.196	0.03	-0.02 – 0.08	0.213
Initial Rank [1]				-1.64	-1.91 – -1.37	<0.001	-1.64	-1.91 – -1.37	<0.001
Initial Rank [2]				-1.64	-1.91 – -1.37	<0.001	-1.64	-1.91 – -1.37	<0.001
Initial Rank [3]				-1.50	-1.77 – -1.22	<0.001	-1.50	-1.77 – -1.22	<0.001
Initial Rank [4]				-1.42	-1.69 – -1.15	<0.001	-1.42	-1.69 – -1.15	<0.001
Initial Rank [5]				-1.16	-1.43 – -0.89	<0.001	-1.16	-1.43 – -0.89	<0.001
Random Effects
σ2	1.15			0.83			0.83
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	87 ResponseId			87 ResponseId			87 ResponseId
							6 item.f
Observations	522			522			522
Marginal R2 / Conditional R2	0.421 / NA			0.583 / NA			0.583 / 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_NoneNeg_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_48:initial.items_50),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_48:initial.items_50))



# 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.14	3.83 – 4.44	<0.001	5.46	5.10 – 5.81	<0.001	5.47	4.97 – 5.96	<0.001
Color Rank	0.16	0.10 – 0.22	<0.001	0.13	0.08 – 0.18	<0.001	0.13	0.05 – 0.22	0.003
Corner Rank	-0.44	-0.50 – -0.38	<0.001	-0.46	-0.51 – -0.40	<0.001	-0.46	-0.54 – -0.37	<0.001
Initial Rank [1]				-1.32	-1.63 – -1.00	<0.001	-1.32	-1.63 – -1.02	<0.001
Initial Rank [2]				-1.52	-1.83 – -1.20	<0.001	-1.53	-1.84 – -1.22	<0.001
Initial Rank [3]				-1.54	-1.86 – -1.23	<0.001	-1.56	-1.87 – -1.24	<0.001
Initial Rank [4]				-1.49	-1.81 – -1.18	<0.001	-1.52	-1.83 – -1.21	<0.001
Initial Rank [5]				-1.15	-1.46 – -0.84	<0.001	-1.15	-1.46 – -0.84	<0.001
Random Effects
σ2	1.39			1.11			1.10
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.02 item.f
N	89 ResponseId			89 ResponseId			89 ResponseId
							6 item.f
Observations	534			534			534
Marginal R2 / Conditional R2	0.310 / NA			0.452 / NA			0.456 / 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.14	3.04 – 3.24	<0.001	4.34	4.18 – 4.50	<0.001	4.34	4.17 – 4.52	<0.001
Color Rank	-0.53	-0.59 – -0.48	<0.001	-0.53	-0.58 – -0.48	<0.001	-0.53	-0.60 – -0.46	<0.001
Condition [Corner]	0.00	-0.13 – 0.14	0.972	0.00	-0.12 – 0.12	0.968	0.00	-0.12 – 0.12	0.968
Corner Rank	0.01	-0.05 – 0.06	0.816	0.03	-0.02 – 0.08	0.271	0.03	-0.04 – 0.10	0.422
Color Rank x Condition [Corner]	0.69	0.61 – 0.77	<0.001	0.66	0.59 – 0.73	<0.001	0.66	0.59 – 0.73	<0.001
Corner Rank x Condition [Corner]	-0.45	-0.53 – -0.37	<0.001	-0.48	-0.55 – -0.41	<0.001	-0.48	-0.55 – -0.41	<0.001
Ini. Rank [1]				-1.48	-1.68 – -1.27	<0.001	-1.48	-1.69 – -1.28	<0.001
Ini. Rank [2]				-1.58	-1.78 – -1.37	<0.001	-1.58	-1.79 – -1.38	<0.001
Ini. Rank [3]				-1.52	-1.73 – -1.31	<0.001	-1.53	-1.73 – -1.32	<0.001
Ini. Rank [4]				-1.46	-1.66 – -1.25	<0.001	-1.47	-1.67 – -1.26	<0.001
Ini. Rank [5]				-1.16	-1.36 – -0.95	<0.001	-1.16	-1.36 – -0.95	<0.001
Random Effects
σ2	1.27			0.97			0.97
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.01 item.f
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.364 / NA			0.515 / NA			0.517 / 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 <- car::vif(M1_lm)
vif_M1

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

print("Model w/ ini. position")

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

vif_M2 <- car::vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.029603  1        1.424641
## condition               1.000000  1        1.000000
## rank.corner.c           2.039343  1        1.428056
## initial.rank            1.030226  5        1.002982
## rank.color.c:condition  2.033717  1        1.426084
## condition:rank.corner.c 2.038398  1        1.427725

# 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.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+(1|ResponseId),touch_order_analysis.long.combined)
M2<-lmer(order~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+(1|ResponseId),touch_order_analysis.long.combined)
M3.DragOrder<-lmer(order~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+(1|ResponseId)+(1|item.f),touch_order_analysis.long.combined)

# summary(M3.DragOrder)

tab_model(M1,M2,M3.DragOrder,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	3.14	3.04 – 3.24	<0.001	4.34	4.18 – 4.50	<0.001	4.34	4.17 – 4.52	<0.001
Color Rank [Nested in Color]	-0.53	-0.59 – -0.48	<0.001	-0.53	-0.58 – -0.48	<0.001	-0.53	-0.60 – -0.46	<0.001
Color Rank [Nested in Corner]	0.16	0.10 – 0.21	<0.001	0.13	0.08 – 0.18	<0.001	0.13	0.06 – 0.20	<0.001
Corner Rank [Nested in Color]	0.01	-0.05 – 0.06	0.816	0.03	-0.02 – 0.08	0.271	0.03	-0.04 – 0.10	0.422
Corner Rank [Nested in Corner]	-0.44	-0.50 – -0.38	<0.001	-0.45	-0.50 – -0.40	<0.001	-0.45	-0.52 – -0.38	<0.001
Condition [Corner]	0.00	-0.13 – 0.14	0.972	0.00	-0.12 – 0.12	0.968	0.00	-0.12 – 0.12	0.968
Ini. Rank [1]				-1.48	-1.68 – -1.27	<0.001	-1.48	-1.69 – -1.28	<0.001
Ini. Rank [2]				-1.58	-1.78 – -1.37	<0.001	-1.58	-1.79 – -1.38	<0.001
Ini. Rank [3]				-1.52	-1.73 – -1.31	<0.001	-1.53	-1.73 – -1.32	<0.001
Ini. Rank [4]				-1.46	-1.66 – -1.25	<0.001	-1.47	-1.67 – -1.26	<0.001
Ini. Rank [5]				-1.16	-1.36 – -0.95	<0.001	-1.16	-1.36 – -0.95	<0.001
Random Effects
σ2	1.27			0.97			0.97
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.01 item.f
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.364 / NA			0.515 / NA			0.517 / NA

# M_robust <- lm_robust(-order~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+item.f,touch_order_analysis.long.combined, clusters = ResponseId)

• Collinearity Check

library(car)
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("Nested Variable w/ rank - 3.5 (mean)")

## [1] "Nested Variable w/ rank - 3.5 (mean)"

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

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.003270  1        1.001633
## CLR.Nested_corner.c 1.009770  1        1.004873
## CNR.Nested_color.c  1.008084  1        1.004034
## CNR.Nested_corner.c 1.011794  1        1.005880
## condition           1.000000  1        1.000000
## initial.rank        1.030226  5        1.002982

print("Nested Variable w raw rank")

## [1] "Nested Variable w raw rank"

vif_M1 <- car::vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.134078  1        1.770333
## CLR.Nested_corner 3.106191  1        1.762439
## CNR.Nested_color  3.149118  1        1.774576
## CNR.Nested_corner 3.112417  1        1.764204
## condition         9.240622  1        3.039839
## initial.rank      1.030226  5        1.002982

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)

Manuscript_distance<-Distance_cleanup.df.combined %>%
  mutate(condition=as.factor(condition),
         distance.abs=abs(distance))%>%
  filter(distance.abs!=0)
t.test(Manuscript_distance$distance.abs, mu = 1, alternative = "greater")

## 
##  One Sample t-test
## 
## data:  Manuscript_distance$distance.abs
## t = 22.714, df = 650, p-value < 2.2e-16
## alternative hypothesis: true mean is greater than 1
## 95 percent confidence interval:
##  1.964525      Inf
## sample estimates:
## mean of x 
##  2.039939

2.3.3 Correlation with Attribute Rank

Color Condition

• Aggregate Stats

Distance_Color.cleanup.df<-Distance_Color.cleanup.df%>%
    filter(ResponseId%in%color_NoneNeg_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_48:initial.items_46),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_48:initial.items_46))



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.69	-1.00 – -0.39	<0.001	-1.84	-2.07 – -1.62	<0.001	-1.84	-2.07 – -1.62	<0.001
Color Rank	0.51	0.45 – 0.57	<0.001	0.50	0.46 – 0.53	<0.001	0.50	0.46 – 0.53	<0.001
Corner Rank	0.00	-0.06 – 0.06	0.959	-0.02	-0.06 – 0.01	0.132	-0.02	-0.06 – 0.01	0.132
Initial Rank [1]				2.52	2.33 – 2.72	<0.001	2.52	2.33 – 2.72	<0.001
Initial Rank [2]				2.05	1.86 – 2.24	<0.001	2.05	1.86 – 2.24	<0.001
Initial Rank [3]				1.52	1.32 – 1.71	<0.001	1.52	1.32 – 1.71	<0.001
Initial Rank [4]				1.08	0.88 – 1.27	<0.001	1.08	0.88 – 1.27	<0.001
Initial Rank [5]				0.59	0.40 – 0.78	<0.001	0.59	0.40 – 0.78	<0.001
Random Effects
σ2	1.28			0.41			0.41
τ00	0.11 ResponseId			0.26 ResponseId			0.26 ResponseId
							0.00 item.f
ICC	0.08			0.38
N	87 ResponseId			87 ResponseId			87 ResponseId
							6 item.f
Observations	522			522			522
Marginal R2 / Conditional R2	0.354 / 0.406			0.690 / 0.809			0.783 / NA

# 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_NoneNeg_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_48:initial.items_50),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=7-initial.rank,
  initial.rank = relevel(factor(initial.rank), ref = 6)
  )%>%
  select(-c(initial.items_48:initial.items_50))



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	-1.06	-1.37 – -0.75	<0.001	-2.35	-2.62 – -2.08	<0.001	-2.35	-2.62 – -2.08	<0.001
Color Rank	0.02	-0.04 – 0.08	0.491	0.04	0.00 – 0.08	0.031	0.04	0.00 – 0.08	0.031
Corner Rank	0.55	0.49 – 0.61	<0.001	0.54	0.50 – 0.58	<0.001	0.54	0.50 – 0.58	<0.001
Initial Rank [1]				2.51	2.29 – 2.73	<0.001	2.51	2.29 – 2.73	<0.001
Initial Rank [2]				1.92	1.70 – 2.14	<0.001	1.92	1.70 – 2.14	<0.001
Initial Rank [3]				1.48	1.26 – 1.70	<0.001	1.48	1.26 – 1.70	<0.001
Initial Rank [4]				1.00	0.78 – 1.22	<0.001	1.00	0.78 – 1.22	<0.001
Initial Rank [5]				0.55	0.34 – 0.77	<0.001	0.55	0.34 – 0.77	<0.001
Random Effects
σ2	1.38			0.55			0.55
τ00	0.15 ResponseId			0.29 ResponseId			0.29 ResponseId
							0.00 item.f
ICC	0.10			0.34
N	89 ResponseId			89 ResponseId			89 ResponseId
							6 item.f
Observations	534			534			534
Marginal R2 / Conditional R2	0.367 / 0.428			0.655 / 0.774			0.743 / 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.09	0.97 – 1.22	<0.001	-0.18	-0.33 – -0.03	0.022	-0.18	-0.33 – -0.03	0.022
Color Rank	0.51	0.45 – 0.57	<0.001	0.50	0.46 – 0.53	<0.001	0.50	0.46 – 0.53	<0.001
Condition [Corner]	-0.15	-0.29 – -0.01	0.035	-0.14	-0.23 – -0.05	0.002	-0.14	-0.23 – -0.05	0.002
Corner Rank	0.00	-0.06 – 0.06	0.959	-0.02	-0.06 – 0.01	0.195	-0.02	-0.06 – 0.01	0.195
Color Rank x Condition [Corner]	-0.49	-0.57 – -0.41	<0.001	-0.46	-0.51 – -0.40	<0.001	-0.46	-0.51 – -0.40	<0.001
Corner Rank x Condition [Corner]	0.55	0.47 – 0.63	<0.001	0.57	0.52 – 0.62	<0.001	0.57	0.52 – 0.62	<0.001
Ini. Rank [1]				2.52	2.36 – 2.67	<0.001	2.52	2.36 – 2.67	<0.001
Ini. Rank [2]				1.98	1.83 – 2.14	<0.001	1.98	1.83 – 2.14	<0.001
Ini. Rank [3]				1.50	1.34 – 1.65	<0.001	1.50	1.34 – 1.65	<0.001
Ini. Rank [4]				1.04	0.88 – 1.19	<0.001	1.04	0.88 – 1.19	<0.001
Ini. Rank [5]				0.57	0.42 – 0.73	<0.001	0.57	0.42 – 0.73	<0.001
Random Effects
σ2	1.33			0.55			0.55
τ00	0.13 ResponseId			0.20 ResponseId			0.20 ResponseId
							0.00 item.f
ICC	0.09			0.27
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.363 / 0.421			0.673 / 0.760			0.737 / 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 <- car::vif(M1_lm)
vif_M1

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

print("Model w/ ini. position")

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

vif_M2 <- car::vif(M2_lm)
vif_M2

##                             GVIF Df GVIF^(1/(2*Df))
## rank.color.c            2.029603  1        1.424641
## condition               1.000000  1        1.000000
## rank.corner.c           2.039343  1        1.428056
## initial.rank            1.030226  5        1.002982
## rank.color.c:condition  2.033717  1        1.426084
## condition:rank.corner.c 2.038398  1        1.427725

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.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+(1|ResponseId),Distance.cleanup.combined)
M2<-lmer(-distance ~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+(1|ResponseId),Distance.cleanup.combined)
M3.Distance<-lmer(-distance~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+(1|ResponseId)+(1|item.f),Distance.cleanup.combined)

tab_model(M1,M2,M3.Distance,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	1.09	0.97 – 1.22	<0.001	-0.18	-0.33 – -0.03	0.022	-0.18	-0.33 – -0.03	0.022
Color Rank [Nested in Color]	0.51	0.45 – 0.57	<0.001	0.50	0.46 – 0.53	<0.001	0.50	0.46 – 0.53	<0.001
Color Rank [Nested in Corner]	0.02	-0.04 – 0.08	0.482	0.04	0.00 – 0.08	0.029	0.04	0.00 – 0.08	0.029
Corner Rank [Nested in Color]	0.00	-0.06 – 0.06	0.959	-0.02	-0.06 – 0.01	0.195	-0.02	-0.06 – 0.01	0.195
Corner Rank [Nested in Corner]	0.55	0.49 – 0.61	<0.001	0.54	0.51 – 0.58	<0.001	0.54	0.51 – 0.58	<0.001
Condition [Corner]	-0.15	-0.29 – -0.01	0.035	-0.14	-0.23 – -0.05	0.002	-0.14	-0.23 – -0.05	0.002
Ini. Rank [1]				2.52	2.36 – 2.67	<0.001	2.52	2.36 – 2.67	<0.001
Ini. Rank [2]				1.98	1.83 – 2.14	<0.001	1.98	1.83 – 2.14	<0.001
Ini. Rank [3]				1.50	1.34 – 1.65	<0.001	1.50	1.34 – 1.65	<0.001
Ini. Rank [4]				1.04	0.88 – 1.19	<0.001	1.04	0.88 – 1.19	<0.001
Ini. Rank [5]				0.57	0.42 – 0.73	<0.001	0.57	0.42 – 0.73	<0.001
Random Effects
σ2	1.33			0.55			0.55
τ00	0.13 ResponseId			0.20 ResponseId			0.20 ResponseId
							0.00 item.f
ICC	0.09			0.27
N	91 ResponseId			91 ResponseId			91 ResponseId
							6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.363 / 0.421			0.673 / 0.760			0.737 / NA

# M_robust <- lm_robust(-distance~CLR.Nested_color.c+CLR.Nested_corner.c+CNR.Nested_color.c+CNR.Nested_corner.c+condition+initial.rank+item.f,Distance.cleanup.combined, clusters = ResponseId)
# tab_model(M_robust)

# summary(M3.Distance)

• 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("Nested Variable w/ rank - 3.5 (mean)")

## [1] "Nested Variable w/ rank - 3.5 (mean)"

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

##                         GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color.c  1.003270  1        1.001633
## CLR.Nested_corner.c 1.009770  1        1.004873
## CNR.Nested_color.c  1.008084  1        1.004034
## CNR.Nested_corner.c 1.011794  1        1.005880
## condition           1.000000  1        1.000000
## initial.rank        1.030226  5        1.002982

print("Nested Variable w raw rank")

## [1] "Nested Variable w raw rank"

vif_M1 <- car::vif(M1_lm)
vif_M1

##                       GVIF Df GVIF^(1/(2*Df))
## CLR.Nested_color  3.134078  1        1.770333
## CLR.Nested_corner 3.106191  1        1.762439
## CNR.Nested_color  3.149118  1        1.774576
## CNR.Nested_corner 3.112417  1        1.764204
## condition         9.240622  1        3.039839
## initial.rank      1.030226  5        1.002982

2.4 Model Output Plot for Manuscript

library(broom.mixed)
library(ggtext)

M3.DragCount_est <- tidy(M3.DragCount, effects = "fixed") %>% mutate(DV = "Drag Count")
M3.DragOrder_est <- tidy(M3.DragOrder, effects = "fixed") %>% mutate(DV = "Drag Order")
M3.Distance_est  <- tidy(M3.Distance, effects = "fixed") %>% mutate(DV = "Drag Distance")

combined_est <- bind_rows(M3.DragCount_est, M3.DragOrder_est, M3.Distance_est)

plot_data <- combined_est %>%
  filter(term %in% c("CLR.Nested_color.c", "CLR.Nested_corner.c",
                     "CNR.Nested_color.c", "CNR.Nested_corner.c")) %>%
    mutate(Predictor = case_when(
    term == "CLR.Nested_color.c"  ~ "Color [Color]",
    term == "CLR.Nested_corner.c" ~ "Corner [Color]",
    term == "CNR.Nested_color.c"  ~ "Color [Corner]",
    term == "CNR.Nested_corner.c" ~ "Corner [Corner]"
  ),
    Type = case_when(
      term %in% c("CLR.Nested_color.c", "CNR.Nested_corner.c") ~ "Concordant",
      term %in% c("CLR.Nested_corner.c", "CNR.Nested_color.c") ~ "Discordant"
    )
  )%>%
  mutate(DV = factor(DV, levels = c("Drag Count", "Drag Order", "Drag Distance")))%>%
  mutate(PredictorLabel = case_when(
    term == "CLR.Nested_color.c"  ~ "<span style='color:#3B6CA8'><b>Color [Color]</b></span>",
    term == "CLR.Nested_corner.c" ~ "<span style='color:#C93312'><b>Corner [Color]</b></span>",
    term == "CNR.Nested_color.c"  ~ "<span style='color:#C93312'><b>Color [Corner]</b></span>",
    term == "CNR.Nested_corner.c" ~ "<span style='color:#3B6CA8'><b>Corner [Corner]</b></span>"
  ))%>%
  mutate(Study="1A")


plot_data.rev<-read.csv("../Rev Order/plot_data.RevStudy.csv")%>%
  mutate(Study ="1B")%>%
  select(-X)

plot_data.Study2<-read.csv("plot_data.Study2.csv")%>%
  mutate(Study ="2")%>%
  select(-X)



Combined_Study1.plot_data<-rbind(plot_data,plot_data.rev) %>%
  mutate(sig_label = case_when(
    p.value < 0.001 ~ "***",
    p.value < 0.01  ~ "**",
    p.value < 0.05  ~ "*",
    TRUE            ~ "ns"
  ),
  y_sig = case_when(
    Study == "1A" ~ 0.95,
    Study == "1B" ~ 0.6
  ))

plot_data.Study2<-plot_data.Study2%>%
  mutate(sig_label = case_when(
    p.value < 0.001 ~ "***",
    p.value < 0.01  ~ "**",
    p.value < 0.05  ~ "*",
    TRUE            ~ "ns"
  ),
  y_sig = case_when(
    Study == "2" ~ 0.65
  ))

(Study1_Plot.Model<-ggplot(Combined_Study1.plot_data, aes(x = PredictorLabel, y = estimate, fill = Type)) +
  geom_bar(stat = "identity", width = 0.7, color = "black", alpha = 0.5) +
  geom_errorbar(aes(ymin = estimate - std.error,
                    ymax = estimate + std.error),
                width = 0.2) +
  geom_text(aes(label = sig_label, y = y_sig),
            vjust = 0, fontface = "bold", size = 6) +
  facet_grid(Study ~ DV) +  
  scale_fill_manual(values = c("Concordant" = "#3B6CA8", "Discordant" = "#C93312")) +
  labs(x = "Nested Predictor", y = "Estimate", fill = "Nested Predictor Type") +
  theme_classic() +
  scale_y_continuous(limits = c(-0.65, 1.2), breaks = c(-0.5, 0, 0.5, 1)) +  
  theme_minimal(base_size = 15) +
  theme(
  axis.text.x = element_markdown(angle = 45, hjust = 1, size = 13),
  axis.text.y = element_markdown(size = 15),
  legend.position = "none",
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  strip.background = element_blank(),
  strip.text.x = element_text(face = "bold", size = 18),
  strip.text.y = element_text(face = "bold", size = 18),
  panel.grid.minor = element_blank(),      
  panel.grid.major.y = element_line(color = "grey80", size = 0.5),
  panel.border = element_rect(color = "black", fill = NA, size = 1),  # <--- this adds the boxes
  legend.text = element_text(size = 15)
))

plot_data.Study2$PredictorLabel<-as.factor(plot_data.Study2$PredictorLabel)
plot_data.Study2$PredictorLabel<-factor(plot_data.Study2$PredictorLabel, levels = c("<span style='color:black'><b>Amt. [Amt.]</b></span>", "<span style='color:black'><b>Prob. [Prob.]</b></span>", "<span style='color:black'><b>Amt. [Prob.]</b></span>","<span style='color:black'><b>Prob. [Amt.]</b></span>"))

plot_data.Study2<-plot_data.Study2%>%
  mutate(DV = factor(DV, levels = c("Drag Count", "Drag Order", "Drag Distance")))

(Study2_Plot.Model<-ggplot(plot_data.Study2, aes(x = PredictorLabel, y = estimate, fill = Type)) +
  geom_bar(stat = "identity", width = 0.7, color = "black", alpha = 0.5) +
  geom_errorbar(aes(ymin = estimate - std.error,
                    ymax = estimate + std.error),
                width = 0.2) +
  geom_text(aes(label = sig_label, y = y_sig),
            vjust = 0, fontface = "bold", size = 6) +
  facet_grid(Study ~ DV) +  
  scale_fill_manual(values = c("Concordant" = "grey70", "Discordant" = "grey70")) +
  labs(x = "Nested Predictor", y = "Estimate", fill = "Nested Predictor Type") +
  theme_classic() +
  scale_y_continuous(limits = c(-1.45, 0.9), breaks = c(-1,-0.5, 0, 0.5)) +  
  theme_minimal(base_size = 15) +
  theme(
  axis.text.x = element_markdown(angle = 45, hjust = 1, size = 13),
  axis.text.y = element_markdown(size = 15),
  legend.position = "none",
  axis.title.x = element_text(face = "bold", size = 15),
  axis.title.y = element_blank(),
  strip.background = element_blank(),
  strip.text.x = element_blank(),
  strip.text.y = element_text(face = "bold", size = 18),
  panel.grid.minor = element_blank(),      
  panel.grid.major.y = element_line(color = "grey80", size = 0.5),
  panel.border = element_rect(color = "black", fill = NA, size = 1),  # <--- this adds the boxes
  legend.text = element_text(size = 15)
))

library(cowplot)
Study1Study2_Plot.Model <- (Study1_Plot.Model / Study2_Plot.Model) +
  plot_layout(heights = c(2.3, 1)) &
  theme(plot.margin = margin(t = 5, r = 5, b = 5, l = 10))  # ⬅️ extended left margin

# Then draw the shared label on that space
plot_w_label <- ggdraw(Study1Study2_Plot.Model) +
  draw_label("Estimate", x = 0.01, y = 0.5, angle = 90, fontface = "bold", size = 15)


ggsave("Model_Output_Plot.svg", plot = plot_w_label, width = 12, height = 10, units = "in", dpi = 300)

3. 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…

WITHOUT Control for Ini. Position

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.r=-distance,
         initial.rank.num=as.numeric(as.character(initial.rank)),
         initial.rank.r=7-initial.rank.num,
         distance_ctrl.ini_rank=distance.r-initial.rank.r)
# hist(Correlation.examine_Color$distance_ctrl.ini_rank)
# Correlation.examine_Color%>%
#   filter(distance_ctrl.ini_rank<(-5))

• 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.r)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance.r)

  # 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(
#   "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
# )

custom_colors <- c(
  "CR4_CL1" = "#041e42",  
  "CR3_CL2" = "#08306b",  
  "CR5_CL3" = "#08519c",  
  "CR2_CL4" = "#3182bd",  
  "CR1_CL5" = "#6baed6", 
  "CR6_CL6" = "#a6cee3"  
)

results<-results%>%
  mutate(item.relabeled=case_when(
    item=="CR1_CL1" ~ "CR6_CL6",
    item=="CR2_CL4" ~ "CR5_CL3",
    item=="CR3_CL6" ~ "CR4_CL1",
    item=="CR4_CL5" ~ "CR3_CL2",
    item=="CR5_CL3" ~ "CR2_CL4",
    item=="CR6_CL2" ~ "CR1_CL5",
    ))


Color_p2<-ggplot(results, aes(x = Correlation, y = correlation, group = item.relabeled, color = item.relabeled, 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

• CR4_CL1

Correlation.examine_Color<-Correlation.examine_Color%>%
  mutate(item.relabeled=case_when(
    item.f=="CR1_CL1" ~ "CR6_CL6",
    item.f=="CR2_CL4" ~ "CR5_CL3",
    item.f=="CR3_CL6" ~ "CR4_CL1",
    item.f=="CR4_CL5" ~ "CR3_CL2",
    item.f=="CR5_CL3" ~ "CR2_CL4",
    item.f=="CR6_CL2" ~ "CR1_CL5",
    ))

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

• CR3_CL2

ggpairs(Correlation.examine_Color%>%filter(item.relabeled=="CR3_CL2"),
                   c("Drag_Count.Ind","order","distance.r"),
                   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.relabeled=="CR5_CL3"),
                   c("Drag_Count.Ind","order","distance.r"),
                   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.relabeled=="CR2_CL4"),
                   c("Drag_Count.Ind","order","distance.r"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR1_CL5

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

• CR6_CL6

ggpairs(Correlation.examine_Color%>%filter(item.relabeled=="CR6_CL6"),
                   c("Drag_Count.Ind","order","distance.r"),
                   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.r=-distance,
         initial.rank.num=as.numeric(as.character(initial.rank)),
         initial.rank.r=7-initial.rank.num,
         distance_ctrl.ini_rank=distance.r-initial.rank.r)

• 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.r)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance.r)

  # 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
# )

custom_colors <- c(
  "CR4_CL1" = "#041e42",  
  "CR3_CL2" = "#08306b",  
  "CR5_CL3" = "#08519c",  
  "CR2_CL4" = "#3182bd",  
  "CR1_CL5" = "#6baed6", 
  "CR6_CL6" = "#a6cee3"  
)

results<-results%>%
  mutate(item.relabeled=case_when(
    item=="CR1_CL1" ~ "CR6_CL6",
    item=="CR2_CL4" ~ "CR5_CL3",
    item=="CR3_CL6" ~ "CR4_CL1",
    item=="CR4_CL5" ~ "CR3_CL2",
    item=="CR5_CL3" ~ "CR2_CL4",
    item=="CR6_CL2" ~ "CR1_CL5",
    ))

Corner<-ggplot(results, aes(x = Correlation, y = correlation, group = item.relabeled, color = item.relabeled, 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

• CR1_CL5

Correlation.examine_Corner<-Correlation.examine_Corner%>%
  mutate(item.relabeled=case_when(
    item.f=="CR1_CL1" ~ "CR6_CL6",
    item.f=="CR2_CL4" ~ "CR5_CL3",
    item.f=="CR3_CL6" ~ "CR4_CL1",
    item.f=="CR4_CL5" ~ "CR3_CL2",
    item.f=="CR5_CL3" ~ "CR2_CL4",
    item.f=="CR6_CL2" ~ "CR1_CL5",
    ))

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

• CR2_CL4

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

• CR3_CL2

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

• CR4_CL1

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

• CR5_CL3

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

• CR6_CL6

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

Model with Combined Datasets

• This models adds respondent and item random intercepts

• To quantify how much unique variance in each outcome variable (e.g., drag order or drag count) is explained by distance, we ran linear regression models with and without distance as a predictor:

  • The full model includes both distance.r and condition as predictors (we need condition because the dataset combines both color and corner tasks).
  • The reduced model includes only condition (and random intercepts).

• We then calculated the difference in R² between the full and reduced models. This difference represents the unique variance in the outcome explained by distance, above and beyond the variance explained by condition.

• Distance explained 21.6% and 24.3% of the variance in drag order and drag count, respectively.

Correlation.examine_Color$condition<-"Color"
Correlation.examine_Corner$condition<-"Corner"


Correlation.examine_combined<-rbind(Correlation.examine_Color,Correlation.examine_Corner)%>%
  mutate(rank.color.c=rank.color-mean(rank.color),
         rank.corner.c=-rank.corner-mean(rank.corner))

distance_order<-lmer(order~distance.r+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
distance_count<-lmer(Drag_Count.Ind~distance.r+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
order_count<-lmer(order~Drag_Count.Ind+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)

tab_model(distance_order,distance_count,order_count,pred.labels = c("Intercept", "Distance (R)","Condition [Corner]","Drag Count Indicator"), dv.labels = c("DV: Order (R)","DV: Drag Count Indicator","DV: Order (R)"))

	DV: Order (R)			DV: Drag Count Indicator			DV: Order (R)
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-3.61	-3.83 – -3.39	<0.001	0.43	0.35 – 0.52	<0.001	-4.19	-4.42 – -3.97	<0.001
Distance (R)	0.43	0.38 – 0.48	<0.001	0.16	0.14 – 0.17	<0.001
Condition [Corner]	0.06	-0.08 – 0.21	0.387	0.03	-0.02 – 0.08	0.281	-0.02	-0.15 – 0.11	0.753
Drag Count Indicator							1.76	1.62 – 1.91	<0.001
Random Effects
σ2	1.43			0.16			1.12
τ00	0.02 ResponseId			0.00 ResponseId			0.12 ResponseId
	0.05 item.f			0.01 item.f			0.05 item.f
ICC	0.05			0.06			0.13
N	91 ResponseId			91 ResponseId			91 ResponseId
	6 item.f			6 item.f			6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.218 / 0.254			0.246 / 0.289			0.367 / 0.448

m1_full <- lmer(order ~ distance.r + condition + (1|ResponseId) + (1|item.f), data = Correlation.examine_combined)
m1_reduced <- lmer(order ~ condition+  (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model

m2_full <- lmer(Drag_Count.Ind ~ distance.r + condition + (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model
m2_reduced <- lmer(Drag_Count.Ind ~ condition + (1|item.f), data = Correlation.examine_combined)# no respondent random variation picked up by the model

m3_full <- lmer(order ~ Drag_Count.Ind + condition+ (1|ResponseId) + (1|item.f), data = Correlation.examine_combined)
m3_reduced <- lmer(order ~ condition+  (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model

library(performance)
report_unique_r2 <- function(full_model, reduced_model, predictor_name = "Predictor") {
  r2_full <- r2(full_model)$R2_marginal
  r2_reduced <- r2(reduced_model)$R2_marginal
  r2_unique <- r2_full - r2_reduced
  
  cat("\n---", predictor_name, "---\n")
  cat("  R² (Full Model):    ", round(r2_full, 3), "\n")
  cat("  R² (Reduced Model): ", round(r2_reduced, 3), "\n")
  cat("  Unique R² for", predictor_name, ":", round(r2_unique, 3), "\n")
  invisible(r2_unique)
}

report_unique_r2(m1_full, m1_reduced, predictor_name = "Distance → Order")

## 
## --- Distance → Order ---
##   R² (Full Model):     0.218 
##   R² (Reduced Model):  0 
##   Unique R² for Distance → Order : 0.218

report_unique_r2(m2_full, m2_reduced, predictor_name = "Distance → Drag Count")

## 
## --- Distance → Drag Count ---
##   R² (Full Model):     0.243 
##   R² (Reduced Model):  0 
##   Unique R² for Distance → Drag Count : 0.243

report_unique_r2(m3_full, m3_reduced, predictor_name = "Drag Count → Order")

## 
## --- Drag Count → Order ---
##   R² (Full Model):     0.367 
##   R² (Reduced Model):  0 
##   Unique R² for Drag Count → Order : 0.367

WITH Control for Ini. Position

• I calculated a new drag distance measure by subtracted the initial position (1 = top, 6 = bottom) from the it. The value of unadjusted drag distance range from -5 to +5, where upward movement reflects positive values and downward movement reflects negative values.

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.r=-distance,
         initial.rank.num=as.numeric(as.character(initial.rank)),
         initial.rank.r=7-initial.rank.num,
         distance_ctrl.ini_rank=distance.r-initial.rank.r)
# hist(Correlation.examine_Color$distance_ctrl.ini_rank)
# Correlation.examine_Color%>%
#   filter(distance_ctrl.ini_rank<(-5))

• 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_ctrl.ini_rank)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance_ctrl.ini_rank)

  # 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_ctrl.ini_rank"),
                   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_ctrl.ini_rank"),
                   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_ctrl.ini_rank"),
                   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_ctrl.ini_rank"),
                   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_ctrl.ini_rank"),
                   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_ctrl.ini_rank"),
                   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.r=-distance,
         initial.rank.num=as.numeric(as.character(initial.rank)),
         initial.rank.r=7-initial.rank.num,
         distance_ctrl.ini_rank=distance.r-initial.rank.r)

• 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_ctrl.ini_rank)
  cd_test <- cor.test(df_item$Drag_Count.Ind, df_item$distance_ctrl.ini_rank)

  # 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_Corner%>%filter(item.f=="CR6_CL2"),
                   c("Drag_Count.Ind","order","distance_ctrl.ini_rank"),
                   lower = list(continuous = wrap("points", position = position_jitter(height = 1, width = 0.2))),
                   diag = list(continuous = "density"))

• CR5_CL3

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

• CR4_CL5

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

• CR3_CL6

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

• CR2_CL4

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

• CR1_CL1

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

Model with Combined Datasets

• Distance adjusted for initial position do not explain of the variance in drag order and drag count, respectively.

Correlation.examine_Color$condition<-"Color"
Correlation.examine_Corner$condition<-"Corner"


Correlation.examine_combined<-rbind(Correlation.examine_Color,Correlation.examine_Corner)%>%
  mutate(rank.color.c=rank.color-mean(rank.color),
         rank.corner.c=-rank.corner-mean(rank.corner))

distance_order<-lmer(order~distance_ctrl.ini_rank+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
distance_count<-lmer(Drag_Count.Ind~distance_ctrl.ini_rank+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
order_count<-lmer(order~Drag_Count.Ind+condition+(1|ResponseId)+(1|item.f),Correlation.examine_combined)

tab_model(distance_order,distance_count,order_count,pred.labels = c("Intercept", "Distance (R)","Condition [Corner]","Drag Count Indicator"), dv.labels = c("DV: Order (R)","DV: Drag Count Indicator","DV: Order (R)"))

	DV: Order (R)			DV: Drag Count Indicator			DV: Order (R)
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-3.13	-3.59 – -2.66	<0.001	0.51	0.32 – 0.70	<0.001	-4.19	-4.42 – -3.97	<0.001
Distance (R)	0.01	-0.05 – 0.07	0.827	-0.04	-0.06 – -0.02	<0.001
Condition [Corner]	-0.00	-0.16 – 0.16	0.986	-0.00	-0.06 – 0.05	0.864	-0.02	-0.15 – 0.11	0.753
Drag Count Indicator							1.76	1.62 – 1.91	<0.001
Random Effects
σ2	1.76			0.20			1.12
τ00	0.00 ResponseId			0.00 ResponseId			0.12 ResponseId
	0.29 item.f			0.05 item.f			0.05 item.f
ICC							0.13
N	91 ResponseId			91 ResponseId			91 ResponseId
	6 item.f			6 item.f			6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.000 / NA			0.016 / NA			0.367 / 0.448

m1_full <- lmer(order ~ distance_ctrl.ini_rank + condition + (1|item.f), data = Correlation.examine_combined)
m1_reduced <- lmer(order ~ condition+  (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model

m2_full <- lmer(Drag_Count.Ind ~ distance_ctrl.ini_rank + condition + (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model
m2_reduced <- lmer(Drag_Count.Ind ~ condition + (1|item.f), data = Correlation.examine_combined)# no respondent random variation picked up by the model

m3_full <- lmer(order ~ Drag_Count.Ind + condition+ (1|ResponseId) + (1|item.f), data = Correlation.examine_combined)
m3_reduced <- lmer(order ~ condition+  (1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model

library(performance)
report_unique_r2 <- function(full_model, reduced_model, predictor_name = "Predictor") {
  r2_full <- r2(full_model)$R2_marginal
  r2_reduced <- r2(reduced_model)$R2_marginal
  r2_unique <- r2_full - r2_reduced
  
  cat("\n---", predictor_name, "---\n")
  cat("  R² (Full Model):    ", round(r2_full, 3), "\n")
  cat("  R² (Reduced Model): ", round(r2_reduced, 3), "\n")
  cat("  Unique R² for", predictor_name, ":", round(r2_unique, 3), "\n")
  invisible(r2_unique)
}

report_unique_r2(m1_full, m1_reduced, predictor_name = "Distance → Order")

## 
## --- Distance → Order ---
##   R² (Full Model):     0 
##   R² (Reduced Model):  0 
##   Unique R² for Distance → Order : 0

report_unique_r2(m2_full, m2_reduced, predictor_name = "Distance → Drag Count")

## 
## --- Distance → Drag Count ---
##   R² (Full Model):     0.013 
##   R² (Reduced Model):  0 
##   Unique R² for Distance → Drag Count : 0.013

report_unique_r2(m3_full, m3_reduced, predictor_name = "Drag Count → Order")

## 
## --- Drag Count → Order ---
##   R² (Full Model):     0.367 
##   R² (Reduced Model):  0 
##   Unique R² for Drag Count → Order : 0.367

Approach 2 (Model Based)

• I added initial rank as controls in the model - to add the control specifically for drag distance, I had to set drag distance as the DV.
• To quantify how much unique variance in drag distance is explained by drag order and drag count) we ran linear regression models with and without distance as a predictor:
  • The full model includes both distance.r, condition, and initial rank as predictors (we need condition because the dataset combines both color and corner tasks).
  • The reduced model includes only condition and initial rank (and random intercepts).
• Drag Order and Drag Count uniquely explained 9% and 6.5% of the variance in rank distance

Correlation.examine_Color$condition<-"Color"
Correlation.examine_Corner$condition<-"Corner"


Correlation.examine_combined<-rbind(Correlation.examine_Color,Correlation.examine_Corner)%>%
  mutate(rank.color.c=rank.color-mean(rank.color),
         rank.corner.c=-rank.corner-mean(rank.corner))

distance_order<-lmer(distance.r~order+condition+as.factor(initial.rank.r)+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
distance_count<-lmer(distance.r~Drag_Count.Ind+condition+as.factor(initial.rank.r)+(1|ResponseId)+(1|item.f),Correlation.examine_combined)
order_count<-lmer(order~Drag_Count.Ind+condition+as.factor(initial.rank.r)+(1|ResponseId)+(1|item.f),Correlation.examine_combined)

tab_model(distance_order,distance_count,order_count,pred.labels = c("Intercept", "Order (R)","Condition [Corner]","Initial Rank [2]","Initial Rank [3]","Initial Rank [4]","Initial Rank [5]","Initial Rank [6]","Drag Count Indicator"), dv.labels = c("DV: Distance (R)","Distance (R)","DV: Order (R)"))

	DV: Distance (R)			Distance (R)			DV: Order (R)
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	1.13	0.62 – 1.64	<0.001	-0.22	-0.71 – 0.26	0.372	-4.50	-4.78 – -4.22	<0.001
Order (R)	0.30	0.25 – 0.34	<0.001
Condition [Corner]	-0.14	-0.25 – -0.03	0.013	-0.15	-0.27 – -0.04	0.010	-0.02	-0.14 – 0.11	0.792
Initial Rank [2]	0.16	-0.04 – 0.36	0.109	0.20	-0.01 – 0.41	0.063	0.47	0.24 – 0.70	<0.001
Initial Rank [3]	0.59	0.39 – 0.79	<0.001	0.64	0.43 – 0.86	<0.001	0.65	0.41 – 0.88	<0.001
Initial Rank [4]	1.02	0.82 – 1.23	<0.001	1.04	0.81 – 1.26	<0.001	0.58	0.33 – 0.82	<0.001
Initial Rank [5]	1.47	1.26 – 1.67	<0.001	1.47	1.24 – 1.69	<0.001	0.56	0.31 – 0.80	<0.001
Initial Rank [6]	2.07	1.87 – 2.28	<0.001	2.05	1.82 – 2.27	<0.001	0.48	0.23 – 0.73	<0.001
Drag Count Indicator				0.69	0.54 – 0.85	<0.001	1.51	1.34 – 1.68	<0.001
Random Effects
σ2	0.83			0.90			1.10
τ00	0.20 ResponseId			0.15 ResponseId			0.09 ResponseId
	0.29 item.f			0.32 item.f			0.07 item.f
ICC	0.38			0.34			0.13
N	91 ResponseId			91 ResponseId			91 ResponseId
	6 item.f			6 item.f			6 item.f
Observations	1056			1056			1056
Marginal R2 / Conditional R2	0.399 / 0.625			0.374 / 0.590			0.367 / 0.448

m1_full <- lmer(distance.r  ~ order + condition + initial.rank+(1|ResponseId)+(1|item.f), data = Correlation.examine_combined)
m1_reduced <- lmer(distance.r ~ condition + initial.rank+(1|ResponseId)+(1|item.f), data = Correlation.examine_combined) 

m2_full <- lmer(distance.r ~ Drag_Count.Ind + condition + initial.rank+(1|ResponseId)+(1|item.f), data = Correlation.examine_combined) 
m2_reduced <- lmer(distance.r ~ condition + initial.rank+(1|ResponseId)+(1|item.f), data = Correlation.examine_combined)

m3_full <- lmer(order ~ Drag_Count.Ind + condition + initial.rank+(1|ResponseId)+(1|item.f), data = Correlation.examine_combined)
m3_reduced <- lmer(order ~ condition + initial.rank+(1|item.f), data = Correlation.examine_combined) # no respondent random variation picked up by the model

library(performance)
report_unique_r2 <- function(full_model, reduced_model, predictor_name = "Predictor") {
  r2_full <- r2(full_model)$R2_marginal
  r2_reduced <- r2(reduced_model)$R2_marginal
  r2_unique <- r2_full - r2_reduced
  
  cat("\n---", predictor_name, "---\n")
  cat("  R² (Full Model):    ", round(r2_full, 3), "\n")
  cat("  R² (Reduced Model): ", round(r2_reduced, 3), "\n")
  cat("  Unique R² for", predictor_name, ":", round(r2_unique, 3), "\n")
  invisible(r2_unique)
}

report_unique_r2(m1_full, m1_reduced, predictor_name = "Distance → Order")

## 
## --- Distance → Order ---
##   R² (Full Model):     0.399 
##   R² (Reduced Model):  0.309 
##   Unique R² for Distance → Order : 0.09

report_unique_r2(m2_full, m2_reduced, predictor_name = "Distance → Drag Count")

## 
## --- Distance → Drag Count ---
##   R² (Full Model):     0.374 
##   R² (Reduced Model):  0.309 
##   Unique R² for Distance → Drag Count : 0.065

report_unique_r2(m3_full, m3_reduced, predictor_name = "Drag Count → Order")

## 
## --- Drag Count → Order ---
##   R² (Full Model):     0.367 
##   R² (Reduced Model):  0.153 
##   Unique R² for Drag Count → Order : 0.213

4. Time Analysis

library(ggimage)
library(ggtext)

TimeAnalysis.Color<-Distance_Color%>%
  filter(ResponseId%in%color_NoneNeg_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(
  "CR3_CL6" = "black",  # Darkest blue
  "CR4_CL5" = "#08306b",
  "CR2_CL4" = "#08519c",
  "CR5_CL3" = "#2171b5",
  "CR6_CL2" = "#4292c6",
  "CR1_CL1" = "#6baed6"   # Lightest blue
)
# 
# item_shapes <- c(
#   "CR6_CL2" = 8,  
#   "CR5_CL3" = 18,  
#   "CR4_CL5" = 23,  
#   "CR3_CL6" = 15,  
#   "CR2_CL4" = 22,  
#   "CR1_CL1" = 21  
# )

TimeAnalysis.Color.expand <- expand_grid(
  ResponseId = unique(TimeAnalysis.Color$ResponseId),
  step = unique(TimeAnalysis.Color$step),
  item.f = unique(TimeAnalysis.Color$item.f)
) %>%
  left_join(
    TimeAnalysis.Color %>% select(ResponseId, step, item.f, current_rank),
    by = c("ResponseId", "step", "item.f")
  ) %>%
  arrange(ResponseId, item.f, step) %>%
  group_by(ResponseId, item.f) %>%
  fill(current_rank, .direction = "down")%>%
  ungroup()


Summary.Color <- TimeAnalysis.Color.expand %>%
  group_by(step, item.f) %>%
  summarize(mean.current_rank = 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_NoneNeg_subj)%>%
  group_by(item.f)%>%
  mutate(initial.rank=as.numeric(initial.rank))%>%
  summarize(mean.current_rank = 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)

Summary.Color <- Summary.Color %>%
  mutate(image = case_when(
    item.f == "CR1_CL1" ~ "Stimuli/CR1_CL1.png",
    item.f == "CR2_CL4" ~ "Stimuli/CR2_CL4.png",
    item.f == "CR3_CL6" ~ "Stimuli/CR3_CL6.png",
    item.f == "CR4_CL5" ~ "Stimuli/CR4_CL5.png",
    item.f == "CR5_CL3" ~ "Stimuli/CR5_CL3.png",
    item.f == "CR6_CL2" ~ "Stimuli/CR6_CL2.png"
  ))
# ggplot(Summary.Color, aes(x = step, y = mean.current_rank, 
#                           color = item.f,  shape = item.f)) +
#   geom_line(size = 1) +  
#   geom_point(size = 15, 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 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) 
Summary.Color <- Summary.Color %>%
  mutate(errorbar_color = case_when(
    item.f %in% c("CR4_CL5", "CR3_CL6", "CR2_CL4") ~ "white",   
    item.f %in% c("CR1_CL1", "CR5_CL3","CR6_CL2" ) ~ "black",  
  ))

# (Color_Plot<-ggplot(Summary.Color%>%filter(step<=4), aes(x = step, y = mean.current_rank)) +
#   # geom_line(aes(group = item.f), size = 1, color = "black") +
#   geom_image(aes(image = image), size = 0.07) +  
#   # geom_errorbar(aes(
#   #   ymin = mean.current_rank - se,
#   #   ymax = mean.current_rank + se,
#   #   color = errorbar_color
#   # ), width = 0.14, size = 0.5, alpha = 1) +
#   geom_ribbon(aes(ymin = mean.current_rank - se, ymax = mean.current_rank + se, group = item.f),
#             alpha = 0.15, fill = "black")+
#   labs(title = "Rank by Color Darkness",
#        x = "Step", y = "Mean Rank") +
#   scale_y_continuous(breaks = 6:0, limits = c(1, 6)) +
#   scale_x_continuous(breaks = 0:7) +
# theme_classic(base_size = 13) +
#   theme(
#     axis.title.x = element_text(face = "bold"),
#     axis.title.y = element_text(face = "bold"),
#     axis.text = element_text(face = "bold"),
#     plot.title = element_text(face = "bold", hjust = 0.5, size = 13),  
#     legend.title = element_text(face = "bold"),
#     legend.text = element_text(size = 12)
#   ))

image_labels <- Summary.Color %>%
  filter(step == 4) %>%
  mutate(step = 4.3)

Color_Plot<-ggplot(Summary.Color %>% filter(step <= 4),
                     aes(x = step, y = mean.current_rank, group = item.f, color = item.f)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2.5) +
  geom_errorbar(aes(ymin = mean.current_rank - se,
                    ymax = mean.current_rank + se),
                width = 0.2, size = 0.6, alpha = 0.9) +
  scale_color_manual(values = c("black","black","black","black","black","black")) +
  scale_fill_manual(values = c("black","black","black","black","black","black")) +
  scale_y_continuous(
  trans = "reverse",
  breaks = 1:6,
  limits = c(6.1, 0.9),  
  expand = c(0, 0))+
  scale_x_continuous(breaks = 0:5) +
  labs(title = "Rank by Color Darkness", x = "Step", y = "Mean Rank",subtitle = "*Darkest (at the top)* to *Lightest (at the bottom)*") +
  theme_classic(base_size = 13) +
  theme(
    axis.title.x = element_text(face = "bold"),
    axis.title.y = element_text(face = "bold"),
    axis.text.x = element_text(size = 13),
    axis.text.y = element_text(size = 13),
    plot.title = element_text(face = "bold", hjust = 0.5),
    plot.subtitle = element_markdown(hjust = 0.5, size=13),
    legend.position = "none"
  ) +
  geom_image(data = image_labels,
             aes(x = step, y = mean.current_rank, image = image),
             size = 0.07, inherit.aes = FALSE)

# this dataset contains observation of items being moved multiple times!
TimeAnalysis.Corner<-Distance_Corner%>%
  filter(ResponseId%in%corner_NoneNeg_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("CR1_CL1", "CR2_CL4","CR3_CL6","CR4_CL5","CR5_CL3","CR6_CL2")

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(
#   "CR3_CL6" = "black",  # Darkest blue
#   "CR4_CL5" = "#08306b",  
#   "CR2_CL4" = "#08519c",   
#   "CR5_CL3" = "#2171b5",  
#   "CR6_CL2" = "#4292c6",  
#   "CR1_CL1" = "#6baed6"   # Lightest blue
# )
# 
# item_shapes <- c(
#   "CR6_CL2" = 54,  
#   "CR5_CL3" = 53,  
#   "CR4_CL5" = 52,  
#   "CR3_CL6" = 51,  
#   "CR2_CL4" = 50,  
#   "CR1_CL1" = 49  
# )

TimeAnalysis.Corner.expand <- expand_grid(
  ResponseId = unique(TimeAnalysis.Corner$ResponseId),
  step = unique(TimeAnalysis.Corner$step),
  item.f = unique(TimeAnalysis.Corner$item.f)
) %>%
  left_join(
    TimeAnalysis.Corner %>% select(ResponseId, step, item.f, current_rank),
    by = c("ResponseId", "step", "item.f")
  ) %>%
  arrange(ResponseId, item.f, step) %>%
  group_by(ResponseId, item.f) %>%
  fill(current_rank, .direction = "down")%>%
  ungroup()


Summary.Corner <- TimeAnalysis.Corner.expand %>%
  group_by(step, item.f) %>%
  summarize(mean.current_rank = 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_NoneNeg_subj)%>%
  group_by(item.f)%>%
  mutate(initial.rank=as.numeric(initial.rank))%>%
  summarize(mean.current_rank = 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)
Summary.Corner <- Summary.Corner %>%
  mutate(image = case_when(
    item.f == "CR1_CL1" ~ "Stimuli/CR1_CL1.png",
    item.f == "CR2_CL4" ~ "Stimuli/CR2_CL4.png",
    item.f == "CR3_CL6" ~ "Stimuli/CR3_CL6.png",
    item.f == "CR4_CL5" ~ "Stimuli/CR4_CL5.png",
    item.f == "CR5_CL3" ~ "Stimuli/CR5_CL3.png",
    item.f == "CR6_CL2" ~ "Stimuli/CR6_CL2.png"
  ))
# ggplot(Summary.Corner, aes(x = step, y = mean.current_rank, 
#                           color = item.f,  shape = item.f)) +
#   geom_line(size = 1) +  
#   geom_point(size = 10, 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 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) 

image_labels_corner <- Summary.Corner %>%
  filter(step == 4) %>%
  mutate(step = 4.3)

Corner_Plot<-ggplot(Summary.Corner %>% filter(step <= 4),
                     aes(x = step, y = mean.current_rank, group = item.f, color = item.f)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2.5) +
  geom_errorbar(aes(ymin = mean.current_rank - se,
                    ymax = mean.current_rank + se),
                width = 0.2, size = 0.6, alpha = 0.9) +
  scale_color_manual(values = c("black","black","black","black","black","black")) +
  scale_fill_manual(values = c("black","black","black","black","black","black")) +
  scale_y_continuous(
  trans = "reverse",
  breaks = 1:6,
  limits = c(6.1, 0.9),  
  expand = c(0, 0))+
  scale_x_continuous(breaks = 0:5) +
  labs(title = "Rank by Number of Corners", x = "Step", y = "Mean Rank",subtitle="*Most (at the top)* to *Least (at the bottom)*") +
  theme_classic(base_size = 13) +
  theme(
    axis.title.x = element_text(face = "bold"),
    axis.title.y = element_blank(),
    axis.text.x = element_text(size = 13),
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    plot.title = element_text(face = "bold", hjust = 0.5),
    plot.subtitle = element_markdown(hjust = 0.5, size=13),
    legend.position = "none"
  ) +
  geom_image(data = image_labels_corner,
             aes(x = step, y = mean.current_rank, image = image),
             size = 0.07, inherit.aes = FALSE)



step_labels <- c("0" = "Initial", "1" = "1", "2" = "2", "3" = "3", "4" = "4")

Color_Plot <- Color_Plot +
  scale_x_continuous(breaks = 0:4, labels = step_labels) +  # customize x axis labels
  annotate("text", x = -0.2, y = 1.2, label = "A", fontface = "bold", size = 8.5) # Add panel A vs. B

Corner_Plot <- Corner_Plot +
  scale_x_continuous(breaks = 0:4, labels = step_labels)+ 
  annotate("text", x = -0.2, y = 1.2, label = "B", fontface = "bold", size = 8.5)


Study1_Plot <- Color_Plot + Corner_Plot +
  plot_annotation(
    title = "Dynamic Ranking Across Steps",
    theme = theme(
      plot.title = element_text(hjust = 0.5, face = "bold", size = 16)
    )
  )

ggsave("Mean_Rank_Plot.svg", plot = Study1_Plot, width = 12, height = 6, units = "in", dpi = 300)

• 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_NoneNeg_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_NoneNeg_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	1337.63	1037.93 – 1637.34	<0.001
Step	-56.74	-89.37 – -24.11	0.001
Condition [Corner] Rank	108.97	31.55 – 186.39	0.006
abs(Drag Distance)	127.69	80.73 – 174.65	<0.001
Initial Rank [1]	-359.78	-609.15 – -110.41	0.005
Initial Rank [2]	-400.37	-648.54 – -152.19	0.002
Initial Rank [3]	-398.74	-647.13 – -150.35	0.002
Initial Rank [4]	-399.55	-652.76 – -146.33	0.002
Initial Rank [5]	-335.65	-593.73 – -77.57	0.011
Random Effects
σ2	252151.37
τ00 ResponseId	163387.40
τ00 item.f	0.00
N ResponseId	91
N item.f	6
Observations	690
Marginal R2 / Conditional R2	0.150 / 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	6027.65	4127.02 – 7928.28	<0.001
Step	-236.91	-493.98 – 20.16	0.071
Condition [Corner] Rank	471.95	-125.21 – 1069.10	0.121
Initial Rank [1]	-2873.13	-4639.23 – -1107.03	0.001
Initial Rank [2]	-3315.87	-5083.81 – -1547.93	<0.001
Initial Rank [3]	-3222.66	-4991.74 – -1453.58	<0.001
Initial Rank [4]	-3357.12	-5158.16 – -1556.07	<0.001
Initial Rank [5]	-3487.30	-5314.74 – -1659.86	<0.001
Random Effects
σ2	10928728.11
τ00 ResponseId	2917584.66
τ00 item.f	44285.96
ICC	0.21
N ResponseId	90
N item.f	6
Observations	514
Marginal R2 / Conditional R2	0.036 / 0.241

• 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.11	2.70 – 3.52	<0.001
Step	-0.34	-0.38 – -0.29	<0.001
Condition [Corner]	-0.05	-0.17 – 0.08	0.491
Initial Rank [1]	0.68	0.29 – 1.08	0.001
Initial Rank [2]	0.10	-0.29 – 0.50	0.609
Initial Rank [3]	-0.31	-0.71 – 0.09	0.133
Initial Rank [4]	-0.85	-1.26 – -0.45	<0.001
Initial Rank [5]	-1.01	-1.42 – -0.60	<0.001
Random Effects
σ2	0.72
τ00 ResponseId	0.02
τ00 item.f	0.01
ICC	0.04
N ResponseId	91
N item.f	6
Observations	690
Marginal R2 / Conditional R2	0.437 / 0.459

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