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]]

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]]

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

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]]

ヒストグラム

2008-03-20T09:03:10+09:00

x <- rnorm(50) hist(x, freq=F) rug(x) lines(density(x)) #win.graph() histogram(x, type="density", panel=function(x, ...) { panel.histogram(x, ...) panel.densityplot(x, ...) panel.rug(x, ...) }) *参照 [[R]]

癌研分布の確認

2008-01-19T17:01:50+09:00

# 各変数の分布の検討 .gcm <- gcmstr[gcmstr$use, c("AGE","AGEG","SEX","FOL_MON","FOL_DAY","FOL_DAY2","OPEY","EVENT", "HEIGHTS","WEIGHT","BMI", "ALIVE5")] # 患者背景 lapply(.gcm[,c("AGE","AGEG","SEX","HEIGHTS","WEIGHT","BMI","OPEY")], summary) lapply(.gcm[,c("AGE","HEIGHTS","WEIGHT","BMI")], sd, na.rm=T) par(mfrow=c(2,2)) lapply(.gcm[,c("AGE","HEIGHTS","WEIGHT","BMI")], hist) splom(~ .gcm[c("AGE","HEIGHTS","WEIGHT","BMI")]) # 患者背景（年代ごと） .res <-by(.gcm, .gcm$OPEY, FUN=function(data1) { list( lapply(data1[,c("AGE","AGEG","SEX","HEIGHTS","WEIGHT","BMI")], summary), lapply(data1[,c("AGE","HEIGHTS","WEIGHT","BMI")], sd, na.rm=T) ) }) print(.res) require(lattice) histogram(~AGE | OPEY, .gcm) histogram(~HEIGHTS | OPEY, .gcm) histogram(~WEIGHT | OPEY, .gcm) histogram(~BMI | OPEY, .gcm) splom(~ .gcm[c("AGE","HEIGHTS","WEIGHT","BMI")] | OPEY, data=.gcm) # 生存時間 lapply(.gcm[,c("FOL_MON","FOL_DAY","FOL_DAY2")], summary) l

癌研胃癌データベース

2008-01-19T16:59:04+09:00

#contents() #hr() *作業ログ -[[Excel データを R のデータフレームに>http://d.hatena.ne.jp/Fumi/20080115/p3]] -体重、身長の外れ値処理 --3 例除外 -変数追加 --打ち切りを欠測とした生存日数（回帰分析用） --5 年生存の 0/1 変数（5 年以内打ち切りは欠測） -生存時間 FOL_MON, FOL_DAY --負になっているレコードあり --FOL_DAY も 0 のレコードあり -[[分布の確認>癌研分布の確認]] #hr() *今後の予定 -データを眺める -線形回帰分析 --対比 --予測 --ブートストラップ --MI --補間 --残差分析 -ロジスティック回帰分析 -生存時間解析 --Cox 回帰 --Kaplan-Meier -混合効果モデル解析 -ANN -TREE モデル #hr() #amazon(4307202201,image)