分割表を標準化自由度次元正単体座標表現する
- 予定パッケージ名
- 関数名
- RegularSpherize
- タイトル
RegularSpherize
- 説明
周辺度数を共有する分割表は、ピアソンのカイ二乗統計量の 平方根をノルムとする、自由度次元空間上の点に対応付けることができる。 その対応付けを行う関数
- 使用例
RegularSpherize(O)
- ソース
RegularSpherize<- function (O = matrix(round(runif(2 * 3) * 100, 0), 2, 3)) { EandM <- tableExpAndMarginals(O) N <- length(O[, 1]) M <- length(O[1, ]) E <- EandM$etable D <- EandM$dtable K <- sum(D^2/E) X <- CategoryVector2D(N, M) P <- dfCoordinate(D) V <- EllipseChiMatrix(E) Xe <- X/c(t(sqrt(E))) EigenOut <- eigen(V) U <- EigenOut$vectors Ui <- solve(U) Pi <- Ui %*% P Mi <- diag(sqrt(EigenOut$values)) if (length(EigenOut$values) == 1) { Mi <- matrix(1, 1, 1) } Pii <- Mi %*% Pi list(O = O, E = E, D = D, K = K, X = X, V = V, Xe = Xe, P = P, EigenOut = EigenOut, Ui = Ui, Mi = Mi, Pi = Pi, Pii = Pii) }
- Rdファイル
\name{RegularSpherize} \alias{RegularSpherize} %- Also NEED an '\alias' for EACH other topic documented here. \title{ RegularSpherize } \description{ 周辺度数を共有する分割表は、ピアソンのカイ二乗統計量の 平方根をノルムとする、自由度次元空間上の点に対応付けることができる。 その対応付けを行う関数 } \usage{ RegularSpherize(O) } \arguments{ \item{O}{NxM 観察テーブル行列} } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ \item{O}{観察テーブルの行列} \item{E}{期待値テーブルの行列} \item{D}{観察-期待値の差分テーブルの行列} \item{K}{Pearson's カイ二乗値} \item{X}{2次元カテゴリベクター} \item{V}{K=D^tVDを満足する行列} \item{Xe}{期待値の逆数ベクトルを対角成分とする対角行列} \item{P}{観測テーブルの標準化前の自由度次元座標} \item{EigenOut}{eigen(V)の結果} \item{Ui}{Vの特異値分解後回転行列} \item{Mi}{Vの特異値分解後拡縮成分の平方根} \item{Pi}{観測テーブルの自由度次元座標の回転後座標} \item{Pii}{観測テーブルの標準化自由度次元正単体座標系座標} } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ O<-matrix(3,4) RegularSpherize(O) }
カイ二乗値の等しいテーブルを作る
- 予定パッケージ名
- 関数名
- makeTblSameChiNM
- タイトル
makeTblSameChiNM
- 説明
観測テーブルを与え、それと周辺度数を同じくするテーブルで、指定のカイ二乗値をとるテーブルを指定個作成する
- 使用例
makeTblSameChiNM (O,k,N)
- ソース
makeTblSameChiNM <- function (O = matrix(c(10, 20, 30, 40, 50, 60), nrow = 2, byrow = TRUE), k = 1, N = 1000) { m1 <- apply(O, 1, sum) m2 <- apply(O, 2, sum) ms <- sum(O) E <- outer(m1, m2, FUN = "*")/ms D <- O - E K <- sum(D^2/E) A <- matrix(runif(length(O) * N), nrow = N) A <- t(apply(A, 1, FUN = "standardizeNMfromLine", nrow = length(O[, 1]), byrow = TRUE)) Kp <- sqrt(apply(t(t(A^2)/c(t(E))), 1, FUN = "sum")) t(t(A/Kp * sqrt(K) * k) + c(t(E))) }
- Rdファイル
\name{makeTblSameChiNM } \alias{makeTblSameChiNM } %- Also NEED an '\alias' for EACH other topic documented here. \title{ makeTblSameChiNM } \description{ 観測テーブルを与え、それと周辺度数を同じくするテーブルで、指定のカイ二乗値をとるテーブルを指定個作成する } \usage{ makeTblSameChiNM (O,k,N) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ (N-1)x(M-1)ベクトル } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ N<-3 M<-4 O<-matrix(sample(10:50,N*M,replace=TRUE),N,M) tableExpAndMarginals(O) A<-makeTblSameChiNM(O) plot3d(A[,1],A[,2],A[,3]) plot(as.data.frame(A)) }
自由度次元空間座標を算出する
- 予定パッケージ名
- 関数名
- dfCoordinate
- タイトル
dfCoordinate
- 説明
自由度次元座標を算出する
- 使用例
dfCoordinate(O,Obs=TRUE)
- ソース
dfCoordinate <- function (D, Obs = FALSE) { if (Obs) { D <- tableExpAndMarginals(D)$dtable } X <- CategoryVector2D(length(D[, 1]), length(D[1, ])) (length(D[, 1]) - 1) * (length(D[1, ]) - 1)/(length(D[, 1]) * length(D[1, ])) * c(t(X) %*% matrix(c(t(D)), length(D), 1)) }
- Rdファイル
\name{dfCoordinate} \alias{dfCoordinate} %- Also NEED an '\alias' for EACH other topic documented here. \title{ dfCoordinate } \description{ 自由度次元座標を算出する } \usage{ dfCoordinate(O,Obs=TRUE) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ (N-1)x(M-1)ベクトル } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ N<-3 M<-4 O<-matrix(sample(10:50,N*M,replace=TRUE),N,M) dfCoordinate(O,Obs=TRUE) }
周辺度数を同じくする表を作る
- 予定パッケージ名
- 関数名
- makeSameMargMatrix
- タイトル
makeSameMargMatrix
- 説明
差分表を作る
- 使用例
makeSameMargMatrix(O)
- ソース
makeSameMargMatrix <- function (O, c = 1) { E <- tableExpAndMarginals(O)$etable diff <- makeDiffMatrix(length(O[, 1]), length(O[1, ]), c) E + diff }
- Rdファイル
\name{makeSameMargMatrix} \alias{makeSameMargMatrix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ makeSameMargMatrix } \description{ 差分表を作る } \usage{ makeSameMargMatrix(O) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ NxM行列 } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ N<-3 M<-4 makeDiffMatrix(N,M,c=1) }
差分を作る
- 予定パッケージ名
- 関数名
- makeDiffMatrix
- タイトル
makeDiffMatrix
- 説明
差分表を作る
- 使用例
makeDiffMatrix(N,M,c)
- ソース
makeDiffMatrix <- function (N, M, c = 1) { library(MCMCpack) testm <- matrix(rdirichlet(1, rep(1, N * M)), nrow = N) * c testm <- testm - sum(testm)/(N * M) m1 <- apply(testm, 1, sum)/M m2 <- apply(testm, 2, sum)/N testm <- testm - m1 testm <- t(t(testm) - m2) testm }
- Rdファイル
\name{makeDiffMatrix} \alias{makeDiffMatrix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ makeDiffMatrix } \description{ 差分表を作る } \usage{ tableExpAndMarginals(O) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ NxM行列 } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ N<-3 M<-4 makeDiffMatrix(N,M,c=1) }
観測表の周辺度数と期待値表を作る
- 予定パッケージ名
- 関数名
- tableExpAndMarginals
- タイトル
tableExpAndMarginals
- 説明
2次元分割表の周辺度数と期待値表を計算する
- 使用例
tableExpAndMarginals(O)
- ソース
tableExpAndMarginals<- function (O = matrix(round(runif(N * M) * 100, 0), N, M)) { mrow <- apply(O, 1, sum) mcol <- apply(O, 2, sum) total <- sum(mrow) etable <- outer(mrow, mcol, FUN = "*")/total list(mrow = mrow, mcol = mcol, total = total, etable = etable, dtable = O - etable, df = (length(mrow) - 1) * (length(mcol) - 1)) }
- Rdファイル
\name{tableExpAndMarginals} \alias{tableExpAndMarginals} %- Also NEED an '\alias' for EACH other topic documented here. \title{ tableExpAndMarginals } \description{ 2次元分割表の周辺度数と期待値表を計算する } \usage{ tableExpAndMarginals(O) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ \item{mrow}{行の周辺度数} \item{mcol}{列の周辺度数} \item{total}{全標本数} \item{etable}{期待値表} \item{dtable}{観測値と期待値の差分表} \item{df}{自由度} } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ N<-3 M<-4 O<-matrix(sample(10:50,N*M,replace=TRUE),N,M) tableExpAndMarginals(O) }
順序なしカテゴリのN個の軸が作る多次元分割表の空間配置
- 予定パッケージ名
- 関数名
- CategoryVectorND
- タイトル
CategoryVectorND
- 説明
N1xN2x...xNkテーブルは(N1-1)x(N2-1)x...x(Nk-1)自由度。N1xN2x...xNkテーブルを(N1-1)x(N2-1)x...x(Nk-1)次元空間上の点に対応付ける
- 使用例
v<-c(3,4,5) CategoryVectorND(v)
- ソース
CategoryVectorND<-function(v=c(2,3,4)){ cvs<-NULL for(i in 1:length(v)){ cvs[[i]]<-CategoryVector(v[i]) } mm<-NULL counter<-rep(0,length(v)) loop<-TRUE cnt<-1 ns<-NULL while(loop){ ns[[cnt]]<-counter+1 tmp<-cvs[[1]][counter[1]+1,] for(i in 2:length(v)){ tmp<-outer(tmp,cvs[[i]][counter[i]+1,],"*") } mm[[cnt]]<-c(tmp) #print(counter) cnt<-cnt+1 counter<-counterplus(counter,v) if(sum(counter)==0){ loop<-FALSE } } list(ind=ns,coords=mm) }
- Rdファイル
\name{CategoryVectorND} \alias{CategoryVectorND} %- Also NEED an '\alias' for EACH other topic documented here. \title{ CategoryVectorND } \description{ N1xN2x...xNkテーブルは(N1-1)x(N2-1)x...x(Nk-1)自由度。N1xN2x...xNkテーブルを(N1-1)x(N2-1)x...x(Nk-1)次元空間上の点に対応付ける } \usage{ v<-c(3,4,5) CategoryVectorND(v) } %- maybe also 'usage' for other objects documented here. \details{ %% ~~ If necessary, more details than the description above ~~ } \value{ \item{ind}{軸のカテゴリ番号を表すベクトル} \item{coords}{位置座標} } \references{ %% ~put references to the literature/web site here ~ } \author{ %% ~~who you are~~ } \note{ %% ~~further notes~~ } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ } \examples{ v<-c(3,4) xx<-CategoryVectorND(v) # 位置座標を行列にする xx2<-matrix(unlist(xx$coords),ncol=prod(v-1),byrow=TRUE) dim(xx2) # CategoryVector2Dにはv[2],v[1]の順に値を与えると、同一の結果が返る yy<-CategoryVector2D(v[2],v[1]) yy-xx2 }
- 参考
- ベクトルの成分を算出するだけであれば、outer積の繰り返しのみで可能
CategoryVectorND2<-function(v=c(2,3,4)){ cvs<-NULL for(i in 1:length(v)){ cvs[[i]]<-CategoryVector(v[i]) } mm<-cvs[[1]] for(i in 2:length(v)){ mm<-outer(mm,cvs[[i]],"*") } mm }