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

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

概要

本サンプルは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 のマニュアルページを参照)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

このデータをダウンロード
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 のマニュアルページを参照)
1
2
3
4
5
6
7
8
9
10

この出力例をダウンロード
 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 のマニュアルページを参照)

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

このソースコードをダウンロード
    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


ご案内
関連情報
© 日本ニューメリカルアルゴリズムズグループ株式会社 2025
Privacy Policy  /  Trademarks