# Load the vcd library for Cohen's Kappa and Weighted Kappa calculation
# If not installed, run: install.packages("vcd")
library(vcd)
 
# Create the 5x5 contingency matrix based on the provided table data
# Rows: Method II (None, Mild, Moderate, Severe, Extreme)
# Columns: Method I (None, Mild, Moderate, Severe, Extreme)
data_matrix <- matrix(
  c(89,  5, 16,  2,  4,   # None (Method II)
    36,  3, 15,  6,  2,   # Mild (Method II)
    20,  4, 22,  6,  1,   # Moderate (Method II)
    14,  2, 37, 18, 16,   # Severe (Method II)
     4,  1, 16, 23, 50),  # Extreme (Method II)
  nrow = 5,
  byrow = TRUE
)
 
# Set row and column names
categories <- c("None", "Mild", "Moderate", "Severe", "Extreme")
rownames(data_matrix) <- categories
colnames(data_matrix) <- categories
 
# Display the contingency table
print("Contingency Table:")
print(data_matrix)
 
# (i) Calculate Unweighted Kappa statistic
kappa_unweighted <- Kappa(data_matrix, weights = "equal")
print("Unweighted Kappa Statistic:")
print(kappa_unweighted)
 
# (ii) Calculate Weighted Kappa statistic (using default squared/Fleiss-Cohen weights)
kappa_weighted <- Kappa(data_matrix, weights = "Fleiss-Cohen")
print("Weighted Kappa Statistic:")
print(kappa_weighted)
 
# Interpretation helper function based on Landis and Koch guidelines
interpret_kappa <- function(k) {
  if (k < 0) {
    return("Poor agreement (less than chance)")
  } else if (k <= 0.20) {
    return("Slight agreement")
  } else if (k <= 0.40) {
    return("Fair agreement")
  } else if (k <= 0.60) {
    return("Moderate agreement")
  } else if (k <= 0.80) {
    return("Substantial agreement")
  } else {
    return("Almost perfect agreement")
  }
}
 
# Extract values and print interpretations
unweighted_val <- kappa_unweighted$Unweighted[1]
weighted_val <- kappa_weighted$Weighted[1]
 
cat("\n--- Interpretation of Results ---\n")
cat(sprintf("(i) Unweighted Kappa = %.4f -> %s\n", unweighted_val, interpret_kappa(unweighted_val)))
cat(sprintf("(ii) Weighted Kappa = %.4f -> %s\n", weighted_val, interpret_kappa(weighted_val)))

IyBMb2FkIHRoZSB2Y2QgbGlicmFyeSBmb3IgQ29oZW4ncyBLYXBwYSBhbmQgV2VpZ2h0ZWQgS2FwcGEgY2FsY3VsYXRpb24KIyBJZiBub3QgaW5zdGFsbGVkLCBydW46IGluc3RhbGwucGFja2FnZXMoInZjZCIpCmxpYnJhcnkodmNkKQoKIyBDcmVhdGUgdGhlIDV4NSBjb250aW5nZW5jeSBtYXRyaXggYmFzZWQgb24gdGhlIHByb3ZpZGVkIHRhYmxlIGRhdGEKIyBSb3dzOiBNZXRob2QgSUkgKE5vbmUsIE1pbGQsIE1vZGVyYXRlLCBTZXZlcmUsIEV4dHJlbWUpCiMgQ29sdW1uczogTWV0aG9kIEkgKE5vbmUsIE1pbGQsIE1vZGVyYXRlLCBTZXZlcmUsIEV4dHJlbWUpCmRhdGFfbWF0cml4IDwtIG1hdHJpeCgKICBjKDg5LCAgNSwgMTYsICAyLCAgNCwgICAjIE5vbmUgKE1ldGhvZCBJSSkKICAgIDM2LCAgMywgMTUsICA2LCAgMiwgICAjIE1pbGQgKE1ldGhvZCBJSSkKICAgIDIwLCAgNCwgMjIsICA2LCAgMSwgICAjIE1vZGVyYXRlIChNZXRob2QgSUkpCiAgICAxNCwgIDIsIDM3LCAxOCwgMTYsICAgIyBTZXZlcmUgKE1ldGhvZCBJSSkKICAgICA0LCAgMSwgMTYsIDIzLCA1MCksICAjIEV4dHJlbWUgKE1ldGhvZCBJSSkKICBucm93ID0gNSwKICBieXJvdyA9IFRSVUUKKQoKIyBTZXQgcm93IGFuZCBjb2x1bW4gbmFtZXMKY2F0ZWdvcmllcyA8LSBjKCJOb25lIiwgIk1pbGQiLCAiTW9kZXJhdGUiLCAiU2V2ZXJlIiwgIkV4dHJlbWUiKQpyb3duYW1lcyhkYXRhX21hdHJpeCkgPC0gY2F0ZWdvcmllcwpjb2xuYW1lcyhkYXRhX21hdHJpeCkgPC0gY2F0ZWdvcmllcwoKIyBEaXNwbGF5IHRoZSBjb250aW5nZW5jeSB0YWJsZQpwcmludCgiQ29udGluZ2VuY3kgVGFibGU6IikKcHJpbnQoZGF0YV9tYXRyaXgpCgojIChpKSBDYWxjdWxhdGUgVW53ZWlnaHRlZCBLYXBwYSBzdGF0aXN0aWMKa2FwcGFfdW53ZWlnaHRlZCA8LSBLYXBwYShkYXRhX21hdHJpeCwgd2VpZ2h0cyA9ICJlcXVhbCIpCnByaW50KCJVbndlaWdodGVkIEthcHBhIFN0YXRpc3RpYzoiKQpwcmludChrYXBwYV91bndlaWdodGVkKQoKIyAoaWkpIENhbGN1bGF0ZSBXZWlnaHRlZCBLYXBwYSBzdGF0aXN0aWMgKHVzaW5nIGRlZmF1bHQgc3F1YXJlZC9GbGVpc3MtQ29oZW4gd2VpZ2h0cykKa2FwcGFfd2VpZ2h0ZWQgPC0gS2FwcGEoZGF0YV9tYXRyaXgsIHdlaWdodHMgPSAiRmxlaXNzLUNvaGVuIikKcHJpbnQoIldlaWdodGVkIEthcHBhIFN0YXRpc3RpYzoiKQpwcmludChrYXBwYV93ZWlnaHRlZCkKCiMgSW50ZXJwcmV0YXRpb24gaGVscGVyIGZ1bmN0aW9uIGJhc2VkIG9uIExhbmRpcyBhbmQgS29jaCBndWlkZWxpbmVzCmludGVycHJldF9rYXBwYSA8LSBmdW5jdGlvbihrKSB7CiAgaWYgKGsgPCAwKSB7CiAgICByZXR1cm4oIlBvb3IgYWdyZWVtZW50IChsZXNzIHRoYW4gY2hhbmNlKSIpCiAgfSBlbHNlIGlmIChrIDw9IDAuMjApIHsKICAgIHJldHVybigiU2xpZ2h0IGFncmVlbWVudCIpCiAgfSBlbHNlIGlmIChrIDw9IDAuNDApIHsKICAgIHJldHVybigiRmFpciBhZ3JlZW1lbnQiKQogIH0gZWxzZSBpZiAoayA8PSAwLjYwKSB7CiAgICByZXR1cm4oIk1vZGVyYXRlIGFncmVlbWVudCIpCiAgfSBlbHNlIGlmIChrIDw9IDAuODApIHsKICAgIHJldHVybigiU3Vic3RhbnRpYWwgYWdyZWVtZW50IikKICB9IGVsc2UgewogICAgcmV0dXJuKCJBbG1vc3QgcGVyZmVjdCBhZ3JlZW1lbnQiKQogIH0KfQoKIyBFeHRyYWN0IHZhbHVlcyBhbmQgcHJpbnQgaW50ZXJwcmV0YXRpb25zCnVud2VpZ2h0ZWRfdmFsIDwtIGthcHBhX3Vud2VpZ2h0ZWQkVW53ZWlnaHRlZFsxXQp3ZWlnaHRlZF92YWwgPC0ga2FwcGFfd2VpZ2h0ZWQkV2VpZ2h0ZWRbMV0KCmNhdCgiXG4tLS0gSW50ZXJwcmV0YXRpb24gb2YgUmVzdWx0cyAtLS1cbiIpCmNhdChzcHJpbnRmKCIoaSkgVW53ZWlnaHRlZCBLYXBwYSA9ICUuNGYgLT4gJXNcbiIsIHVud2VpZ2h0ZWRfdmFsLCBpbnRlcnByZXRfa2FwcGEodW53ZWlnaHRlZF92YWwpKSkKY2F0KHNwcmludGYoIihpaSkgV2VpZ2h0ZWQgS2FwcGEgPSAlLjRmIC0+ICVzXG4iLCB3ZWlnaHRlZF92YWwsIGludGVycHJldF9rYXBwYSh3ZWlnaHRlZF92YWwpKSk=