目的

定点を通る直線回帰式の傾きを計算する

使用法

sregc(x, x, cxy=NULL)

引数

x      独立変数ベクトル
y      従属変数ベクトル
cxy    定点の x, y 座標。NULL の場合は x, y の平均値（普通の直線回帰式）

ソース

インストールは，以下の 1 行をコピーし，R コンソールにペーストする
source("http://aoki2.si.gunma-u.ac.jp/R/src/sregc.R", encoding="euc-jp")

# 定点を通る直線回帰式の傾き
sregc <- function(   x,                                      # 独立変数                      
                        y,                                      # 従属変数
                        cxy=NULL)                               # 定点の y 座標
{
        OK <- complete.cases(x, y)                           # 欠損値を持つケースを除く
        x <- x[OK]
        y <- y[OK]
        n <- length(x)                                               # サンプルサイズ
        sxy <- sum(x*y)                                              
        sxx <- sum(x^2)
        sx <- sum(x)
        sy <- sum(y)
        if (is.null(cxy)) {                                     # cxy が NULL なら，平均値
                cx <- mean(x)
                cy <- mean(y)
        }
        else {                                                  # 2 つのベクトルとして指定されていれば
                cx <- cxy[1]
                cy <- cxy[2]
        }
        return((sxy-cy*sx-cx*sy+n*cx*cy)/(sxx-2*cx*sx+n*cx^2))
}


使用例

> x <- c(1,2,3,4,5,6)
> y <- c(3,2,4,1,4,3)

# 任意の点を通る直線回帰式
> sregc(x, y, cxy=c(0, 2))
[1] 0.2087912

# 原点を通る直線回帰式
> sregc(x, y, cxy=c(0, 0))
[1] 0.6703297

# 定数の指定を省略すると普通の直線回帰式
> (slope <- sregc(x, y))
[1] 0.08571429
> (intercept <- mean(y)-slope*mean(x)) # 切片を計算
[1] 2.533333

# 同じ答えになることを確かめてみる
> lm(y~x)

Call:
lm(formula = y ~ x)

Coefficients:
(Intercept)            x  
    2.53333      0.08571