Skip to content

Instantly share code, notes, and snippets.

@heavywatal
Created March 20, 2012 02:24
Show Gist options
  • Save heavywatal/2130242 to your computer and use it in GitHub Desktop.
Save heavywatal/2130242 to your computer and use it in GitHub Desktop.
allocate alphabets to indicate significance of the deferences among levels
signif_levels = function(tbl) {
colnames(tbl) = c("lhs", "rhs", "significant")
tbl$lhs = as.character(tbl$lhs)
tbl$rhs = as.character(tbl$rhs)
print(tbl); cat('\n')
output = data.frame(group=unique(c(tbl$lhs, tbl$rhs)), level=''
, stringsAsFactors=FALSE)
print(output$group); cat('\n')
nakama_list = list()
j = 1
for (i in seq(nrow(output))) {
g = output$group[i]
nakama = c(g, tbl$rhs[tbl$lhs == g & !tbl$signif])
issubset = FALSE
for (prev_nakama in nakama_list) {
issubset = issubset | all(nakama %in% prev_nakama)
}
if (issubset) {
cat("ignored subset: "); print(nakama)
} else {
cat("new group", letters[j], ':'); print(nakama)
cat(g, "+=", letters[j], '\n')
output$level[i] = paste(output$level[i], letters[j], sep='')
for (h in tbl$rhs[tbl$lhs == g & !tbl$signif]) {
cat(h, "+=", letters[j], '\n')
group_h = (output$group == h)
output$level[group_h] = paste(output$level[group_h], letters[j], sep='')
}
nakama_list[[letters[j]]] = nakama
j = j + 1
}
#print(nakama_list)
for (h in tbl$rhs[tbl$lhs == g & tbl$signif]) {
group_h = (output$group == h)
m = charintersect(output$level[i], output$level[group_h])
for (oldl in m) {
cat("significant in the same group", oldl, ':')
print(c(g, h))
cat("group", oldl, ":\n")
print(nakama_list[[oldl]])
ns_with_h = tbl$lhs[!tbl$signif & tbl$rhs==h]
ns_with_h = c(ns_with_h, tbl$rhs[!tbl$signif & tbl$lhs==h])
cat(h, " non-significant:\n")
print(ns_with_h)
ns_with_h = intersect(ns_with_h, nakama_list[[oldl]])
cat("intersect:\n")
print(ns_with_h)
common = unlist(strsplit(output$level[group_h], ''))
for (x in ns_with_h) {
common = charintersect(paste(common, sep=''), output$level[output$group==x])
}
if (any(common!=oldl)) {
cat("members are already in the same group", common[common!=oldl],'\n')
output$level[group_h] = sub(oldl, '', output$level[group_h])
cat(h, "-=", oldl, '\n')
} else {
output$level[group_h] = sub(oldl, letters[j], output$level[group_h])
cat(h, "-=", oldl, '\n')
cat(h, "+=", letters[j], '\n')
for (x in ns_with_h) {
output$level[output$group==x] = paste(output$level[output$group==x], letters[j], sep='')
cat(x, "+=", letters[j], '\n')
}
j = j + 1
}
}
}
}
return (output)
}
charintersect = function(lhs, rhs) {
intersect(unlist(strsplit(lhs, '')), unlist(strsplit(rhs, '')))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment