分割表を標準化自由度次元正単体座標表現する

  • 予定パッケージ名
  • 関数名
    • 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
}