階層イメージ・階層帰属意識生成を説明するFKモデル(Fararo & Kosaka 2003)を再現するプログラムである.
関数の引数として客観階層を指定する.ここでは,ランクは3,2,1といった数字で表す.
FK <- function(obj) {
obj <- obj[seq(ncol(obj),1)]
colnames(obj) <- NULL
obj <- as.matrix(obj)
im <- replicate(nrow(obj),replicate(ncol(obj),replicate(nrow(obj)," ")))
for (k in 1:nrow(obj)) {
for (j in 1:nrow(obj)) {
for (i in 1:ncol(obj)) {
if (obj[[k,i]] == obj[[j,i]]) {
im[[j,i,k]] <- obj[[k,i]]
} else {
im[[j,i,k]] <- obj[[j,i]]
break
}
}
}
}
eqim <- data.frame(lapply(1:nrow(obj),
function(k) apply(im[,,k], 1, function(x) paste(x, collapse = ""))))
colnames(eqim) <- apply(obj, 1, function(x) paste(x, collapse = ""))
print(eqim)
ci <- sapply(1:ncol(eqim),function(k) grep(colnames(eqim)[k],unique(eqim[,k])))
hist(ci, breaks=seq(0.5,max(ci)+0.5,1), col = "skyblue", main="")
}
obj22 <- expand.grid(c(2,1),c(2,1))
FK(obj22)
## 22 21 12 11
## 1 22 22 2 2
## 2 21 21 2 2
## 3 1 1 12 12
## 4 1 1 11 11
obj23 <- expand.grid(c(3,2,1),c(3,2,1))
FK(obj23)
## 33 32 31 23 22 21 13 12 11
## 1 33 33 33 3 3 3 3 3 3
## 2 32 32 32 3 3 3 3 3 3
## 3 31 31 31 3 3 3 3 3 3
## 4 2 2 2 23 23 23 2 2 2
## 5 2 2 2 22 22 22 2 2 2
## 6 2 2 2 21 21 21 2 2 2
## 7 1 1 1 1 1 1 13 13 13
## 8 1 1 1 1 1 1 12 12 12
## 9 1 1 1 1 1 1 11 11 11
obj32 <- expand.grid(c(2,1),c(2,1),c(2,1))
FK(obj32)
## 222 221 212 211 122 121 112 111
## 1 222 222 22 22 2 2 2 2
## 2 221 221 22 22 2 2 2 2
## 3 21 21 212 212 2 2 2 2
## 4 21 21 211 211 2 2 2 2
## 5 1 1 1 1 122 122 12 12
## 6 1 1 1 1 121 121 12 12
## 7 1 1 1 1 11 11 112 112
## 8 1 1 1 1 11 11 111 111
obj33 <- expand.grid(c(3,2,1),c(3,2,1),c(3,2,1))
FK(obj33)
## 333 332 331 323 322 321 313 312 311 233 232 231 223 222 221 213 212 211 133
## 1 333 333 333 33 33 33 33 33 33 3 3 3 3 3 3 3 3 3 3
## 2 332 332 332 33 33 33 33 33 33 3 3 3 3 3 3 3 3 3 3
## 3 331 331 331 33 33 33 33 33 33 3 3 3 3 3 3 3 3 3 3
## 4 32 32 32 323 323 323 32 32 32 3 3 3 3 3 3 3 3 3 3
## 5 32 32 32 322 322 322 32 32 32 3 3 3 3 3 3 3 3 3 3
## 6 32 32 32 321 321 321 32 32 32 3 3 3 3 3 3 3 3 3 3
## 7 31 31 31 31 31 31 313 313 313 3 3 3 3 3 3 3 3 3 3
## 8 31 31 31 31 31 31 312 312 312 3 3 3 3 3 3 3 3 3 3
## 9 31 31 31 31 31 31 311 311 311 3 3 3 3 3 3 3 3 3 3
## 10 2 2 2 2 2 2 2 2 2 233 233 233 23 23 23 23 23 23 2
## 11 2 2 2 2 2 2 2 2 2 232 232 232 23 23 23 23 23 23 2
## 12 2 2 2 2 2 2 2 2 2 231 231 231 23 23 23 23 23 23 2
## 13 2 2 2 2 2 2 2 2 2 22 22 22 223 223 223 22 22 22 2
## 14 2 2 2 2 2 2 2 2 2 22 22 22 222 222 222 22 22 22 2
## 15 2 2 2 2 2 2 2 2 2 22 22 22 221 221 221 22 22 22 2
## 16 2 2 2 2 2 2 2 2 2 21 21 21 21 21 21 213 213 213 2
## 17 2 2 2 2 2 2 2 2 2 21 21 21 21 21 21 212 212 212 2
## 18 2 2 2 2 2 2 2 2 2 21 21 21 21 21 21 211 211 211 2
## 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 133
## 20 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 132
## 21 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 131
## 22 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 12
## 23 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 12
## 24 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 12
## 25 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 11
## 26 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 11
## 27 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 11
## 132 131 123 122 121 113 112 111
## 1 3 3 3 3 3 3 3 3
## 2 3 3 3 3 3 3 3 3
## 3 3 3 3 3 3 3 3 3
## 4 3 3 3 3 3 3 3 3
## 5 3 3 3 3 3 3 3 3
## 6 3 3 3 3 3 3 3 3
## 7 3 3 3 3 3 3 3 3
## 8 3 3 3 3 3 3 3 3
## 9 3 3 3 3 3 3 3 3
## 10 2 2 2 2 2 2 2 2
## 11 2 2 2 2 2 2 2 2
## 12 2 2 2 2 2 2 2 2
## 13 2 2 2 2 2 2 2 2
## 14 2 2 2 2 2 2 2 2
## 15 2 2 2 2 2 2 2 2
## 16 2 2 2 2 2 2 2 2
## 17 2 2 2 2 2 2 2 2
## 18 2 2 2 2 2 2 2 2
## 19 133 133 13 13 13 13 13 13
## 20 132 132 13 13 13 13 13 13
## 21 131 131 13 13 13 13 13 13
## 22 12 12 123 123 123 12 12 12
## 23 12 12 122 122 122 12 12 12
## 24 12 12 121 121 121 12 12 12
## 25 11 11 11 11 11 113 113 113
## 26 11 11 11 11 11 112 112 112
## 27 11 11 11 11 11 111 111 111