1

線形回帰モデルの勾配降下を計算する関数を作成しようとしました。しかし、私が得た答えは、正規方程式法を使用して得た答えと一致しません。

私のサンプルデータは次のとおりです。

df <- data.frame(c(1,5,6),c(3,5,6),c(4,6,8))

c(4,6,8) は y の値です。

lm_gradient_descent <- function(df,learning_rate, y_col=length(df),scale=TRUE){

n_features <- length(df) #n_features is the number of features in the data set

#using mean normalization to scale features

if(scale==TRUE){

for (i in 1:(n_features)){
  df[,i] <- (df[,i]-mean(df[,i]))/sd(df[,i])
    }
  }
  y_data <- df[,y_col]
  df[,y_col] <- NULL
  par <- rep(1,n_features)
  df <- merge(1,df)
  data_mat <- data.matrix(df)
  #we need a temp_arr to store each iteration of parameter values so that we can do a 
  #simultaneous update
  temp_arr <- rep(0,n_features)
  diff <- 1
  while(diff>0.0000001){
    for (i in 1:(n_features)){
      temp_arr[i] <- par[i]-learning_rate*sum((data_mat%*%par-y_data)*df[,i])/length(y_data)
    }
    diff <- par[1]-temp_arr[1]
    print(diff)
    par <- temp_arr
  }

  return(par)
}

この関数を実行すると、

lm_gradient_descent(df,0.0001,,0)

私が得た結果は

c(0.9165891,0.6115482,0.5652970)

正規方程式法を使用すると、

c(2,1,0).

この関数で私が間違っていた場所に誰かが光を当ててくれることを願っています。

4

3 に答える 3

0

この時点で数週間経っていることはわかっていますが、いくつかの理由で試してみることにします。

  • Rは比較的新しいので、コードを解読して書き直すことは私にとって良い習慣です
  • 別の勾配降下問題に取り組んでいるので、これはすべて私にとって新鮮です
  • スタックフロー ポイントが必要で、
  • 私が知る限り、有効な答えは得られませんでした。

まず、データ構造について。データフレームから始めて、列の名前を変更し、ベクトルを取り除き、次に行列を取り除きます。Xマトリックス (コンポーネントの「機能」はxsubscriptと呼ばれるため、大文字になっていますi) とy解ベクトルから始める方がはるかに簡単です。

X <- cbind(c(1,5,6),c(3,5,6))
y <- c(4,6,8)

線形適合モデルを適合させることにより、スケーリングの有無にかかわらず、目的のソリューションが何であるかを簡単に確認できます。(注: 私たちはX/featuresのみをスケーリングし、 y/solutions はスケーリングしません)

> lm(y~X)

Call:
lm(formula = y ~ X)

Coefficients:
(Intercept)           X1           X2  
         -4           -1            3  

> lm(y~scale(X))

Call:
lm(formula = y ~ scale(X))

Coefficients:
(Intercept)    scale(X)1    scale(X)2  
      6.000       -2.646        4.583

コードに関して言えば、R の優れた点の 1 つは、ループを使用するよりもはるかに高速な行列乗算を実行できることです。

lm_gradient_descent <- function(X, y, learning_rate, scale=TRUE){

  if(scale==TRUE){X <- scale(X)}

  X <- cbind(1, X)

  theta <- rep(0, ncol(X)) #your old temp_arr
  diff <- 1
  old.error <- sum( (X %*% theta - y)^2 ) / (2*length(y))
  while(diff>0.000000001){
    theta <- theta - learning_rate * t(X) %*% (X %*% theta - y) / length(y)
    new.error <- sum( (X %*% theta - y)^2 ) / (2*length(y))
    diff <- abs(old.error - new.error)
    old.error <- new.error
  }
  return(theta)
}

そして、それが機能することを示すために...

> lm_gradient_descent(X, y, .01, 0)
           [,1]
[1,] -3.9360685
[2,] -0.9851775
[3,]  2.9736566

対予想(-4, -1, 3)

定義された反復回数のループを好む@cfhに同意するものの、その価値については、実際にはabs関数が必要かどうかわかりません。その場合diff < 0、関数は収束していません。

最後に、のようなものを使用するのではなく、すべてのエラーを記録するベクトルを使用することをお勧めしますold.error。new.error次に、そのベクトルをプロットして、関数が収束する速さを確認できます。

于 2015-05-17T19:27:48.093 に答える
0

停止基準を使用しました

old parameters - new parameters <= 0.0000001

まず第一に、abs()この基準を使用したい場合は、欠落があると思います (ただし、R に関する私の無知が原因かもしれません)。でも使っても

abs(old parameters - new parameters) <= 0.0000001

これは良い停止基準ではありません。進行が遅くなったというだけで、すでに十分に正確であるということではありません。代わりに、単純に反復回数を固定して反復してみてください。残念ながら、ここで勾配降下法に適切で一般的に適用可能な停止基準を与えるのはそれほど簡単ではありません。

于 2015-05-02T17:25:55.747 に答える