mD_JPH {lazy.symbolic}R Documentation

スカラー関数の行列に関する微分

Description

英語のヘルプファイルは: mD

Arguments

expr

X_ のスカラー関数を含む式または文字列

X_

微分対象の変数

sym

= 1 の場合、X_ は対称行列とみなす

simplify

= 0 結果を簡約化しない

trace_chain

= TRUE の場合、適用された規則の履歴を表示

print

= 1 結果を表示

debug

= 1 中間結果を表示

Details

この関数は mD0 を呼び出すラッパーです。 入力の前処理と出力の後処理を行います。

結果を数値的に確認するには、
gramdmn および gradma
関数を使用します。(下記例参照)

現在、入力として利用できるのは trdet のみです。
式の中に diag(X_) を含めることは出来ません。

simplify=1 が指定された場合、
Expanddistribute_tremove_paren
が結果の簡約化に使用されます。

Value

X_ に関するスカラー関数の一階導関数を文字列として返す

Examples


# we need this.
modify_math_operators()

mD("tr(X)","X")
mD("tr(A%*%X)","X")
mD("tr(A%*%t(X))","X")
mD("tr(X%*%A)","X")
mD("tr(t(X)%*%A)","X")
mD("tr(A%*%t(X)%*%B%*%X%*%C)","X")
mD("tr(A%*%X%*%B%*%X%*%C)","X")

mD("tr(A%*%inv(X))","X")
mD("tr(A%*%inv(t(X)))","X")
mD("tr(A%*%inv(B%*%X%*%C)%*%D)","X")
mD("tr(A%*%inv(t(X)%*%B%*%X)%*%C)","X")

mD("tr(Diag(t(X)%*%X))","X")
mD("tr(A%*%(Diag(t(X)%*%C%*%X))%*%B)","X")

mD("tr((X%.%B))","X")
mD("tr(A%*%(X%.%B)%*%C)","X")
mD("tr((t(X)%.%X))","X")
mD("tr(A%*%(t(X)%.%B%.%X)%*%C)","X")

mD("det(X)","X")
mD("det(t(X))","X")
mD("det(A%*%X)","X")

# symmetric X
mD("tr(A%*%X)", "X", sym=1)
mD("tr(t(X)%*%A%*%X)", "X", sym=1)



## Not run: 
 # 以下はコピペで動かしてみてください。.

 # 数値的検証の例。

 # 逆行列: tr(A%*%inv(t(X)%*%B%*%X)%*%C)
 expr <- "tr(A%*%inv(t(X)%*%B%*%X)%*%C)"
 dexpr <- mD(expr,"X")
 printm(dexpr)
 nvar1 <- 2; nvar2 <- 3
 set.seed(1701)
 Xn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 An <- matrix(rnorm(nvar2*nvar1),nvar2,nvar1)
 Bn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 Cn <- matrix(rnorm(nvar1*nvar2),nvar1,nvar2)
 values <- "X=Xn; A=An; B=Bn; C=Cn"
 Ga <- 0; Gn <- 9999
 Ga <- gradma( expr, dexpr=dexpr, values=values)
 Gn <- gradmn( expr, values=values)
 printm(Ga,Gn)
 printm(max(abs(Ga-Gn))/mean(abs(Gn)))


 # アダマール積: tr(A%*%(t(X)%.%C%.%X)%*%B)
 expr <- "tr(A%*%(t(X)%.%C%.%X)%*%B)"
 dexpr <- mD(expr, "X")
 printm(dexpr)
 nvar1 <- 2; nvar2 <- 3
 set.seed(1701)
 Xn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 An <- matrix(rnorm(nvar2*nvar1),nvar2,nvar1)
 Bn <- matrix(rnorm(nvar1*nvar2),nvar1,nvar2)
 Cn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 values <- "X=Xn; A=An; B=Bn; C=Cn; D=Dn"
 rm(Ga,Gn)
 Ga=Eval(dexpr, values=values, fullsymb=1)
 Gn=gradmn( expr, values=values )
 printm(Ga,Gn)
 printm(max(abs(Ga-Gn))/mean(abs(Gn)))


 # 行列式: det(A%*%X%*%B)+det(C%*%t(X)%*%D)
 expr <- "det(A%*%X%*%B)+det(C%*%t(X)%*%D)"
 dexpr <- mD(expr,"X")
 printm(dexpr)
 nvar1 <- 3
 set.seed(1701)
 Xn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 An <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 Bn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 Cn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 Dn <- matrix(rnorm(nvar1*nvar1),nvar1,nvar1)
 values <- "X=Xn; A=An; B=Bn; C=Cn; D=Dn"
 Ga <- 0; Gn <- 9999
 Ga <- gradma( expr, dexpr=dexpr, values=values)
 Gn <- gradmn( expr, values=values)
 printm(Ga,Gn)
 printm(max(abs(Ga-Gn))/mean(abs(Gn)))



# Some complex examples

# 重み付き多変量重回帰分析
rss <- ssq("Y-X%*%B", U="W", V="V", expand=2) |> printm()

# differantiate rss w.r.t the regression coefficient matrix B.
dexpr <- mD(rss, "B", trace_chain=1, print=1)
printm(dexpr)
# numerical checking by gradma and gradmn functions
set.seed(1701)
n <- 5; ny <- 4; nx <- 3
Vn <- diag(ny)*2
Wn <- diag(n)*3
Xn <- matrix(rnorm(n*nx),n,nx)
Bn <- matrix(rnorm(nx*ny),nx,ny)
Yn <- matrix(rnorm(n*ny),n,ny)
values <- c("B=Bn; Y=Yn; X=Xn; V=Vn; W=Wn")#'
Ga <- 0; Gn <- 9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))


# 重み付き冗長性分析(縮小ランク回帰分析)
rss <- ssq("Y-X%*%A%*%t(B)", U="W", V="V", expand=2) |> printm()

# differantiate rss w.r.t the regression coefficient matrix B.
dexpr <- mD(rss, "A", trace_chain=1, print=1)
printm(dexpr)
# numerical checking by gradma and gradmn functions
set.seed(1701)
n <- 5; ny <- 4; nx <- 3; ndim <- 2
Vn <- diag(ny)*2
Wn <- diag(n)*3
Xn <- matrix(rnorm(n*nx),n,nx)
An <- matrix(rnorm(nx*ndim),nx,ndim)
Bn <- matrix(rnorm(ny*ndim),ny,ndim)
Yn <- matrix(rnorm(n*ny),n,ny)
values <- c("A=An; B=Bn; Y=Yn; X=Xn; V=Vn; W=Wn")#'
Ga <- 0; Gn <- 9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))

dexpr <- mD(rss, "B", trace_chain=1, print=1)
printm(dexpr)
# numerical checking by gradma and gradmn functions
values <- c("B=Bn; A=An; Y=Yn; X=Xn; V=Vn; W=Wn")#'
Ga <- 0; Gn <- 9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))




# 因子分析の最小2乗解
rss <- ssq("S-(L%*%Phi%*%t(L)+Psi)", expand=2)

# d ssq / d L
dexpr <- mD(rss,"L", trace_chain=1, print=1)
printm(dexpr)
set.seed(1701)
nvar <- 3; ndim <- 2
Ln <- matrix(rnorm(nvar*ndim),nvar,ndim)
Phin <- matrix(runif(ndim*ndim),ndim,ndim)
Phin <- (Phin+t(Phin))/2; Phin <- Phin-Diag(Phin)+diag(ndim)
Psin <- diag(nvar) / 10
Sn <- matrix(runif(nvar*nvar),nvar,nvar); Sn=(Sn+t(Sn))/2; diag(Sn)=1
values <- "L=Ln; Phi=Phin; Psi=Psin; S=Sn"
Ga <- 0; Gn <- 9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))

# d ssq / d Phi
dexpr <- mD(rss,"Phi", print=1)
printm(dexpr)
values <- "Phi=Phin; L=Ln; Psi=Psin; S=Sn"
Ga <- 0; Gn=9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))

# d ssq / d Psi
dexpr <- mD(rss,"Psi", print=1)
printm(dexpr)
values <- "Psi=Psin; Phi=Phin; L=Ln; S=Sn"
Ga <- 0; Gn <- 9999
Ga <- gradma( rss, dexpr=dexpr, values=values)
Gn <- gradmn( rss, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))



# 因子分析の最尤解
expr1 <- "tr(inv(L%*%Phi%*%t(L)+Psi)%*%S)"
expr2 <- "log(det(inv(L%*%Phi%*%t(L)+Psi)%*%S))"
F <- expr1+expr2

# d F / d L
dexpr <- mD(F,"L")
printm(dexpr)
set.seed(1701)
nvar <- 3; ndim <- 2
Ln <- matrix(rnorm(nvar*ndim),nvar,ndim)
Phin <- matrix(runif(ndim*ndim),ndim,ndim)
Phin <- (Phin+t(Phin))/2; Phin <- Phin-Diag(Phin)+diag(ndim)
Psin <- diag(nvar) / 10
Sn <- matrix(runif(nvar*nvar),nvar,nvar); Sn=(Sn+t(Sn))/2; diag(Sn)=1
values <- "L=Ln; Phi=Phin; Psi=Psin; S=Sn"
Ga <- 0; Gn <- 9999
Ga <- gradma( F, dexpr=dexpr, values=values)
Gn <- gradmn( F, values=values)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))


# d F / d Phi
dexpr <- mD(F,"Phi", sym=1)
printm(dexpr)
values <- "Phi=Phin; L=Ln; Psi=Psin; S=Sn"
Ga <- 0; G <- 9999
Ga <- gradma( F, dexpr=dexpr, values=values)
Gn <- gradmn( F, values=values, sym=1)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))


# d F / d Psi
dexpr <- mD(F,"Psi", sym=1)
printm(dexpr)
values <- "Psi=Psin; Phi=Phin; L=Ln; S=Sn"
Ga <- 0; G <- 9999
Ga <- gradma( F, dexpr=dexpr, values=values)
Gn <- gradmn( F, values=values, sym=1)
printm(Ga,Gn)
printm(max(abs(Ga-Gn))/mean(abs(Gn)))



## End(Not run)



[Package lazy.symbolic version 1.0.0.20250830 ]