mD_JPH {lazy.symbolic} | R Documentation |
スカラー関数の行列に関する微分
Description
英語のヘルプファイルは: mD
Arguments
expr |
X_ のスカラー関数を含む式または文字列 |
X_ |
微分対象の変数 |
sym |
= 1 の場合、 |
simplify |
= 0 結果を簡約化しない |
trace_chain |
= TRUE の場合、適用された規則の履歴を表示 |
print |
= 1 結果を表示 |
debug |
= 1 中間結果を表示 |
Details
この関数は mD0
を呼び出すラッパーです。
入力の前処理と出力の後処理を行います。
結果を数値的に確認するには、
gramdmn
および gradma
関数を使用します。(下記例参照)
現在、入力として利用できるのは tr
と det
のみです。
式の中に diag(X_)
を含めることは出来ません。
simplify=1
が指定された場合、
Expand
、distribute_t
、remove_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 ]