Archives@Wiki

LIBNAMEでExcel

2008-09-01T22:34:15+09:00

* ファイル開いておく; LIBNAME xls "C:\Book1.xls"; * シート名 Sheet1; DATA data1; SET xls.'sheet1$'n; RUN; LIBNAME xls CLEAR; *参照 -[[SAS]]

SAS

2008-09-01T22:32:52+09:00

*[[実用SAS生物統計ハンドブック]] *SAS/GRAPH -[[SAS/GRAPH ファイルへの保存]] *SAS/Access -[[LIBNAMEでExcel]]

lmeでPKモデル

2008-04-06T20:48:44+09:00

*lme で IV 1-コンパートメントモデル -k は正規分布 -V は対数正規分布 -個体内誤差は対数正規分布 -両辺を対数変換すると線形モデルになる require(nlme) set.seed(2801) n <- 50 m <- 5 k <- 0.1 + rnorm(n, mean=0, sd=0.1*0.2) k[k<=0] # check v <- 1 * exp(rnorm(n, mean=0, sd=0.2)) ds <- data.frame( ID=rep(seq(n), each=m), TIME=runif(n*m, min=5/60, max=24), k=rep(k, each=m), v=rep(v, each=m) ) iv1 <- function(TIME, k, v, Dose=1) { Dose / v * exp(-k * TIME) } ds$PRED <- with(ds, iv1(TIME, k, v)) ds$DV <- ds$PRED * exp(rnorm(n*m, sd=0.1)) ds.g <- groupedData(DV ~ TIME | ID, ds, order.groups=F) (fm1 <- lm(log(DV) ~ TIME, ds)) (fm2 <- lme(log(DV) ~ TIME, ds.g, random=pdDiag(form=~1))) (fm3 <- lme(log(DV) ~ TIME, ds.g, random=pdDiag(form=~1+TIME) )) ---- *参照 [[R]]

R

2008-04-06T20:46:38+09:00

*[[Fleiss]] -[[直線回帰 (Fleiss)]] --[[直線回帰の逆予測]] *[[Chow&Liu]] -[[データ Table3.6.1]] *その他 -[[RのTips]] -[[引数 ...]] -[[ヒストグラム]] -[[平均±標準偏差のプロット]] -[[回帰の予測区間のプロット]] -[[latticeプロットの順序]] -[[lmeでPKモデル]]

lmeとnlme

2008-04-05T16:45:11+09:00

*変量効果、個体内誤差のモデリング require(nlme) set.seed(2801) # lme n <- 100 m <- 5 data.lme <- data.frame( ID=rep(seq(n), each=m), TIME=runif(n*m, max=10), k0=rep(10*exp(rnorm(n, sd=0.2)), each=m), k1=rep(1*exp(rnorm(n, sd=0.2)), each=m) ) data.lme$pred <- with(data.lme, k0+k1*TIME) data.lme$y <- data.lme$pred * exp(rnorm(nrow(data.lme), sd=0.1)) summary(fm1 <- lm(y ~ TIME, data.lme)) # 切片のみ。ID 単位で個体間変動を考える summary(fm2 <- lme(y ~ TIME, data.lme, random=list(ID=~1))) # 切片と傾き、独立 summary(fm3 <- update(fm2, random=list(ID=pdDiag(~1+TIME)))) # fm3 = fm4 summary(fm4 <- update(fm2, random=list(ID=pdDiag(~TIME)))) # 切片と傾き、相関あり summary(fm5 <- update(fm2, random=list(ID=pdSymm(~TIME)))) # gls dose <- c(1,2,4,8,16) data.power <- data.frame( ID=rep(seq(6), each=5), dose=rep(dose, 6), cl=rep(1*exp(rnorm(6, sd=0.2)), each=5) ) data.power$auc <- with(data.power, dose*1000/cl) * exp(rnorm(nrow(data.power), sd=0.2)) data.power.g <- groupedData(auc ~ dose | ID, data.power) (fm11 <- gls(auc ~ factor(dose) -1, data.power)) # dose 毎に異なる分散を推定 (fm12 <- update(fm11, weights=varIdent(form=~ 1 | dose))) # ID 内で compound symmetry の相関 (fm13 <- update(fm11, corr=corCompSymm(form=~1 | ID))) # ID 内でフルの相関 (fm14 <- update(fm11, corr=corSymm(form=~1 | ID))) # nlme n <- 50 m <- 5 ccr <- rnorm(n, mean=80, sd=20) bw <- rnorm(n, mean=60, sd=10) cl <- (ccr / 1000 + .01) * exp(rnorm(n, sd=0.2)) vd <- (bw / 60 + 1) * exp(rnorm(n, sd=0.2)) ke <- cl / vd data.ppk <- data.frame( ID=rep(seq(n), each=m), TIME=runif(n*m, min=0.5, max=24), CCR=rep(ccr, each=m), BW =rep(bw, each=m), CL =rep(cl, each=m), V =rep(vd, each=m) ) iv1 <- function(TIME, lCL, lV, Dose=1) { CL <- exp(lCL) V <- exp(lV) Dose / V * exp(-CL/V * TIME) } data.ppk$PRED <- with(data.ppk, iv1(TIME, log(CL), log(V))) data.ppk$DV <- data.ppk$PRED * exp(rnorm(nrow(data.ppk), sd=0.1)) data.ppk.g <- groupedData(DV ~ TIME | ID, data.ppk, order=F, labels=list(x="Time", y="Concentration"), units=list(x="(hr)", y="(ng/mL)") ) # lCL と lV にフルの相関 (fm21 <- nlme(log(DV) ~ log(iv1(TIME, lCL, lV)), data.ppk.g, fixed=list(lCL~1, lV~1), random=(lCL+lV~1), start=c(log(0.1), log(1)) )) # lCL と lV 独立 (fm22 <- update(fm21, random=pdDiag(form=list(lCL~1, lV~1)))) # lCL = TH1 + TH2 * CCR # start での初期値指定では切片が先に来る (fm23 <- update(fm22, fixed=list(lCL~CCR+1, lV~1), start=c(log(0.1), 0, log(1)) )) # lV = TH3 + TH4 * BW (fm24 <- update(fm23, fixed=list(lCL~CCR+1, lV~BW+1), start=c(log(0.1), 0, log(1), 0) )) # ID 単位で CS 構造の個体内相関を考慮 (fm25 <- update(fm22, corr=corCompSymm(form=~1|ID))) # 分散が予測値の 2 乗に比例と仮定 # 2 (=1 * 2) に固定している。 # デフォルトで予測値の a 乗に比例 (fm26 <- update(fm22, weights=varPower(fixed=1)))

トップページ

2008-04-05T16:43:44+09:00

*目次 -[[Fleiss]] -[[Chow&Liu]] -[[Pinheiro&Bates]] -[[癌研胃癌データベース]] -[[R]] -[[SAS]] -[[NONMEM]] -[[lmeとnlme]] ---- *Wiki 内検索 #search()

RのTips

2008-03-26T22:40:31+09:00

summary(lm(...), cor=T) pairs(..., panel=panel.smooth) plot(..., xlab=expression(hat(epsilon)[i])) influence(lm()) rstudent(lm()) cooks.distance() identify(1:50, ginf$coef[,2], coutries) which.max() ---- *参照 [[R]]

latticeプロットの順序

2008-03-23T21:21:36+09:00

*条件付きプロットの順序未完成。index.cond, perm.cond の使い方をもっと調べる必要あり。 xyplot(AUC ~ DOSE | factor(DRUG), ds, scales=list(x=list(log=10), y=list(log=10)), layout=c(2,2), index.cond=list(c(3,4,1,2,7,8,5,6))) ---- *参照 [[R]]

回帰の予測区間のプロット

2008-03-22T16:19:55+09:00

#--- サンプルデータ作成 ---# set.seed(2801) data <- data.frame(x=rep(seq(5), rep(6,5))) data$y <- data$x * 10 + 5 + rnorm(nrow(data), sd=10) #--- 予測したい x の範囲 ---# x.pred <- data.frame(x=seq(1, 6, length=101)) #--- 直線回帰 ---# fm1 <- lm(y ~ x, data) #--- 信頼区間 ---# fm1.conf <- predict(fm1, x.pred, interval="confidence") # 平均値 fm1.pred <- predict(fm1, x.pred, interval="prediction") # 個別 #--- プロット ---# matplot(x.pred, fm1.pred, lty=c(1,2,2), type="l", col="black", xlab="x", ylab="y") points(data$x, data$y) lines(x.pred$x, fm1.conf[,"lwr"], lty=2, col="blue") lines(x.pred$x, fm1.conf[,"upr"], lty=2, col="blue") *参照 [[R]]

平均±標準偏差のプロット

2008-03-22T14:25:56+09:00

#--- 例示用のサンプルデータ作成 ---# set.seed(2801) x <- rep(seq(5), rep(6, 5)) y <- 10 * x + 5 + rnorm(length(x), mean=0, sd=3) #--- X, Y の平均、標準偏差 ---# .mean <- tapply(y, x, mean) .sd <- tapply(y, x, sd) #--- データフレームにまとめる ---# .mean.sd <- data.frame( x=as.numeric(names(.mean)), mean=.mean, msd=.mean-.sd, # 平均 - 標準偏差 psd=.mean+.sd # 平均 + 標準偏差 ) #--- 生値プロット ---# plot(x, y) #--- 平均±標準偏差のプロット ---# plot.mean.sd <- function( data, # 名前付きベクトル x.diff=0, # 平均値を X 軸方向にずらして表示させる際の差分 length=0.1, # エラーバーの上下の横線の幅 cex=1.2 # 平均値シンボルのサイズ ) { x <- data["x"] + x.diff points(x, data["mean"], pch=19, cex=cex) # 平均値を●で arrows( x, data["msd"], x, data["psd"], angle=90, length=length, code=3 ) # エラーバー return(invisible()) } #--- 行単位で処理 ---# apply(.mean.sd, 1, FUN=plot.mean.sd, x.diff=0.1) *参照 [[R]]