static void whittle2 (Array acf, Array Aold, Array Bold, int lag,
char *direction, Array A, Array K, Array E)
{
int d, i, nser=DIM(acf)[1];
const void *vmax;
Array beta, tmp, id;
d = strcmp(direction, "forward") == 0;
vmax = vmaxget();
beta = make_zero_matrix(nser,nser);
tmp = make_zero_matrix(nser, nser);
id = make_identity_matrix(nser);
set_array_to_zero(E);
copy_array(id, subarray(A,0));
for(i = 0; i < lag; i++) {
matrix_prod(subarray(acf,lag - i), subarray(Aold,i), d, 1, tmp);
array_op(beta, tmp, '+', beta);
matrix_prod(subarray(acf,i), subarray(Bold,i), d, 1, tmp);
array_op(E, tmp, '+', E);
}
qr_solve(E, beta, K);
transpose_matrix(K,K);
for (i = 1; i <= lag; i++) {
matrix_prod(K, subarray(Bold,lag - i), 0, 0, tmp);
array_op(subarray(Aold,i), tmp, '-', subarray(A,i));
}
vmaxset(vmax);
}
double *pwl_approx_1d ( int nd, double xd[], double yd[], int nc, double xc[] )
/******************************************************************************/
/*
Purpose:
PWL_APPROX_1D determines the control values for a PWL approximant.
Discussion:
The piecewise linear approximant is defined by NC control pairs
(XC(I),YC(I)) and approximates ND data pairs (XD(I),YD(I)).
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
10 October 2012
Author:
John Burkardt
Parameters:
Input, int ND, the number of data points.
ND must be at least 1.
Input, double XD[ND], the data points.
Input, double YD[ND], the data values.
Input, int NC, the number of control points.
NC must be at least 1.
Input, double XC[NC], the control points. Set these with a
command like
xc = r8vec_linspace_new ( nc, xmin, xmax );
Output, double PWL_APPROX_1D[NC], the control values.
*/
{
double *a;
double *yc;
/*
Define the NDxNC linear system that determines the control values.
*/
a = pwl_approx_1d_matrix ( nd, xd, yd, nc, xc );
/*
Solve the system.
*/
yc = qr_solve ( nd, nc, a, yd );
free ( a );
return yc;
}
int main(int argc, char **argv) {
int n, m;
double A[MAX][MAX];
double b[MAX];
int map[MAX];
double sigma[MAX];
int rank;
readMatrix(A, b, &n, &m);
getColNorms(A, sigma, n, m);
//printVector(sigma, m);
rank = qr(A, b, sigma, map, n, m);
printf("posto: %d\n", rank);
//printVector(b, n);
qr_solve(A, b, sigma, m, rank);
printf("residuo: %lf\n", findResidual(b, n, rank));
remap(b, map, m);
printf("resultado:\n");
printVector(b, m);
plotSolution(m, b);
return 0;
}
void test02 ( )
/******************************************************************************/
/*
Purpose:
TEST02 tests QR_SOLVE.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 September 2012
Author:
John Burkardt
*/
{
double *a;
double *b;
double b_norm;
int i;
int m;
int n;
int prob;
int prob_num;
double *r1;
double r1_norm;
double *r2;
double r2_norm;
double x_diff_norm;
double *x1;
double x1_norm;
double *x2;
double x2_norm;
printf ( "\n" );
printf ( "TEST02\n" );
printf ( " QR_SOLVE is a function with a simple interface which\n" );
printf ( " solves a linear system A*x = b in the least squares sense.\n" );
printf ( " Compare a tabulated solution X1 to the QR_SOLVE result X2.\n" );
prob_num = p00_prob_num ( );
printf ( "\n" );
printf ( " Number of problems = %d\n", prob_num );
printf ( "\n" );
printf ( " Index M N ||B|| ||X1 - X2|| ||X1|| ||X2|| ||R1|| ||R2||\n" );
printf ( "\n" );
for ( prob = 1; prob <= prob_num; prob++ )
{
/*
Get problem size.
*/
m = p00_m ( prob );
n = p00_n ( prob );
/*
Retrieve problem data.
*/
a = p00_a ( prob, m, n );
b = p00_b ( prob, m );
x1 = p00_x ( prob, n );
b_norm = r8vec_norm ( m, b );
x1_norm = r8vec_norm ( n, x1 );
r1 = r8mat_mv_new ( m, n, a, x1 );
for ( i = 0; i < m; i++ )
{
r1[i] = r1[i] - b[i];
}
r1_norm = r8vec_norm ( m, r1 );
/*
Use QR_SOLVE on the problem.
*/
x2 = qr_solve ( m, n, a, b );
x2_norm = r8vec_norm ( n, x2 );
r2 = r8mat_mv_new ( m, n, a, x2 );
for ( i = 0; i < m; i++ )
{
r2[i] = r2[i] - b[i];
}
r2_norm = r8vec_norm ( m, r2 );
/*
Compare tabulated and computed solutions.
*/
x_diff_norm = r8vec_norm_affine ( n, x1, x2 );
/*
Report results for this problem.
*/
printf ( " %5d %4d %4d %12g %12g %12g %12g %12g %12g\n",
prob, m, n, b_norm, x_diff_norm, x1_norm, x2_norm, r1_norm, r2_norm );
/*
Deallocate memory.
*/
free ( a );
free ( b );
free ( r1 );
free ( r2 );
free ( x1 );
free ( x2 );
}
return;
}
DLLEXPORT lapack_int z_qr_solve(lapack_int m, lapack_int n, lapack_int bn, lapack_complex_double a[], lapack_complex_double b[], lapack_complex_double x[])
{
return qr_solve(m, n, bn, a, b, x, LAPACKE_zgels);
}
DLLEXPORT lapack_int c_qr_solve(lapack_int m, lapack_int n, lapack_int bn, lapack_complex_float a[], lapack_complex_float b[], lapack_complex_float x[])
{
return qr_solve(m, n, bn, a, b, x, LAPACKE_cgels);
}
DLLEXPORT lapack_int d_qr_solve(lapack_int m, lapack_int n, lapack_int bn, double a[], double b[], double x[])
{
return qr_solve(m, n, bn, a, b, x, LAPACKE_dgels);
}
DLLEXPORT lapack_int s_qr_solve(lapack_int m, lapack_int n, lapack_int bn, float a[], float b[], float x[])
{
return qr_solve(m, n, bn, a, b, x, LAPACKE_sgels);
}
double *vandermonde_approx_2d_coef ( int n, int m, double x[], double y[],
double z[] )
/******************************************************************************/
/*
Purpose:
VANDERMONDE_APPROX_2D_COEF computes a 2D polynomial approximant.
Discussion:
We assume the approximating function has the form of a polynomial
in X and Y of total degree M.
p(x,y) = c00
+ c10 * x + c01 * y
+ c20 * x^2 + c11 * xy + c02 * y^2
+ ...
+ cm0 * x^(m) + ... + c0m * y^m.
If we let T(K) = the K-th triangular number
= sum ( 1 <= I <= K ) I
then the number of coefficients in the above polynomial is T(M+1).
We have n data locations (x(i),y(i)) and values z(i) to approximate:
p(x(i),y(i)) = z(i)
This can be cast as an NxT(M+1) linear system for the polynomial
coefficients:
[ 1 x1 y1 x1^2 ... y1^m ] [ c00 ] = [ z1 ]
[ 1 x2 y2 x2^2 ... y2^m ] [ c10 ] = [ z2 ]
[ 1 x3 y3 x3^2 ... y3^m ] [ c01 ] = [ z3 ]
[ ...................... ] [ ... ] = [ ... ]
[ 1 xn yn xn^2 ... yn^m ] [ c0m ] = [ zn ]
In the typical case, N is greater than T(M+1) (we have more data and
equations than degrees of freedom) and so a least squares solution is
appropriate, in which case the computed polynomial will be a least squares
approximant to the data.
The polynomial defined by the T(M+1) coefficients C could be evaluated
at the Nx2-vector x by the command
pval = r8poly_value_2d ( m, c, n, x )
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 October 2012
Author:
John Burkardt
Parameters:
Input, int N, the number of data points.
Input, int M, the maximum degree of the polynomial.
Input, double X[N], Y[N] the data locations.
Input, double Z[N], the data values.
Output, double VANDERMONDE_APPROX_2D_COEF[T(M+1)], the
coefficients of the approximating polynomial.
*/
{
double *a;
double *c;
int tm;
tm = triangle_num ( m + 1 );
a = vandermonde_approx_2d_matrix ( n, m, tm, x, y );
c = qr_solve ( n, tm, a, z );
free ( a );
return c;
}
DLLEXPORT MKL_INT z_qr_solve(MKL_INT m, MKL_INT n, MKL_INT bn, MKL_Complex16 a[], MKL_Complex16 b[], MKL_Complex16 x[], MKL_Complex16 work[], MKL_INT len)
{
return qr_solve(m, n, bn, a, b, x, work, len, zgels);
}
DLLEXPORT MKL_INT c_qr_solve(MKL_INT m, MKL_INT n, MKL_INT bn, MKL_Complex8 a[], MKL_Complex8 b[], MKL_Complex8 x[], MKL_Complex8 work[], MKL_INT len)
{
return qr_solve(m, n, bn, a, b, x, work, len, cgels);
}
DLLEXPORT MKL_INT d_qr_solve(MKL_INT m, MKL_INT n, MKL_INT bn, double a[], double b[], double x[], double work[], MKL_INT len)
{
return qr_solve(m, n, bn, a, b, x, work, len, dgels);
}
DLLEXPORT MKL_INT s_qr_solve(MKL_INT m, MKL_INT n, MKL_INT bn, float a[], float b[], float x[], float work[], MKL_INT len)
{
return qr_solve(m, n, bn, a, b, x, work, len, sgels);
}
static void burg2(Array ss_ff, Array ss_bb, Array ss_fb, Array E,
Array KA, Array KB)
/*
Estimate partial correlation by minimizing (1/2)*log(det(s)) where
"s" is the the sum of the forward and backward prediction errors.
In the multivariate case, the forward (KA) and backward (KB) partial
correlation coefficients are related by
KA = solve(E) %*% t(KB) %*% E
where E is the prediction variance.
*/
{
int i, j, k, l, nser = NROW(ss_ff);
int iter;
Array ss_bf;
Array s, tmp, d1;
Array D1, D2, THETA, THETAOLD, THETADIFF, TMP;
Array obj;
Array e, f, g, h, sg, sh;
Array theta;
ss_bf = make_zero_matrix(nser,nser);
transpose_matrix(ss_fb, ss_bf);
s = make_zero_matrix(nser, nser);
tmp = make_zero_matrix(nser, nser);
d1 = make_zero_matrix(nser, nser);
e = make_zero_matrix(nser, nser);
f = make_zero_matrix(nser, nser);
g = make_zero_matrix(nser, nser);
h = make_zero_matrix(nser, nser);
sg = make_zero_matrix(nser, nser);
sh = make_zero_matrix(nser, nser);
theta = make_zero_matrix(nser, nser);
D1 = make_zero_matrix(nser*nser, 1);
D2 = make_zero_matrix(nser*nser, nser*nser);
THETA = make_zero_matrix(nser*nser, 1); /* theta in vector form */
THETAOLD = make_zero_matrix(nser*nser, 1);
THETADIFF = make_zero_matrix(nser*nser, 1);
TMP = make_zero_matrix(nser*nser, 1);
obj = make_zero_matrix(1,1);
/* utility matrices e,f,g,h */
qr_solve(E, ss_bf, e);
qr_solve(E, ss_fb, f);
qr_solve(E, ss_bb, tmp);
transpose_matrix(tmp, tmp);
qr_solve(E, tmp, g);
qr_solve(E, ss_ff, tmp);
transpose_matrix(tmp, tmp);
qr_solve(E, tmp, h);
for(iter = 0; iter < BURG_MAX_ITER; iter++)
{
/* Forward and backward partial correlation coefficients */
transpose_matrix(theta, tmp);
qr_solve(E, tmp, tmp);
transpose_matrix(tmp, KA);
qr_solve(E, theta, tmp);
transpose_matrix(tmp, KB);
/* Sum of forward and backward prediction errors ... */
set_array_to_zero(s);
/* Forward */
array_op(s, ss_ff, '+', s);
matrix_prod(KA, ss_bf, 0, 0, tmp);
array_op(s, tmp, '-', s);
transpose_matrix(tmp, tmp);
array_op(s, tmp, '-', s);
matrix_prod(ss_bb, KA, 0, 1, tmp);
matrix_prod(KA, tmp, 0, 0, tmp);
array_op(s, tmp, '+', s);
/* Backward */
array_op(s, ss_bb, '+', s);
matrix_prod(KB, ss_fb, 0, 0, tmp);
array_op(s, tmp, '-', s);
transpose_matrix(tmp, tmp);
array_op(s, tmp, '-', s);
matrix_prod(ss_ff, KB, 0, 1, tmp);
matrix_prod(KB, tmp, 0, 0, tmp);
array_op(s, tmp, '+', s);
matrix_prod(s, f, 0, 0, d1);
matrix_prod(e, s, 1, 0, tmp);
array_op(d1, tmp, '+', d1);
/*matrix_prod(g,s,0,0,sg);*/
matrix_prod(s,g,0,0,sg);
matrix_prod(s,h,0,0,sh);
for (i = 0; i < nser; i++) {
for (j = 0; j < nser; j++) {
MATRIX(D1)[nser*i+j][0] = MATRIX(d1)[i][j];
for (k = 0; k < nser; k++)
for (l = 0; l < nser; l++) {
MATRIX(D2)[nser*i+j][nser*k+l] =
(i == k) * MATRIX(sg)[j][l] +
MATRIX(sh)[i][k] * (j == l);
}
}
}
copy_array(THETA, THETAOLD);
qr_solve(D2, D1, THETA);
for (i = 0; i < vector_length(theta); i++)
VECTOR(theta)[i] = VECTOR(THETA)[i];
matrix_prod(D2, THETA, 0, 0, TMP);
array_op(THETAOLD, THETA, '-', THETADIFF);
matrix_prod(D2, THETADIFF, 0, 0, TMP);
matrix_prod(THETADIFF, TMP, 1, 0, obj);
if (VECTOR(obj)[0] < BURG_TOL)
break;
}
if (iter == BURG_MAX_ITER)
error(_("Burg's algorithm failed to find partial correlation"));
}
DLLEXPORT lapack_int c_qr_solve(lapack_int m, lapack_int n, lapack_int bn, lapack_complex_float a[], lapack_complex_float b[], lapack_complex_float x[], lapack_complex_float work[], lapack_int len)
{
return qr_solve(m, n, bn, a, b, x, work, len, LAPACK_cgels);
}
void test01 ( int prob, int grd, int m )
/******************************************************************************/
/*
Purpose:
VANDERMONDE_APPROX_2D_TEST01 tests VANDERMONDE_APPROX_2D_MATRIX.
Licensing:
This code is distributed under the GNU LGPL license.
Modified:
11 October 2012
Author:
John Burkardt
Parameters:
Input, int PROB, the problem number.
Input, int GRD, the grid number.
(Can't use GRID as the name because that's also a plotting function.)
Input, int M, the total polynomial degree.
*/
{
double *a;
double app_error;
double *c;
int nd;
int ni;
int tm;
double *xd;
double *xi;
double *yd;
double *yi;
double *zd;
double *zi;
printf ( "\n" );
printf ( "TEST01:\n" );
printf ( " Approximate data from TEST_INTERP_2D problem #%d\n", prob );
printf ( " Use grid from TEST_INTERP_2D with index #%d\n", grd );
printf ( " Using polynomial approximant of total degree %d\n", m );
nd = g00_size ( grd );
printf ( " Number of data points = %d\n", nd );
xd = ( double * ) malloc ( nd * sizeof ( double ) );
yd = ( double * ) malloc ( nd * sizeof ( double ) );
g00_xy ( grd, nd, xd, yd );
zd = ( double * ) malloc ( nd * sizeof ( double ) );
f00_f0 ( prob, nd, xd, yd, zd );
if ( nd < 10 )
{
r8vec3_print ( nd, xd, yd, zd, " X, Y, Z data:" );
}
/*
Compute the Vandermonde matrix.
*/
tm = triangle_num ( m + 1 );
a = vandermonde_approx_2d_matrix ( nd, m, tm, xd, yd );
/*
Solve linear system.
*/
c = qr_solve ( nd, tm, a, zd );
/*
#1: Does approximant match function at data points?
*/
ni = nd;
xi = r8vec_copy_new ( ni, xd );
yi = r8vec_copy_new ( ni, yd );
zi = r8poly_value_2d ( m, c, ni, xi, yi );
app_error = r8vec_norm_affine ( ni, zi, zd ) / ( double ) ( ni );
printf ( "\n" );
printf ( " L2 data approximation error = %g\n", app_error );
free ( a );
free ( c );
free ( xd );
free ( xi );
free ( yd );
free ( yi );
free ( zd );
free ( zi );
return;
}
DLLEXPORT lapack_int z_qr_solve(lapack_int m, lapack_int n, lapack_int bn, lapack_complex_double a[], lapack_complex_double b[], lapack_complex_double x[], lapack_complex_double work[], lapack_int len)
{
return qr_solve(m, n, bn, a, b, x, work, len, LAPACK_zgels);
}
int muscles_interpolate (IN int m, int n,
IN double *matrix,
IN double *xes,
IN double *yes,
IN double *rights,
OUT int *answers,
OUT double *xCoefs,
OUT double *yCoefs,
IN int verbose)
{
int result = 0;
//======================================================
double *x_coefs = qr_solve (m, n, matrix, xes);
double *y_coefs = qr_solve (m, n, matrix, yes);
//======================================================
if ( !x_coefs || !y_coefs )
{
result = 1;
goto RESULT;
}
for ( int j = 0; j < n; ++j )
xCoefs[j] = x_coefs[j];
for ( int j = 0; j < n; ++j )
yCoefs[j] = y_coefs[j];
if ( verbose )
{
printf ("\n\n");
for ( int j = 0; j < n; ++j )
printf ("%.4lf ", x_coefs[j]);
printf ("\n");
for ( int j = 0; j < n; ++j )
printf ("%.4lf ", y_coefs[j]);
printf ("\n\n");
// --- checking ------------
double sum_x = 0.;
double sum_y = 0.;
for ( int j = 0; j < n; ++j )
{
sum_x += matrix[j] * x_coefs[j];
sum_y += matrix[j] * y_coefs[j];
}
printf ("%.4lf == %.4lf\n", sum_x, xes[0]);
printf ("%.4lf == %.4lf\n", sum_y, yes[0]);
printf ("\n");
} // end if verbose
//--------------------------------
double *maxtix[] = { x_coefs, y_coefs };
double objects[] = { 1., 1., 1., 1. };
if ( SimplexMethod::calculate (n, 2, maxtix, rights, objects, answers, verbose) )
{
result = 1;
goto RESULT;
}
if ( verbose )
{
double sum_x = 0.;
double sum_y = 0.;
for ( int j = 0; j < n; ++j )
{
sum_x += matrix[j] * answers[j];
sum_y += matrix[j] * answers[j];
}
printf ("%lf == %lf\n", sum_x, rights[0]);
printf ("%lf == %lf\n", sum_y, rights[1]);
}
RESULT:;
if ( x_coefs ) free (x_coefs);
if ( y_coefs ) free (y_coefs);
return result;
}
