CREATE FUNCTION "201405"."12_regression_plr_4"(text[], float, int DEFAULT 0)
RETURNS text LANGUAGE plr IMMUTABLE AS $R$

# 引数から設定値取得
pdf = arg1[1]
scn = arg1[2]
tbn = arg1[3]
xvs = arg1[4:(length(arg1)-1)] # 説明変数（要素数自由）
yvs = arg1[length(arg1)] # 応答変数（一要素）
alp = arg2 # 有意水準
prd = arg3 # 0 回帰直線のみ, 1 信頼区間を描く, 2 予測区間を描く, 3 両方描く

# 引数 prd 想定外ならメッセージ出力し終了
if(!any(prd==0:3)) return('arg3 NOT IN (0, 1, 2, 3)')

# 各領域の描画設定 ただし描画は par3 から
par1 = list(omd=c(0, 1, 0, 1), mfrow=c(1,1), cex=8/12, lheight=1.1, new=T
	, plt=c(0.01, 1, 0, 0.98))
par2 = list(mgp=c(2.5, 1, 0), new=T
	, plt=c(0.32, 0.54, 0.14, 0.96))
par3 = list(mgp=c(2.5, 1, 0), omd=c(0.56, 0.98, 0, 1), mfrow=c(2,3), cex=8/12
	, plt=c(0.14, 0.84, 0.16, 0.86))

# 信頼・予測区間の点間隔パラメータ（大きいほど線が滑らか）
dpi = 50

# 以下、流れは従前と同じ

# サンプルテーブル読込
df1 = pg.spi.exec(paste(sep=''
	, 'SELECT * FROM "', scn, '"."', tbn, '"'))

# 列コメント取得
df2 = pg.spi.exec(paste(sep=''
	, 'SELECT attname, description FROM pg_namespace n
	JOIN pg_class c ON n.oid = c.relnamespace
	JOIN pg_attribute a ON c.oid = a.attrelid
	JOIN pg_description d
		ON (a.attrelid, a.attnum) = (d.objoid, d.objsubid)
	WHERE (nspname, relname) = ($$', scn, '$$, $$', tbn, '$$)'))
lab = iconv(df2[,2], from='UTF-8', to='SJIS')
names(lab) = df2[,1]

# 主処理
main = function(){
	graphics.off()
	pdf(family='Japan1GothicBBB', file=pdf, height=100/25.4, width=297/25.4)
	sapply(xvs, plt) # 説明変数一つずつ処理
	graphics.off()
	return(pdf)
}

# プロット
plt = function(colx){
	# 列名を変数に入れ、単回帰実行
	coly = yvs
	x = df1[,colx]
	y = df1[,coly]
	lm1 = lm(formula=y ~ x)
	cof = gsub(' ', '', format(lm1$coefficients, digits=4))
	pva = summary(lm1)$coefficients[2,4] # p-value

	# 最初に右 : 回帰診断図（有意の場合のみ）
	par(par3)
	if(pva < alp){
		plot(lm1, cex.id=8/12, cex.caption=8/12, which=1:6)
	} else {
		for(i in 1:6) plot(axes=F, type='n', x=0, xlab='', ylab='')
	}

	# 左 : 空プロットして結果文字列を描画
	par(par1)
	plot(axes=F, type='n'
		, x=c(1,2), xaxs='i', xlab='', y=c(1,2), yaxs='i', ylab='')
	options('show.signif.stars'=F)
	str = paste(sep='\n'
		, paste('schema :', scn)
		, paste('table  :', tbn)
		, paste('x :', lab[colx], '(', colx, ')')
		, paste('y :', lab[coly], '(', coly, ')')
		, paste('alpha :', alp)
		, paste(collapse='\n', capture.output(summary(lm1)))
		, paste(sep='', '(formula) y = ', cof[2], ' * x'
			, ifelse(cof[1] >= 0, ' + ', ' '), cof[1]))
	text(adj=c(0,1), label=str, x=1, y=2)

	# 中 : 散布図
	par(par2)
	plot(axes=F, type='n', x=x, y=y, xlab='', ylab='')
		# 横軸の両端得るだけの空プロット
	if(prd == 0 | pva >= alp){ # 回帰直線のみ、または有意でない時
		ylm = range(y)
	} else { # 信頼・予測区間描き、かつ有意な時
		xvs = seq(par('usr')[1], par('usr')[2]
			, length=floor(par('pin')[1] * dpi))
		yv1 = predict(lm1, data.frame(x=xvs), interval='confidence')
		yv2 = predict(lm1, data.frame(x=xvs), interval='prediction')
		if(prd == 1){
			ylm = range(y, yv1[,'lwr'], yv1[,'upr'])
		} else {
			ylm = range(y, yv2[,'lwr'], yv2[,'upr'])
		}
	}
	par(par2)
	plot(x=x, y=y, xlab=lab[colx], xpd=NA, ylab=lab[coly], ylim=ylm)
	if(pva >= alp) return() # 有意でない時ここでプロット終了

	# 回帰直線と信頼・予測区間
	abline(lm1, col=2, lty=1, xpd=F)
	for(i in c('lwr', 'upr')){
		if(any(prd==c(1,3))) lines(x=xvs, y=yv1[,i], col=2, lty=2)
		if(any(prd==c(2,3))) lines(x=xvs, y=yv2[,i], col=4, lty=2)
	}
}

# 実行
main()
$R$ ;

SELECT "201405"."12_regression_plr_4"(ARRAY[
	'R:/20140512_test.pdf'
	, '201405'
	, '05_dat_sample'
	, 'column1', 'column2', 'column3', 'column4'
	, 'column5']
	, 0.05, 3) ; -- 信頼・予測区間を両方描画