For reference, the data is from my adjective order experiment, investigating the order people tend to place adjectives in various languages (think in English, the tendency towards 'big red car' vs 'red big car'.

I have eight categories of data - size, age, colour, shape, condition, opinion, material, origin.

I'm trying to find the latent, underlying order that speakers are following from the sequences I asked them to order, which are of varying length. I think the varying lengths may be what's fucking it up, as if disproportionate weighting is given to ordering in short sequences of 2 rather than 4. It could also perhaps be that not all categories appear with the same regularity.

I can tell from the 'decoy' results (which is pretty much inverted Georgian, to serve as an indicator. If it's not mirroring Georgian, something is wrong) that it isn't turning out right.

I am not a good statistician and I think it shows. Can anyone see what I did wrong?

Here is the data sheet

**Code:** (sorry for formatting)

library(readxl)

library(BayesMallows)

library(dplyr)

Read data

df <- read_excel("~/Downloads/AdjOrderExcel-2.xlsx")

Adjective codes

codes <- c(

  "si", "ag", "op", "sh",

  "con", "col", "or", "ma"

)

category_names <- c(

  si = "Size",

  ag = "Age",

  op = "Opinion",

  sh = "Shape",

  con = "Condition",

  col = "Color",

  or = "Origin",

  ma = "Material"

)

Convert Order column to numeric rankings

convert_order <- function(x){

  match(strsplit(x, ",\s*")[[1]], codes)

}

results <- list()

Run Mallows model for each language

for(lang in unique(df$Language)){

  

  cat("Running:", lang, "\n")

  

  # Get partial rankings for this language

  rankings <- df %>%

    filter(Language == lang) %>%

    pull(Order) %>%

    lapply(convert_order)

  

  # Pad partial rankings with NA

  ranking_matrix <- t(

    sapply(rankings, function(x){

      c(x, rep(NA, length(codes) - length(x)))

    })

  )

  

  # Create BayesMallows object

  mallows_data <- setup_rank_data(

    rankings = ranking_matrix

  )

  

  # Fit model

  fit <- compute_mallows(

    data = mallows_data,

    compute_options = set_compute_options(

      nmc = 5000,

      burnin = 1000

    )

  )

  

  # Extract posterior ranking

  rho <- fit$rho

  

  # Critical Fix: Map the "Item X" label directly to the correct index in 'codes'

  ranking_table <- rho %>%

    group_by(item) %>%

    summarise(mean_rank = mean(value)) %>%

    mutate(item_index = as.numeric(gsub("Item ", "", item))) %>%

    arrange(mean_rank) # Sort from best rank (1) to worst rank (8)

  

  # Extract the correctly ordered codes

  ordered_codes <- codes[ranking_table$item_index]

  

  # Save result

  results[[lang]] <- data.frame(

    Language = lang,

    Rank = 1:length(codes),

    Code = ordered_codes,

    Category = unname(category_names[ordered_codes])

  )

}

Combine languages

final_results <- bind_rows(results)

print(final_results)

write.csv(

  final_results,

  "BayesMallows_language_rankingssss.csv",

  row.names = FALSE

)

From: Fionn Ó Dubhairle <fionndoorley1@gmail.com> Sent: Friday, July 31, 2026 10:11 PM To: Kariniemi, Valentine <valentine.kariniemi@helsinki.fi> Subject: Extralang

 

library(readxl)

library(tidyverse)

==========================================

1. Load Data & Configure Variables

==========================================

datat <- read_excel("~/Downloads/AdjOrderExcel-2.xlsx")

order_column <- "Order"

lang_column  <- "Language" 

code_dictionary <- c(

  "si"  = "Size", 

  "ag"  = "Age", 

  "op"  = "Opinion", 

  "sh"  = "Shape",

  "con" = "Condition", 

  "col" = "Color", 

  "or"  = "Origin", 

  "ma"  = "Material"

)

target_categories <- unname(code_dictionary)

Add sequence tracking keys

datat <- datat %>% mutate(row_id = row_number())

==========================================

2. Parse Raw Adjective Code Strings

==========================================

long_ranks <- datat %>%

  select(row_id, !!sym(lang_column), !!sym(order_column)) %>%

  filter(!is.na(!!sym(order_column))) %>%

  separate_rows(!!sym(order_column), sep = ", ") %>%

  rename(ShortCode = !!sym(order_column)) %>%

  mutate(Category = code_dictionary[ShortCode]) %>%

  filter(!is.na(Category)) %>%

  group_by(row_id) %>%

  mutate(Rank = row_number()) %>%

  ungroup()

==========================================

3. Calculate Head-to-Head Outcomes

==========================================

pairwise_matches <- long_ranks %>%

  rename(CatA = Category, RankA = Rank) %>%

  inner_join(

    long_ranks %>% rename(CatB = Category, RankB = Rank),

    by = c("row_id", lang_column),

    relationship = "many-to-many"

  ) %>%

  filter(CatA != CatB) %>% 

  group_by(!!sym(lang_column), CatA, CatB) %>%

  summarise(

    WinsA = sum(RankA < RankB),

    Total = n(),

    .groups = "drop"

  ) %>%

  mutate(WinRate = WinsA / Total)

==========================================

4. Generate the Summary Grid DataFrame

==========================================

master_summary <- pairwise_matches %>%

  group_by(!!sym(lang_column), CatA) %>%

  summarise(AvgWinRate = round(mean(WinRate, na.rm = TRUE) * 100, 1), .groups = "drop") %>%

  rename(Category = CatA) %>%

  pivot_wider(names_from = !!sym(lang_column), values_from = AvgWinRate)

final_table <- tibble(Category = target_categories) %>%

  left_join(master_summary, by = "Category")

==========================================

5. Print the Matrix

==========================================

print("--- COALESCED WIN-RATE COMPARISON MATRIX ---")

print(final_table)

==========================================

6. NEW: Dynamically Generate Order Strings

==========================================

print("--- EXTRACTED LINGUISTIC PREFERENCE ORDERS ---")

Isolate columns that correspond to languages

lang_names <- setdiff(names(final_table), "Category")

for (lang in lang_names) {

  # Sort categories dynamically from highest win score to lowest win score

  ordered_df <- final_table %>%

    select(Category, !!sym(lang)) %>%

    filter(!is.na(!!sym(lang))) %>%

    arrange(desc(!!sym(lang)))

  

  # Format string items as "Category (Score)"

  formatted_elements <- paste0(ordered_df$Category, " (", ordered_df[[lang]], ")")

  final_chain <- paste(formatted_elements, collapse = " → ")

  

  # Print cleanly formatted layout

  cat("\n", "Language [", lang, "]:\n", final_chain, "\n", sep="")

}

From: Kariniemi, Valentine <valentine.kariniemi@helsinki.fi> Sent: Saturday, August 1, 2026 11:05 AM To: Fionn Ó Dubhairle <fionndoorley1@gmail.com> Subject: Re: Extralang

 

Hide quoted text

library(readxl)

library(BayesMallows)

library(dplyr)

Read data

df <- read_excel("~/Downloads/AdjOrderExcel-2.xlsx")

Adjective codes

codes <- c(

  "si", "ag", "op", "sh",

  "con", "col", "or", "ma"

)

category_names <- c(

  si = "Size",

  ag = "Age",

  op = "Opinion",

  sh = "Shape",

  con = "Condition",

  col = "Color",

  or = "Origin",

  ma = "Material"

)

Convert Order column to numeric rankings

convert_order <- function(x){

  match(strsplit(x, ",\s*")[[1]], codes)

}

results <- list()

Run Mallows model for each language

for(lang in unique(df$Language)){

  

  cat("Running:", lang, "\n")

  

  # Get partial rankings for this language

  rankings <- df %>%

    filter(Language == lang) %>%

    pull(Order) %>%

    lapply(convert_order)

  

  # Pad partial rankings with NA

  ranking_matrix <- t(

    sapply(rankings, function(x){

      c(x, rep(NA, length(codes) - length(x)))

    })

  )

  

  # Create BayesMallows object

  mallows_data <- setup_rank_data(

    rankings = ranking_matrix

  )

  

  # Fit model

  fit <- compute_mallows(

    data = mallows_data,

    compute_options = set_compute_options(

      nmc = 5000,

      burnin = 1000

    )

  )

  

  # Extract posterior ranking

  rho <- fit$rho

  

  # Critical Fix: Map the "Item X" label directly to the correct index in 'codes'

  ranking_table <- rho %>%

    group_by(item) %>%

    summarise(mean_rank = mean(value)) %>%

    mutate(item_index = as.numeric(gsub("Item ", "", item))) %>%

    arrange(mean_rank) # Sort from best rank (1) to worst rank (8)

  

  # Extract the correctly ordered codes

  ordered_codes <- codes[ranking_table$item_index]

  

  # Save result

  results[[lang]] <- data.frame(

    Language = lang,

    Rank = 1:length(codes),

    Code = ordered_codes,

    Category = unname(category_names[ordered_codes])

  )

}

Combine languages

final_results <- bind_rows(results)

print(final_results)

write.csv(

  final_results,

  "BayesMallows_language_rankingssss.csv",

  row.names = FALSE

)