目的

数量化 IV 類による分析を行う

使用法

qt4(s)
print.qt4(obj, ax=res$ax, digits=5)
plot.qt4(obj, text.cex=0.7, ...)

引数

s         類似度行列（正方行列，対称行列でなくてもよい）
ax        出力する次元数
digits    結果の出力桁数
text.cex  ラベルのフォントの大きさ
...        plot への引数

ソース

インストールは，以下の 1 行をコピーし，R コンソールにペーストする
source("http://aoki2.si.gunma-u.ac.jp/R/src/qt4.R", encoding="euc-jp")

# 数量化 IV 類
qt4 <- function(s)                                   # 類似度行列
{
        if (is.data.frame(s)) {
                s <- as.matrix(s)
        }
        n <- nrow(s)                                 # 行列のサイズ
        object.names <- colnames(s)
        if (is.null(object.names)) {
                object.names <- paste("対象", 1:n, sep="")
        }
        h <- s+t(s)                                  # 転置行列との和を計算して，
        diag(h) <- 0                                 # 対角要素を 0 にする
        diag(h) <- -rowSums(h)                               # 行和を求めて新たな対角要素とする
        res <- eigen(h)                                      # 固有値固有ベクトルを求める
        values <- res$values[res$values > 1e-5]              # 固有値が 0.00001 以上のものを解とする
        ax <- length(values)                         # 解の個数
        vectors <- res$vectors[,1:ax]                        # 固有ベクトル
        colnames(vectors) <- names(values) <- paste("解", 1:ax, sep="") # 名前を付ける
        rownames(vectors) <- object.names            # 名前を付ける
        return(structure(list(ax=ax, n=n, values=values, vectors=vectors), class="qt4"))
}
# print メソッド
print.qt4 <- function(       res,                            # princo が返すオブジェクト
                        ax=res$ax,                      # 何次元までの解を出力するか
                        digits=5)                       # 表示桁数
{
        ax <- min(ax, res$ax)
        val <- res$values
        val2 <- val/sum(val)
        val <- rbind(val, val2, cumsum(val2))
        rownames(val) <- c("固有値", "寄与率", "累積寄与率")
        print(round(val[, 1:ax], digits=digits))
        cat("\nベクトル\n\n")
        print(round(res$vectors[, 1:ax], digits=digits))
}
# plot メソッド
plot.qt4 <- function(        res,                            # princo が返すオブジェクト
                        text.cex=0.7,                   # ラベルのフォントの大きさ
                        ...)                            # plot への引数
{
        if (res$ax >= 2) {                              # 二次元以上の解が得られたら，
                plot(res$vectors[,1:2], ...)            # 二次元の図を描く
                abline(v=0, h=0)
                old <- par(xpd=TRUE)
                text(res$vectors[,1], res$vectors[,2], rownames(res$vectors), pos=4, offset=.2, cex=text.cex)
                par(old)
        }
        else {
                warning("解が一次元なので，二次元配置図は描けません。")
        }
}


使用例

> s <- matrix(c(	# 4行4列の類似度行列例（ファイルから読んでも良い）
	0, -3, -5, -1,
	-1, 0, -2, -3,
	-2, -3, 0, -2,
	-3, -4, -1, 0
), byrow=TRUE, ncol=4)

> ( a <- qt4(s) )
                解1      解2      解3
固有値     23.14960 21.17475 15.67565
寄与率      0.38583  0.35291  0.26126
累積寄与率  0.38583  0.73874  1.00000

ベクトル

           解1      解2      解3
対象1 -0.38519  0.62299 -0.46206
対象2 -0.60147 -0.52910  0.32907
対象3  0.53280 -0.45162 -0.51202
対象4  0.45386  0.35773  0.64501

インストールは，以下の 1 行をコピーし，R コンソールにペーストする
source("http://aoki2.si.gunma-u.ac.jp/R/src/similarity.matrix.R", encoding="euc-jp")

# データ行列から類似度行列を作る
similarity.matrix <- function(       dat,                            # データ行列
                                power=1,                        # 距離のべき乗数（ユークリッド二乗距離なら 2 を指定）
                                ...)                            # dist 関数への引数（距離の種類などの指定）
{
        d <- as.matrix(dist(dat, ...))
        if (power != 1) {
                d <- d^power
        }
        d <- -d
        diag(d) <- 0
        return(d)
}


# plot メソッドでグラフ表示する

> a <- similarity.matrix(iris[1:4], method="minkowski")
> b <- qt4(a)
> plot(b, col=(1:3)[as.integer(iris[,5])])
> plot(b, col=(1:3)[as.integer(iris[,5])], xlim=c(-0.025, 0.1), ylim=c(-0.03, 0.0), cex=0.6)

　　　　　全体


　　　　　中心部拡大



 解説ページ