実一般化線形最小二乗: 線形等式制約

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

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

概要

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

線形等式制約最小二乗問題を解きます。

\begin{displaymath} \min_{x} \left\Vert c - A x \right\Vert _{2} \: \mbox{ subject to } \: B x = d \end{displaymath}

ここで

\begin{displaymath} A = \left( \begin{array}{rrrr} -0.57 & -1.28 & -0.39 & 0.... ...ccc} 1 & 0 & -1 & 0 \\ 0 & 1 & 0 & -1 \end{array} \right), \end{displaymath}


\begin{displaymath} c = \left( \begin{array}{r} -1.50 \\ -2.14 \\ 1.23 \\... ... d = \left( \begin{array}{r} 0 \\ 0 \end{array} \right). \end{displaymath}

制約 $ B x = d$は $ x_{1} = x_{3}$と $ x_{2} = x_{4}$に対応します。

入力データ

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

  6      4      2           :Values of M, N and P

 -0.57  -1.28  -0.39   0.25
 -1.93   1.08  -0.31  -2.14
  2.30   0.24   0.40  -0.35
 -1.93   0.64  -0.66   0.08
  0.15   0.30   0.15  -2.13
 -0.02   1.03  -1.43   0.50 :End of matrix A

  1.00   0.00  -1.00   0.00
  0.00   1.00   0.00  -1.00 :End of matrix B

 -1.50
 -2.14
  1.23
 -0.54
 -1.68
  0.82                      :End of vector c

  0.00
  0.00                      :End of vector d

出力結果

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

 Constrained least squares solution
      0.4890     0.9975     0.4890     0.9975

 Square root of the residual sum of squares
      2.51E-02

ソースコード

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

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

!     DGGLSE Example Program Text

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

!     .. Use Statements ..
      Use blas_interfaces, Only: dnrm2
      Use lapack_interfaces, Only: dgglse
      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(:, :), c(:), d(:), work(:), &
        x(:)
!     .. Executable Statements ..
      Write (nout, *) 'DGGLSE Example Program Results'
      Write (nout, *)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) m, n, p
      lda = m
      ldb = p
      lwork = p + n + nb*(m+n)
      Allocate (a(lda,n), b(ldb,n), c(m), d(p), work(lwork), x(n))

!     Read A, B, C and D from data file

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

!     Solve the equality-constrained least squares problem

!     minimize ||c - A*x|| (in the 2-norm) subject to B*x = D

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

!     Print least squares solution

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

!     Compute the square root of the residual sum of squares

      rnorm = dnrm2(m-n+p, c(n-p+1), 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, E11.2)
    End Program


ご案内
関連情報
Privacy Policy  /  Trademarks