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

Preliminaries

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 %>%
  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(corner_incorrect_subj)) # 3 subj
# length(unique(corner_reverse_subj))
# length(unique(corner_correct_subj))

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

# unique(corner_incorrect_subj)

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

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

• Tau <= 0: 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 )

• 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 = 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.05 – 0.18	<0.001	0.17	0.07 – 0.44	<0.001	0.18	0.05 – 0.63	0.008
Color Rank	1.81	1.59 – 2.06	<0.001	2.38	1.98 – 2.87	<0.001	2.33	1.82 – 2.97	<0.001
Corner Rank	1.25	1.12 – 1.39	<0.001	1.26	1.10 – 1.44	0.001	1.27	1.03 – 1.57	0.026
Initial Rank [1]				0.01	0.00 – 0.02	<0.001	0.01	0.00 – 0.02	<0.001
Initial Rank [2]				0.15	0.06 – 0.34	<0.001	0.14	0.06 – 0.33	<0.001
Initial Rank [3]				0.34	0.14 – 0.82	0.016	0.33	0.14 – 0.80	0.014
Initial Rank [4]				0.50	0.21 – 1.19	0.116	0.49	0.20 – 1.20	0.117
Initial Rank [5]				0.70	0.28 – 1.74	0.444	0.68	0.27 – 1.73	0.423
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.15 ResponseId			0.14 ResponseId
							0.12 item.f
ICC	0.00			0.04			0.07
N	90 ResponseId			90 ResponseId			90 ResponseId
							6 item.f
Observations	540			540			540
Marginal R2 / Conditional R2	0.267 / 0.267			0.606 / 0.623			0.588 / 0.617

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

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

Corner Condition

• Aggregate Stats

drag_and_drop_count_Corner_long<-drag_and_drop_count_Corner_long%>%
  filter(ResponseId%in%corner_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 = 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.21	0.12 – 0.36	<0.001	0.16	0.06 – 0.38	<0.001	0.16	0.06 – 0.38	<0.001
Color Rank	1.09	0.97 – 1.21	0.135	1.16	1.02 – 1.33	0.026	1.16	1.02 – 1.33	0.026
Corner Rank	1.67	1.49 – 1.87	<0.001	2.16	1.82 – 2.55	<0.001	2.16	1.82 – 2.55	<0.001
Initial Rank [1]				0.02	0.01 – 0.04	<0.001	0.02	0.01 – 0.04	<0.001
Initial Rank [2]				0.31	0.15 – 0.67	0.003	0.31	0.15 – 0.67	0.003
Initial Rank [3]				0.69	0.32 – 1.50	0.351	0.69	0.32 – 1.50	0.351
Initial Rank [4]				1.65	0.72 – 3.79	0.239	1.65	0.72 – 3.79	0.239
Initial Rank [5]				1.72	0.75 – 3.93	0.199	1.72	0.75 – 3.93	0.199
Random Effects
σ2	3.29			3.29			3.29
τ00	0.00 ResponseId			0.05 ResponseId			0.05 ResponseId
							0.00 item.f
ICC				0.01
N	95 ResponseId			95 ResponseId			95 ResponseId
							6 item.f
Observations	570			570			570
Marginal R2 / Conditional R2	0.194 / NA			0.555 / 0.562			0.559 / 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.63	1.34 – 1.98	<0.001	5.26	3.27 – 8.47	<0.001	5.26	3.27 – 8.47	<0.001
Color Rank	1.81	1.59 – 2.06	<0.001	2.33	1.98 – 2.76	<0.001	2.33	1.98 – 2.76	<0.001
Condition [Corner]	1.03	0.78 – 1.35	0.849	1.05	0.75 – 1.48	0.772	1.05	0.75 – 1.48	0.771
Corner Rank	1.25	1.12 – 1.39	<0.001	1.26	1.11 – 1.44	<0.001	1.26	1.11 – 1.44	<0.001
Color Rank x Condition [Corner]	0.60	0.51 – 0.71	<0.001	0.49	0.40 – 0.61	<0.001	0.49	0.40 – 0.61	<0.001
Corner Rank x Condition [Corner]	1.34	1.14 – 1.57	<0.001	1.68	1.37 – 2.05	<0.001	1.68	1.37 – 2.05	<0.001
Ini. Rank [1]				0.01	0.01 – 0.02	<0.001	0.01	0.01 – 0.02	<0.001
Ini. Rank [2]				0.22	0.13 – 0.39	<0.001	0.22	0.13 – 0.39	<0.001
Ini. Rank [3]				0.50	0.28 – 0.88	0.017	0.50	0.28 – 0.88	0.017
Ini. Rank [4]				0.92	0.51 – 1.66	0.790	0.92	0.51 – 1.66	0.789
Ini. Rank [5]				1.11	0.61 – 2.02	0.740	1.11	0.61 – 2.02	0.741
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.00			0.00			0.00
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.231 / 0.231			0.579 / 0.581			0.579 / 0.581

# 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.057235                1.000000                2.057235 
##  rank.color.c:condition condition:rank.corner.c 
##                2.057235                2.057235

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.063920  1        1.436635
## condition               1.000000  1        1.000000
## rank.corner.c           2.072326  1        1.439557
## initial.rank            1.031014  5        1.003059
## rank.color.c:condition  2.066042  1        1.437373
## condition:rank.corner.c 2.069820  1        1.438687

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<-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,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.63	1.34 – 1.98	<0.001	5.26	3.27 – 8.47	<0.001	5.26	3.27 – 8.47	<0.001
Color Rank [Nested in Color]	1.81	1.59 – 2.06	<0.001	2.33	1.98 – 2.76	<0.001	2.33	1.98 – 2.76	<0.001
Color Rank [Nested in Corner]	1.09	0.97 – 1.21	0.135	1.15	1.01 – 1.31	0.038	1.15	1.01 – 1.31	0.038
Corner Rank [Nested in Color]	1.25	1.12 – 1.39	<0.001	1.26	1.11 – 1.44	<0.001	1.26	1.11 – 1.44	<0.001
Corner Rank [Nested in Corner]	1.67	1.49 – 1.87	<0.001	2.12	1.82 – 2.48	<0.001	2.12	1.82 – 2.48	<0.001
Condition [Corner]	1.03	0.78 – 1.35	0.849	1.05	0.75 – 1.48	0.772	1.05	0.75 – 1.48	0.772
Ini. Rank [1]				0.01	0.01 – 0.02	<0.001	0.01	0.01 – 0.02	<0.001
Ini. Rank [2]				0.22	0.13 – 0.39	<0.001	0.22	0.13 – 0.39	<0.001
Ini. Rank [3]				0.50	0.28 – 0.88	0.017	0.50	0.28 – 0.88	0.017
Ini. Rank [4]				0.92	0.51 – 1.66	0.790	0.92	0.51 – 1.66	0.789
Ini. Rank [5]				1.11	0.61 – 2.02	0.740	1.11	0.61 – 2.02	0.741
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.00			0.00			0.00
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.231 / 0.231			0.579 / 0.581			0.579 / 0.581

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.49	0.29 – 0.69	<0.001	1.66	1.18 – 2.14	<0.001	1.66	1.18 – 2.14	<0.001
Color Rank [Nested in Color]	0.60	0.47 – 0.72	<0.001	0.85	0.68 – 1.01	<0.001	0.85	0.68 – 1.01	<0.001
Color Rank [Nested in Corner]	0.08	-0.03 – 0.19	0.135	0.14	0.01 – 0.27	0.038	0.14	0.01 – 0.27	0.038
Corner Rank [Nested in Color]	0.22	0.11 – 0.33	<0.001	0.23	0.10 – 0.36	<0.001	0.23	0.10 – 0.36	<0.001
Corner Rank [Nested in Corner]	0.51	0.40 – 0.63	<0.001	0.75	0.60 – 0.91	<0.001	0.75	0.60 – 0.91	<0.001
Condition [Corner]	0.03	-0.25 – 0.30	0.849	0.05	-0.29 – 0.39	0.772	0.05	-0.29 – 0.39	0.772
Ini. Rank [1]				-4.42	-5.13 – -3.72	<0.001	-4.42	-5.13 – -3.72	<0.001
Ini. Rank [2]				-1.50	-2.06 – -0.94	<0.001	-1.50	-2.06 – -0.95	<0.001
Ini. Rank [3]				-0.69	-1.26 – -0.12	0.017	-0.69	-1.26 – -0.13	0.017
Ini. Rank [4]				-0.08	-0.67 – 0.51	0.790	-0.08	-0.67 – 0.51	0.789
Ini. Rank [5]				0.10	-0.50 – 0.70	0.740	0.10	-0.50 – 0.70	0.741
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.00			0.00			0.00
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.231 / 0.231			0.579 / 0.581			0.579 / 0.581

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

• 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.004069  1        1.002033
## CLR.Nested_corner.c 1.009322  1        1.004650
## CNR.Nested_color.c  1.008158  1        1.004071
## CNR.Nested_corner.c 1.012232  1        1.006097
## condition           1.000000  1        1.000000
## initial.rank        1.031014  5        1.003059

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.169602  1        1.780338
## CLR.Nested_corner 3.071612  1        1.752602
## CNR.Nested_color  3.182511  1        1.783959
## CNR.Nested_corner 3.080467  1        1.755126
## condition         9.231194  1        3.038288
## initial.rank      1.031014  5        1.003059

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 = 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.96	-5.24 – -4.68	<0.001	-4.47	-4.77 – -4.16	<0.001	-4.47	-4.79 – -4.15	<0.001
Color Rank	0.53	0.47 – 0.58	<0.001	0.52	0.47 – 0.57	<0.001	0.52	0.47 – 0.57	<0.001
Corner Rank	-0.01	-0.06 – 0.05	0.797	-0.03	-0.07 – 0.02	0.261	-0.03	-0.08 – 0.02	0.307
Initial Rank [1]				-1.63	-1.91 – -1.36	<0.001	-1.63	-1.91 – -1.36	<0.001
Initial Rank [2]				-0.42	-0.69 – -0.15	0.003	-0.42	-0.69 – -0.15	0.003
Initial Rank [3]				-0.20	-0.47 – 0.08	0.157	-0.20	-0.47 – 0.08	0.159
Initial Rank [4]				-0.13	-0.40 – 0.14	0.352	-0.13	-0.40 – 0.14	0.350
Initial Rank [5]				-0.03	-0.30 – 0.25	0.857	-0.02	-0.30 – 0.25	0.859
Random Effects
σ2	1.19			0.87			0.87
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.00 item.f
N	90 ResponseId			90 ResponseId			90 ResponseId
							6 item.f
Observations	540			540			540
Marginal R2 / Conditional R2	0.405 / NA			0.565 / NA			0.565 / 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 = 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.21	-4.50 – -3.92	<0.001	-4.22	-4.57 – -3.88	<0.001	-4.22	-4.66 – -3.79	<0.001
Color Rank	-0.15	-0.21 – -0.09	<0.001	-0.12	-0.18 – -0.07	<0.001	-0.12	-0.20 – -0.05	0.001
Corner Rank	0.45	0.39 – 0.51	<0.001	0.46	0.41 – 0.51	<0.001	0.46	0.39 – 0.53	<0.001
Initial Rank [1]				-1.29	-1.59 – -0.99	<0.001	-1.29	-1.59 – -0.99	<0.001
Initial Rank [2]				-0.10	-0.40 – 0.20	0.529	-0.11	-0.41 – 0.20	0.492
Initial Rank [3]				0.19	-0.11 – 0.50	0.208	0.20	-0.10 – 0.50	0.193
Initial Rank [4]				0.26	-0.05 – 0.56	0.100	0.26	-0.05 – 0.56	0.099
Initial Rank [5]				0.25	-0.05 – 0.56	0.099	0.26	-0.04 – 0.56	0.095
Random Effects
σ2	1.40			1.11			1.11
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.01 item.f
N	95 ResponseId			95 ResponseId			95 ResponseId
							6 item.f
Observations	570			570			570
Marginal R2 / Conditional R2	0.317 / NA			0.458 / NA			0.460 / 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.15	-3.24 – -3.05	<0.001	-2.89	-3.05 – -2.74	<0.001	-2.89	-3.06 – -2.72	<0.001
Color Rank	0.53	0.47 – 0.58	<0.001	0.52	0.47 – 0.57	<0.001	0.52	0.46 – 0.58	<0.001
Condition [Corner]	-0.01	-0.15 – 0.12	0.865	-0.01	-0.13 – 0.11	0.846	-0.01	-0.13 – 0.11	0.846
Corner Rank	-0.01	-0.06 – 0.05	0.805	-0.02	-0.07 – 0.03	0.340	-0.02	-0.08 – 0.04	0.435
Color Rank x Condition [Corner]	-0.68	-0.75 – -0.60	<0.001	-0.64	-0.71 – -0.58	<0.001	-0.64	-0.71 – -0.58	<0.001
Corner Rank x Condition [Corner]	0.46	0.38 – 0.54	<0.001	0.48	0.41 – 0.55	<0.001	0.48	0.41 – 0.55	<0.001
Ini. Rank [1]				-1.46	-1.66 – -1.25	<0.001	-1.46	-1.66 – -1.26	<0.001
Ini. Rank [2]				-0.26	-0.46 – -0.05	0.014	-0.26	-0.46 – -0.06	0.013
Ini. Rank [3]				0.00	-0.20 – 0.21	0.980	0.01	-0.20 – 0.21	0.953
Ini. Rank [4]				0.07	-0.14 – 0.27	0.526	0.07	-0.14 – 0.27	0.527
Ini. Rank [5]				0.12	-0.09 – 0.32	0.262	0.12	-0.09 – 0.32	0.263
Random Effects
σ2	1.29			0.99			0.99
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.01 item.f
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.359 / NA			0.508 / NA			0.509 / 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.057235                1.000000                2.057235 
##  rank.color.c:condition condition:rank.corner.c 
##                2.057235                2.057235

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.063920  1        1.436635
## condition               1.000000  1        1.000000
## rank.corner.c           2.072326  1        1.439557
## initial.rank            1.031014  5        1.003059
## rank.color.c:condition  2.066042  1        1.437373
## condition:rank.corner.c 2.069820  1        1.438687

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

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

	Subj. Random_eff			Add Ini. Position			Add Item Random_eff
Predictors	Estimates	CI	p	Estimates	CI	p	Estimates	CI	p
Intercept	-3.15	-3.24 – -3.05	<0.001	-2.89	-3.05 – -2.74	<0.001	-2.89	-3.06 – -2.72	<0.001
Color Rank [Nested in Color]	0.53	0.47 – 0.58	<0.001	0.52	0.47 – 0.57	<0.001	0.52	0.46 – 0.58	<0.001
Color Rank [Nested in Corner]	-0.15	-0.20 – -0.10	<0.001	-0.13	-0.17 – -0.08	<0.001	-0.13	-0.18 – -0.07	<0.001
Corner Rank [Nested in Color]	-0.01	-0.06 – 0.05	0.805	-0.02	-0.07 – 0.03	0.340	-0.02	-0.08 – 0.04	0.435
Corner Rank [Nested in Corner]	0.45	0.40 – 0.51	<0.001	0.46	0.41 – 0.50	<0.001	0.46	0.40 – 0.52	<0.001
Condition [Corner]	-0.01	-0.15 – 0.12	0.865	-0.01	-0.13 – 0.11	0.846	-0.01	-0.13 – 0.11	0.846
Ini. Rank [1]				-1.46	-1.66 – -1.25	<0.001	-1.46	-1.66 – -1.26	<0.001
Ini. Rank [2]				-0.26	-0.46 – -0.05	0.014	-0.26	-0.46 – -0.06	0.013
Ini. Rank [3]				0.00	-0.20 – 0.21	0.980	0.01	-0.20 – 0.21	0.953
Ini. Rank [4]				0.07	-0.14 – 0.27	0.526	0.07	-0.14 – 0.27	0.527
Ini. Rank [5]				0.12	-0.09 – 0.32	0.262	0.12	-0.09 – 0.32	0.263
Random Effects
σ2	1.29			0.99			0.99
τ00	0.00 ResponseId			0.00 ResponseId			0.00 ResponseId
							0.01 item.f
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.359 / NA			0.508 / NA			0.509 / 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)
# tab_model(M_robust)

• 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.004069  1        1.002033
## CLR.Nested_corner.c 1.009322  1        1.004650
## CNR.Nested_color.c  1.008158  1        1.004071
## CNR.Nested_corner.c 1.012232  1        1.006097
## condition           1.000000  1        1.000000
## initial.rank        1.031014  5        1.003059

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.169602  1        1.780338
## CLR.Nested_corner 3.071612  1        1.752602
## CNR.Nested_color  3.182511  1        1.783959
## CNR.Nested_corner 3.080467  1        1.755126
## condition         9.231194  1        3.038288
## initial.rank      1.031014  5        1.003059

2.3 DV3: Drag Distance

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

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

• Coding of Distance:

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

2.3.1 Distribution of Drag Distance

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

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

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

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


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


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

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

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

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

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

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

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

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

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


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


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


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

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



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

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

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

2.3.2 Model-Free Visualization

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

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

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

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



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


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

• If we plot the ABSOLUTE VALUE of Distance:

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

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



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

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

2.3.3 Correlation with Attribute Rank

Color Condition

• Aggregate Stats

Distance_Color.cleanup.df<-Distance_Color.cleanup.df%>%
    filter(ResponseId%in%color_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 = 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.66	-0.96 – -0.36	<0.001	0.72	0.48 – 0.96	<0.001	0.72	0.48 – 0.96	<0.001
Color Rank	0.51	0.45 – 0.57	<0.001	0.49	0.46 – 0.52	<0.001	0.49	0.46 – 0.52	<0.001
Corner Rank	-0.00	-0.06 – 0.05	0.905	-0.02	-0.06 – 0.01	0.146	-0.02	-0.06 – 0.01	0.146
Initial Rank [1]				-2.52	-2.72 – -2.33	<0.001	-2.52	-2.72 – -2.33	<0.001
Initial Rank [2]				-1.93	-2.12 – -1.73	<0.001	-1.93	-2.12 – -1.73	<0.001
Initial Rank [3]				-1.44	-1.64 – -1.24	<0.001	-1.44	-1.64 – -1.24	<0.001
Initial Rank [4]				-1.03	-1.23 – -0.84	<0.001	-1.03	-1.23 – -0.84	<0.001
Initial Rank [5]				-0.51	-0.70 – -0.31	<0.001	-0.51	-0.70 – -0.31	<0.001
Random Effects
σ2	1.30			0.45			0.45
τ00	0.11 ResponseId			0.25 ResponseId			0.25 ResponseId
							0.00 item.f
ICC	0.08			0.36
N	90 ResponseId			90 ResponseId			90 ResponseId
							6 item.f
Observations	540			540			540
Marginal R2 / Conditional R2	0.349 / 0.399			0.677 / 0.792			0.765 / 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 = 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.04	-1.34 – -0.73	<0.001	0.20	-0.07 – 0.47	0.148	0.20	-0.07 – 0.47	0.148
Color Rank	0.02	-0.04 – 0.07	0.538	0.04	0.00 – 0.08	0.035	0.04	0.00 – 0.08	0.035
Corner Rank	0.56	0.50 – 0.61	<0.001	0.54	0.50 – 0.57	<0.001	0.54	0.50 – 0.57	<0.001
Initial Rank [1]				-2.46	-2.68 – -2.24	<0.001	-2.46	-2.68 – -2.24	<0.001
Initial Rank [2]				-1.93	-2.15 – -1.72	<0.001	-1.93	-2.15 – -1.72	<0.001
Initial Rank [3]				-1.48	-1.70 – -1.27	<0.001	-1.48	-1.70 – -1.27	<0.001
Initial Rank [4]				-1.00	-1.22 – -0.79	<0.001	-1.00	-1.22 – -0.79	<0.001
Initial Rank [5]				-0.57	-0.78 – -0.35	<0.001	-0.57	-0.78 – -0.35	<0.001
Random Effects
σ2	1.38			0.57			0.57
τ00	0.15 ResponseId			0.29 ResponseId			0.29 ResponseId
							0.00 item.f
ICC	0.10			0.34
N	95 ResponseId			95 ResponseId			95 ResponseId
							6 item.f
Observations	570			570			570
Marginal R2 / Conditional R2	0.371 / 0.434			0.648 / 0.766			0.735 / 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.11	0.98 – 1.23	<0.001	2.35	2.20 – 2.50	<0.001	2.35	2.20 – 2.50	<0.001
Color Rank	0.51	0.45 – 0.57	<0.001	0.49	0.45 – 0.53	<0.001	0.49	0.45 – 0.53	<0.001
Condition [Corner]	-0.13	-0.27 – 0.01	0.062	-0.13	-0.22 – -0.04	0.006	-0.13	-0.22 – -0.04	0.006
Corner Rank	-0.00	-0.06 – 0.05	0.906	-0.02	-0.06 – 0.01	0.208	-0.02	-0.06 – 0.01	0.208
Color Rank x Condition [Corner]	-0.49	-0.57 – -0.41	<0.001	-0.45	-0.50 – -0.40	<0.001	-0.45	-0.50 – -0.40	<0.001
Corner Rank x Condition [Corner]	0.56	0.48 – 0.64	<0.001	0.56	0.51 – 0.61	<0.001	0.56	0.51 – 0.61	<0.001
Ini. Rank [1]				-2.49	-2.65 – -2.34	<0.001	-2.49	-2.65 – -2.34	<0.001
Ini. Rank [2]				-1.93	-2.09 – -1.78	<0.001	-1.93	-2.09 – -1.78	<0.001
Ini. Rank [3]				-1.46	-1.62 – -1.31	<0.001	-1.46	-1.62 – -1.31	<0.001
Ini. Rank [4]				-1.02	-1.17 – -0.86	<0.001	-1.02	-1.17 – -0.86	<0.001
Ini. Rank [5]				-0.54	-0.69 – -0.38	<0.001	-0.54	-0.69 – -0.38	<0.001
Random Effects
σ2	1.34			0.58			0.58
τ00	0.14 ResponseId			0.20 ResponseId			0.20 ResponseId
							0.00 item.f
ICC	0.09			0.26
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.362 / 0.423			0.663 / 0.751			0.727 / 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.057235                1.000000                2.057235 
##  rank.color.c:condition condition:rank.corner.c 
##                2.057235                2.057235

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.063920  1        1.436635
## condition               1.000000  1        1.000000
## rank.corner.c           2.072326  1        1.439557
## initial.rank            1.031014  5        1.003059
## rank.color.c:condition  2.066042  1        1.437373
## condition:rank.corner.c 2.069820  1        1.438687

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<-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,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.11	0.98 – 1.23	<0.001	2.35	2.20 – 2.50	<0.001	2.35	2.20 – 2.50	<0.001
Color Rank [Nested in Color]	0.51	0.45 – 0.57	<0.001	0.49	0.45 – 0.53	<0.001	0.49	0.45 – 0.53	<0.001
Color Rank [Nested in Corner]	0.02	-0.04 – 0.07	0.531	0.04	0.00 – 0.08	0.035	0.04	0.00 – 0.08	0.035
Corner Rank [Nested in Color]	-0.00	-0.06 – 0.05	0.906	-0.02	-0.06 – 0.01	0.208	-0.02	-0.06 – 0.01	0.208
Corner Rank [Nested in Corner]	0.56	0.50 – 0.61	<0.001	0.54	0.50 – 0.57	<0.001	0.54	0.50 – 0.57	<0.001
Condition [Corner]	-0.13	-0.27 – 0.01	0.062	-0.13	-0.22 – -0.04	0.006	-0.13	-0.22 – -0.04	0.006
Ini. Rank [1]				-2.49	-2.65 – -2.34	<0.001	-2.49	-2.65 – -2.34	<0.001
Ini. Rank [2]				-1.93	-2.09 – -1.78	<0.001	-1.93	-2.09 – -1.78	<0.001
Ini. Rank [3]				-1.46	-1.62 – -1.31	<0.001	-1.46	-1.62 – -1.31	<0.001
Ini. Rank [4]				-1.02	-1.17 – -0.86	<0.001	-1.02	-1.17 – -0.86	<0.001
Ini. Rank [5]				-0.54	-0.69 – -0.38	<0.001	-0.54	-0.69 – -0.38	<0.001
Random Effects
σ2	1.34			0.58			0.58
τ00	0.14 ResponseId			0.20 ResponseId			0.20 ResponseId
							0.00 item.f
ICC	0.09			0.26
N	98 ResponseId			98 ResponseId			98 ResponseId
							6 item.f
Observations	1110			1110			1110
Marginal R2 / Conditional R2	0.362 / 0.423			0.663 / 0.751			0.727 / 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)

• 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.004069  1        1.002033
## CLR.Nested_corner.c 1.009322  1        1.004650
## CNR.Nested_color.c  1.008158  1        1.004071
## CNR.Nested_corner.c 1.012232  1        1.006097
## condition           1.000000  1        1.000000
## initial.rank        1.031014  5        1.003059

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.169602  1        1.780338
## CLR.Nested_corner 3.071612  1        1.752602
## CNR.Nested_color  3.182511  1        1.783959
## CNR.Nested_corner 3.080467  1        1.755126
## condition         9.231194  1        3.038288
## initial.rank      1.031014  5        1.003059

2.4 Correlation Between Measures

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

Color Condition

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

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

• Here is a summary plot

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

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

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


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

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

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


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

Color_p2

• CR3_CL6

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

• CR4_CL5

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

• CR2_CL4

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

• CR5_CL3

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

• CR6_CL2

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

• CR1_CL1

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

Corner Condition

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

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

• Here is a summary plot

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

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

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

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

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

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

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

• CR6_CL2

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

• CR5_CL3

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

• CR4_CL5

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

• CR3_CL6

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

• CR2_CL4

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

• CR1_CL1

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

2.5 Time Analysis

TimeAnalysis.Color<-Distance_Color%>%
  filter(ResponseId%in%color_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("CR4_CL5" = "#1b9e77", "CR2_CL4" = "#d95f02", 
                 "CR6_CL2" = "#7570b3", "CR1_CL1" = "#e7298a", 
                 "CR5_CL3" = "#66a61e", "CR3_CL6" = "#e6ab02")

item_shapes <- c("CR4_CL5" = 21, "CR2_CL4" = 22, 
                 "CR6_CL2" = 23, "CR1_CL1" = 24, 
                 "CR5_CL3" = 25, "CR3_CL6" = 11)
# TimeAnalysis.Color #one more step here to expand the dataset

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 = 7-mean(current_rank),
            sd.current_rank = sd(current_rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")



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

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

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

# this dataset contains observation of items being moved multiple times!
TimeAnalysis.Corner<-Distance_Corner%>%
  filter(ResponseId%in%corner_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("CR4_CL5" = "#1b9e77", "CR2_CL4" = "#d95f02", 
                 "CR6_CL2" = "#7570b3", "CR1_CL1" = "#e7298a", 
                 "CR5_CL3" = "#66a61e", "CR3_CL6" = "#e6ab02")

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

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 = 7-mean(current_rank),
            sd.current_rank = sd(current_rank),
            n = n(),  
            se = sd.current_rank / sqrt(n),  
            .groups = "drop")


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

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

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

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

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

  • Comparison time = time difference between mousedown and mouseup.

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

# this dataset contains observation of items being moved multiple times!
TimeAnalysis.Color.model<-Distance_Color%>%
  filter(ResponseId%in%color_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	934.35	715.18 – 1153.52	<0.001
Step	-48.97	-79.71 – -18.24	0.002
Condition [Corner] Rank	96.45	21.22 – 171.67	0.012
abs(Drag Distance)	134.84	90.21 – 179.46	<0.001
Initial Rank [1]	338.38	97.63 – 579.13	0.006
Initial Rank [2]	38.63	-109.32 – 186.57	0.608
Initial Rank [3]	-38.48	-173.77 – 96.80	0.577
Initial Rank [4]	-42.75	-164.43 – 78.93	0.491
Initial Rank [5]	-47.10	-159.41 – 65.21	0.411
Random Effects
σ2	246889.83
τ00 ResponseId	159698.59
τ00 item.f	0.00
N ResponseId	98
N item.f	6
Observations	734
Marginal R2 / Conditional R2	0.151 / 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	3066.17	2019.66 – 4112.68	<0.001
Step	-218.76	-455.86 – 18.34	0.070
Condition [Corner] Rank	433.59	-133.92 – 1001.10	0.134
Initial Rank [1]	2796.16	1125.74 – 4466.59	0.001
Initial Rank [2]	-595.55	-1561.28 – 370.18	0.226
Initial Rank [3]	-474.95	-1358.69 – 408.80	0.292
Initial Rank [4]	-356.78	-1203.56 – 490.00	0.408
Initial Rank [5]	-329.53	-1146.72 – 487.67	0.429
Random Effects
σ2	10341337.49
τ00 ResponseId	2726326.53
τ00 item.f	47610.86
ICC	0.21
N ResponseId	97
N item.f	6
Observations	549
Marginal R2 / Conditional R2	0.033 / 0.238

• 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.81	3.60 – 4.02	<0.001
Step	-0.33	-0.38 – -0.29	<0.001
Condition [Corner]	-0.02	-0.15 – 0.11	0.746
Initial Rank [1]	-0.72	-1.11 – -0.33	<0.001
Initial Rank [2]	-1.76	-1.97 – -1.55	<0.001
Initial Rank [3]	-1.58	-1.77 – -1.38	<0.001
Initial Rank [4]	-1.01	-1.20 – -0.82	<0.001
Initial Rank [5]	-0.63	-0.81 – -0.44	<0.001
Random Effects
σ2	0.73
τ00 ResponseId	0.03
τ00 item.f	0.01
ICC	0.05
N ResponseId	98
N item.f	6
Observations	734
Marginal R2 / Conditional R2	0.437 / 0.466

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