function sparse_grid_cc_dataset ( dim_num, level_max )

%*****************************************************************************80
%
%% SPARSE_GRID_CC_DATASET is the main program for SPARSE_GRID_CC_DATASET.
%
%  Discussion:
%
%    This program computes a sparse grid quadrature rule based on 1D
%    Clenshaw-Curtis rules and writes it to a file..
%
%    The user specifies:
%    * the spatial dimension of the quadrature region,
%    * the level that defines the Smolyak grid.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 April 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'SPARSE_GRID_CC_DATASET\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Compute the abscissas and weights of a quadrature rule\n' );
  fprintf ( 1, '  associated with a sparse grid derived from a Smolyak\n' );
  fprintf ( 1, '  construction based on 1D Clenshaw-Curtis rules.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Inputs to the program include:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '    DIM_NUM, the spatial dimension.\n' );
  fprintf ( 1, '    (typically in the range of 2 to 10)\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '    LEVEL_MAX, the "level" of the sparse grid.\n' );
  fprintf ( 1, '    (typically in the range of 0, 1, 2, 3, ...\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Output from the program includes:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '    A printed table of the abscissas and weights.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '    * A set of 3 files that define the quadrature rule.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '    "cc_d?_level?_r.txt", a file of the ranges.\n' );
  fprintf ( 1, '    "cc_d?_level?_w.txt", a file of the weights;\n' );
  fprintf ( 1, '    "cc_d?_level?_x.txt", a file of the abscissas;\n' );
%
%  Get the spatial dimension.
%
  if ( nargin < 1 )
    fprintf ( 1, '\n' );
    dim_num = input ( '  Enter the value of DIM_NUM (1 or greater): ' );
  elseif ( ischar ( dim_num ) )
    dim_num = str2num ( dim_num );
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Spatial dimension requested is = %d\n', dim_num );
%
%  Get the level.
%
  if ( nargin < 2 )
    fprintf ( 1, '\n' );
    level_max = input ( '  Enter the value of LEVEL_MAX (0 or greater): ' );
  elseif ( ischar ( level_max ) )
    level_max = str2num ( level_max );
  end

  level_min = max ( 0, level_max + 1 - dim_num );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  LEVEL_MIN = %d\n', level_min );
  fprintf ( 1, '  LEVEL_MAX = %d\n', level_max );
%
%  How many distinct points will there be?
%
  point_num = sparse_grid_cfn_size ( dim_num, level_max );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The number of distinct abscissas in the\n' );
  fprintf ( 1, '  quadrature rule is determined from the spatial\n' );
  fprintf ( 1, '  dimension DIM_NUM and the level LEVEL_MAX.\n' );
  fprintf ( 1, '  For the given input, this value will be = %d\n', point_num );

  r = zeros ( dim_num, 2 );
%
%  Compute the weights and points.
%
  r(1:dim_num,1) = -1.0;
  r(1:dim_num,2) = +1.0;

  [ w, x ] = sparse_grid_cc ( dim_num, level_max, point_num );

  r8mat_transpose_print_some ( dim_num, point_num, x, 1, 1, ...
    dim_num, 10, '  First 10 grid points:' );

  r8vec_print_some ( point_num, w, 1, 10, '  First 10 weights:' );

  weight_sum = sum ( w(1:point_num) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Weights sum to   %24.16f\n', weight_sum );
  fprintf ( 1, '  Correct value is %24.16f\n', 2.0^dim_num );
%
%  Write the rule to files.
%
  r_filename = sprintf ( 'cc_d%d_level%d_r.txt', dim_num, level_max );
  w_filename = sprintf ( 'cc_d%d_level%d_w.txt', dim_num, level_max );
  x_filename = sprintf ( 'cc_d%d_level%d_x.txt', dim_num, level_max );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Creating R file = "%s".\n', r_filename );

  r8mat_write ( r_filename, dim_num, 2, r );

  fprintf ( 1, '  Creating W file = "%s".\n', w_filename );

  r8mat_write ( w_filename, 1, point_num, w );

  fprintf ( 1, '  Creating X file = "%s".\n', x_filename );

  r8mat_write ( x_filename, dim_num, point_num, x );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'SPARSE_GRID_CC_DATASET:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );

  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function test_level = abscissa_level_closed_nd ( level_max, dim_num, ...
  test_num, test_val )

%*******************************************************************************
%
%% ABSCISSA_LEVEL_CLOSED_ND: first level at which given abscissa is generated.
%
%  Discussion:
%
%    We assume an underlying product grid.  In each dimension, this product
%    grid has order 2^LEVEL_MAX + 1.
%
%    We will say a sparse grid has total level LEVEL if each point in the
%    grid has a total level of LEVEL or less.
%
%    The "level" of a point is determined as the sum of the levels of the
%    point in each spatial dimension.
%
%    The level of a point in a single spatial dimension I is determined as
%    the level, between 0 and LEVEL_MAX, at which the point's I'th index
%    would have been generated.
%
%
%    This description is terse and perhaps unenlightening.  Keep in mind
%    that the product grid is the product of 1D grids,
%    that the 1D grids are built up by levels, having
%    orders (total number of points ) 1, 3, 5, 9, 17, 33 and so on,
%    and that these 1D grids are nested, so that each point in a 1D grid
%    has a first level at which it appears.
%
%    Our procedure for generating the points of a sparse grid, then, is
%    to choose a value LEVEL_MAX, to generate the full product grid,
%    but then only to keep those points on the full product grid whose
%    LEVEL is less than or equal to LEVEL_MAX.
%
%
%    Note that this routine is really just testing out the idea of
%    determining the level.  Our true desire is to be able to start
%    with a value LEVEL, and determine, in a straightforward manner,
%    all the points that are generated exactly at that level, or
%    all the points that are generated up to and including that level.
%
%    This allows us to generate the new points to be added to one sparse
%    grid to get the next, or to generate a particular sparse grid at once.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer LEVEL_MAX, controls the size of the final sparse grid.
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer TEST_NUM, the number of points to be tested.
%
%    Input, integer TEST_VAL(DIM_NUM,TEST_NUM), the indices of the points
%    to be tested.  Normally, each index would be between 0 and 2^LEVEL_MAX.
%
%    Output, integer TEST_LEVEL(TEST_NUM), the value of LEVEL at which the
%    point would first be generated, assuming that a standard sequence of
%    nested grids is used.
%
  test_level = zeros ( test_num, 1 );

  if ( level_max == 0 )
    test_level(1:test_num) = 0;
    return
  end

  order = 2^level_max + 1;

  for j = 1 : test_num

    test_level(j) = index_to_level_closed ( dim_num, test_val(1:dim_num,j), ...
      order, level_max );

  end

  return
end
function value = cc_abscissa ( n, i )

%*******************************************************************************
%
%% CC_ABSCISSA returns the I-th abscissa of the Clenshaw Curtis rule.
%
%  Discussion:
%
%    The abscissas are numbered from left to right.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 March 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the rule.
%
%    Input, integer I, the index of the desired abscissa.  1 <= I <= N.
%
%    Output, real VALUE, the value of the I-th abscissa in the
%    rule of order N.
%
  if ( n < 1 )
    value = - Inf;
  elseif ( i < 1 || n < i )
    value = - Inf;
  elseif ( n == 1 )
    value = 0.0;
  elseif ( 2 * ( n - i ) == n - 1 )
    value = 0.0;
  else
    value = cos ( ( n - i ) * pi / ( n - 1 ) );
  end

  return
end
function w = cc_weights ( n )

%*******************************************************************************
%
%% CC_WEIGHTS computes Clenshaw Curtis weights.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Charles Clenshaw, Alan Curtis,
%    A Method for Numerical Integration on an Automatic Computer,
%    Numerische Mathematik,
%    Volume 2, Number 1, December 1960, pages 197-205.
%
%  Parameters:
%
%    Input, integer N, the order of the rule.
%
%    Output, real W(N), the weights of the rule.
%
  w = zeros ( n, 1 );

  if ( n == 1 )
    w(1) = 2.0;
    return
  end

  theta = zeros ( n, 1 );

  for i = 1 : n
    theta(i) = ( i - 1 ) * pi / ( n - 1 );
  end

  for i = 1 : n

    w(i) = 1.0;

    for j = 1 : floor ( ( n - 1 ) / 2 )

      if ( 2 * j == ( n - 1 ) )
        b = 1.0;
      else
        b = 2.0;
      end

      w(i) = w(i) - b * cos ( 2.0 * j * theta(i) ) / ( 4 * j * j - 1 );

    end

  end

  w(1)     =       w(1)     / ( n - 1 );
  w(2:n-1) = 2.0 * w(2:n-1) / ( n - 1 );
  w(n)     =       w(n)     / ( n - 1 );

  return
end
function value = choose ( n, k )

%*******************************************************************************
%
%% CHOOSE computes the binomial coefficient C(N,K).
%
%  Discussion:
%
%    The value is calculated in such a way as to avoid overflow and
%    roundoff.  The calculation is done in integer arithmetic.
%
%    The formula used is:
%
%      C(N,K) = N! / ( K! * (N-K)! )
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    ML Wolfson, HV Wright,
%    Algorithm 160:
%    Combinatorial of M Things Taken N at a Time,
%    Communications of the ACM,
%    Volume 6, Number 4, April 1963, page 161.
%
%  Parameters:
%
%    Input, integer N, K, are the values of N and K.
%
%    Output, integer VALUE, the number of combinations of N
%    things taken K at a time.
%
  mn = min ( k, n - k );

  if ( mn < 0 )

    value = 0;

  elseif ( mn == 0 )

    value = 1;

  else

    mx = max ( k, n - k );
    value = mx + 1;

    for i = 2 : mn
      value = ( value * ( mx + i ) ) / i;
    end

  end

  return
end
function [ a, more, h, t ] = comp_next ( n, k, a, more, h, t )

%*******************************************************************************
%
%% COMP_NEXT computes the compositions of the integer N into K parts.
%
%  Discussion:
%
%    A composition of the integer N into K parts is an ordered sequence
%    of K nonnegative integers which sum to N.  The compositions (1,2,1)
%    and (1,1,2) are considered to be distinct.
%
%    The routine computes one composition on each call until there are no more.
%    For instance, one composition of 6 into 3 parts is
%    3+2+1, another would be 6+0+0.
%
%    On the first call to this routine, set MORE = FALSE.  The routine
%    will compute the first element in the sequence of compositions, and
%    return it, as well as setting MORE = TRUE.  If more compositions
%    are desired, call again, and again.  Each time, the routine will
%    return with a new composition.
%
%    However, when the LAST composition in the sequence is computed
%    and returned, the routine will reset MORE to FALSE, signaling that
%    the end of the sequence has been reached.
%
%    This routine originally used a SAVE statement to maintain the
%    variables H and T.  I have decided (based on an wasting an
%    entire morning trying to track down a problem) that it is safer
%    to pass these variables as arguments, even though the user should
%    never alter them.  This allows this routine to safely shuffle
%    between several ongoing calculations.
%
%    There are 28 compositions of 6 into three parts.  This routine will
%    produce those compositions in the following order:
%
%     I         A
%     -     ---------
%     1     6   0   0
%     2     5   1   0
%     3     4   2   0
%     4     3   3   0
%     5     2   4   0
%     6     1   5   0
%     7     0   6   0
%     8     5   0   1
%     9     4   1   1
%    10     3   2   1
%    11     2   3   1
%    12     1   4   1
%    13     0   5   1
%    14     4   0   2
%    15     3   1   2
%    16     2   2   2
%    17     1   3   2
%    18     0   4   2
%    19     3   0   3
%    20     2   1   3
%    21     1   2   3
%    22     0   3   3
%    23     2   0   4
%    24     1   1   4
%    25     0   2   4
%    26     1   0   5
%    27     0   1   5
%    28     0   0   6
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 July 2008
%
%  Author:
%
%    Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Albert Nijenhuis, Herbert Wilf,
%    Combinatorial Algorithms for Computers and Calculators,
%    Second Edition,
%    Academic Press, 1978,
%    ISBN: 0-12-519260-6,
%    LC: QA164.N54.
%
%  Parameters:
%
%    Input, integer N, the integer whose compositions are desired.
%
%    Input, integer K, the number of parts in the composition.
%
%    Input, integer A(K), the previous composition.  On the first call,
%    with MORE = FALSE, set A = [].  Thereafter, A should be the
%    value of A output from the previous call.
%
%    Input, logical MORE.  The input value of MORE on the first
%    call should be FALSE, which tells the program to initialize.
%    On subsequent calls, MORE should be TRUE, or simply the
%    output value of MORE from the previous call.
%
%    Input, integer H, T, two internal parameters needed for the
%    computation.  The user may need to initialize these before the
%    very first call, but these initial values are not important.
%    The user should not alter these parameters once the computation
%    begins.
%
%    Output, integer A(K), the next composition.
%
%    Output, logical MORE, will be TRUE unless the composition
%    that is being returned is the final one in the sequence.
%
%    Output, integer H, T, the updated values of the two internal
%    parameters.
%
  if ( ~more )

    t = n;
    h = 0;
    a(1) = n;
    a(2:k) = 0;

  else

    if ( 1 < t )
      h = 0;
    end

    h = h + 1;
    t = a(h);
    a(h) = 0;
    a(1) = t - 1;
    a(h+1) = a(h+1) + 1;

  end

  more = ( a(k) ~= n );

  return
end
function value = i4_modp ( i, j )

%*******************************************************************************
%
%% I4_MODP returns the nonnegative remainder of I4 division.
%
%  Discussion:
%
%    If
%      NREM = I4_MODP ( I, J )
%      NMULT = ( I - NREM ) / J
%    then
%      I = J * NMULT + NREM
%    where NREM is always nonnegative.
%
%    The MOD function computes a result with the same sign as the
%    quantity being divided.  Thus, suppose you had an angle A,
%    and you wanted to ensure that it was between 0 and 360.
%    Then mod(A,360) would do, if A was positive, but if A
%    was negative, your result would be between -360 and 0.
%
%    On the other hand, I4_MODP(A,360) is between 0 and 360, always.
%
%  Example:
%
%        I     J     MOD  I4_MODP    Factorization
%
%      107    50       7       7    107 =  2 *  50 + 7
%      107   -50       7       7    107 = -2 * -50 + 7
%     -107    50      -7      43   -107 = -3 *  50 + 43
%     -107   -50      -7      43   -107 =  3 * -50 + 43
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 March 1999
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer I, the number to be divided.
%
%    Input, integer J, the number that divides I.
%
%    Output, integer VALUE, the nonnegative remainder when I is
%    divided by J.
%
  if ( j == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4_MODP - Fatal error!\n' );
    fprintf ( 1, '  Illegal divisor J = %d\n', j );
    error ( 'I4_MODP - Fatal error!' );
  end

  value = mod ( i, j );

  if ( value < 0 )
    value = value + abs ( j );
  end

  return
end
function value = index_to_level_closed ( dim_num, t, order, level_max )

%*******************************************************************************
%
%% INDEX_TO_LEVEL_CLOSED determines the level of a point given its index.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer T(DIM_NUM), the grid indices of a point in a 1D closed rule.
%    0 <= T(I) <= ORDER.
%
%    Input, integer ORDER, the order of the rule.
%
%    Input, integer LEVEL_MAX, the level with respect to which the
%    index applies.
%
%    Output, integer VALUE, the first level on which
%    the point associated with the given index will appear.
%
  value = 0;

  for dim = 1 : dim_num

    s = i4_modp ( t(dim), order );

    if ( s == 0 )

      level = 0;

    else

      level = level_max;

      while ( mod ( s, 2 ) == 0 )
        s = floor ( s / 2 );
        level = level - 1;
      end

    end

    if ( level == 0 )
      level = 1;
    elseif ( level == 1 )
      level = 0;
    end

    value = value + level;

  end

  return
end
function order = level_to_order_closed ( dim_num, level )

%*******************************************************************************
%
%% LEVEL_TO_ORDER_CLOSED converts a level to an order for closed rules.
%
%  Discussion:
%
%    Sparse grids can naturally be nested.  A natural scheme is to use
%    a series of one-dimensional rules arranged in a series of "levels"
%    whose order roughly doubles with each step.
%
%    The arrangement described here works naturally for the Clenshaw Curtis
%    and Newton Cotes closed rules.
%
%    The following table shows how the growth will occur:
%
%    Level    Order
%
%    0          1
%    1          3 =  2 + 1
%    2          5 =  4 + 1
%    3          9 =  8 + 1
%    4         17 = 16 + 1
%    5         33 = 32 + 1
%
%    For the Clenshaw Curtis and Newton Cotes Closed rules, the point growth
%    is nested.  If we have ORDER points on a particular LEVEL, the next
%    level includes all these old points, plus ORDER-1 new points, formed
%    in the gaps between successive pairs of old points.
%
%    Level    Order = New + Old
%
%    0          1   =  1  +  0
%    1          3   =  2  +  1
%    2          5   =  2  +  3
%    3          9   =  4  +  5
%    4         17   =  8  +  9
%    5         33   = 16  + 17
%
%    In this routine, we assume that a vector of levels is given,
%    and the corresponding orders are desired.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL(DIM_NUM), the nesting level.
%
%    Output, integer ORDER(DIM_NUM), the order (number of points) of the rule.
%
  order = zeros ( dim_num, 1 );

  for dim = 1 : dim_num

    if ( level(dim) < 0 )
      order(dim) = -1;
    elseif ( level(dim) == 0 )
      order(dim) = 1;
    else
      order(dim) = ( 2^level(dim) ) + 1;
    end

  end

  return
end
function indx = multigrid_index0 ( dim_num, order_1d, order_nd )

%*******************************************************************************
%
%% MULTIGRID_INDEX0 returns an indexed multidimensional grid.
%
%  Discussion:
%
%    For dimension DIM, the second index of INDX may vary from
%    0 to ORDER_1D(DIM)-1.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension of the points.
%
%    Input, integer ORDER_1D(DIM_NUM), the order of the
%    rule in each dimension.
%
%    Input, integer ORDER_ND, the product of the entries of ORDER_1D.
%
%    Output, integer INDX(DIM_NUM,ORDER_ND), the indices of the points in
%    the grid.  The second dimension of this array is equal to the
%    product of the entries of ORDER_1D.
%
  p = 0;
  indx = zeros(dim_num,order_nd);

  a = [];
  more = 0;

  while ( 1 )

    [ a, more ] = vec_colex_next2 ( dim_num, order_1d, a, more );

    if ( ~more )
      break
    end

    p = p + 1;

    indx(1:dim_num,p) = a(1:dim_num)';

  end

  return
end
function grid_index = multigrid_scale_closed ( dim_num, order_nd, level_max, ...
  level_1d, grid_index )

%*******************************************************************************
%
%% MULTIGRID_SCALE_CLOSED renumbers a grid as a subgrid on a higher level.
%
%  Discussion:
%
%    This routine takes a grid associated with a given value of
%    LEVEL, and multiplies all the indices by a power of 2, so that
%    the indices reflect the position of the same points, but in
%    a grid of level LEVEL_MAX.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer ORDER_ND, the number of points in the grid.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Input, integer LEVEL_1D(DIM_NUM), the level in each dimension.
%
%    Input, integer GRID_INDEX(DIM_NUM,POINT_NUM), the index
%    values for each grid point, based in the level for which the grid
%    was generated.
%
%    Output, integer GRID_INDEX(DIM_NUM,POINT_NUM), the index
%    values for each grid point, appropriate for the grid as a subgrid
%    of a grid of level LEVEL_MAX.
%
  for dim = 1 : dim_num

    if ( level_1d(dim) == 0 )

      if ( 0 == level_max )
        order_max = 1;
      else
        order_max = 2^level_max + 1;
      end

      grid_index(dim,1:order_nd) = floor ( ( order_max - 1 ) / 2 );

    else

      factor = 2^( level_max - level_1d(dim) );

      grid_index(dim,1:order_nd) = grid_index(dim,1:order_nd) * factor;

    end

  end

  return
end
function w_nd = product_weights_cc ( dim_num, order_1d, order_nd )

%*******************************************************************************
%
%% PRODUCT_WEIGHTS_CC computes weights for a Clenshaw Curtis product rule.
%
%  Discussion:
%
%    This routine computes the weights for a quadrature rule which is
%    a product of 1D closed rules of varying order.
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer ORDER_1D(DIM_NUM), the order of the 1D rules.
%
%    Input, integer ORDER_ND, the order of the product rule.
%
%    Output, real W_ND(DIM_NUM,ORDER_ND), the product rule weights.
%
  w_nd(1:order_nd) = 1.0;

  for dim = 1 : dim_num

    w_1d = cc_weights ( order_1d(dim) );

    w_nd = r8vec_direct_product2 ( dim, order_1d(dim), w_1d, dim_num, ...
      order_nd, w_nd );

  end

  return
end
function r8mat_transpose_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

%*******************************************************************************
%
%% R8MAT_TRANSPOSE_PRINT_SOME prints some of an R8MAT, transposed.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 May 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real A(M,N), an M by N matrix to be printed.
%
%    Input, integer ILO, JLO, the first row and column to print.
%
%    Input, integer IHI, JHI, the last row and column to print.
%
%    Input, string TITLE, an optional title.
%
  incx = 5;

  if ( 0 < s_len_trim ( title ) )
    fprintf ( 1, '\n' );
    fprintf ( 1, '%s\n', title );
  end

  for i2lo = max ( ilo, 1 ) : incx : min ( ihi, m )

    i2hi = i2lo + incx - 1;
    i2hi = min ( i2hi, m );
    i2hi = min ( i2hi, ihi );

    inc = i2hi + 1 - i2lo;

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Row: ' );
    for i = i2lo : i2hi
      fprintf ( 1, '%7d       ', i );
    end
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Col\n' );

    j2lo = max ( jlo, 1 );
    j2hi = min ( jhi, n );

    for j = j2lo : j2hi

      fprintf ( 1, '%5d ', j );
      for i2 = 1 : inc
        i = i2lo - 1 + i2;
        fprintf ( 1, '%12f', a(i,j) );
      end
      fprintf ( 1, '\n' );

    end

  end

  return
end
function r8mat_write ( output_filename, m, n, table )

%*****************************************************************************80
%
%% R8MAT_WRITE writes an R8MAT file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 August 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string OUTPUT_FILENAME, the output filename.
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer N, the number of points.
%
%    Input, real TABLE(M,N), the points.
%

%
%  Open the file.
%
  output_unit = fopen ( output_filename, 'wt' );

  if ( output_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8MAT_WRITE - Error!\n' );
    fprintf ( 1, '  Could not open the output file.\n' );
    error ( 'R8MAT_WRITE - Error!' );
  end
%
%  Write the data.
%
%  For smaller data files, and less precision, try:
%
%     fprintf ( output_unit, '  %14.6f', table(i,j) );
%
  for j = 1 : n
    for i = 1 : m
      fprintf ( output_unit, '  %24.16f', table(i,j) );
    end
    fprintf ( output_unit, '\n' );
  end
%
%  Close the file.
%
  fclose ( output_unit );

  return
end
function w = r8vec_direct_product2 ( factor_index, factor_order, ...
  factor_value, factor_num, point_num, w )

%*******************************************************************************
%
%% R8VEC_DIRECT_PRODUCT2 creates a direct product of R8VEC's.
%
%  Discussion:
%
%    To explain what is going on here, suppose we had to construct
%    a multidimensional quadrature rule as the product of K rules
%    for 1D quadrature.
%
%    The product rule will be represented as a list of points and weights.
%
%    The J-th item in the product rule will be associated with
%      item J1 of 1D rule 1,
%      item J2 of 1D rule 2,
%      ...,
%      item JK of 1D rule K.
%
%    In particular,
%      X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK))
%    and
%      W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK)
%
%    So we can construct the quadrature rule if we can properly
%    distribute the information in the 1D quadrature rules.
%
%    This routine carries out that task for the weights W.
%
%    Another way to do this would be to compute, one by one, the
%    set of all possible indices (J1,J2,...,JK), and then index
%    the appropriate information.  An advantage of the method shown
%    here is that you can process the K-th set of information and
%    then discard it.
%
%  Example:
%
%    Rule 1:
%      Order = 4
%      W(1:4) = ( 2, 3, 5, 7 )
%
%    Rule 2:
%      Order = 3
%      W(1:3) = ( 11, 13, 17 )
%
%    Rule 3:
%      Order = 2
%      W(1:2) = ( 19, 23 )
%
%    Product Rule:
%      Order = 24
%      W(1:24) =
%        ( 2 * 11 * 19 )
%        ( 3 * 11 * 19 )
%        ( 4 * 11 * 19 )
%        ( 7 * 11 * 19 )
%        ( 2 * 13 * 19 )
%        ( 3 * 13 * 19 )
%        ( 5 * 13 * 19 )
%        ( 7 * 13 * 19 )
%        ( 2 * 17 * 19 )
%        ( 3 * 17 * 19 )
%        ( 5 * 17 * 19 )
%        ( 7 * 17 * 19 )
%        ( 2 * 11 * 23 )
%        ( 3 * 11 * 23 )
%        ( 5 * 11 * 23 )
%        ( 7 * 11 * 23 )
%        ( 2 * 13 * 23 )
%        ( 3 * 13 * 23 )
%        ( 5 * 13 * 23 )
%        ( 7 * 13 * 23 )
%        ( 2 * 17 * 23 )
%        ( 3 * 17 * 23 )
%        ( 5 * 17 * 23 )
%        ( 7 * 17 * 23 )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer FACTOR_INDEX, the index of the factor being processed.
%    The first factor processed must be factor 1.
%
%    Input, integer FACTOR_ORDER, the order of the factor.
%
%    Input, real FACTOR_VALUE(FACTOR_ORDER), the factor values for
%    factor FACTOR_INDEX.
%
%    Input, integer FACTOR_NUM, the number of factors.
%
%    Input, integer POINT_NUM, the number of elements in the direct product.
%
%    Input/output, real W(POINT_NUM), the elements of the
%    direct product, updated by the latest factor.
%
%  Local Parameters:
%
%    Local, integer START, the first location of a block of values to set.
%
%    Local, integer CONTIG, the number of consecutive values to set.
%
%    Local, integer SKIP, the distance from the current value of START
%    to the next location of a block of values to set.
%
%    Local, integer REP, the number of blocks of values to set.
%
  persistent contig;
  persistent rep;
  persistent skip;

  if ( factor_index == 1 )
    contig = 1;
    skip = 1;
    rep = point_num;
    w(1:point_num) = 1.0;
  end

  rep = rep / factor_order;
  skip = skip * factor_order;

  for j = 1 : factor_order

    start = 1 + ( j - 1 ) * contig;

    for k = 1 : rep
      w(start:start+contig-1) = w(start:start+contig-1) * factor_value(j);
      start = start + skip;
    end

  end

  contig = contig * factor_order;

  return
end
function r8vec_print_some ( n, a, i_lo, i_hi, title )

%*******************************************************************************
%
%% R8VEC_PRINT_SOME prints "some" of an R8VEC.
%
%  Discussion:
%
%    An R8VEC is a vector of R8 values.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 October 2006
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the dimension of the vector.
%
%    Input, real A(N), the vector to be printed.
%
%    Input, integer MAX_PRINT, the maximum number of lines to print.
%
%    Input, string TITLE, an optional title.
%
  if ( 0 < s_len_trim ( title ) )
    fprintf ( 1, '\n' );
    fprintf ( 1, '%s\n', title );
  end

  fprintf ( 1, '\n' );

  for i = max ( 1, i_lo ) : min ( n, i_hi )
    fprintf ( 1, '  %8d  %12f\n', i, a(i) );
  end

  return
end
function len = s_len_trim ( s )

%*******************************************************************************
%
%% S_LEN_TRIM returns the length of a character string to the last nonblank.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 June 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be measured.
%
%    Output, integer LEN, the length of the string up to the last nonblank.
%
  len = length ( s );

  while ( 0 < len )
    if ( s(len) ~= ' ' )
      return
    end
    len = len - 1;
  end

  return
end
 function [ grid_weight, grid_point ] = sparse_grid_cc ( dim_num, ...
   level_max, point_num  )

%*******************************************************************************
%
%% SPARSE_GRID_CC computes a sparse grid of Clenshaw Curtis points.
%
%  Discussion:
%
%    This program computes a quadrature rule and writes it to a file.
%
%    The quadrature rule is associated with a sparse grid derived from
%    a Smolyak construction using a closed 1D quadrature rule.
%
%    The user specifies:
%    * the spatial dimension of the quadrature region,
%    * the level that defines the Smolyak grid.
%    * the closed 1D quadrature rule (Clenshaw-Curtis or Newton-Cotes Closed).
%
%  License:
%
%    This software is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, controls the size of the final sparse grid.
%
%    Input, integer POINT_NUM, the number of points in the grid, as determined
%    by SPARSE_GRID_CC_SIZE.
%
%    Output, real GRID_WEIGHTS(POINT_NUM), the weights.
%
%    Output, real GRID_POINTS(DIM_NUM,POINT_NUM), the points.
%

%
%  Determine the index vector, relative to the full product grid,
%  that identifies the points in the sparse grid.
%
  grid_index = sparse_grid_cc_index ( dim_num, level_max, point_num );
%
%  Compute the physical coordinates of the abscissas.
%
  if ( 0 == level_max )
    order_max = 1;
  else
    order_max = 2^level_max + 1;
  end

  grid_point = zeros ( dim_num, point_num );

  for point = 1 : point_num
    for dim = 1 : dim_num
      grid_point(dim,point) = ...
        cc_abscissa ( order_max, grid_index(dim,point) + 1 );
    end
  end
%
%  Gather the weights.
%
  grid_weight = sparse_grid_cc_weights ( dim_num, level_max, point_num, ...
    grid_index );

  return
end
function grid_index = sparse_grid_cc_index ( dim_num, level_max, point_num )

%*******************************************************************************
%
%% SPARSE_GRID_CC_INDEX indexes the points forming a sparse grid.
%
%  Discussion:
%
%    The points forming the sparse grid are guaranteed to be a subset
%    of a certain product grid.  The product grid is formed by DIM_NUM
%    copies of a 1D rule of fixed order.  The orders of the 1D rule,
%    (called ORDER_1D) and the order of the product grid, (called ORDER)
%    are determined from the value LEVEL_MAX.
%
%    Thus, any point in the product grid can be identified by its grid index,
%    a set of DIM_NUM indices, each between 1 and ORDER_1D.
%
%    This routine creates the GRID_INDEX array, listing (uniquely) the
%    points of the sparse grid.
%
%    An assumption has been made that the 1D rule is closed (includes
%    the interval endpoints) and nested (points that are part of a rule
%    of a given level will be part of every rule of higher level).
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 July 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Input, integer POINT_NUM, the total number of points in the grids.
%
%    Output, integer GRID_INDEX(DIM_NUM,POINT_NUM), a list of point indices,
%    representing a subset of the product grid of level LEVEL_MAX,
%    representing (exactly once) each point that will show up in a
%    sparse grid of level LEVEL_MAX.
%
  grid_index = zeros ( dim_num, point_num );
%
%  The outer loop generates LEVELs from 0 to LEVEL_MAX.
%
  point_num2 = 0;

  for level = 0 : level_max
%
%  The middle loop generates the next partition LEVEL_1D(1:DIM_NUM)
%  that adds up to LEVEL.
%
    level_1d = [];
    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );
%
%  Transform each 1D level to a corresponding 1D order.
%
      order_1d = level_to_order_closed ( dim_num, level_1d );
%
%  The product of the 1D orders gives us the number of points in this grid.
%
      order_nd = prod ( order_1d(1:dim_num) );
%
%  The inner (hidden) loop generates all points corresponding to given grid.
%
      grid_index2 = multigrid_index0 ( dim_num, order_1d, order_nd );
%
%  Adjust these grid indices to reflect LEVEL_MAX.
%
      grid_index2 = multigrid_scale_closed ( dim_num, order_nd, level_max, level_1d, ...
        grid_index2 );
%
%  Determine the first level of appearance of each of the points.
%
      grid_level = abscissa_level_closed_nd ( level_max, dim_num, order_nd, ....
        grid_index2 );
%
%  Only keep those points which first appear on this level.
%
      for point = 1 : order_nd

        if ( grid_level(point) == level )

          point_num2 = point_num2 + 1;

          grid_index(1:dim_num,point_num2) = grid_index2(1:dim_num,point);

        end

      end

      if ( ~more )
        break
      end

    end

  end

  return
end
function point_num = sparse_grid_cfn_size ( dim_num, level_max )

%*****************************************************************************80
%
%% SPARSE_GRID_CFN_SIZE sizes a sparse grid using Closed Fully Nested rules.
%
%  Discussion:
%
%    The grid is defined as the sum of the product rules whose LEVEL
%    satisfies:
%
%      0 <= LEVEL <= LEVEL_MAX.
%
%    This calculation is much faster than a previous method.  It simply
%    computes the number of new points that are added at each level in the
%    1D rule, and then counts the new points at a given DIM_NUM dimensional
%    level vector as the product of the new points added in each dimension.
%
%    This approach will work for nested families, and may be extensible
%    to other families, and to mixed rules.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 December 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Output, integer POINT_NUM, the total number of unique
%    points in the grids.
%

%
%  Special case.
%
  if ( level_max < 0 )
    point_num = 0;
    return
  end

  if ( level_max == 0 )
    point_num = 1;
    return
  end
%
%  Construct the vector that counts the new points in the 1D rule.
%
  new_1d = zeros ( level_max+1, 1 );

  new_1d(0+1) = 1;
  new_1d(1+1) = 2;

  j = 1;
  for i = 2 : level_max
    j = j * 2;
    new_1d(i+1) = j;
  end
%
%  Count the number of points by counting the number of new points
%  associated with each level vector.
%
  level_1d = zeros ( dim_num, 1 );

  point_num = 0;

  for level = 0 : level_max

    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );

      point_num = point_num + prod ( new_1d(level_1d(1:dim_num)+1) );

      if ( ~more )
        break
      end

    end

  end

  return
end
function grid_weight = sparse_grid_cc_weights ( dim_num, level_max, point_num, ...
  grid_index )

%*******************************************************************************
%
%% SPARSE_GRID_CC_WEIGHTS gathers the weights.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 July 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Fabio Nobile, Raul Tempone, Clayton Webster,
%    A Sparse Grid Stochastic Collocation Method for Partial Differential
%    Equations with Random Input Data,
%    SIAM Journal on Numerical Analysis,
%    Volume 46, Number 5, 2008, pages 2309-2345.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer LEVEL_MAX, the maximum value of LEVEL.
%
%    Input, integer POINT_NUM, the total number of points in the grids.
%
%    Input, integer GRID_INDEX(DIM_NUM,POINT_NUM), a list of point indices,
%    representing a subset of the product grid of level LEVEL_MAX,
%    representing (exactly once) each point that will show up in a
%    sparse grid of level LEVEL_MAX.
%
%    Output, real GRID_WEIGHT(POINT_NUM), the weights
%    associated with the sparse grid points.
%
  if ( level_max == 0 )
    grid_weight(1:point_num) = 2.0^dim_num;
    return
  end

  grid_weight(1:point_num) = 0.0;

  level_min = max ( 0, level_max + 1 - dim_num );

  for level = level_min : level_max
%
%  The middle loop generates the next partition LEVEL_1D(1:DIM_NUM)
%  that adds up to LEVEL.
%
    level_1d = [];
    more = 0;
    h = 0;
    t = 0;

    while ( 1 )

      [ level_1d, more, h, t ] = comp_next ( level, dim_num, level_1d, more, h, t );
%
%  Transform each 1D level to a corresponding 1D order.
%
      order_1d = level_to_order_closed ( dim_num, level_1d );
%
%  The product of the 1D orders gives us the number of points in this grid.
%
      order_nd = prod ( order_1d(1:dim_num) );
%
%  Generate the indices of the points corresponding to the grid.
%
      grid_index2 = multigrid_index0 ( dim_num, order_1d, order_nd );
%
%  Compute the weights for this grid.
%
      grid_weight2 = product_weights_cc ( dim_num, order_1d, order_nd );
%
%  Adjust the grid indices to reflect LEVEL_MAX.
%
      grid_index2 = multigrid_scale_closed ( dim_num, order_nd, level_max, ...
        level_1d, grid_index2 );
%
%  Now determine the coefficient.
%
      coeff = (-1)^( level_max - level ) ...
        * choose ( dim_num - 1, level_max - level );

      for point2 = 1 : order_nd

        for point = 1 : point_num

          if ( all ( ...
            grid_index2(1:dim_num,point2) == grid_index(1:dim_num,point) ...
          ) )
            grid_weight(point) = grid_weight(point) ...
              + coeff * grid_weight2(point2);
            break
          end

        end

      end

      if ( ~more )
        break
      end

    end

  end

  return
end
function timestamp ( )

%*******************************************************************************
%
%% TIMESTAMP prints the current YMDHMS date as a timestamp.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  t = now;
  c = datevec ( t );
  s = datestr ( c, 0 );
  fprintf ( 1, '%s\n', s );

  return
end
function [ a, more ] = vec_colex_next2 ( dim_num, base, a, more )

%*******************************************************************************
%
%% VEC_COLEX_NEXT2 generates vectors in colex order.
%
%  Discussion:
%
%    The vectors are produced in colexical order, starting with
%    (0,0,...,0),
%    (1,0,...,0),
%    ...
%    (BASE(1)-1,BASE(2)-1,...,BASE(DIM_NUM)-1).
%
%  Example:
%
%    DIM_NUM = 2,
%    BASE = [ 3, 3]
%
%    0   0
%    1   0
%    2   0
%    0   1
%    1   1
%    2   1
%    0   2
%    1   2
%    2   2
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 November 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Dennis Stanton, Dennis White,
%    Constructive Combinatorics,
%    Springer, 1986,
%    ISBN: 0387963472,
%    LC: QA164.S79.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Input, integer BASE(DIM_NUM), the base to be used in each dimension.
%
%    Input, integer A(DIM_NUM), except on the first call, this should
%    be the output value of A on the last call.
%
%    Input, logical MORE, should be FALSE on the first call, and
%    thereafter should be the output value of MORE from the previous call.
%
%    Output, integer A(DIM_NUM), the next vector.
%
%    Output, logical MORE, is TRUE if another vector was computed.
%    If MORE is FALSE on return, then ignore the output value A, and
%    stop calling the routine.
%
  if ( ~more )

    a(1:dim_num) = 0;
    more = 1;

  else

    for i = 1 : dim_num

      a(i) = a(i) + 1;

      if ( a(i) < base(i) )
        return
      end

      a(i) = 0;

    end

    more = 0;

  end

  return
end


function s = resampstr(p,m,n)
%RESAMPSTR Stratified resampling
%
%  Description
%    S = RESAMPSTR(P) returns a new set of indices according to
%      the probabilities P. P is array of probabilities, which are
%      not necessarily normalized, though they must be
%      non-negative, and not all zero. The size of S is the size of P.
%
%    S = RESAMPSTR(P,M,N) returns an M by N matrix.
%
%    Default is to use no-sort resampling. For sorted resampling use
%      [PS,PI]=SORT(P);
%      S=PI(RESAMPSTR(PS));
%    Sorted re-sampling is slower but has slightly smaller
%    variance. Stratified resampling is unbiased, almost as fast as
%    deterministic resampling (RESAMPDET), and has only a slightly
%    larger variance.
%
%    In stratified resampling indices are sampled using random
%    numbers u_j~U[(j-1)/n,j/n], where n is length of P. Compare
%    this to simple random resampling where u_j~U[0,1].
%
%  Reference
%    Kitagawa, G., Monte Carlo Filter and Smoother for Non-Gaussian
%    Nonlinear State Space Models, Journal of Computational and
%    Graphical Statistics, 5(1):1-25, 1996.
%
%  See also
%    RESAMPSIM, RESAMPRES, RESAMPDET
%
% Copyright (c) 2003-2004,2010 Aki Vehtari

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

if nargin<2
  [m,n]=size(p);
elseif nargin==2
  n=m;
end
mn=m.*n;
pn=p./sum(p(:)).*mn;
s=zeros(m,n);
r=rand(1,mn);
k=0;
c=0;
for i=1:numel(pn)
  c=c+pn(i);
  if c>=1
    a=floor(c);
    c=c-a;
    s(k+[1:a])=i;
    k=k+a;
  end
  if k<mn && c>=r(k+1)
    c=c-1;
    k=k+1;
    s(k)=i;
  end
end


function p = prior_corrunif(varargin)
% * PRIOR_R  Correlation prior structure
%
% * Description:
%
%  - REFERENCE: prior for correlation matrix
%    Barnard, J.; McCulloch, R. & li Meng, X.
%    Modelling covariance matrices in terms of standart deviations and correlations
%    with applications to shrinkage. Statistical Sinica, 2000
%
%  - P = PRIOR_CORRUNIF('PARAM1', VALUE1, ...)
%    creates the prior structure in which the
%    named parameters have the specified values. Any unspecified
%    parameters are set to default values.
%
%  - P = PRIOR_CORRUNIF(P, 'PARAM1', VALUE1, ...)
%    modify a prior structure with the named parameters altered
%    with the specified values.
%
%  - Parameters for correlation prior [default]
%     nu       - degree of freedom [15]
%     prior_nu - prior for nu [prior_fixed]
%
%  - some inverse-Wishart properties
%    if W ~ InvWish_d (v, A) then E[W] = A/(v-d-1)
%    nu > = d
%    d = number os species (dimension of the square matrix)
%    the construction for this prior assumes A = I.
%
%  - dimension of the correlation vector: (numberClass^2 - numberClass)/2
%
% * See also
%    PRIOR_*
%
% Copyright (c) 2000-2001,2010 Aki Vehtari
% Copyright (c) 2009,2015 Jarno Vanhatalo
% Copyright (c) 2010 Jaakko Riihimäki
% ------------ 2015 Marcelo Hartmann

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

  ip = inputParser;
  ip.FunctionName = 'PRIOR_CORRUNIF';
  ip.addOptional('p', [], @isstruct);
  ip.addParamValue('nu', 15, @(x) isscalar(x) && x > 0);
  ip.addParamValue('prior_nu', [], @(x) isstruct(x) || isempty(x));
  ip.addParamValue('numberClass', 2, @(x) mod(x, 1) == 0 && x > 1);
  ip.addParamValue('aValue', 1, @(x) isreal(x) &&  x > 0);
  ip.parse(varargin{:});
  p = ip.Results.p;

  if isempty(p)
    init = true;
    p.type = 'CORRUNIF';

  else
    if ~isfield(p, 'type') && ~isequal(p.type, 'CORRUNIF')
      error('First argument does not seem to be a valid prior structure')
    end

    init = false;
  end

  % transformation to the real line (aValue stretches or squeeze the real line).
  p.aValue = ip.Results.aValue;

  % Initialize parameters
  % check the condition nu > numberSpecies
  if init || ~ismember('nu', ip.UsingDefaults)
      p.nu = ip.Results.nu;
  end

  if init || ~ismember('numberClass', ip.UsingDefaults)
      p.numberClass = ip.Results.numberClass;
      p.vectSize = (p.numberClass^2 - p.numberClass)/2;
  end

  if p.nu < (p.numberClass - 1)
      error('Degrees of freedom (nu) should be greater than number of classes')
  end

  % Initialize prior structure
  if init
      p.p = [];
  end
  if init || ~ismember('nu_prior', ip.UsingDefaults)
      p.p.nu = ip.Results.prior_nu;
  end

  if init
    % set functions
    p.fh.pak = @prior_corrunif_pak;
    p.fh.unpak = @prior_corrunif_unpak;
  % p.fh.RealToRho = @prior_corrunif_RealToRho;
    p.fh.lp = @prior_corrunif_lp;
    p.fh.lpg = @prior_corrunif_lpg;
    p.fh.recappend = @prior_corrunif_recappend;
  end

end

function [w, s, h] = prior_corrunif_pak(p)
% This is a mandatory subfunction used for example
% in energy and gradient computations.

  w = [];  s = {};  h = [];

  if ~isempty(p.p.nu)
      w = [w p.nu];
      s = [s; 'R.nu'];
      h = [h 1];
  end

end

function [p, w] = prior_corrunif_unpak(p, w)
% This is a mandatory subfunction used for example
% in energy and gradient computations.

  if ~isempty(p.p.nu)
      i1 = 1;
      p.nu = w(i1);
      w = w(i1 + 1:end);
  end

end

function lp = prior_corrunif_lp(x, p)
% This is a mandatory subfunction used for example
% in energy computations.

  % Evaluating log-prior(R)
  % correlation vector
  rho = x';

  % create entries
  seq = 1:p.vectSize;
  i = ceil(0.5 + 0.5 * sqrt(1 + 8*(seq)));
  j = seq - (i - 2).*(i - 1)/2;
  ind1 = (j - 1) * p.numberClass + i;
  ind2 = (i - 1) * p.numberClass + j;

  % build correlation matrix
  R = eye(p.numberClass);

  % filling elements in lower and upper part
  R([ind1, ind2]) = [rho; rho];
  detR = det(R);

  if eps < detR && ~any(abs(rho) > 1)
      % cholesk decompostion
      L = chol(R, 'lower');

      % parameters of the distribution
      a = 0.5*(p.nu - 1)*(p.numberClass - 1) - 1;
      b = - p.nu/2;

      % building principal submatrices and evaluating log determinant
      sDetlogSub = 0;
      for k = 1:p.numberClass
          A = R;
          A(:, k) = []; A(k, :) = [];
          Lsub = chol(A, 'lower');
          sDetlogSub = sDetlogSub + sum(log(diag(Lsub)));
      end

      % evaluating unnormalized log-prior
      lp = 2 * (a*sum(log(diag(L))) + b*sDetlogSub);

  else
      lp = -Inf;

  end

% adding log-hyperprior(nu)
if ~isempty(p.p.nu)
    lp = lp + p.p.nu.fh.lp(p.nu, p.p.nu) + log(p.nu);
end

end

function lpg = prior_corrunif_lpg(x, p)
% This is a mandatory subfunction used for example
% in gradient computations.

 % taking the correlation vector
 rho = x';

 % creating entries
 seq = 1:p.vectSize;
 i = ceil(0.5 + 0.5 * sqrt(1 + 8*(seq)));
 j = seq - (i - 2).*(i - 1)/2;
 ind1 = (j - 1) * p.numberClass + i;
 ind2 = (i - 1) * p.numberClass + j;

 % building corr matrix
 R = eye(p.numberClass);

 % filling elements in lower and upper part
 R([ind1, ind2]) = [rho; rho];

 % all(eig(R) > 0)
  if ~any(abs(rho) > 1)

     % grad vector
     lpg = ones(1, p.vectSize);

     % cholesk decompostion
     % L = chol(R, 'lower');

     % parameters of the distribution
     a = 0.5*(p.nu - 1)*(p.numberClass - 1) - 1;
     b = - p.nu/2;

     % building principal submatrices and evaluating log determinant
     invR = inv(R);

     % COULD WE USE COFACTOR MATRIX ?
     % Id1 = eye(p.numberClass-1);
     aux = 0;

     for j = 2:p.numberClass
         for i = 1:(j-1)
             sumtrDer = 0;
             sumtrDer = sumtrDer + 2*a*invR(j, i);
             for k = 1:p.numberClass
                 if k == i || k == j
                     % sumtrDer = sumtrDer + 0;
                     continue
                 else
                     A = R;
                     A(:, k) = []; A(k, :) = [];
                     % L = chol(A, 'lower');
                     invAk = inv(A);
                     if k < j && (i == 1 || k > i)
                         m = j-1;
                         sumtrDer = sumtrDer + 2*b*invAk(m, i);
                     elseif k < j && k < i
                         l = i-1;
                         m = j-1;
                         sumtrDer = sumtrDer + 2*b*invAk(m, l);
                     else
                         sumtrDer = sumtrDer + 2*b*invAk(j, i);
                     end
                 end
             end
             aux = aux + 1;
             lpg(aux) = sumtrDer;
         end
     end

 else
     lpg = repmat(-Inf, 1, p.vectSize);
 end

 if ~isempty(p.p.nu)
     lpgnu = p.p.nu.fh.lpg(p.nu, p.p.nu).*p.nu + 1;
     lpg = [lpg lpgnu];
  end
end

function rec = prior_corrunif_recappend(rec, ri, p)
% This subfunction is needed when using MCMC sampling (gp_mc).
% The parameters are not sampled in any case.

rec = rec;
if ~isempty(p.p.nu)
    rec.nu(ri,:) = p.nu;
end

end


function cvt_test04 ( )

%*****************************************************************************80
%
%% CVT_TEST04 repeats test 1 with uniform initialization and Halton sampling.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 November 2006
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST04\n' );
  fprintf ( 1, '  CVT computes a Centroidal Voronoi Tessellation.\n' );
  fprintf ( 1, '  Repeat test 1, but with Halton sampling.\n' );

  dim_num = 2;
  n = 10;
  batch = 1000;
  init = 0;
  init_string = 'uniform';
  it_max = 40;
  it_fixed = 1;
  sample = 1;
  sample_num = 10000;
  sample_string = 'halton';
  seed = 123456789;
  r = [];

  seed_init = seed;

  [ r, seed, it_num, it_diff, energy ] = cvt ( dim_num, n, batch, init, ...
    sample, sample_num, it_max, it_fixed, seed, r );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Dimension DIM_NUM =        %12d\n', dim_num );
  fprintf ( 1, '  Number of points N =       %12d\n', n );
  fprintf ( 1, '  Initial SEED =             %12d\n', seed_init );
  fprintf ( 1, '  Current SEED =             %12d\n', seed );
  fprintf ( 1, '  INIT =                    "%s".\n', init_string );
  fprintf ( 1, '  Max iterations IT_MAX =    %12d\n', it_max );
  fprintf ( 1, '  IT_FIXED (fixed samples) = %12d\n', it_fixed );
  fprintf ( 1, '  Iterations IT_NUM =        %12d\n', it_num );
  fprintf ( 1, '  Difference IT_DIFF =       %14f\n', it_diff );
  fprintf ( 1, '  CVT ENERGY =               %14f\n', energy );
  fprintf ( 1, '  SAMPLE =                  "%s".\n', sample_string );
  fprintf ( 1, '  Samples SAMPLE_NUM    =    %12d\n', sample_num );
  fprintf ( 1, '  Sampling BATCH size =      %12d\n', batch );
  fprintf ( 1, '  EPSILON (unit roundoff) =  %12e\n', eps );

  r8mat_transpose_print ( dim_num, n, r, '  Generators (rows):' );

  return
end


function [blockedIrrRxns, sol, tol] = findBlockedIrrRxns(model, tol, varargin)
% find all blocked irreversible reactions by solving one single LP problem:
%      min sum(z_pos + z_neg)
%      s.t.   Sv = 0
%             lb <= v <= ub
%             v_j + tol*z_pos_j >= tol   for each reaction j with lb_j >= 0
%             v_j - tol*z_neg_j <= -tol  for each reaction j with ub_j <= 0
%
% USAGE:
%    [blockedIrrRxns, fluxes] = findBlockedIrrRxns(model, tol, parameters)
%
% INPUT:
%    model:           COBRA model
%
% OPTIONAL INPUTL
%    tol:             tolerance for zeros (default feasTol*10, use default if the input is smaller)
%    parameters:      COBRA and solver-specific parameters, as a input structure or parameter/value inputs
%
% OUTPUTS:
%    blockedIrrRxns:  cell array of blocked irreversible reactions
%    sol:             solution structure from solveCobraLP
%    tol:             tolerance for zeros used (might be different from the input)

if nargin < 2
    tol = 0;
end

[~, cobraParams, solverVarargin] = parseCobraVarargin(varargin, {}, {}, {}, {'LP'});
% if tol < feasTol * 10, v, z_pos, z_neg = 0 may be feasible due to tolerance
tol = max([tol, cobraParams.LP.feasTol * 10]);

LP = struct();
if 0
    rxnFwdOnly = find(model.lb >= 0);
    rxnRevOnly = find(model.ub <= 0);
else
    %avoid reactions bound at zero
    rxnFwdOnly = find(model.lb >= 0 & model.ub>0);
    rxnRevOnly = find(model.ub <= 0 & model.lb<0);
end
[nF, nR] = deal(numel(rxnFwdOnly), numel(rxnRevOnly));
[m, n] = size(model.S);
LP.A = [model.S,                        sparse(m, nF + nR); ...  % Sv = 0
    sparse(1:nF, rxnFwdOnly, 1, nF, n), sparse(1:nF, 1:nF, tol, nF, nF + nR); ...  % v + tol*z_pos >= tol
    sparse(1:nR, rxnRevOnly, 1, nR, n), sparse(1:nR, (nF + 1):(nF + nR), -tol, nR, nF + nR)];  % v - tol*z_neg <= -tol
LP.b = [model.b; tol * ones(nF, 1); -tol * ones(nR, 1)];
LP.c = [zeros(n, 1); ones(nF + nR, 1)];
LP.lb = [model.lb; zeros(nF + nR, 1)];
LP.ub = [model.ub; ones(nF + nR, 1)];
LP.csense = [repmat('E', m, 1); repmat('G', nF, 1); repmat('L', nR, 1)];
LP.osense = 1;

sol = solveCobraLP(LP, solverVarargin.LP{:});

if sol.stat ~= 1
    warning('The model is infeasible')
    blockedIrrRxns = {};
    return
end

blockedIrrRxns = model.rxns((abs(sol.full(1:n)) < tol * (1 - cobraParams.LP.optTol)) & (model.lb >= 0 | model.ub <= 0));


% maximally flat delay LC filter pp 323 A. I. Zveref
% Copyright 2004-2013 The MathWorks, Inc.
R=8;      % load resistance
fc=80e3;  % bandpass corner

w=2*pi*fc;

c1=1.5012; l2=0.978; c3=.612;l4=.211;  % Rs=inf,  Rl = 1
% scale for freq and impedance ...
C1=c1/(R*w)
L2=l2*R/w
C3=c3/(R*w)
L4=l4*R/w


function [A] = tapas_uniqc_spm_matrix(P, order)
% Return an affine transformation matrix
% copy of spm_matrix from Version 6906 (SPM12) 20-Oct-16
% FORMAT [A] = spm_matrix(P [,order])
% P(1)  - x translation
% P(2)  - y translation
% P(3)  - z translation
% P(4)  - x rotation about - {pitch} (radians)
% P(5)  - y rotation about - {roll}  (radians)
% P(6)  - z rotation about - {yaw}   (radians)
% P(7)  - x scaling
% P(8)  - y scaling
% P(9)  - z scaling
% P(10) - x affine
% P(11) - y affine
% P(12) - z affine
%
% order - application order of transformations [Default: 'T*R*Z*S']
%
% A     - affine transformation matrix
%__________________________________________________________________________
%
% spm_matrix returns a matrix defining an orthogonal linear (translation,
% rotation, scaling or affine) transformation given a vector of
% parameters (P).  By default, the transformations are applied in the
% following order (i.e., the opposite to which they are specified):
%
% 1) shear
% 2) scale (zoom)
% 3) rotation - yaw, roll & pitch
% 4) translation
%
% This order can be changed by calling spm_matrix with a string as a
% second argument. This string may contain any valid MATLAB expression
% that returns a 4x4 matrix after evaluation. The special characters 'S',
% 'Z', 'R', 'T' can be used to reference the transformations 1)-4)
% above. The default order is 'T*R*Z*S', as described above.
%
% SPM uses a PRE-multiplication format i.e. Y = A*X where X and Y are 4 x n
% matrices of n coordinates.
%__________________________________________________________________________
%
% See also: tapas_uniqc_spm_imatrix.m
%__________________________________________________________________________
% Copyright (C) 1994-2011 Wellcome Trust Centre for Neuroimaging

% Karl Friston

%-Special case: translation only
%--------------------------------------------------------------------------
if numel(P) == 3
    A = eye(4);
    A(1:3,4) = P(:);
    return;
end

%-Pad P with 'null' parameters
%--------------------------------------------------------------------------
q  = [0 0 0 0 0 0 1 1 1 0 0 0];
P  = [P q((length(P) + 1):12)];

%-Translation / Rotation / Scale / Shear
%--------------------------------------------------------------------------
T  =   [1   0   0   P(1);
        0   1   0   P(2);
        0   0   1   P(3);
        0   0   0   1];

R1  =  [1   0           0           0;
        0   cos(P(4))   sin(P(4))   0;
        0  -sin(P(4))   cos(P(4))   0;
        0   0           0           1];

R2  =  [cos(P(5))   0   sin(P(5))   0;
        0           1   0           0;
       -sin(P(5))   0   cos(P(5))   0;
        0           0   0           1];

R3  =  [cos(P(6))   sin(P(6))   0   0;
       -sin(P(6))   cos(P(6))   0   0;
        0           0           1   0;
        0           0           0   1];

R   = R1*R2*R3;

Z   =  [P(7)   0       0       0;
        0      P(8)    0       0;
        0      0       P(9)    0;
        0      0       0       1];

S   =  [1      P(10)   P(11)   0;
        0      1       P(12)   0;
        0      0       1       0;
        0      0       0       1];

%-Affine transformation matrix
%--------------------------------------------------------------------------
if nargin < 2
    A = T*R*Z*S;
else
    A = eval(sprintf('%s;', order));
    if ~isnumeric(A) || ~isequal(size(A),[4 4])
        error('tapas:uniqc:SpmMatrix:InvalidOrderExpression', ...
            'Invalid order expression ''%s''.', order);
    end
end


% MRC_scheme.m
% Receiver diversity - MRC
clear, clf
L_frame=130;
N_packet=4000;
b=2;                % Set to 1/2/3/4 for BPSK/QPSK/16QAM/64QAM
SNRdBs=[0:2:20];
sq2=sqrt(2);
%SNRdBs=[0:10:20]; sq2=sqrt(2);
for iter=1:3
   if iter==1
       NT=1;
       NR=1;
       gs='-kx'; % SISO
    elseif iter==2
        NT=1;
        NR=2;
        gs='-^';
   else
       NT=1;
       NR=4;
       gs='-ro';
   end
   sq_NT=sqrt(NT);
   for i_SNR=1:length(SNRdBs)
      SNRdB=SNRdBs(i_SNR);
      sigma=sqrt(0.5/(10^(SNRdB/10)));
      for i_packet=1:N_packet
         symbol_data=randi([0,1],L_frame*b,NT);
         [temp,sym_tab,P]=modulator(symbol_data.',b);
         X=temp.';
         Hr = (randn(L_frame,NR)+j*randn(L_frame,NR))/sq2;
         H = reshape(Hr,L_frame,NR);
         Habs = sum(abs(H).^2,2);
         Z=0;
         for i=1:NR
            R(:,i) = sum(H(:,i).*X,2)/sq_NT + sigma*(randn(L_frame,1)+j*randn(L_frame,1));
            Z = Z + R(:,i).*conj(H(:,i));
         end
         for m=1:P
            d1(:,m)=abs(sum(Z,2)-sym_tab(m)).^2+(-1+sum(Habs,2))*abs(sym_tab(m))^2;
         end
         [y1,i1] = min(d1,[],2);
         Xd=sym_tab(i1).';
         temp1 = X>0;
         temp2 = Xd>0;
         noeb_p(i_packet)=sum(sum(temp1~=temp2));
      end
      BER(iter,i_SNR) = sum(noeb_p)/(N_packet*L_frame*b);
   end
   semilogy(SNRdBs,BER(iter,:),gs);
   hold on;
   axis([SNRdBs([1 end]) 1e-6 1e0])
end
title('BER perfoemancde of MRC Scheme');
xlabel('SNR[dB]');
ylabel('BER')
grid on;
set(gca,'fontsize',9)
legend('SISO','MRC (Tx:1,Rx:2)','MRC (Tx:1,Rx:4)')


function [Btuph] = TW2Btuph(TW)
% Convert power from terawatts to British thermal units per hour.
% Chad A. Greene 2012
Btuph = TW*3.412141633e+12;


% Gives estimate of T0-normalized LF parameters given an Rd value
%
% Description
%  The Rd shape parameter [1] of the Liljencrants-Fant (LF) glottal model [2]
%  expresses a regression of the original shape parameters {te,tp,ta}. This
%  function gives the shape parameters {te,tp,ta} which correspond to a given Rd
%  value.
%
% Input
%  Rd  : The Rd shape parameter to convert.
%
% Output
%  te  : Glottal shape parameter, see [1]p.6 (assuming T0=1 ! (T0-normalized))
%  tp  : Glottal shape parameter, see [1]p.6 (assuming T0=1 ! (T0-normalized))
%  ta  : Glottal shape parameter, see [1]p.6 (assuming T0=1 ! (T0-normalized))
%
% See Also
%  gfm_spec_lf.m
%
% References
%  [1] G. Fant, "The LF-model revisited. Transformations and frequency domain
%      analysis", STL-QPSR 36(2-3):119-156, 1995.
%  [2] G. Fant, J. Liljencrants and Q. Lin, "A four-parameter model of glottal
%      flow", STL-QPSR, vol. 4, pp. 1-13, 1985.
%
% Copyright (c) 2011 University of Crete - Computer Science Department
%
% License
%  This file is under the LGPL license,  you can
%  redistribute it and/or modify it under the terms of the GNU Lesser General
%  Public License as published by the Free Software Foundation, either version 3
%  of the License, or (at your option) any later version. This file is
%  distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
%  without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
%  PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
%  details.
%
% This function is part of the Covarep project: http://covarep.github.io/covarep
%
% Author
%  Gilles Degottex <degottex@csd.uoc.gr>
%

function [te tp ta] = Rd2tetpta(Rd)

	Rap = (-1+4.8.*Rd)/100;                             % [1](2)
	Rkp = (22.4+11.8.*Rd)/100;                          % [1](3)
	Rgp = 1./(4*((0.11.*Rd./(1/2+1.2.*Rkp))-Rap)./Rkp); % [1] indirectly (4)

	tp = 1./(2.*Rgp); % [1]p.121
	te = tp.*(Rkp+1); % [1]p.121
	ta = Rap;         % [1]p.121

return


function t = logtform(rmin, rmax, nr, nw)
% LOGTFORM makes a log-polar transform structure for imtransform
%     T = LOGTFORM(RMIN, RMAX, NR, NW) returns the transform structure for
%     a system with minimum ring radius RMIN, maximum ring radius RMAX, NR
%     rings and NR wedges. The empty matrix may be given for any one (but
%     only one) of these in which case the circular-samples condition
%     RMAX=RMIN*exp(2*pi*(NR-1)/NW) will be applied (with an adjustment
%     to RMIN if necessary to make NR and NW integers.
%
% See also LOGSAMPLE, LOGSAMPBACK

% Copyright David Young 2010

[rmin, rmax, nr, nw, k] = complete_args(rmin, rmax, nr, nw);
tdata = struct('rmin', rmin, 'rmax', rmax, 'nr', nr, 'nw', nw, 'k', k);
t = maketform('custom', 2, 2, @contorth, @rthtocon, tdata);
end

function x = contorth(u, t)
% Conventional to log-polar. See maketform.
td = t.tdata;
[th, p] = cart2pol(u(:,1), u(:, 2));
p(~p) = td.rmin/2;            % Omit centre point
x = [td.k * log(p/td.rmin),  td.nw*mod(th/(2*pi), 1)];
end

function u = rthtocon(x, t)
% Log-polar to conventional. See maketform.
td = t.tdata;
p = td.rmin * exp(x(:, 1)/td.k);
th = (2*pi/td.nw) * x(:, 2);
[x, y] = pol2cart(th, p);
u = [x, y];
end

function [rmin, rmax, nr, nw, k] = complete_args(rmin, rmax, nr, nw)
% Circular pixels condition
if isempty(rmin)
    k = nw / (2*pi);
    rmin = rmax * exp((1-nr)/k);
elseif isempty(rmax)
    k = nw / (2*pi);
    rmax = rmin * exp((nr-1)/k);
elseif isempty(nw)
    k = (nr-1) / log(rmax/rmin);
    nw = round(2 * pi * k);
    k = nw / (2*pi);
    rmin = rmax * exp((1-nr)/k);
elseif isempty(nr)
    k = nw / (2*pi);
    nr = round(k * log(rmax/rmin) + 1);
    rmin = rmax * exp((1-nr)/k);
else
    k = (nr-1) / log(rmax/rmin);
end
end


function [xyZ,sigma,gammaVal]=ellips2PolarStereo(latLon,lambda0,k0,xyPole,a,f)
%%ELLIPS2POLARSTEREO Convert a point on the reference ellipsoid in
%            ellipsoidal (geodetic) coordinates gives as a latitude and a
%            longitude into a point on the polar stereographic projection.
%            Stereographic projections tend to be used near the poles. The
%            Uniform Polar Stereographic (UPS) coordinate system, which is
%            a specific realization of the polar stereographic coordinate
%            system, is typically only used at latitudes >=84 degrees and
%            those < -80 degrees.
%
%INPUTS: latLon A 2XN set of N [latitude;longitude] pairs given in radians
%               to be converted into polar stereographic coordinates.
%       lambda0 The location in raidns of the central meridian. If this
%               parameter is omitted or an empty matrix is passed, the
%               default of 0 is used, which is the value used in the UPS
%               system.
%            k0 The unitless central scale factor. If this parameter is
%               omitted or an empty matrix is passed, then the default of
%               0.994 is used, which is the value used in the UPS.
%        xyPole A 2X1 vector holding the false Easting and False
%               Northing of the origin. This is typically given in meters.
%               If this parameter is omitted or an empty matrix is passed,
%               then the default of [2000000;2000000] is used, which is the
%               value in meters used for the UPS system.
%             a The semi-major axis of the reference ellipsoid. If this
%               argument is omitted, the value in
%               Constants.WGS84SemiMajorAxis is used.
%             f The flattening factor of the reference ellipsoid. If this
%               argument is omitted, the value in Constants.WGS84Flattening
%               is used.
%
%OUTPUTS: xyZ A 3XN set of points in polar stereographic coordinates
%             consisting of [Easting;Northing;Z], where Z=sign(latitude),
%             so 1 for the northern hemisphere and -1 for the southern
%             hemisphere and 0 on the equator. Easting and Northing will be
%             in meters if a and xyPole are in meters.
%       sigma The NX1 set of point scales. This indicates how the map
%             projections enlarges or reduces small distances in this type
%             of map projection.
%    gammaVal The NX1 set of convergence of meridians in radians. This
%             gives the angles of intersection between the meridian and
%             vertical lines on the map projection that are given by
%             x=constant value. This value
%
%If lambda0, k0, xyPole, a and f are all omitted, then the conversion is
%for the UPS on the WGS-84 reference ellipsoid.
%
%Chapter 21 of [1] discusses the polar stereographic projection. The
%implementation is taken from Sections 8 and 9 of [1]. Section 10 of 2
%provides the values for the UPS.
%
%REFERENCES:
%[1] J. P. Snyder, "Map projections- a working manual," U.S. Geological
%    Survey, Tech. Rep. 1395, 1987.
%[2] Office of Geomatics, "National geospatial-intelligence agency
%    standardization document: Implementation practice: The universal
%    grids and the transverse mercator and polar stereographic map
%    projections," National Geospatial-Intelligence Agency, Tech. Rep.
%    NGA.SIG.0012 2.0.0 UTMUPS, 25 Mar. 2014. [Online]. Available:
%    http://earth-info.nga.mil/GandG/publications/NGA_SIG_0012_2_0_0_UTMUPS/NGA.SIG.0012_2.0.0_UTMUPS.pdf
%
%July 2017 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

if(nargin<2||isempty(lambda0))
   lambda0=0;%Central meridian location for UPS.
end

if(nargin<3||isempty(k0))
   k0=0.994;%Central scale factor for UPS
end

if(nargin<4||isempty(xyPole))
   xyPole=[2000000;2000000];%Easting and Northing of the pole for UPS.
end

if(nargin<5||isempty(a))
    a=Constants.WGS84SemiMajorAxis;
end

if(nargin<6||isempty(f))
    f=Constants.WGS84Flattening;
end

%The first numerical eccentricity of the ellipsoid.
e=sqrt(2*f-f^2);

N=size(latLon,2);

xyZ=zeros(3,N);
sigma=zeros(N,1);
gammaVal=zeros(N,1);
for curPoint=1:N
    phi=latLon(1,curPoint);
    lambda=latLon(2,curPoint);
    lambda=lambda-lambda0;

    Z=sign(phi);
    if(Z==-1)
        phi=-phi;
    end

    sinPhi=sin(phi);
    sinLambda=sin(lambda);
    cosLambda=cos(lambda);

    [sinChi,cosChi]=ellipsLat2SinCosConformLat(phi,f);

    k90=sqrt(1-e^2)*exp(e*atanh(e));
    denom=k90*(1+sinChi);
    x=2*k0*a*sinLambda*cosChi/denom;
    y=-2*k0*a*cosLambda*cosChi/denom;
    sigma(curPoint)=k0*2*sqrt(1-e^2*sinPhi^2)*exp(e*atanh(e*sinPhi))/(k90*(1+sinPhi));
    gammaVal(curPoint)=lambda;

    if(Z==-1)
        y=-y;
        gammaVal(curPoint)=-gammaVal(curPoint);
    end

    xyZ(:,curPoint)=[x;y;Z]+[xyPole;0];
end
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


%kvpml 'Estimate Fractal Dimension of Image Based on P(m,L) (K1)'
% This MatLab function was automatically generated by a converter (KhorosToMatLab) from the Khoros vpml.pane file
%
% Parameters:
% InputFile: i 'Input Image ', required: 'input image'
% Integer: l 'Lower window size', default: 3: 'select the initial size of the sliding window'
% Integer: u 'Upper window size', default: 5: 'select the final size of the sliding window'
% Integer: s 'Window step size ', default: 2: 'select the window step size or interval'
% Integer: q 'Range of moments ', default: 3: 'select the range of moments (-r/2 <= 0 >= r/2)'
% OutputFile: o1 'Output Image ', required: 'resulting multiband fractal dimension output image'
% OutputFile: o2 'Output FD Image ', required: 'output image specifying fractal dimension of each class'
% OutputFile: f1 'Output ASCII File', optional: 'output file for P(m,L) statistics'
%
% Example: [o1, o2, f1] = kvpml(i, {'i','';'l',3;'u',5;'s',2;'q',3;'o1','';'o2','';'f1',''})
%
% Khoros helpfile follows below:
%
%  PROGRAM
% vpml - Estimate Fractal Dimension of Image Based on P(m,L)  (K1)
%
%  DESCRIPTION
% .I vpml
% estimates the fractal dimension of an image based on the probability
% that there are m pixels within a window of size L centered on a pixel
% from a particular class.  For a selected range of window sizes (L),
% the window is centered on the first occurrence of the pixel belonging
% to a particular class.  The number of pixels within a window of size L,
% belonging to a specific class are counted (including the center pixel
% of the window), and a "histogram" is formed as the window is moved over
% the image.  This "histogram" represents the total number of occurrences,
% m, of a class of pixels in a window of size L.  From this, a normalized
% histogram is formed, which yields an estimate of the probability density
% function, P(m,L), for each window size L.
%
% All selected moments (q) of the P(m,L) distributions for each of the
% desired window sizes are determined, and a linear regression or "best fit
% line" is found for the moment generating function, log(M(L))^1/q, versus
% the log of the window size, log(L).  The slope of the "best fit line"
% provides an estimate for the fractal dimension, D.
%
% The center pixel of the largest window, Lmax, is replaced with the computed
% fractal dimension based on the probability density function, P(m,L).
% The largest window size, Lmax, determines the resulting size of the fractal
% dimension image.  This results in a border of size (Lmax / 2) around the
% image, which is set to zero.
%
% The input arguments are described as follows:
%
%  "-i" 15
% specifies the input image, which must be of data type BYTE or INTEGER.
% The input image must be a single band image.
%
%  "-o1" 15
% specifies the output image, which will be a multiband image representing
% the fractal dimension of the input image for each of the specified
% moments.  The resulting output image will be of data storage type
% FLOAT, and will have a border of pixels of value zero.  The size of
% the border will be determined by the size of the largest window
% specified.  This can be determined from the following formulation,
% (Lmax -1) / 2 = border size.  Where Lmax is the size of the largest
% window used.  For example, if the largest window size is 9, then the
% border size will be (9 - 1) / 2 = 4 pixels.
%
%  "-o2" 15
% specifies fractal dimension image, representing the fractal dimension
% vectors for each class and moment.  This image will always have a row
% size of 1 and a column size determined by the number of classes in the
% input image.  The number of data bands will be equal to the number of
% moments used in the estimation of the fractal dimension.
%
%  "-f1" 15
% uses an ASCII file as output for the image information specifying the
% size of the input image, number of classes in the input image, and the
% range of moments used in the estimation of the fractal dimension.  Also
% included is a listing of the fractal dimensions for each class and
% moment.
%
%  "-l" 15
% specifies the initial or lower size of the sliding window.  This MUST be
% an odd number resulting in a window with a center pixel.  This means that
% the minimum size of the sliding window is 3 x 3.  The default value is
% 3, resulting in an initial window size of 3 x 3.
%
%  "-u" 15
% specifies the final or upper size of the sliding window.  This MUST also
% be an odd number resulting in a window with a center pixel.  The size of
% the upper window MUST be at least one step greater than the lower window
% size.  That is, if the lower window is 3 x 3, then the minimum size of
% the upper window must be 5 x 5, or one step greater than the lower window.
% This is necessary, since there must be at least two points for a best
% fit line to be formed determining the slope and ultimately the fractal
% dimension.
%
%  "-s" 15
% specifies the step size or interval used when specifying a range of
% window sizes.  The default value is two, corresponding to the next odd
% window size with a center pixel.  This may be helpful when a wide range
% of window sizes is required, as it will reduce the number of points
% generated for the best fit line and hence the number of calculations.
%
%  "-q" 15
% specifies the range of moments to base the P(m,L) fractal dimension
% calculations on.  This must be an odd number, corresponding to the
% number of moments centered on zero.  For example, a value of 5 would
% result in the computation of the fractal dimension for the range of
% moments, -2, -1, 0, 1, 2.  The default value is 3, resulting in the
% range of -1, 0, 1.
%
% The input image MUST be of data storage type BYTE or INTEGER.
%
%
%
%  EXAMPLES
%
% vpml -i in_img -o1 out_img1 -o2 out_img2 -f1 file1 -u 11 -s 4 -q 5
% this will estimate the fractal dimension of the in_img using a
% range of sliding window sizes from 3 x 3 (default lower value of 3)
% to an upper size of 11 x 11, with a step size of 4.  This means that
% windows of size 3 x 3, 7 x 7, and 11 x 11 will be used in the fractal
% dimension calculation.  A value of 5 was selected for the number of
% moments to be calculated, meaning that the fractal dimension will be
% computed for the range of moments, -2, -1, 0, 1, 2.  The resulting
% output image, out_img1 will consist of a five-band FLOAT image with
% each band representing the fractal dimension for a particular moment, q.
% The out_img2 will consist of a single row, five-band image specifying
% the fractal dimension for each class of the input image and moment, q.
% The ASCII file1 will provide the user with information on the size of
% the input image, number of classes, and the resulting fractal dimensions
% for each class and moment.
%
%  "SEE ALSO"
% vfractal(1)
%
%  RESTRICTIONS
%
% The input image MUST be of data storage type BYTE or INTEGER.
% The output images are of data storage type FLOAT.
%
%  REFERENCES
% A reference for the pml algorithm is p. 67 of The Science of Fract.
% Images edited by Hienz-Otto Peitgen and Dietmar Saupe.
%
%  COPYRIGHT
% Copyright (C) 1993 - 1997, Khoral Research, Inc. ("KRI")  All rights reserved.
%

function varargout = kvpml(varargin)
if nargin ==0
  Inputs={};arglist={'',''};
elseif nargin ==1
  Inputs=varargin{1};arglist={'',''};
elseif nargin ==2
  Inputs=varargin{1}; arglist=varargin{2};
else error('Usage: [out1,..] = kvpml(Inputs,arglist).');
end
if size(arglist,2)~=2
  error('arglist must be of form {''ParameterTag1'',value1;''ParameterTag2'',value2}')
 end
narglist={'i', '__input';'l', 3;'u', 5;'s', 2;'q', 3;'o1', '__output';'o2', '__output';'f1', '__output'};
maxval={0,10000,10000,10000,1000,0,0,1};
minval={0,3,5,2,3,0,0,1};
istoggle=[0,1,1,1,1,0,0,1];
was_set=istoggle * 0;
paramtype={'InputFile','Integer','Integer','Integer','Integer','OutputFile','OutputFile','OutputFile'};
% identify the input arrays and assign them to the arguments as stated by the user
if ~iscell(Inputs)
Inputs = {Inputs};
end
NumReqOutputs=2; nextinput=1; nextoutput=1;
  for ii=1:size(arglist,1)
  wasmatched=0;
  for jj=1:size(narglist,1)
   if strcmp(arglist{ii,1},narglist{jj,1})  % a given argument was matched to the possible arguments
     wasmatched = 1;
     was_set(jj) = 1;
     if strcmp(narglist{jj,2}, '__input')
      if (nextinput > length(Inputs))
        error(['Input ' narglist{jj,1} ' has no corresponding input!']);
      end
      narglist{jj,2} = 'OK_in';
      nextinput = nextinput + 1;
     elseif strcmp(narglist{jj,2}, '__output')
      if (nextoutput > nargout)
        error(['Output nr. ' narglist{jj,1} ' is not present in the assignment list of outputs !']);
      end
      if (isempty(arglist{ii,2}))
        narglist{jj,2} = 'OK_out';
      else
        narglist{jj,2} = arglist{ii,2};
      end

      nextoutput = nextoutput + 1;
      if (minval{jj} == 0)
         NumReqOutputs = NumReqOutputs - 1;
      end
     elseif isstr(arglist{ii,2})
      narglist{jj,2} = arglist{ii,2};
     else
        if strcmp(paramtype{jj}, 'Integer') & (round(arglist{ii,2}) ~= arglist{ii,2})
            error(['Argument ' arglist{ii,1} ' is of integer type but non-integer number ' arglist{ii,2} ' was supplied']);
        end
        if (minval{jj} ~= 0 | maxval{jj} ~= 0)
          if (minval{jj} == 1 & maxval{jj} == 1 & arglist{ii,2} < 0)
            error(['Argument ' arglist{ii,1} ' must be bigger or equal to zero!']);
          elseif (minval{jj} == -1 & maxval{jj} == -1 & arglist{ii,2} > 0)
            error(['Argument ' arglist{ii,1} ' must be smaller or equal to zero!']);
          elseif (minval{jj} == 2 & maxval{jj} == 2 & arglist{ii,2} <= 0)
            error(['Argument ' arglist{ii,1} ' must be bigger than zero!']);
          elseif (minval{jj} == -2 & maxval{jj} == -2 & arglist{ii,2} >= 0)
            error(['Argument ' arglist{ii,1} ' must be smaller than zero!']);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} < minval{jj})
            error(['Argument ' arglist{ii,1} ' must be bigger than ' num2str(minval{jj})]);
          elseif (minval{jj} ~= maxval{jj} & arglist{ii,2} > maxval{jj})
            error(['Argument ' arglist{ii,1} ' must be smaller than ' num2str(maxval{jj})]);
          end
        end
     end
     if ~strcmp(narglist{jj,2},'OK_out') &  ~strcmp(narglist{jj,2},'OK_in')
       narglist{jj,2} = arglist{ii,2};
     end
   end
   end
   if (wasmatched == 0 & ~strcmp(arglist{ii,1},''))
        error(['Argument ' arglist{ii,1} ' is not a valid argument for this function']);
   end
end
% match the remaining inputs/outputs to the unused arguments and test for missing required inputs
 for jj=1:size(narglist,1)
     if  strcmp(paramtype{jj}, 'Toggle')
        if (narglist{jj,2} ==0)
          narglist{jj,1} = '';
        end;
        narglist{jj,2} = '';
     end;
     if  ~strcmp(narglist{jj,2},'__input') && ~strcmp(narglist{jj,2},'__output') && istoggle(jj) && ~ was_set(jj)
          narglist{jj,1} = '';
          narglist{jj,2} = '';
     end;
     if strcmp(narglist{jj,2}, '__input')
      if (minval{jj} == 0)  % meaning this input is required
        if (nextinput > size(Inputs))
           error(['Required input ' narglist{jj,1} ' has no corresponding input in the list!']);
        else
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        end
      else  % this is an optional input
        if (nextinput <= length(Inputs))
          narglist{jj,2} = 'OK_in';
          nextinput = nextinput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end;
     else
     if strcmp(narglist{jj,2}, '__output')
      if (minval{jj} == 0) % this is a required output
        if (nextoutput > nargout & nargout > 1)
           error(['Required output ' narglist{jj,1} ' is not stated in the assignment list!']);
        else
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
          NumReqOutputs = NumReqOutputs-1;
        end
      else % this is an optional output
        if (nargout - nextoutput >= NumReqOutputs)
          narglist{jj,2} = 'OK_out';
          nextoutput = nextoutput + 1;
        else
          narglist{jj,1} = '';
          narglist{jj,2} = '';
        end;
      end
     end
  end
end
if nargout
   varargout = cell(1,nargout);
else
  varargout = cell(1,1);
end
global KhorosRoot
if exist('KhorosRoot') && ~isempty(KhorosRoot)
w=['"' KhorosRoot];
else
if ispc
  w='"C:\Program Files\dip\khorosBin\';
else
[s,w] = system('which cantata');
w=['"' w(1:end-8)];
end
end
[varargout{:}]=callKhoros([w 'vpml"  '],Inputs,narglist);