実一般化線形最小二乗: GLM

LAPACKサンプルソースコード : 使用ルーチン名：DGGGLM

ホーム > LAPACKサンプルプログラム目次 > 実一般化線形最小二乗 > GLM

概要

本サンプルはFortran言語によりLAPACKルーチンDGGGLMを利用するサンプルプログラムです。

加重線形最小二乗問題を解きます。

\begin{displaymath} \min_{x} \left\Vert B^{-1} (d - A x) \right\Vert _{2} \end{displaymath}

ここで

\begin{displaymath} A = \left( \begin{array}{rrr} -0.57 & -1.28 & -0.39 \\ ... ...{r} 1.32 \\ -4.00 \\ 5.52 \\ 3.24 \end{array} \right). \end{displaymath}

入力データ

（本ルーチンの詳細はDGGGLM のマニュアルページを参照）
このデータをダウンロード 
DGGGLM Example Program Data

  4      3      4           :Values of M, N and P

 -0.57  -1.28  -0.39
 -1.93   1.08  -0.31
  2.30   0.24  -0.40
 -0.02   1.03  -1.43        :End of matrix A

  0.50   0.00   0.00   0.00
  0.00   1.00   0.00   0.00
  0.00   0.00   2.00   0.00
  0.00   0.00   0.00   5.00 :End of matrix B

  1.32
 -4.00
  5.52
  3.24                      :End of vector d

出力結果

（本ルーチンの詳細はDGGGLM のマニュアルページを参照）
この出力例をダウンロード 
 DGGGLM Example Program Results

 Weighted least squares solution
      1.9889    -1.0058    -2.9911

 Residual vector
     -6.37E-04  -2.45E-03  -4.72E-03   7.70E-03

 Square root of the residual sum of squares
      9.38E-03

ソースコード

（本ルーチンの詳細はDGGGLM のマニュアルページを参照）

※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。
このソースコードをダウンロード 
    Program dggglm_example

!     DGGGLM Example Program Text

!     Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com

!     .. Use Statements ..
      Use blas_interfaces, Only: dnrm2
      Use lapack_interfaces, Only: dggglm
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter :: nb = 64, nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=dp) :: rnorm
      Integer :: i, info, lda, ldb, lwork, m, n, p
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: a(:, :), b(:, :), d(:), work(:), x(:), &
        y(:)
!     .. Executable Statements ..
      Write (nout, *) 'DGGGLM Example Program Results'
      Write (nout, *)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) m, n, p
      lda = m
      ldb = m
      lwork = n + m + nb*(m+p)
      Allocate (a(lda,n), b(ldb,p), d(m), work(lwork), x(n), y(p))

!     Read A, B and D from data file

      Read (nin, *)(a(i,1:n), i=1, m)
      Read (nin, *)(b(i,1:p), i=1, m)
      Read (nin, *) d(1:m)

!     Solve the weighted least squares problem

!     minimize ||inv(B)*(d - A*x)|| (in the 2-norm)

      Call dggglm(m, n, p, a, lda, b, ldb, d, x, y, work, lwork, info)

!     Print least squares solution, x

      Write (nout, *) 'Weighted least squares solution'
      Write (nout, 100) x(1:n)

!     Print residual vector y = inv(B)*(d - A*x)

      Write (nout, *)
      Write (nout, *) 'Residual vector'
      Write (nout, 110) y(1:p)

!     Compute and print the square root of the residual sum of
!     squares

      rnorm = dnrm2(p, y, 1)

      Write (nout, *)
      Write (nout, *) 'Square root of the residual sum of squares'
      Write (nout, 110) rnorm

100   Format (1X, 7F11.4)
110   Format (3X, 1P, 7E11.2)
    End Program


ご案内
関連情報
Privacy Policy  /  Trademarks