ユーザー定義関数
じぶんで関数をつくってみよう。
関数名 <- function(引数1, 引数2, ... ){
記述
return(オブジェクト)
}
以下、簡単な関数の例
# クリップボードにコピーしたExcelのデータ (含変数名。 or タブ区切りテキスト) をRのオブジェクトに付置する関数。
read.c <- function(x) {
read.delim("clipboard")
}
# 使い方
# 事前に何かデータをコピーしておく
dat <- read.c()
dat
関数については Rの関数定義の基本 を参照。
自分が定義した関数を最初から使えるようにするにはn 起動のカスタマイズ を参照。
自作関数のリスト
source("http://eau.uijin.com/management/images/aor.functions.r")
Astat(): carパッケージ、Anova関数の結果オブジェクトを整形。
dn(): データフレームの変数名を列挙
datcheck(): データのチェック。各変数の記述統計やら度数を集計する。主にリッカート尺度用。
read.c(): クリップボードのExcelデータを読みこむ。
corstars2: 相関係数の表を出力
des: psychパッケージのdescribe関数を書き換えてoptions(digits=) の小数点以下表示設定を反映するようにした
dimhead: dimとhead
pwr.f2.test2: pwr.f2.testの修正。サンプルサイズの入力必須。
multi.plot データフレームの散布図。psychパッケージのmulti.histの散布図版
kr20: Kuder-Richardson's formula 20
sem.aic2: semパッケージ、sem関数のオブジェクトからAICを計算。
cprp: 合計欄なしの2元の集計表を渡して、合計、行パーセント、列パーセント、全体パーセントを計算
Rでvlookup
# rvlookupの中身
rvlookup <- function(index, range, colno) { # Excelの真似。検索値、範囲、列番号。
# indexがベクトルかどうか。ベクトルならOK、データフレームなら1列目を取り出してiiに付置する。
if(is.vector(index)) {
index <- as.character(index)
} else if (is.data.frame(index)) {
index <- as.character(index[,1])
}
ii <- data.frame(index, idno=1:length(index)) # 検索値。ベクトルを与える。
names(ii)[1] <- "id"
rr <- range # データのリスト。Excelのvlookupどおり一番左の1列目をキーにする。
names(rr)[1] <- "id"
colno <- colno+1 # データリストのうち、検索したいデータの列番号
x <- merge(ii, rr, by="id", all.x=T, sort=F)
res <- x[,colno]
return(res[order(x$idno)])
}
# サンプルデータ。datlist=商品一覧、datest=見積書。
# 参考：http://www.eurus.dti.ne.jp/yoneyama/Excel/kansu/vlookup2.htm。
datlist <- data.frame(
no = c("a01", "b01", "c01"),
iname = c("tv", "radio", "video"),
price = c(50000, 5000, 20000)
)
datest <- data.frame(
no = c("b01", "c01", "a01")
)
datlist
datest
# datestのnoにあてはまる値段（price）をdatlistから検索してくる。
rvlookup(datest, datlist, 3)
# 単に結合したい場合はmergeを使う。ただしsortオプションはdatestに同じ名前のキーが複数あるとうまく機能しないので注意。
merge(datest, datlist, by="no", all.x=T, sort=F)
# うまくいかない例
x <- rbind(datest, datest)
merge(x, datlist, by="no", all.x=T, sort=F) # ソートされてしまう。
# ソートの回避
x <- data.frame(x, idno=1:nrow(x)) # 最初に番号をつけておき、並べ替える。
res2 <- res[order(res$idno),]
res2
リストをデータフレームにする
listtodf <- function (x) {
lst <- x
xx <- lapply(lst, function(a) t(data.frame(a)))
## 各要素がtableのときはdata.frameではなくas.vectorにする
n <- length(xx)
temp <- xx[[1]]
for (i in 2:n) {
temp <- merge(temp, xx[[i]], all=T, sort=F)
}
res <- temp
rownames(res) <- names(lst)
res
return(res)
}
# 例示データ
x <- c(A=1,B=2)
y <- c(A=66,B=77, C=88)
z <- c(A=100,C=200)
lst <- list(x,y,z)
names(lst) <- c("x", "y", "z")
lst # 要素数の違うリスト
listtodf(lst)
グループごと（因子変数ごと）に相関関係の散布図をプロット
plotgr <- function(x,y,gr) {
x <- x; y <- y
grf <- as.factor(gr) # グループ変数を因子に
grc <- as.character(gr) # グループ変数を文字列に
grlv <- levels(grf) # グループの水準名ベクトル
ngr <- nlevels(grf) # グループの水準数
colff <- rainbow(ngr) # 水準数分の色名生成
colv <- grc # 色名格納用ベクトル
for (i in 1:ngr) {
colv[grc==grlv[i]] <- colff[i] # 色名ベクトル生成。長さはグループ変数と同じ。
}
plot(x, y, pch=16, col=colv)
legend("topright", legend=grlv, col=colff, pch=16)
}
# 例示データ
x <- c(seq(-3,3,(6/9)), rnorm(60))
y <- c(1:10, rnorm(50),rep(4,10))
gr <- rep(c("a", "b", "c", "d", "e", "f", "g"), each=10)
dev.off()
plotgr(x,y,gr) # aは正比例、gは変化なし
グループごとに別々のグラフで散布図を描く
plotsp <- function(x,y,gr, xnm="x", ynm="y") {
xnm <- xnm
ynm <- ynm
gr <- factor(gr)
ngr <- nc <- nlevels(gr)
ncr <- ceiling(sqrt(nc))
ncc <- ncr
nms <- levels(gr)
par(mfrow=c(ncr, ncc))
for (i in 1:ngr) {
xx <- x[gr==nms[i]]
yy <- y[gr==nms[i]]
crres <- cor.test(xx,yy)
plot(xx, yy, main=paste(nms[i], ", r = ", round(crres$estimate, 3), ", df = ", crres$parameter, ", p = ", round(crres$p.value, 3), sep=""), xlab=xnm, ylab=ynm)
}
}
# 例示データ
x <- c(seq(-3,3,(6/9)), rnorm(60))
y <- c(1:10, rnorm(50),rep(4,10))
gr <- rep(c("a", "b", "c", "d", "e", "f", "g"), each=10)
dev.off()
plotsp(x,y,gr) # aは正比例、gは変化なし
データフレームの因子変数を文字列に変換用
translatefc <- function(x) {
fnv <- as.vector(unlist(which(sapply(x, class)=="factor")))
for (i in 1:length(fnv)) {
x[,fnv[i]] <- as.character(x[,fnv[i]])
}
return(x)
}
write.cの改良
write.c <- function(x, row.names=FALSE) {
x <- write.table(x=x, "clipboard", sep="\t", row.names=row.names, quote=FALSE)
}
よく使いそうな関数覚書
# formatC(): 一桁数値にゼロをくっつける
x <- 1:20
formatC(x,width=2,flag="0") # ゼロ1個
x <- c(1:20, 101:105)
formatC(x,width=3,flag="0") # ゼロ3個
コード追加用
source("http://eau.uijin.com/about/aorf.R") # ちょっとはずいから白くしておこう。