/* -*- Mode: C; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- */
/* vim:set sw=2 sts=2 et cin: */
/*
 * This file is part of the MUSE Instrument Pipeline
 * Copyright (C) 2005-2015 European Southern Observatory
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 */

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

/*----------------------------------------------------------------------------*
 *                             Includes                                       *
 *----------------------------------------------------------------------------*/
#ifdef HAVE_READLINK
#define _DEFAULT_SOURCE
#define _BSD_SOURCE /* get readlink() from unistd.h */
#include <unistd.h> /* readlink(), has to be included before cpl.h */
#endif
#include <cpl.h>
#include <string.h>
#include <math.h>

#include "muse_cplwrappers.h"

/*----------------------------------------------------------------------------*
 *                             Debugging Macros                               *
 *         Set these to 1 or higher for (lots of) debugging output            *
 *----------------------------------------------------------------------------*/
#define DEBUG_SQR 0 /* debugging in muse_cplvector_get_semiquartile() */

/*----------------------------------------------------------------------------*/
/**
 * @defgroup muse_cplwrappers  CPL wrappers
 *
 * This group handles several utility functions that are convenient wrappers
 * of CPL functions or functions that could extend CPL.
 *
 * Currently there are functions that work on cpl_image, cpl_imagelist,
 * cpl_vector, cpl_table, and cpl_array objects.
 */
/*----------------------------------------------------------------------------*/

/**@{*/

/*----------------------------------------------------------------------------*/
/**
  @brief    Provide an 'OR' operation of two integer images
  @param    aTarget the first operand that will be the target image
  @param    aImage  the image that shall be appplied to the first
  @param    mask    additional mask to apply to each pixel.
  @return   CPL_ERROR_NONE if everything was OK

  @remark
  This works only with data type CPL_TYPE_INT. The pixel mask is not
  used at all.

  @error{return CPL_ERROR_NULL_INPUT, NULL input target or image}
  @error{return CPL_ERROR_TYPE_MISMATCH, the passed image type is not CPL_TYPE_INT}
  @error{return CPL_ERROR_ILLEGAL_INPUT, the input images have different sizes}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplimage_or(cpl_image *aTarget, const cpl_image *aImage, unsigned int mask)
{
  cpl_ensure_code(aTarget && aImage, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(cpl_image_get_type(aTarget) == CPL_TYPE_INT,
                  CPL_ERROR_INVALID_TYPE);
  cpl_ensure_code(cpl_image_get_type(aImage) == CPL_TYPE_INT,
                  CPL_ERROR_INVALID_TYPE);
  cpl_ensure_code(cpl_image_get_size_x(aTarget) == cpl_image_get_size_x(aImage),
                  CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(cpl_image_get_size_y(aTarget) == cpl_image_get_size_y(aImage),
                  CPL_ERROR_ILLEGAL_INPUT);

  int *target = cpl_image_get_data_int(aTarget);
  const int *data = cpl_image_get_data_int_const(aImage);
  cpl_size nData = cpl_image_get_size_x(aImage) * cpl_image_get_size_y(aImage);
  cpl_size i;
  for (i = 0; i < nData; i++, data++, target++) {
    *target |= *data & mask;
  }
  return CPL_ERROR_NONE;
} /* muse_cplimage_or() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Concatenate two images in y direction.
  @param    aImage1 First image
  @param    aImage2 Second image
  @return   Concatenated image
  @cpl_ensure{aImage1 || aImage2, CPL_ERROR_NULL_INPUT, NULL}
  @cpl_ensure{cpl_image_get_type(aImage1) == cpl_image_get_type(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL}
  @cpl_ensure{cpl_image_get_size_x(aImage1) == cpl_image_get_size_x(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL}

  If one of the pointers is NULL, just return a copy of the other image. If both
  input images are NULL, fail. The returned image has to be deallocated using
  cpl_image_delete().
 */
/*----------------------------------------------------------------------------*/
cpl_image *
muse_cplimage_concat_y(const cpl_image *aImage1, const cpl_image *aImage2)
{
  cpl_ensure(aImage1 || aImage2, CPL_ERROR_NULL_INPUT, NULL);
  if (aImage1 == NULL) {
    return cpl_image_duplicate(aImage2);
  }
  if (aImage2 == NULL) {
    return cpl_image_duplicate(aImage1);
  }
  cpl_type type = cpl_image_get_type(aImage1);
  cpl_ensure(type == cpl_image_get_type(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL);
  cpl_size xsize = cpl_image_get_size_x(aImage1);
  cpl_ensure(xsize == cpl_image_get_size_x(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL);

  cpl_size ysize1 = cpl_image_get_size_y(aImage1);
  cpl_size ysize2 = cpl_image_get_size_y(aImage2);
  cpl_image *res = cpl_image_new(xsize, ysize1 + ysize2, type);
  void *resdata = cpl_image_get_data(res);
  const void *data1 = cpl_image_get_data_const(aImage1);
  cpl_size size1 = xsize * ysize1 * cpl_type_get_sizeof(type);
  const void *data2 = cpl_image_get_data_const(aImage2);
  cpl_size size2 = xsize * ysize2 * cpl_type_get_sizeof(type);
  memcpy(resdata, data1, size1);
  memcpy((char *)resdata+size1, data2, size2);

  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Concatenate two images in x direction.
  @param    aImage1 First image
  @param    aImage2 Second image
  @return   Concatenated image
  @cpl_ensure{aImage1 || aImage2, CPL_ERROR_NULL_INPUT, NULL}
  @cpl_ensure{cpl_image_get_type(aImage1) == cpl_image_get_type(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL}
  @cpl_ensure{cpl_image_get_size_y(aImage1) == cpl_image_get_size_y(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL}

  If one of the pointers is NULL, just return a copy of the other image. If both
  input images are NULL, fail. The returned image has to be deallocated using
  cpl_image_delete().
 */
/*----------------------------------------------------------------------------*/
cpl_image *
muse_cplimage_concat_x(const cpl_image *aImage1, const cpl_image *aImage2)
{
  cpl_ensure(aImage1 || aImage2, CPL_ERROR_NULL_INPUT, NULL);
  if (aImage1 == NULL) {
    return cpl_image_duplicate(aImage2);
  }
  if (aImage2 == NULL) {
    return cpl_image_duplicate(aImage1);
  }
  cpl_type type = cpl_image_get_type(aImage1);
  cpl_ensure(type == cpl_image_get_type(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL);
  cpl_size ysize = cpl_image_get_size_y(aImage1);
  cpl_ensure(ysize == cpl_image_get_size_y(aImage2), CPL_ERROR_ILLEGAL_INPUT, NULL);

  cpl_size xsize1 = cpl_image_get_size_x(aImage1);
  cpl_size xsize2 = cpl_image_get_size_x(aImage2);
  cpl_image *res = cpl_image_new(xsize1 + xsize2, ysize, type);
  void *resdata = cpl_image_get_data(res);
  const void *data1 = cpl_image_get_data_const(aImage1);
  cpl_size size1 = xsize1 * cpl_type_get_sizeof(type);
  const void *data2 = cpl_image_get_data_const(aImage2);
  cpl_size size2 = xsize2 * cpl_type_get_sizeof(type);
  cpl_size size = (size1 + size2) * ysize;
  cpl_size y, y3, y4; /* instead of y1 and y2 to circumvent warning */
  for (y = 0, y3 = 0, y4 = 0; y < size; y+=size1+size2, y3+=size1, y4+=size2) {
    memcpy((char *)resdata + y, (char *)data1 + y3, size1);
    memcpy((char *)resdata + y + size1, (char *)data2 + y4, size2);
  }
  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Subtract a median-filtered version of the input image from itself.
  @param  aImage   Image to be filtered and subtracted from
  @param  aNX      Median filter width, has to be odd
  @param  aNY      Median filter height, has to be odd
  @return The subtracted image or NULL on error.

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, input image is NULL}
  @error{set CPL_ERROR_ILLEGAL_INPUT\, return NULL, aNX or aNY are even}
 */
/*----------------------------------------------------------------------------*/
cpl_image *
muse_cplimage_filter_median_subtract(cpl_image *aImage,
                                     unsigned int aNX, unsigned int aNY)
{
  cpl_ensure(aImage, CPL_ERROR_NULL_INPUT, NULL);
  /* make sure here already that none is an even number */
  cpl_ensure((aNX & 1) && (aNY & 1), CPL_ERROR_ILLEGAL_INPUT, NULL);

  /* create filtered image of the same size as input image */
  cpl_image *filtered = cpl_image_new(cpl_image_get_size_x(aImage),
                                      cpl_image_get_size_y(aImage),
                                      CPL_TYPE_FLOAT);
  /* create mask of the necessary size */
  cpl_mask *mask = cpl_mask_new(aNX, aNY);
  cpl_mask_not(mask);
  cpl_errorstate prestate = cpl_errorstate_get();
  cpl_image_filter_mask(filtered, aImage, mask, CPL_FILTER_MEDIAN,
                        CPL_BORDER_FILTER);
  if (!cpl_errorstate_is_equal(prestate)) {
    cpl_msg_error(__func__, "filtering failed: %s", cpl_error_get_message());
    cpl_mask_delete(mask);
    cpl_image_delete(filtered);
    return NULL;
  }
  cpl_mask_delete(mask);

  /* now subtract the filtered image from the input image */
  cpl_image *subtracted = cpl_image_subtract_create(aImage, filtered);
  cpl_image_delete(filtered);

  return subtracted;
} /* muse_cplimage_filter_median_subtract() */

/*----------------------------------------------------------------------------*/
/**
  @brief Compute slopes of an image, both horizontally and vertically.
  @param  aImage    Image to be investigated
  @param  aWindow   Image window to use
                    (integer array with 4 elements: xmin, xmax, ymin, ymax, see
                    muse_quadrants_get_window())
  @return A two-element cpl_vector * containing x- and y-slope or NULL on error.

  Collapse the given image window along rows and columns, then fit a 1st-order
  polynomial to the values of both images to derive the slope in both
  directions.

  @note This function ignores any bad pixel mask set on the input image.

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, aImage or aWindow are NULL}
  @error{propagate error from cpl_image_collapse_window_create()\, return NULL,
         positions given through aWindow are outside image}
  @error{propagate error from cpl_polynomial_fit()\, return NULL,
         polynomial fit fails}
 */
/*----------------------------------------------------------------------------*/
cpl_vector *
muse_cplimage_slope_window(const cpl_image *aImage, const cpl_size *aWindow)
{
  cpl_ensure(aImage && aWindow, CPL_ERROR_NULL_INPUT, NULL);
  /* duplicate the input image to remove the bad pixel mask, if one exists */
  cpl_image *image = cpl_image_duplicate(aImage);
  cpl_image_accept_all(image);

  cpl_vector *slopes = cpl_vector_new(2); /* two elements: x- and y-slope */
  unsigned char k; /* vector index, collapsing direction */
  for (k = 0; k <= 1; k++) {
    /* collapse by row (direction 0) or column (1) */
    cpl_image *coll = cpl_image_collapse_window_create(image,
                                                       aWindow[0], aWindow[2],
                                                       aWindow[1], aWindow[3],
                                                       k);
    if (!coll) {
      cpl_image_delete(image);
      cpl_vector_delete(slopes);
      return NULL;
    }
    /* we need the average, not the sum! */
    if (k == 0) {
      cpl_image_divide_scalar(coll, aWindow[3] - aWindow[2] + 1);
    } else {
      cpl_image_divide_scalar(coll, aWindow[1] - aWindow[0] + 1);
    }
    int npx = k == 0 ? cpl_image_get_size_x(coll) : cpl_image_get_size_y(coll);
    /* convert coordinates into matrices */
    cpl_matrix *coords = cpl_matrix_new(1, npx);
    cpl_vector *values = cpl_vector_new(npx);
    float *data = cpl_image_get_data_float(coll);
    int i;
    for (i = 0; i < npx; i++) {
      cpl_matrix_set(coords, 0, i, i + 1);
      /* do it manually one-by-one, to use cpl_vector_wrap() *
       * one would first need to cast the data to double     */
      cpl_vector_set(values, i, data[i]);
    } /* for i (all pixels) */

    cpl_polynomial *fit = cpl_polynomial_new(1);
    const cpl_boolean sym = CPL_FALSE;
    const cpl_size mindeg = 0, maxdeg = 1;
    cpl_error_code err = cpl_polynomial_fit(fit, coords, &sym, values, NULL,
                                            CPL_FALSE, &mindeg, &maxdeg);
    cpl_matrix_delete(coords);
    cpl_vector_delete(values);
    cpl_image_delete(coll);

    if (err != CPL_ERROR_NONE) {
      cpl_msg_warning(__func__, "Could not fit %s slope: %s",
                      k == 0 ? "horizontal" : "vertical",
                      cpl_error_get_message());
      cpl_polynomial_delete(fit);
      cpl_vector_delete(slopes);
      cpl_image_delete(image);
      return NULL;
    }
#if 0
    printf("%s: fit (%s)\n", __func__, k == 0 ? "rows" : "cols");
    cpl_polynomial_dump(fit, stdout);
    fflush(stdout);
#endif
    const cpl_size pows = { 1 };
    cpl_vector_set(slopes, k, cpl_polynomial_get_coeff(fit, &pows));
    cpl_polynomial_delete(fit);
  } /* for k (collapsing direction) */
  cpl_image_delete(image);
#if 0
  printf("slopes vector:\n");
  cpl_vector_dump(slopes, stdout);
  fflush(stdout);
#endif

  return slopes;
} /* muse_cplimage_slope_window() */

/*----------------------------------------------------------------------------*/
/**
   @brief Get the percentile of an image.
   @param aImage input image
   @param aFraction Fraction of the total number of pixels
   @return Threshold where the number of pixels below is the specified fraction
   of total valid pixels.

   @cpl_ensure{aImage != NULL, CPL_ERROR_NULL_INPUT, 0.0}
*/
/*----------------------------------------------------------------------------*/
double
muse_cplimage_get_percentile(const cpl_image *aImage, double aFraction)
{
  cpl_ensure(aImage != NULL, CPL_ERROR_NULL_INPUT, 0.0);

  cpl_array *a = muse_cplarray_new_from_image(aImage);
  muse_cplarray_erase_invalid(a);
  cpl_size n = cpl_array_get_size(a);
  muse_cplarray_sort(a, TRUE);
  if (aFraction < 0) {
    aFraction = 0.;
  }
  if (aFraction > 1) {
    aFraction = 1.;
  }
  /* array index of where the percentile is located */
  cpl_size i = lround(n * aFraction) - 1;
  if (i < 0) {
    i = 0;
  }
  if (i >= n) {
    i = n - 1;
  }
  double res = cpl_array_get(a, i, NULL);
  cpl_array_delete(a);
  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief   Copy the unmasked part of one image into the other.
  @param   aImage      the destination image
  @param   aImageSrc   the source image
  @param   aMask       the mask within which to copy the pixels
  @return   CPL_ERROR_NONE on success another cpl_error_code on failure

  The idea of this function is that sometimes a portion of an image needs to be
  copied that is not rectangular. In this case, a mask can be constructed so
  that the unmasked pixels (those with CPL_BINARY_0) define the regions to copy
  over.
  This function therefore loops over all pixels, tests this condition and then
  sets the values in the destination image accordingly.

  @note This function ignores the bad pixel mask of both images.

  @note Currently, this function only supports CPL_TYPE_FLOAT images.

  @error{set and return CPL_ERROR_NULL_INPUT, one of the input pointers is NULL}
  @error{set and return CPL_ERROR_INCOMPATIBLE_INPUT,
         the sizes of the input images and mask are different}
  @error{set and return CPL_ERROR_INVALID_TYPE,
         cannot get data pointers from the input images (wrong type?)}
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplimage_copy_within_mask(cpl_image *aImage, const cpl_image *aImageSrc,
                               const cpl_mask *aMask)
{
  cpl_ensure_code(aImage && aImageSrc && aMask, CPL_ERROR_NULL_INPUT);

  /* check the sizes */
  int i, j, n = 0,
      nx = cpl_image_get_size_x(aImage),
      ny = cpl_image_get_size_y(aImage),
      nx2 = cpl_image_get_size_x(aImageSrc),
      ny2 = cpl_image_get_size_y(aImageSrc),
      nxm = cpl_mask_get_size_x(aMask),
      nym = cpl_mask_get_size_y(aMask);
  cpl_ensure_code(nx == nx2 && nx == nxm, CPL_ERROR_INCOMPATIBLE_INPUT);
  cpl_ensure_code(ny == ny2 && ny == nym, CPL_ERROR_INCOMPATIBLE_INPUT);
  /* get pointers to the data, this will fail for non-float images */
  float *im = cpl_image_get_data_float(aImage);
  const float *im2 = cpl_image_get_data_float_const(aImageSrc);
  cpl_ensure_code(im && im2, CPL_ERROR_INVALID_TYPE);
  /* no need to check mask pointer, that also only checks for NULL input... */
  const cpl_binary *m = cpl_mask_get_data_const(aMask);
  for (i = 0; i < nx; i++) {
    for (j = 0; j < ny; j++) {
      if (!m[i + j*nx]) {
        /* not masked, i.e. CPL_BINARY_0, copy this pixel */
        im[i + j*nx] = im2[i + j*nx];
#if 0
        if (n==0) {
          cpl_msg_debug(__func__, "%d,%d: got copied...", i+1, j+1);
        }
#endif
        n++;
      }
    } /* for j (columns) */
  } /* for i (rows) */
#if 0
  cpl_msg_debug(__func__, "copied %d pixels", n);
#endif
  return CPL_ERROR_NONE;
} /* muse_cplimage_copy_within_mask() */


/*----------------------------------------------------------------------------*/
/**
   @brief Compute the OR of an image list to a single image.
   @param imlist  the input images list
   @return the image built by the OR operation of all images, or NULL in
           error case.

   The returned image has to be deallocated with cpl_image_delete().
   The input image list must be of type CPL_TYPE_INT.

   @error{set CPL_ERROR_NULL_INPUT, any input pointer is NULL}
   @error{set CPL_ERROR_ILLEGAL_INPUT, the input images have different sizes}
   @error{set CPL_ERROR_INVALID_TYPE, an image type is not CPL_TYPE_INT}
*/
/*----------------------------------------------------------------------------*/
cpl_image *
muse_cplimagelist_collapse_or_create(const cpl_imagelist *imlist)
{
  cpl_ensure(imlist, CPL_ERROR_NULL_INPUT, NULL);
  int count = cpl_imagelist_get_size(imlist);
  cpl_ensure(count > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
  cpl_image *res = cpl_image_duplicate(cpl_imagelist_get_const(imlist, 0));
  int i;
  unsigned int mask = 0xffffffff;
  for (i = 1; i < count; i++) {
    int r = muse_cplimage_or(res, cpl_imagelist_get_const(imlist, i), mask);
    if (r != CPL_ERROR_NONE) {
      cpl_image_delete(res);
      return NULL;
    }
  }
  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Adapt mask with masked region in one quadrant to size of an image.
  @param    aMask    mask to adapt
  @param    aImage   reference imgae
  @return   a new mask on success, or NULL on error

  If the input mask has a quadrant with many masked pixels (like a masked
  corner), this quadrant is extracted and copied into a new mask, so that its
  outer corner again comes to lie in the new corner.

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, aMask and/or aImage are NULL}
  @error{set CPL_ERROR_DATA_NOT_FOUND\, return NULL,
         aMask does not contain a quadrant with masked pixels}
  @error{propagate CPL error\, return NULL,
         relevant quadrant could not be copied into output mask of aImage-size}
 */
/*----------------------------------------------------------------------------*/
cpl_mask *
muse_cplmask_adapt_to_image(const cpl_mask *aMask, const cpl_image *aImage)
{
  cpl_ensure(aMask && aImage, CPL_ERROR_NULL_INPUT, NULL);

  /* find masked region */
  enum corner { NONE = 0,
                BOTTOMLEFT = 1, BOTTOMRIGHT = 2,
                TOPRIGHT = 3, TOPLEFT = 4 };
  const char *cnames[] = { "none",
                           "bottom left", "bottom right",
                           "top right", "top left" };
  int nx = cpl_mask_get_size_x(aMask),
      ny = cpl_mask_get_size_y(aMask),
      nximage = cpl_image_get_size_x(aImage),
      nyimage = cpl_image_get_size_y(aImage),
      nmax = 0;
  enum corner nmaxcorner = NONE;
  int ncount = cpl_mask_count_window(aMask, 1, 1, nx/2, ny/2);
  if (ncount > nmax) {
    nmaxcorner = BOTTOMLEFT;
    nmax = ncount;
  }
  ncount = cpl_mask_count_window(aMask, nx/2, 1, nx, ny/2);
  if (ncount > nmax) {
    nmaxcorner = BOTTOMRIGHT;
    nmax = ncount;
  }
  ncount = cpl_mask_count_window(aMask, nx/2, ny/2, nx, ny);
  if (ncount > nmax) {
    nmaxcorner = TOPRIGHT;
    nmax = ncount;
  }
  ncount = cpl_mask_count_window(aMask, 1, ny/2, nx/2, ny);
  if (ncount > nmax) {
    nmaxcorner = TOPLEFT;
    nmax = ncount;
  }
  if (nmaxcorner == NONE) {
    cpl_error_set_message(__func__, CPL_ERROR_DATA_NOT_FOUND, "No masked "
                          "quadrant found, cannot adapt %dx%d mask to %dx%d "
                          "image size!", nx, ny, nximage, nyimage);
    return NULL;
  }
  cpl_msg_debug(__func__, "Adapting %dx%d mask in %s quadrant (%d masked pixels)"
                " to %dx%d image", nx, ny, cnames[nmaxcorner], nmax,
                nximage, nyimage);
  /* extract masked quadrant */
  cpl_mask *xmask;
  switch (nmaxcorner) {
  case BOTTOMLEFT:
    xmask = cpl_mask_extract(aMask, 1, 1, nx/2, ny/2);
    break;
  case BOTTOMRIGHT:
    xmask = cpl_mask_extract(aMask, nx/2, 1, nx, ny/2);
    break;
  case TOPRIGHT:
    xmask = cpl_mask_extract(aMask, nx/2, ny/2, nx, ny);
    break;
  default: /* TOPLEFT */
    xmask = cpl_mask_extract(aMask, 1, ny/2, nx/2, ny);
  } /* switch */
  /* track the extracted size */
  nx = cpl_mask_get_size_x(xmask);
  ny = cpl_mask_get_size_y(xmask);

  /* create new mask of the right size */
  cpl_mask *outmask = cpl_mask_new(nximage, nyimage);
  /* copy the extracted region into it, so that it aligns with the right corner */
  cpl_error_code rc = CPL_ERROR_NONE;
  switch (nmaxcorner) {
  case BOTTOMLEFT:
    rc = cpl_mask_copy(outmask, xmask, 1, 1);
    break;
  case BOTTOMRIGHT:
    rc = cpl_mask_copy(outmask, xmask, nximage - nx + 1, 1);
    break;
  case TOPRIGHT:
    rc = cpl_mask_copy(outmask, xmask, nximage - nx + 1, nyimage - ny + 1);
    break;
  default: /* TOPLEFT */
    rc = cpl_mask_copy(outmask, xmask, 1, nyimage - ny + 1);
  } /* switch */
  cpl_mask_delete(xmask);
  if (rc != CPL_ERROR_NONE) {
    cpl_mask_delete(outmask);
    cpl_error_set_message(__func__, rc, "Could not copy %dx%d quadrant with "
                          "masked region into new %dx%d mask", nx, ny,
                          nximage, nyimage);
    return NULL;
  }

  return outmask;
} /* muse_cplmask_adapt_to_image() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Fill part of a mask with a given (binary) value.
  @param    aMask    mask to adapt
  @param    aLLX     lower left x position (FITS convention, 1 for leftmost)
  @param    aLLY     lower left y position (FITS convention, 1 for lowest)
  @param    aURX     top right x position
  @param    aURY     top right y position
  @param    aValue   the binary value to fill with
  @return   CPL_ERROR_NONE on success another cpl_error_code on failure

  This is the equivalent of cpl_image_fill_window() but for a @c cpl_mask.

  @error{set and return CPL_ERROR_NULL_INPUT, aMask is NULL}
  @error{set and return CPL_ERROR_ILLEGAL_INPUT,
         one of the coordinates given is outside the mask\, or the coordinates are reversed}
 */
/*----------------------------------------------------------------------------*/
/* a la cpl_image_fill_window() but for a mask */
cpl_error_code
muse_cplmask_fill_window(cpl_mask *aMask, cpl_size aLLX, cpl_size aLLY,
                         cpl_size aURX, cpl_size aURY, cpl_binary aValue)
{
  cpl_ensure_code(aMask, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(aLLX >= 1, CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(aLLY >= 1, CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(aLLX <= aURX, CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(aLLY <= aURY, CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(aURX <= cpl_mask_get_size_x(aMask), CPL_ERROR_ILLEGAL_INPUT);
  cpl_ensure_code(aURY <= cpl_mask_get_size_y(aMask), CPL_ERROR_ILLEGAL_INPUT);

  cpl_error_code rc = CPL_ERROR_NONE;
  cpl_binary *m = cpl_mask_get_data(aMask);
  cpl_size i, j,
           nx = cpl_mask_get_size_x(aMask);
  for (i = aLLX - 1; i < aURX; i++) {
    for (j = aLLY - 1; j < aURY; j++) {
      m[i + j*nx] = aValue;
    } /* for j (columns) */
  } /* for i (rows) */
  return rc ? cpl_error_set_where(__func__) : CPL_ERROR_NONE;
} /* muse_cplmask_fill_window() */

/*----------------------------------------------------------------------------*/
/**
  @brief  Compute the element-wise product of two matrices.
  @param  aMatrix1   First matrix object.
  @param  aMatrix2   Second matrix object.
  @return On success the function returns a new matrix object. In case an
          error occurs @c NULL is returned.

  The function multiplies the matrices @em aMatrix1 and @em aMatrix2 element
  by element. The input matrices must have the same dimensions. The result
  is returned in a new matrix object.

  The returned matrix has to be deallocated using cpl_matrix_delete().

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, a parameter is NULL}
  @error{set CPL_ERROR_INCOMPATIBLE_INPUT\, return NULL, input matrices have different sizes}

 */
/*----------------------------------------------------------------------------*/
cpl_matrix *
muse_cplmatrix_multiply_create(const cpl_matrix *aMatrix1,
                               const cpl_matrix *aMatrix2)
{
  cpl_ensure(aMatrix1 && aMatrix2, CPL_ERROR_NULL_INPUT, NULL);

  cpl_matrix *result = cpl_matrix_duplicate(aMatrix1);

  if (cpl_matrix_multiply(result, aMatrix2) != CPL_ERROR_NONE) {
    cpl_error_set_where(__func__);
    cpl_matrix_delete(result);
    return NULL;
  }
  return result;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Select matrix elements according to a condition.
  @param aMatrix     A matrix object.
  @param aValue      The value to compare with the matrix elements.
  @param aCondition  The condition function to use for comparing matrix
                     elements with the reference value
  @return On success the function returns an array object with the offset
          positions of the selected matrix elements. In case an error occurs
          @c NULL is returned.

  Using the compare function @em aCondition all matrix elements are compared
  to the given value @em aValue. The position of the selected matrix element
  is stored in the returned index array. The returned position gives the
  offset from the start of the matrix data buffer.
 */
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplmatrix_where(const cpl_matrix *aMatrix, double aValue,
                      muse_cplmatrix_element_compare_func aCondition)
{

  cpl_ensure(aMatrix, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(aCondition, CPL_ERROR_NULL_INPUT, NULL);

  cpl_size i;
  cpl_size count = 0;
  cpl_size size  = cpl_matrix_get_nrow(aMatrix) * cpl_matrix_get_ncol(aMatrix);

  const double *mdata = cpl_matrix_get_data_const(aMatrix);

  cpl_size *selection  = cpl_malloc(size * sizeof *selection);
  cpl_size *_selection = selection;

  for (i = 0; i < size; ++i) {
    if (aCondition(mdata[i], aValue)) {
      *_selection++ = i;
      ++count;
    }
  }
  cpl_array *where = cpl_array_new(count, CPL_TYPE_SIZE);
  cpl_array_copy_data_cplsize(where, selection);
  cpl_free(selection);

  return where;

}

/*----------------------------------------------------------------------------*/
/**
  @brief  Extract the elements given by the index array
  @param  aMatrix   A matrix object.
  @param  aIndices  Array containing the matrix element offsets to extract.
  @return A new matrix object containing the extracted matrix elements or
          @c NULL in case of an error.

  Creates a row vector (1xN matrix object) filled with the elements of the
  matrix @em aMatrix which are listed in the index array @em aIndices. The
  selected indices given by @em aIndices are offset indices, i.e. are
  obtained from the matrix row and column indices using the relation
  row index times number of columns plus column index.

  The returned array has to be deallocated using cpl_array_delete().

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, a parameter is NULL}
  @error{set CPL_ERROR_INVALID_TYPE\, return NULL, aIndices type is not CPL_TYPE_SIZE}

 */
/*----------------------------------------------------------------------------*/
cpl_matrix *
muse_cplmatrix_extract_selected(const cpl_matrix *aMatrix,
                                const cpl_array *aIndices)
{
  cpl_ensure(aMatrix, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(aIndices, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(cpl_array_get_type(aIndices) == CPL_TYPE_SIZE,
             CPL_ERROR_INVALID_TYPE, NULL);

  cpl_size maxpos = cpl_matrix_get_nrow(aMatrix) * cpl_matrix_get_ncol(aMatrix);
  cpl_size sz = cpl_array_get_size(aIndices);
  cpl_matrix *subset = cpl_matrix_new(1, sz);

  double *sdata = cpl_matrix_get_data(subset);
  const double *mdata = cpl_matrix_get_data_const(aMatrix);
  const cpl_size *idata = cpl_array_get_data_cplsize_const(aIndices);

  cpl_size i;
  for (i = 0; i < sz; ++i) {
    if ((idata[i] >= 0) && (idata[i] < maxpos)) {
      *sdata++ = mdata[idata[i]];
    }
  }
  return subset;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the average absolute deviation of a (constant) vector.
  @param    aVector   vector of values
  @param    aCenter   pre-computed central value of the vector (e.g. the median)
  @return   The averaged absoluted deviation against aCenter or 0. on error

  @error{set CPL_ERROR_NULL_INPUT\, return 0., aVector is NULL}
 */
/*----------------------------------------------------------------------------*/
double
muse_cplvector_get_adev_const(const cpl_vector *aVector, double aCenter)
{
  cpl_ensure(aVector, CPL_ERROR_NULL_INPUT, 0.);
  double mdev = 0;
  cpl_size i, n = cpl_vector_get_size(aVector);
  for (i = 0; i < n; i++) {
    mdev += fabs(cpl_vector_get(aVector, i) - aCenter);
  }
  return mdev / (double)n; /* return normalized value */
} /* muse_cplvector_get_adev_const() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the median and average absolute deviation against the median
            of a vector.
  @param    aVector   vector of values
  @param    aMedian   the computed median (optional, can be NULL)
  @return   The median deviation of the elements or 0. on error.

  @warning  This function is optimized for speed and hence re-orders the
            elements in the input vector, see cpl_vector_get_median().

  @error{set CPL_ERROR_NULL_INPUT\, return 0., aVector is NULL}
 */
/*----------------------------------------------------------------------------*/
double
muse_cplvector_get_median_dev(cpl_vector *aVector, double *aMedian)
{
  cpl_ensure(aVector, CPL_ERROR_NULL_INPUT, 0.);
  double median = cpl_vector_get_median(aVector),
         mdev = 0.;
  cpl_size i, n = cpl_vector_get_size(aVector);
  for (i = 0; i < n; i++) {
    mdev += fabs(cpl_vector_get(aVector, i) - median);
  }
  if (aMedian) {
    *aMedian = median;
  }
  return mdev / (double)n; /* return normalized value */
} /* muse_cplvector_get_median_dev() */

/*----------------------------------------------------------------------------*/
/**
  @brief    compute the semi-quartile range of a vector of elements
  @param    aVector         Input cpl_vector
  @return   the semi-quartile range of the elements

  The semiquartile range is a measure similar to standard deviation but it
  employs the median and rejects outliers so that it is more robust in the
  case of a few outliers.

  Algorithm:
  determine median, then the medians of the parts of the sorted vector above
  and below the median value, subtract them, and divide by two
 */
/*----------------------------------------------------------------------------*/
double
muse_cplvector_get_semiquartile(cpl_vector *aVector)
{
  double sqr = 0;
  double median = cpl_vector_get_median_const(aVector);
  cpl_vector *v = cpl_vector_duplicate(aVector), *v2;
  int i, splitindex = 0;

  cpl_vector_sort(v, +1);
#if DEBUG_SQR
  cpl_vector_dump(v, stdout);
  fflush(stdout);
  printf("median=%f%d\n", median);
  fflush(stdout);
#endif
  /* search for point to split the sorted vector, better just do it linearly */
  splitindex = cpl_vector_find(v, median);

  /* copy upper half into new vector */
  v2 = cpl_vector_new(cpl_vector_get_size(v) - splitindex - 1);
#if DEBUG_SQR
  printf("Copying elements %d to %d\n", splitindex+1, cpl_vector_get_size(v)-1);
#endif
  for (i = splitindex; i < cpl_vector_get_size(v); i++){
#if DEBUG_SQR
    printf("  %d %f\n", i+1, cpl_vector_get(v, i));
#endif
    cpl_vector_set(v2, i-splitindex, cpl_vector_get(v, i));
  }
#if DEBUG_SQR
  printf("\n");
  fflush(stdout);
#endif
  sqr = cpl_vector_get_median(v2); /* the upper median, non const OK */
  cpl_vector_delete(v2);

  /* copy lower half into new vector */
  v2 = cpl_vector_new(splitindex - 1);
#if DEBUG_SQR
  printf("Copying elements %d to %d\n", 1, splitindex+1);
#endif
  for (i = 0; i <= splitindex; i++) {
#if DEBUG_SQR
    printf("  %d %f\n", i+1, cpl_vector_get(v, i));
#endif
    cpl_vector_set(v2, i, cpl_vector_get(v, i));
  }
#if DEBUG_SQR
  printf("\n");
  fflush(stdout);
#endif
  sqr -= cpl_vector_get_median(v2); /* subtract the lower median, non const OK */
  cpl_vector_delete(v2);

  return sqr/2.0; /* divide by two to get semiquartile range */
} /* muse_cplvector_get_semiquartile() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Threshold a vector to a given interval.
  @param    aVec     Vector to threshold.
  @param    aLoCut   Lower bound.
  @param    aHiCut   Higher bound.
  @param    aLoVal   Value to assign to pixels below low bound.
  @param    aHiVal   Value to assign to pixels above high bound.
  @return   CPL_ERROR_NONE on success another cpl_error_code on failure

  Elements outside of the provided interval are assigned the given values.

  Use DBL_MIN and DBL_MAX for the aLoCut and aHiCut to avoid any element
  replacement.

  aLoCut must be smaller than or equal to aHiCut.

  @error{return CPL_ERROR_NULL_INPUT, NULL input vector}
  @error{return CPL_ERROR_ILLEGAL_INPUT, aLoCut is higher than aHiCut}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplvector_threshold(cpl_vector *aVec, double aLoCut, double aHiCut,
                         double aLoVal, double aHiVal)
{
  cpl_ensure_code(aVec, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(aLoCut <= aHiCut, CPL_ERROR_ILLEGAL_INPUT);

  double *data = cpl_vector_get_data(aVec);
  int i, n = cpl_vector_get_size(aVec);
  for (i = 0; i < n; i++) {
    if (data[i] > aHiCut) {
      data[i] = aHiVal;
    } else if (data[i] < aLoCut) {
      data[i] = aLoVal;
    }
  } /* for i (vector elements) */

  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    delete the given element from the input vector
  @param    aVector         Input cpl_vector
  @param    aElement        Position of the element to remove
  @return   CPL_ERROR_NONE on success.

  This function is similar to cpl_matrix_erase_columns() but for CPL vectors.
  A portion of the vector data is physically removed. The pointer to the vector
  data may change, therefore pointers previously retrieved by calling
  cpl_vector_get_data() should be discarded.
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplvector_erase_element(cpl_vector *aVector, int aElement)
{
  cpl_ensure_code(aVector, CPL_ERROR_NULL_INPUT);
  int size = cpl_vector_get_size(aVector);
  cpl_ensure_code(aElement >= 0 && aElement < size, CPL_ERROR_ILLEGAL_INPUT);

  if (aElement < size - 1) {
    /* if it's not the last element, we need to move the remaining *
     * elements so that they overwrite the one to be removed       */
    double *data = cpl_vector_get_data(aVector);
    memmove(&data[aElement], &data[aElement+1],
            (size-1 - aElement) * sizeof(double));
  }

  /* resize the vector to account for the removed element */
  return cpl_vector_set_size(aVector, size - 1);
} /* muse_cplvector_erase_element() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Count the number of unique entries in a given vector.
  @param    aVector   Input CPL vector.
  @return   The number of unique entries on success, a negative number on error.

  @error{set CPL_ERROR_NULL_INPUT\, return -1, aVector is NULL}
 */
/*----------------------------------------------------------------------------*/
cpl_size
muse_cplvector_count_unique(const cpl_vector *aVector)
{
  cpl_ensure(aVector, CPL_ERROR_NULL_INPUT, -1);
  cpl_vector *sorted = cpl_vector_duplicate(aVector);
  cpl_vector_sort(sorted, CPL_SORT_ASCENDING);
  double *data = cpl_vector_get_data(sorted);
  cpl_size i, n = cpl_vector_get_size(sorted),
           nunique = 1; /* first element is always unique */
  for (i = 1; i < n; i++) { /* start at 2nd element */
    if (data[i] != data[i - 1]) {
      nunique++;
    }
  } /* for i (all elements in sorted vector) */
  cpl_vector_delete(sorted);
  return nunique;
} /* muse_cplvector_count_unique() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Separate out all unique entries in a given vector into a new one.
  @param    aVector   Input CPL vector.
  @return   A new cpl_vector * on success, NULL on failure.

  @error{set CPL_ERROR_NULL_INPUT\, return -1, aVector is NULL}
 */
/*----------------------------------------------------------------------------*/
cpl_vector *
muse_cplvector_get_unique(const cpl_vector *aVector)
{
  cpl_ensure(aVector, CPL_ERROR_NULL_INPUT, NULL);
  cpl_vector *sorted = cpl_vector_duplicate(aVector);
  cpl_vector_sort(sorted, CPL_SORT_ASCENDING);
  double *data = cpl_vector_get_data(sorted);
  cpl_size i, n = cpl_vector_get_size(sorted),
           iunique = 0;
  cpl_vector *vunique = cpl_vector_new(n);
  cpl_vector_set(vunique, iunique++, data[0]); /* set unique first element */
  for (i = 1; i < n; i++) { /* start at 2nd element */
    if (data[i] != data[i - 1]) {
      cpl_vector_set(vunique, iunique++, data[i]);
    }
  } /* for i (all elements in sorted vector) */
  cpl_vector_delete(sorted);
  cpl_vector_set_size(vunique, iunique);
  return vunique;
} /* muse_cplvector_get_unique() */

/*----------------------------------------------------------------------------*/
/** @brief Create an empty table according to the specified definition.
    @param aDef    Column definitions.
    @param aLength Length of the table.
    @return Empty table of lines.

    This sets the depth of array columns (signified by CPL_TYPE_POINTER) to 2.
    If any other depth is required, use @c cpl_table_set_column_depth() to set
    it after this call.
 */
/*----------------------------------------------------------------------------*/
cpl_table *
muse_cpltable_new(const muse_cpltable_def *aDef, cpl_size aLength)
{
  cpl_ensure(aDef, CPL_ERROR_NULL_INPUT, NULL);
  cpl_table *res = cpl_table_new(aLength);
  for (; aDef->name != NULL; aDef++) {
    cpl_error_code rc = CPL_ERROR_NONE;
    if (aDef->type & CPL_TYPE_POINTER) {
      rc = cpl_table_new_column_array(res, aDef->name, aDef->type, 2);
    } else {
      rc = cpl_table_new_column(res, aDef->name, aDef->type);
    }
    if (rc != CPL_ERROR_NONE) {
      cpl_table_delete(res);
      return NULL;
    }
    if (aDef->unit != NULL) {
      if (cpl_table_set_column_unit(res, aDef->name,
                                    aDef->unit) != CPL_ERROR_NONE) {
        return NULL;
      }
    }
    if (aDef->format != NULL) {
      if (cpl_table_set_column_format(res, aDef->name,
                                      aDef->format) != CPL_ERROR_NONE) {
        return NULL;
      }
    }
  }
  return res;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Load a table from disk (and check against definition).
   @param aFile         file name
   @param aExtension    extension name
   @param aDefinition   optional table definition; if not NULL, the loaded table
                        will be checked against it
   @return Loaded CPL table, or NULL on error.

   @error{propagate error code from cpl_fits_find_extension()\, return NULL,
          extension with given name is not found}
 */
/*----------------------------------------------------------------------------*/
cpl_table *
muse_cpltable_load(const char *aFile, const char *aExtension,
                   const muse_cpltable_def aDefinition[])
{
  int extension = cpl_fits_find_extension(aFile, aExtension);
  if (extension <= 0) {
    cpl_error_set_message(__func__, cpl_error_get_code(), "%s['%s']: "
                          "extension not found by EXTNAME", aFile, aExtension);
    return NULL;
  }
  cpl_msg_debug(__func__, "Loading %s['%s'] from extension %d", aFile,
                aExtension, extension);
  cpl_table *tbl = cpl_table_load(aFile, extension, 1);
  if (muse_cpltable_check(tbl, aDefinition) != CPL_ERROR_NONE) {
    cpl_table_delete(tbl);
    return NULL;
  }
  return tbl;
} /* muse_cpltable_load() */

/*----------------------------------------------------------------------------*/
/**
   @brief Save a table to disk (into a FITS extension)
   @param aTable Table to save.
   @param aFile File name
   @param aExtension Extension name
   @param aDefinition Optional table definition. If not NULL, table
          will be checked against this definition before saving.
   @retval CPL_ERROR_NONE Success
   @cpl_ensure_code{aTable != NULL, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{aFile != NULL, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{aExtension != NULL, CPL_ERROR_NULL_INPUT}

   This function saves the table as an extension. It requires that the file
   already exists with at least the main header.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cpltable_append_file(const cpl_table *aTable, const char *aFile,
                          const char *aExtension,
                          const muse_cpltable_def aDefinition[]) {
  cpl_ensure_code(aTable != NULL, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(aFile != NULL, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(aExtension != NULL, CPL_ERROR_NULL_INPUT);
  cpl_error_code r = muse_cpltable_check(aTable, aDefinition);
  if (r != CPL_ERROR_NONE) {
    cpl_msg_error(__func__, " %s['%s'] Table format error", aFile, aExtension);
    cpl_error_set(__func__, r);
    return r;
  }
  cpl_propertylist *props = cpl_propertylist_new();
  cpl_propertylist_update_string(props, "EXTNAME", aExtension);
  r = cpl_table_save(aTable, NULL, props, aFile, CPL_IO_EXTEND);
  cpl_propertylist_delete(props);
  if (r != CPL_ERROR_NONE) {
    cpl_msg_error(__func__, "%s[%s]: %s", aFile, aExtension,
                  cpl_error_get_message());
  }
  return r;
}


/*----------------------------------------------------------------------------*/
/** @brief Check whether the table contains the fields of the definition.
    @param aTable  CPL table to check.
    @param aDef    Column definitions.
    @return CPL_ERROR_NONE, or the error.
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cpltable_check(const cpl_table *aTable, const muse_cpltable_def *aDef)
{
  if (aTable == NULL) {
    cpl_msg_error(__func__, "NULL table");
    cpl_error_set(__func__, CPL_ERROR_NULL_INPUT);
    return CPL_ERROR_NULL_INPUT;
  }
  if (aDef == NULL) {
    return CPL_ERROR_NONE;
  }
  cpl_error_code rc = CPL_ERROR_NONE;
  for (; aDef->name != NULL; aDef++) {
    if (!cpl_table_has_column(aTable, aDef->name)) {
      if (aDef->required) {
        rc = CPL_ERROR_ILLEGAL_INPUT;
        cpl_error_set_message(__func__, rc, "table column '%s' not found",
                              aDef->name);
      }
      continue;
    }
    cpl_type coltype = cpl_table_get_column_type(aTable, aDef->name);
    if (((coltype | CPL_TYPE_POINTER) != (aDef->type | CPL_TYPE_POINTER))  ||
        ((coltype & CPL_TYPE_POINTER) && !(aDef->type & CPL_TYPE_POINTER))) {
      rc = CPL_ERROR_ILLEGAL_INPUT;
      cpl_error_set_message(__func__, rc,
                            "table column '%s' format '%s' is not '%s'",
                            aDef->name, cpl_type_get_name(coltype),
                            cpl_type_get_name(aDef->type));
    }
  }
  return rc;
} /* muse_cpltable_check() */

/*----------------------------------------------------------------------------*/
/**
  @brief Create an array from a section of a column.
  @param aTable Input table
  @param aColumn Input column name
  @return Pointer to the array, or NULL in case or error.
  @cpl_ensure{aTable, CPL_ERROR_NULL_INPUT, NULL}
  @cpl_ensure{aColumn, CPL_ERROR_NULL_INPUT, NULL}
  @cpl_ensure{Supported data type, CPL_ERROR_ILLEGAL_INPUT, NULL}

  The newly created array shares its data pointer with the original table, and
  should be deleted with cpl_array_unwrap(). If you need an independent array,
  duplicate it with cpl_array_duplicate().

  Only column of type <tt>CPL_TYPE_DOUBLE</tt>, <tt>CPL_TYPE_FLOAT</tt>, and
  <tt>CPL_TYPE_INT</tt> are supported. The validity of cells is ignored here.
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cpltable_extract_column(cpl_table *aTable, const char *aColumn)
{
  cpl_ensure(aTable && aColumn, CPL_ERROR_NULL_INPUT, NULL);
  cpl_size nRows = cpl_table_get_nrow(aTable);

  cpl_type type = cpl_table_get_column_type(aTable, aColumn);
  if (nRows == 0) {
    return cpl_array_new(0, type);
  }
  if (type == CPL_TYPE_DOUBLE) {
    double *src = cpl_table_get_data_double(aTable, aColumn);
    return cpl_array_wrap_double(src, nRows);
  } else if (type == CPL_TYPE_FLOAT) {
    float *src = cpl_table_get_data_float(aTable, aColumn);
    return cpl_array_wrap_float(src, nRows);
  } else if (type == CPL_TYPE_INT) {
    int *src = cpl_table_get_data_int(aTable, aColumn);
    return cpl_array_wrap_int(src, nRows);
  } else {
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    cpl_msg_error(__func__, "%s: %i - %s", cpl_error_get_message(), type,
                  cpl_type_get_name(type));
    return NULL;
  }
}

/*----------------------------------------------------------------------------*/
/**
   @brief Copy an array into a table.
   @param aTable  Pointer to table.
   @param aColumn Name of table column to be accessed.
   @param aArray  Array to be copied
   @retval CPL_ERROR_NONE Everything went OK.

   @error{return CPL_ERROR_NULL_INPUT, one of the input arguments is NULL}
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cpltable_copy_array(cpl_table *aTable, const char *aColumn,
                         const cpl_array *aArray)
{
  cpl_ensure_code(aTable && aColumn && aArray, CPL_ERROR_NULL_INPUT);
  cpl_size n_rows = cpl_table_get_nrow(aTable);
  cpl_size i;
  for (i = 0; i < n_rows; i++) {
    int flag;
    double d = cpl_array_get(aArray, i, &flag);
    if (flag == 0) {
      cpl_table_set(aTable, aColumn, i, d);
    } else {
      cpl_table_set_invalid(aTable, aColumn, i);
    }
  }
  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Return the copy of an array of a table cell.
   @param aTable  Pointer to table.
   @param aColumn Name of table column to be accessed.
   @param aRow    Position of element to be read.
   @return Pointer to array. In case of an invalid column element, or in
           case of error, a NULL pointer is always returned.
   @cpl_ensure{aTable && aColumn, CPL_ERROR_NULL_INPUT, NULL}
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cpltable_get_array_copy(cpl_table *aTable, const char *aColumn,
                             cpl_size aRow)
{
  cpl_ensure(aTable && aColumn, CPL_ERROR_NULL_INPUT, NULL);
  if (cpl_table_get_column_type(aTable, aColumn) & CPL_TYPE_POINTER) {
    return cpl_array_duplicate(cpl_table_get_array(aTable, aColumn, aRow));
  } else {
    cpl_array *res
      = cpl_array_new(1, cpl_table_get_column_type(aTable, aColumn));
    int flag;
    cpl_array_set(res, 0, cpl_table_get(aTable, aColumn, aRow, &flag));
    if (flag) {
      cpl_array_delete(res);
      return NULL;
    } else {
      return res;
    }
  }
}
/*----------------------------------------------------------------------------*/
/**
   @brief Find a row in a table
   @param aTable Pointer to the table.
   @param aColumn Name of table column to be accessed.
   @param aValue Value to search.
   @return The row index, or 0 on error.
   @cpl_ensure{aTable != NULL, CPL_ERROR_NULL_INPUT, 0}
   @cpl_ensure{Supported data type, CPL_ERROR_ILLEGAL_INPUT, 0}

   This function assumes that the array is sorted. It then searches the last
   index where the value value is smaller than the specified value. The validity
   is ignored here.
*/
/*----------------------------------------------------------------------------*/

cpl_size
muse_cpltable_find_sorted(const cpl_table *aTable, const char *aColumn,
                          double aValue) {
  cpl_ensure(aTable && aColumn, CPL_ERROR_NULL_INPUT, 0);
  cpl_array *array = muse_cpltable_extract_column((cpl_table *)aTable, aColumn);
  cpl_size res = muse_cplarray_find_sorted(array, aValue);
  cpl_array_unwrap(array);
  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Copy the image data into an array.
  @param  aImage Source image
  @return The created array, or NULL on error.

  The validity of values will be copied, too.
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_new_from_image(const cpl_image *aImage) {
  cpl_size nx = cpl_image_get_size_x(aImage);
  cpl_size ny = cpl_image_get_size_y(aImage);
  cpl_array *array = cpl_array_new(nx*ny, cpl_image_get_type(aImage));
  cpl_size i = 0;
  cpl_size iy;
  for (iy = 1; iy <= ny; iy++) {
    int ix;
    for (ix = 1; ix <= nx; ix++, i++) {
      int rej;
      double d = cpl_image_get(aImage, ix, iy, &rej);
      cpl_array_set(array, i, d);
      if (rej) {
        cpl_array_set_invalid(array, i);
      }
    }
  }
  return array;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Apply a polynomial to an array
   @param aArray Pointer to array
   @param aCoeff Polynomial coefficients.
                 First coefficient is lowest order (constant).
   @retval CPL_ERROR_NONE Everything went OK.

   If the length of the coefficient array is zero, all values of the value are
   are set to zero. No error is set in this case.

   @error{return CPL_ERROR_NULL_INPUT, one of the input arguments is NULL}
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_poly1d(cpl_array *aArray, const cpl_array *aCoeff)
{
  cpl_ensure_code(aArray && aCoeff, CPL_ERROR_NULL_INPUT);
  const cpl_size nrows = cpl_array_get_size(aArray);
  cpl_size order = cpl_array_get_size(aCoeff);
  if (order == 0) {
    cpl_array_fill_window(aArray, 0, nrows, 0.0);
    return CPL_ERROR_NONE;
  }
  order--;
  cpl_array *x = cpl_array_duplicate(aArray);
  cpl_array_fill_window(aArray, 0, nrows, cpl_array_get(aCoeff, order, NULL));

  int k;
  for (k = order-1; k >= 0; k--) {
    cpl_array_multiply(aArray, x);
    cpl_array_add_scalar(aArray, cpl_array_get(aCoeff, k, NULL));
  }

  cpl_array_delete(x);

  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Apply a polynomial to a double value.
   @param aDouble Argument.
   @param aCoeff Polynomial coefficients.
                 First coefficient is lowest order (constant).
   @return The result
   @cpl_ensure{aCoeff, CPL_ERROR_NULL_INPUT, NAN}

   If the length of the coefficient array is zero, 0.0 is returned. No error
   is set in this case.
*/
/*----------------------------------------------------------------------------*/
double
muse_cplarray_poly1d_double(double aDouble, const cpl_array *aCoeff)
{
  cpl_ensure(aCoeff, CPL_ERROR_NULL_INPUT, NAN);
  cpl_size order = cpl_array_get_size(aCoeff);
  if (order == 0) {
    return 0.0;
  }
  order--;
  double res = cpl_array_get(aCoeff, order, NULL);
  int k;
  for (k = order-1; k >= 0; k--) {
    res = res * aDouble + cpl_array_get(aCoeff, k, NULL);
  }
  return res;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Dump a numerical array to stdout with a name prefixed to each line.
  @param aArray   Pointer to the array.
  @param aName    Name of the array.
  @return CPL_ERROR_NONE or another CPL error on failure.

  @error{return CPL_ERROR_NULL_INPUT, one of the input arguments is NULL}
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_dump_name(const cpl_array *aArray, const char *aName)
{
  cpl_ensure_code(aArray && aName, CPL_ERROR_NULL_INPUT);
  cpl_size i, size = cpl_array_get_size(aArray);
  for (i = 0; i < size; i++) {
    printf("%s[%"CPL_SIZE_FORMAT"] = %g\n", aName, i,
           cpl_array_get(aArray, i, NULL));
  }
  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Erase all invalid values from an array.
   @param aArray Pointer to the array.
   @cpl_ensure_code{aArray != NULL, CPL_ERROR_NULL_INPUT}
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_erase_invalid(cpl_array *aArray)
{
  cpl_ensure_code(aArray != NULL, CPL_ERROR_NULL_INPUT);
  cpl_size n = cpl_array_get_size(aArray);
  cpl_size n_val = n - cpl_array_count_invalid(aArray);
#if 0 /* DEBUG */
  cpl_msg_debug(__func__, "size = %li, %li valid", (long)n, (long)n_val);
#endif
  if (n_val == n) {
    return CPL_ERROR_NONE;
  }
  cpl_size i;
  cpl_size idx = 0;
  for (i = 0; (i < n) && (idx < n_val); i++) {
    int rej;
    double d = cpl_array_get(aArray, i, &rej);
    if (!rej) {
      if (idx < i) {
        cpl_array_set(aArray, idx, d);
      }
      idx++;
    }
  }
  cpl_array_set_size(aArray, n_val);
  return CPL_ERROR_NONE;
}

/*---------------------------------------------------------------------------*/
/**
  @brief   Erase outliers from an array using histogram information.
  @param   aArray       the input array
  @param   aHistogram   histogram to use
  @param   aGap         size of the gap in the histogram to separate outliers
  @param   aLimit       the limit below which values count as gap
  @return  The number of erased array entries of a negative value on failure.

  @warning Pre-existing invalid entries in aArray are erased and counted, too.

  @error{return CPL_ERROR_NULL_INPUT\, return -1, aArray or aHistogram are NULL}
  @error{return CPL_ERROR_INVALID_TYPE\, return -2,
         aArray is not of numerical type (element zero cannot be read with cpl_array_get())}
 */
/*---------------------------------------------------------------------------*/
cpl_size
muse_cplarray_erase_outliers(cpl_array *aArray, const cpl_bivector *aHistogram,
                             cpl_size aGap, double aLimit)
{
  cpl_ensure(aArray && aHistogram, CPL_ERROR_NULL_INPUT, -1);
  /* test for numerical array */
  int err;
  double value = cpl_array_get(aArray, 0, &err);
  cpl_ensure(err >= 0, CPL_ERROR_ILLEGAL_INPUT, -2);

  /* start at the peak of the histogram */
  const double *hpos = cpl_bivector_get_x_data_const(aHistogram),
               *hval = cpl_bivector_get_y_data_const(aHistogram);
  cpl_size nhist = cpl_bivector_get_size(aHistogram);
  cpl_array *ahist = cpl_array_wrap_double((double *)hval, nhist);
  cpl_size imax;
  cpl_array_get_maxpos(ahist, &imax);
  cpl_array_unwrap(ahist);

  /* go to lower values in the histogram, search for the first gap */
  double loval = hpos[0],
         hival = hpos[nhist - 1];
  cpl_size i, nlow = 0;
  for (i = imax; i >= 0; i--) {
    if (hval[i] <= aLimit) {
      if (nlow == 0) { /* keep this as the initial low value */
        loval = hpos[i];
      }
      nlow++;
      if (nlow == aGap) { /* gap already wide enough */
        break;
      }
    } else if (nlow > 0) {
      nlow = 0; /* gap not wide enough after all */
      loval = hpos[0];
    }
  } /* for i */
  /* same search now to higher histogram values */
  for (i = imax; i < nhist; i++) {
    if (hval[i] <= aLimit) {
      if (nlow == 0) { /* keep this as the initial low value */
        hival = hpos[i];
      }
      nlow++;
      if (nlow == aGap) { /* gap already wide enough */
        break;
      }
    } else if (nlow > 0) {
      nlow = 0; /* gap not wide enough after all */
      hival = hpos[nhist - 1];
    }
  } /* for i */
  cpl_msg_debug(__func__, "Histogram gaps (%"CPL_SIZE_FORMAT" consecutive "
                "entries <= %f) at %f and %f", aGap, aLimit, loval, hival);

  /* now go through the array, and set values larger *
   * or smaller than these extremes to invalid       */
  cpl_size idx, narray = cpl_array_get_size(aArray);
  for (idx = 0; idx < narray; idx++) {
    value = cpl_array_get(aArray, idx, NULL);
    if (value > hival || value < loval) {
      cpl_array_set_invalid(aArray, idx);
    }
  } /* for idx */

  /* finally count them and then remove all invalid ones */
  cpl_size nbad = cpl_array_count_invalid(aArray);
  muse_cplarray_erase_invalid(aArray);
  return nbad;
} /* muse_cplarray_erase_outliers() */


/*----------------------------------------------------------------------------*/
/* Helper functions for quicksort */
/*----------------------------------------------------------------------------*/
/** @private */
static int cmp_double_asc(const void *p1, const void *p2) {
  double d = (*(const double *)p1 - *(const double *)p2);
  return (d  < 0)?-1:(d>0)?1:0;
}
/** @private */
static int cmp_double_desc(const void *p1, const void *p2) {
  double d = (*(const double *)p1 - *(const double *)p2);
  return (d  < 0)?1:(d>0)?-1:0;
}
/** @private */
static int cmp_float_asc(const void *p1, const void *p2) {
  float d = (*(const float *)p1 - *(const float *)p2);
  return (d  < 0)?-1:(d>0)?1:0;
}
/** @private */
static int cmp_float_desc(const void *p1, const void *p2) {
  float d = (*(const float *)p1 - *(const float *)p2);
  return (d  < 0)?1:(d>0)?-1:0;
}
/** @private */
static int cmp_int_asc(const void *p1, const void *p2) {
  return (*(const int *)p1 - *(const int *)p2);
}
/** @private */
static int cmp_int_desc(const void *p1, const void *p2) {
  return (*(const int *)p2 - *(const int *)p1);
}

/** @private */
static int cmp_long_asc(const void *p1, const void *p2) {
  return (*(const long *)p1 - *(const long *)p2);
}
/** @private */
static int cmp_long_desc(const void *p1, const void *p2) {
  return (*(const long *)p2 - *(const long *)p1);
}

/** @private */
static int cmp_string_asc(const void *p1, const void *p2) {
  return strcmp(*(const char **)p1, *(const char **)p2);
}
/** @private */
static int cmp_string_desc(const void *p1, const void *p2) {
  return strcmp(*(const char **)p2, *(const char **)p1);
}

/*----------------------------------------------------------------------------*/
/**
   @brief Sort float, int or double array by quicksort.
   @param aArray Pointer to the array.
   @param aOrder Sort order of the array, ascending if true
   @cpl_ensure_code{aArray != NULL, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{!cpl_array_has_invalid(aArray), CPL_ERROR_NULL_INPUT}

   This function currently only works with arrays that have no invalid values.
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_sort(cpl_array *aArray, cpl_boolean aOrder)
{
  cpl_ensure_code(aArray != NULL, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(!cpl_array_has_invalid(aArray), CPL_ERROR_NULL_INPUT);

  cpl_size n = cpl_array_get_size(aArray);
  if (cpl_array_get_type(aArray) == CPL_TYPE_DOUBLE) {
    double *d = cpl_array_get_data_double(aArray);
    qsort(d, n, sizeof(double), (aOrder)?cmp_double_asc:cmp_double_desc);
    return CPL_ERROR_NONE;
  } else if (cpl_array_get_type(aArray) == CPL_TYPE_FLOAT) {
    float *d = cpl_array_get_data_float(aArray);
    qsort(d, n, sizeof(float), (aOrder)?cmp_float_asc:cmp_float_desc);
    return CPL_ERROR_NONE;
  } else if (cpl_array_get_type(aArray) == CPL_TYPE_INT) {
    int *d = cpl_array_get_data_int(aArray);
    qsort(d, n, sizeof(int), (aOrder)?cmp_int_asc:cmp_int_desc);
    return CPL_ERROR_NONE;
  } else if (cpl_array_get_type(aArray) == CPL_TYPE_LONG) {
    long *d = cpl_array_get_data_long(aArray);
    qsort(d, n, sizeof(long), (aOrder)?cmp_long_asc:cmp_long_desc);
    return CPL_ERROR_NONE;
  } else if (cpl_array_get_type(aArray) == CPL_TYPE_STRING) {
    char **d = cpl_array_get_data_string(aArray);
    qsort(d, n, sizeof(char *), (aOrder)?cmp_string_asc:cmp_string_desc);
    return CPL_ERROR_NONE;
  } else {
    return CPL_ERROR_ILLEGAL_INPUT;
  }
}

/*---------------------------------------------------------------------------*/
/**
  @brief   Create a histogram for a numerical array.
  @param   aArray   the input array
  @param   aWidth   the bin width
  @param   aMin     lower histogram limit, can be NAN
  @param   aMax     upper histogram limit, can be NAN
  @return  A bivector containing the histogram (x component contain the values,
           y component contains the histogram counts).

  @note aMin and aMax can be NAN to signify an automatic computation of the
        limits using the exreme value(s) of the input array.

  @error{return CPL_ERROR_NULL_INPUT\, return NULL, aArray is NULL}
  @error{return CPL_ERROR_INVALID_TYPE\, return NULL,
         aArray is not of numerical type (element zero cannot be read with cpl_array_get())}
  @error{return CPL_ERROR_ILLEGAL_INPUT\, return NULL,
         aMin is not less than aMax}
 */
/*---------------------------------------------------------------------------*/
cpl_bivector *
muse_cplarray_histogram(const cpl_array *aArray, double aWidth,
                        double aMin, double aMax)
{
  cpl_ensure(aArray, CPL_ERROR_NULL_INPUT, NULL);
  /* test for numerical array */
  int err;
  double value = cpl_array_get(aArray, 0, &err);
  cpl_ensure(err >= 0, CPL_ERROR_INVALID_TYPE, NULL);
  if (!isnan(aMin) && !isnan(aMax) && aMin >= aMax) { /* inverse extremes */
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    return NULL;
  }
  if (isnan(aMin)) {
    aMin = cpl_array_get_min(aArray);
  }
  if (isnan(aMax)) {
    aMax = cpl_array_get_max(aArray);
  }
  cpl_size hlen = lround((aMax - aMin) / aWidth) + 1;
  cpl_bivector *histogram = cpl_bivector_new(hlen);

  /* fill histogram positions */
  double *hpos = cpl_bivector_get_x_data(histogram);
  cpl_size i;
  for (i = 0; i < hlen; i++) {
    hpos[i] = i * aWidth + aMin;
  } /* for i */

  /* fill histogram values */
  double *hval = cpl_bivector_get_y_data(histogram);
  /* histogram has at least zero everywhere */
  cpl_vector_fill(cpl_bivector_get_y(histogram), 0.);
  cpl_size n = cpl_array_get_size(aArray);
  for (i = 0; i < n; i++) {
    value = cpl_array_get(aArray, i, &err);
    if (err) {
      continue;
    }
    /* find histogram index */
    cpl_size idx = lround((value - aMin) / aWidth);
    if (idx >= hlen || idx < 0) {
      continue;
    }
    /* add one to the histogram at the respective index */
    hval[idx] += 1;
  } /* for i */
#if 0
  printf("histogram %f...%f / %f\n", aMin, aMax, aWidth);
  cpl_bivector_dump(histogram, stdout);
  fflush(stdout);
#endif
  return histogram;
} /* muse_cplarray_histogram() */

/*----------------------------------------------------------------------------*/
/**
   @brief Find a row in an array
   @param aArray Pointer to the array.
   @param aValue Value to search.
   @return The row index, or 0 on error.
   @cpl_ensure{aArray != NULL, CPL_ERROR_NULL_INPUT, 0}
   @cpl_ensure{Supported data type, CPL_ERROR_ILLEGAL_INPUT, 0}

   This function assumes that the array is sorted. It then searches the last
   index where the value value is smaller than the specified value. The validity
   is ignored here.
*/
/*----------------------------------------------------------------------------*/
cpl_size
muse_cplarray_find_sorted(const cpl_array *aArray,  double aValue)
{
  cpl_ensure(aArray, CPL_ERROR_NULL_INPUT, 0);
  cpl_size min = 0;
  cpl_size max = cpl_array_get_size(aArray);
  cpl_type type = cpl_array_get_type(aArray);
  if (type == CPL_TYPE_DOUBLE) {
    const double *data = cpl_array_get_data_double_const(aArray);
    while (max - min > 1) {
      int i = (max + min)/2;
      if (data[i] > aValue) {
        max = i;
      } else {
        min = i;
      }
    }
  } else if (type == CPL_TYPE_FLOAT) {
    const float *data = cpl_array_get_data_float_const(aArray);
    while (max - min > 1) {
      int i = (max + min)/2;
      if (data[i] > aValue) {
        max = i;
      } else {
        min = i;
      }
    }
  } else if (type == CPL_TYPE_INT) {
    const int *data = cpl_array_get_data_int_const(aArray);
    while (max - min > 1) {
      int i = (max + min)/2;
      if (data[i] > aValue) {
        max = i;
      } else {
        min = i;
      }
    }
  } else {
    cpl_msg_error(__func__, "illegal type %i", type);
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    return 0;
  }
  return min;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Check, if an array contains duplicate values.
   @param aArray   Pointer to the array.
   @return CPL_TRUE, if duplicates were detected, CPL_FALSE otherwise.

   This is a very simple (and slow!) routine that just compares all values
   against all others, and stops when it detected a duplicate.

   @note This function currently only works for integer types.

   @error{set CPL_ERROR_NULL_INPUT\, return CPL_FALSE, NULL input array}
   @error{set CPL_ERROR_UNSUPPORTED_MODE\, return CPL_FALSE,
          array is of non-integer type}
*/
/*----------------------------------------------------------------------------*/
cpl_boolean
muse_cplarray_has_duplicate(const cpl_array *aArray)
{
  cpl_ensure(aArray, CPL_ERROR_NULL_INPUT, CPL_FALSE);
  cpl_type type = cpl_array_get_type(aArray);
  switch (type) {
  case CPL_TYPE_INT:
  case CPL_TYPE_LONG:
  case CPL_TYPE_LONG_LONG:
  case CPL_TYPE_SIZE:
    break;
  default:
    cpl_error_set(__func__, CPL_ERROR_UNSUPPORTED_MODE);
    return CPL_FALSE;
  }

  cpl_size idx, n = cpl_array_get_size(aArray);
  for (idx = 0; idx < n - 1; idx++) {
    int err;
    cpl_size v1 = cpl_array_get(aArray, idx, &err);
    if (err) { /* invalid somehow, skip this one */
      continue;
    }
    cpl_size idx2;
    for (idx2 = idx + 1; idx2 < n; idx2++) {
      cpl_size v2 = cpl_array_get(aArray, idx2, &err);
      if (err) { /* invalid somehow, skip this one */
        continue;
      }
      if (v2 == v1) {
#if 0
        cpl_msg_debug(__func__, "entry[%"CPL_SIZE_FORMAT"] == entry[%"
                      CPL_SIZE_FORMAT"] == %"CPL_SIZE_FORMAT, idx, idx2, v1);
#endif
        return CPL_TRUE;
      }
    } /* for idx2 (array indices starting after idx) */
  } /* for idx (all array indices but the last) */
  return CPL_FALSE;
} /* muse_cplarray_has_duplicate() */

/*----------------------------------------------------------------------------*/
/**
  @brief Create an array from a section of another array.
  @param aArray Input array
  @param aStart First element.
  @param aCount Number of elements
  @retval CPL_ERROR_NONE Everything went OK

  This function is like cpl_array_extract and differs in that it uses the same
  data vector as the original one. So, changing values in the new array will
  also change these values in the original array. The new array should not be
  deleted, but unwrapped.
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_extract(cpl_array *aArray, cpl_size aStart, cpl_size aCount)
{
  cpl_size nrows = cpl_array_get_size(aArray);
  if (aCount > nrows - aStart) {
    aCount = nrows - aStart;
  }
  cpl_type type = cpl_array_get_type(aArray);
  if (type == CPL_TYPE_DOUBLE) {
    return cpl_array_wrap_double(cpl_array_get_data_double(aArray) + aStart,
                                 aCount);
  } else if (type == CPL_TYPE_FLOAT) {
    return cpl_array_wrap_float(cpl_array_get_data_float(aArray) + aStart,
                                aCount);
  } else if (type == CPL_TYPE_INT) {
    return cpl_array_wrap_int(cpl_array_get_data_int(aArray) + aStart,
                              aCount);
  } else {
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    return NULL;
  }
}
/*----------------------------------------------------------------------------*/
/**
  @brief Add the value of an array to a window of a table column.
  @param aDest Pointer to destination array.
  @param aStart First row to be added.
  @param aArray Array to be added.
  @retval CPL_ERROR_NONE Everything went OK
  @cpl_ensure_code{aDest && aArray, CPL_ERROR_NULL_INPUT}

  The columns are summed element by element, and the result of the sum is
  stored in the target column. Only arrays of types <tt>CPL_TYPE_DOUBLE</tt>,
  <tt>CPL_TYPE_FLOAT</tt>, and <tt>CPL_TYPE_INT</tt> are supported. The
  validity of cells is ignored here.
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_add_window(cpl_array *aDest, cpl_size aStart,
                         const cpl_array *aArray)
{
  cpl_ensure_code(aDest && aArray, CPL_ERROR_NULL_INPUT);
  cpl_size count = cpl_array_get_size(aArray);
  cpl_array *destArray = muse_cplarray_extract(aDest, aStart, count);
  if (destArray == NULL) {
    return CPL_ERROR_ILLEGAL_INPUT;
  }
  cpl_array_add(destArray, aArray);
  cpl_array_unwrap(destArray);

  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Build the difference of any element and one of the next elements.
   @param aArray Input array
   @param aOffset number of rows to step ahead.
   @return The array with the differences.
   @cpl_ensure{aArray, CPL_ERROR_NULL_INPUT, NULL}
   @cpl_ensure{aOffset > 0, CPL_ERROR_ILLEGAL_INPUT, NULL}

*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_diff(const cpl_array *aArray, int aOffset)
{
  cpl_ensure(aArray, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(aOffset > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
  cpl_size nrows = cpl_array_get_size(aArray);

  cpl_array *a1 = cpl_array_extract(aArray, 0, nrows - aOffset);
  cpl_array *a2 = cpl_array_extract(aArray, aOffset, nrows - aOffset);
  if (a1 == NULL || a2 == NULL) {
    cpl_array_delete(a1);
    cpl_array_delete(a2);
    return NULL;
  }
  cpl_array_subtract(a2, a1);
  cpl_array_delete(a1);
  return a2;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Compute the error function of array elements.
  @param aArray Pointer to array.
  @retval CPL_ERROR_NONE Everything went OK
  @cpl_ensure_code{aArray, CPL_ERROR_NULL_INPUT}
  @cpl_ensure_code{Supported data type, CPL_ERROR_ILLEGAL_INPUT}

  Each column element is replaced by its error function. This function only
  works with <tt>CPL_TYPE_DOUBLE</tt> and <tt>CPL_TYPE_FLOAT</tt> arrays. The
  validity of cells is ignored.

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_erf(cpl_array *aArray)
{
  cpl_ensure_code(aArray, CPL_ERROR_NULL_INPUT);
  cpl_type type = cpl_array_get_type(aArray);
  cpl_size n = cpl_array_get_size(aArray);
  if (type == CPL_TYPE_DOUBLE) {
    double *d = cpl_array_get_data_double(aArray);
    cpl_size i;
    for (i = 0; i < n; i++, d++) {
      *d = erf(*d);
    }
  } else if (type == CPL_TYPE_FLOAT) {
    float *d = cpl_array_get_data_float(aArray);
    cpl_size i;
    for (i = 0; i < n; i++, d++) {
      *d = erf(*d);
    }
  } else {
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    return CPL_ERROR_ILLEGAL_INPUT;
  }
  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
  @brief Compute the exponential function of array elements.
  @param aArray Pointer to array.
  @retval CPL_ERROR_NONE Everything went OK
  @cpl_ensure_code{aArray, CPL_ERROR_NULL_INPUT}
  @cpl_ensure_code{Supported data type, CPL_ERROR_ILLEGAL_INPUT}

  Each column element is replaced by its exponential function. This function only
  works with <tt>CPL_TYPE_DOUBLE</tt> and <tt>CPL_TYPE_FLOAT</tt> arrays. The
  validity of cells is ignored.

*/
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplarray_exp(cpl_array *aArray)
{
  cpl_ensure_code(aArray, CPL_ERROR_NULL_INPUT);
  cpl_type type = cpl_array_get_type(aArray);
  cpl_size n = cpl_array_get_size(aArray);
  if (type == CPL_TYPE_DOUBLE) {
    double *d = cpl_array_get_data_double(aArray);
    cpl_size i;
    for (i = 0; i < n; i++, d++) {
      *d = exp(*d);
    }
  } else if (type == CPL_TYPE_FLOAT) {
    float *d = cpl_array_get_data_float(aArray);
    cpl_size i;
    for (i = 0; i < n; i++, d++) {
      *d = expf(*d);
    }
  } else {
    cpl_error_set(__func__, CPL_ERROR_ILLEGAL_INPUT);
    return CPL_ERROR_ILLEGAL_INPUT;
  }
  return CPL_ERROR_NONE;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Linear interpolation of a 1d array
   @param aTargetAbscissa Target abscissa (x) array
   @param aSourceAbscissa Source abscissa (x) array
   @param aSourceOrdinate Source ordinate (y) array
   @@return Target ordinate (y) array

   @cpl_ensure_code{aTargetAbscissa, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{aSourceAbscissa, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{aSourceOrdinate, CPL_ERROR_NULL_INPUT}
   @cpl_ensure_code{any data column is not double, CPL_ERROR_ILLEGAL_INPUT}

   The linear interpolation will be done from the values in the source table
   to the abscissa points in the target table.

   The abscissa points of both source and target tables must be growing.

   The abscissa points of the target must be in range of those of the source
   (i.e. extrapolation is not allowed).

   The source table must be of at least length 2.
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_interpolate_linear(const cpl_array *aTargetAbscissa,
                                 const cpl_array *aSourceAbscissa,
                                 const cpl_array *aSourceOrdinate)
{
  cpl_ensure(aTargetAbscissa && aSourceAbscissa && aSourceOrdinate,
             CPL_ERROR_NULL_INPUT, NULL);

  double *targetX = cpl_array_get_data_double((cpl_array *)aTargetAbscissa);
  double *srcX = cpl_array_get_data_double((cpl_array *)aSourceAbscissa);
  double *srcY = cpl_array_get_data_double((cpl_array *)aSourceOrdinate);
  cpl_ensure(targetX && srcX && srcY, CPL_ERROR_ILLEGAL_INPUT, NULL);

  cpl_array *targetOrdinate = cpl_array_duplicate(aTargetAbscissa);
  double *targetY = cpl_array_get_data_double(targetOrdinate);

  cpl_size n_src = cpl_array_get_size(aSourceAbscissa);
  cpl_vector *srcX_vec = cpl_vector_wrap(n_src, srcX);
  cpl_vector *srcY_vec = cpl_vector_wrap(n_src, srcY);
  cpl_bivector *src_vec = cpl_bivector_wrap_vectors(srcX_vec, srcY_vec);

  cpl_size offset = (srcX[0] <= targetX[0])?0:
    muse_cplarray_find_sorted(aTargetAbscissa, srcX[0]) + 1;
  cpl_size n_target =
    muse_cplarray_find_sorted(aTargetAbscissa, srcX[n_src-1]) - offset + 1;

  cpl_vector *targetX_vec = cpl_vector_wrap(n_target, targetX + offset);
  cpl_vector *targetY_vec = cpl_vector_wrap(n_target, targetY + offset);
  cpl_bivector *target_vec = cpl_bivector_wrap_vectors(targetX_vec,
                                                       targetY_vec);
  if (offset > 0) {
    cpl_array_fill_window_invalid(targetOrdinate, 0, offset);
  }
  if (offset + n_target < (unsigned)cpl_array_get_size(targetOrdinate)) {
    cpl_array_fill_window_invalid(targetOrdinate, offset + n_target,
                                  cpl_array_get_size(targetOrdinate)
                                  - (offset + n_target));
  }
  cpl_bivector_interpolate_linear(target_vec, src_vec);
  cpl_bivector_unwrap_vectors(target_vec);
  cpl_vector_unwrap(targetX_vec);
  cpl_vector_unwrap(targetY_vec);
  cpl_bivector_unwrap_vectors(src_vec);
  cpl_vector_unwrap(srcX_vec);
  cpl_vector_unwrap(srcY_vec);

  return targetOrdinate;
}

/*----------------------------------------------------------------------------*/
/**
   @brief Linear interpolation of a 1d column
   @param aTargetAbscissa   Target abscissa (x) array
   @param aSrcTable         Source table
   @param aSrcAbscissa      Target abscissa (x) column
   @param aSrcOrdinate      Target ordinate (y) column
   @@return Target ordinate (y) column

   The linear interpolation will be done from the values in the source table
   to the abscissa points in the target table.

   The abscissa points of both source and target tables must be growing.

   The abscissa points of the target must be in range of those of the source
   (i.e. extrapolation is not allowed).

   The source table must be of at least length 2.
*/
/*----------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_interpolate_table_linear(const cpl_array *aTargetAbscissa,
                                       const cpl_table *aSrcTable,
                                       const char *aSrcAbscissa,
                                       const char *aSrcOrdinate)
{
  cpl_array *sabs = muse_cpltable_extract_column((cpl_table *)aSrcTable,
                                                  aSrcAbscissa);
  cpl_array *sord = muse_cpltable_extract_column((cpl_table *)aSrcTable,
                                                 aSrcOrdinate);
  cpl_array *ord = muse_cplarray_interpolate_linear(aTargetAbscissa,  sabs, sord);
  cpl_array_unwrap(sabs);
  cpl_array_unwrap(sord);
  return ord;
}

/*---------------------------------------------------------------------------*/
/**
  @brief   Convert a delimited string into an array of strings.
  @param   aString   the input string
  @param   aDelim    the delimiting string
  @return  CPL_ERROR_NONE on success or a cpl_error_code on failure

  This function acts a bit like strtok(), just that it finds all tokens in one
  go, and takes the aDelim as a single delimiter. It is hopefully threadsafe,
  unlike strtok(). Consecutive occurrences of aDelim are ignored, i.e. the
  output array does not contain empty strings.

  @error{return CPL_ERROR_NULL_INPUT\, return NULL, aString or aDelim are NULL}
 */
/*---------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_new_from_delimited_string(const char *aString, const char *aDelim)
{
  cpl_ensure(aString && aDelim, CPL_ERROR_NULL_INPUT, NULL);
  /* duplicate the string to be able to work on it */
  char *string = cpl_strdup(aString);

  /* loop to find delimiters and save sub-strings in array */
  char *prev = string, *next;
  cpl_array *out = cpl_array_new(0, CPL_TYPE_STRING);
  int ntok = 0;
  do {
    next = strstr(prev, aDelim);
    if (next) {
      *next = '\0'; /* terminate this token starting at |prev| */
    }
    if (strlen(prev)) { /* don't want to add non-empty strings */
      cpl_array_set_size(out, ++ntok);
      cpl_array_set_string(out, ntok - 1, prev);
    }
    prev = next + strlen(aDelim);
  } while (next);
  cpl_free(string);

#if 0
  printf("Input string %s and delimiter %s resulted in output\n",
         aString, aDelim);
  cpl_array_dump(out, 0, cpl_array_get_size(out), stdout);
  fflush(stdout);
#endif
  return out;
} /* muse_cplarray_new_from_delimited_string() */

/*---------------------------------------------------------------------------*/
/**
  @brief   Convert a string array into an array of type double.
  @param   aArray   the input string array
  @return  a new array of CPL_TYPE_DOUBLE on success or NULL on failure

  This function assumes that every element of the string array contains a
  number and does element-wise conversions using atof().

  The returned array has to be deallocated using cpl_array_delete() after use.

  @error{return CPL_ERROR_NULL_INPUT\, return NULL, aArray is NULL}
  @error{return CPL_ERROR_ILLEGAL_INPUT\, return NULL,
         aArray is not of type CPL_TYPE_STRING}
 */
/*---------------------------------------------------------------------------*/
cpl_array *
muse_cplarray_string_to_double(const cpl_array *aArray)
{
  cpl_ensure(aArray, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(cpl_array_get_type(aArray) == CPL_TYPE_STRING,
             CPL_ERROR_ILLEGAL_INPUT, NULL);

  cpl_size i, n = cpl_array_get_size(aArray);
  cpl_array *darray = cpl_array_new(n, CPL_TYPE_DOUBLE);
  for (i = 0; i < n; i++) {
    const char *string = cpl_array_get_string(aArray, i);
    if (!string) {
      continue;
    }
    cpl_array_set_double(darray, i, atof(string));
  } /* for i (array elements) */
  return darray;
} /* muse_cplarray_string_to_double() */

/*---------------------------------------------------------------------------*/
/**
  @brief   Return the full recipe parameter belonging to prefix and shortname.
  @param   aParameters   the list of parameters
  @param   aPrefix       the prefix of the recipe
  @param   aName         name of this parameter
  @return  The parameter or NULL on error.

  This function just concatenates aPrefix and aName with a dot in between and
  then searches for a parameter with this full name.

  All error checking is already done inside cpl_parameterlist_find() which this
  function wraps.
 */
/*---------------------------------------------------------------------------*/
cpl_parameter *
muse_cplparamerterlist_find_prefix(cpl_parameterlist *aParameters,
                                   const char *aPrefix, const char *aName)
{
  char *fullname = cpl_sprintf("%s.%s", aPrefix, aName);
  cpl_parameter *p = cpl_parameterlist_find(aParameters, fullname);
  cpl_free(fullname);
  return p;
}

/*---------------------------------------------------------------------------*/
/**
  @brief   Recreate a cpl_parameterlist from the RECi headers of an output MUSE
           product.
  @param   aHeader   the input FITS header
  @param   aRecNum   the number of the ESO.PRO.REC header, i.e. 1 for REC1
  @return  The parameterlist or NULL on error.

  This takes ESO.PRO.RECi.ID and ESO.PRO.RECi.PIPE.ID to construct a context
  for parameters, and then loops through all ESO.PRO.RECi.PARAMj.{NAME,VALUE}
  keywords. It takes the content of the NAME keyword to set the parameter name,
  and then tries to determine the type of keyword from the contents of the
  string in VALUE and creates an entry in the parameterlist for each such entry.

  @note It may misidentify doubles as integers if the dot is missing!
  @note It does currently not try to determine the parameter default value,
        hence the default of all parameters are unset!

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, aHeader is NULL}
  @error{set CPL_ERROR_ILLEGAL_INPUT\, return NULL, aRecNum is not positive}
  @error{set CPL_ERROR_ILLEGAL_INPUT\, return NULL,
         no recipe name was found using ESO.PRO.RECi.ID}
  @error{set CPL_ERROR_INCOMPATIBLE_INPUT\, return NULL,
         no muse pipeline ID was found using ESO.PRO.RECi.PIPE.ID}
 */
/*---------------------------------------------------------------------------*/
cpl_parameterlist *
muse_cplparameterlist_from_propertylist(const cpl_propertylist *aHeader,
                                        int aRecNum)
{
  cpl_ensure(aHeader, CPL_ERROR_NULL_INPUT, NULL);
  cpl_ensure(aRecNum > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);

  /* check that the input header has a recipe name */
  char *kw = cpl_sprintf("ESO PRO REC%d ID", aRecNum);
  const char *recipe = cpl_propertylist_get_string(aHeader, kw);
  cpl_free(kw);
  cpl_ensure(recipe, CPL_ERROR_ILLEGAL_INPUT, NULL);
  /* check that the input header was written by the MUSE pipeline */
  kw = cpl_sprintf("ESO PRO REC%d PIPE ID", aRecNum);
  const char *pipeid = cpl_propertylist_get_string(aHeader, kw);
  cpl_free(kw);
  cpl_ensure(strstr(recipe, "muse_") && strstr(pipeid, "muse"),
             CPL_ERROR_INCOMPATIBLE_INPUT, NULL);
  char *context = cpl_sprintf("muse.%s", recipe);

  /* create the new parameter list to be filled from the header */
  cpl_parameterlist *parlist = cpl_parameterlist_new();
  int npar;
  for (npar = 1; npar < cpl_propertylist_get_size(aHeader); npar++) {
    char *kwname = cpl_sprintf("ESO PRO REC%d PARAM%d NAME", aRecNum, npar),
         *kwvalue = cpl_sprintf("ESO PRO REC%d PARAM%d VALUE", aRecNum, npar);
    if (!cpl_propertylist_has(aHeader, kwname) ||
        !cpl_propertylist_has(aHeader, kwvalue)) {
      cpl_free(kwname);
      cpl_free(kwvalue);
      break;
    }
    const cpl_property *prop = cpl_propertylist_get_property_const(aHeader,
                                                                   kwvalue);
    /* since they are all saved as strings, convert them to other types *
     * based on the first character and the presence of a dot           */
    const char *value = cpl_property_get_string(prop);
    cpl_type type = CPL_TYPE_STRING;
    if (!strncmp(value, "true", 5) || !strncmp(value, "false", 6)) {
        type = CPL_TYPE_BOOL;
    } else if (!strchr(value, ',') && /* no comma-separator of multiple numbers */
               ((value[0] >= '0' && value[0] <= '9') || /* numerical type */
                value[0] == '-' || value[0] == '+')) {
      /* this might mis-identify a few doubles saved without dot as ints! */
      if (strchr(value, '.') || strchr(value, 'E')) {
        type = CPL_TYPE_DOUBLE;
      } else {
        type = CPL_TYPE_INT;
      } /* else */
    } /* else */
    char *parname = cpl_sprintf("muse.%s.%s", recipe,
                                cpl_propertylist_get_string(aHeader, kwname));
    const char *comment = cpl_property_get_comment(prop),
               *comname = cpl_propertylist_get_comment(aHeader, kwname);
    char defstr[41] = "true"; /* string with the default value */
    if (comment) {
      sscanf(comment, "Default: %40s", defstr);
    }
    cpl_parameter *par = NULL;
    switch (type) {
    case CPL_TYPE_BOOL:
      par = cpl_parameter_new_value(parname, type, comname, context,
                                    !strncmp(defstr, "true", 5) ? CPL_TRUE : CPL_FALSE);
      if (!strncmp(value, "true", 5)) {
        cpl_parameter_set_bool(par, CPL_TRUE);
      } else {
        cpl_parameter_set_bool(par, CPL_FALSE);
      }
      break;
    case CPL_TYPE_INT:
      par = cpl_parameter_new_value(parname, type, comname, context, atoi(defstr));
      cpl_parameter_set_int(par, atoi(value));
      break;
    case CPL_TYPE_DOUBLE:
      par = cpl_parameter_new_value(parname, type, comname, context, atof(defstr));
      cpl_parameter_set_double(par, atof(value));
      break;
    case CPL_TYPE_STRING:
      par = cpl_parameter_new_value(parname, type, comname, context, defstr);
      cpl_parameter_set_string(par, value);
      break;
    default:
      /* cannot do anything */
      par = cpl_parameter_new_value(parname, type, comname, context, 0);
      cpl_msg_warning(__func__, "property of type %s (%d) found!",
                      cpl_type_get_name(type), type);
    } /* switch */
    cpl_parameterlist_append(parlist, par);
    cpl_free(parname);
    cpl_free(kwname);
    cpl_free(kwvalue);
  } /* for npar */
  cpl_free(context);
  return parlist;
} /* muse_cplparameterlist_from_propertylist() */

/*---------------------------------------------------------------------------*/
/**
  @brief   Duplicate a CPL parameter list.
  @param   aPList   the parameter list to duplicate
  @return  the duplicated parameter list or NULL on error.

  @note This function uses the CPL call cpl_parameterlist_get_next_const()
        to iterate through the list. The input list therefore must not be
        accessed at the same time from another thread.

  @error{set CPL_ERROR_NULL_INPUT\, return NULL, aPList is NULL}
 */
/*---------------------------------------------------------------------------*/
cpl_parameterlist *
muse_cplparameterlist_duplicate(const cpl_parameterlist *aPList)
{
  cpl_ensure(aPList, CPL_ERROR_NULL_INPUT, NULL);

  cpl_parameterlist *list = cpl_parameterlist_new();
  const cpl_parameter *par = cpl_parameterlist_get_first_const(aPList);
  while (par) {
    cpl_parameterlist_append(list, cpl_parameter_duplicate(par));
    par = cpl_parameterlist_get_next_const(aPList);
  } /* while */
  return list;
} /* muse_cplparameterlist_duplicate() */

/*----------------------------------------------------------------------------*/
/**
  @brief  Update an integer-like property irrespective of the real type.
  @param  aHeader    the property list
  @param  aKeyword   the keyword to update
  @param  aValue     the value to set
  @return CPL_ERROR_NONE on success another cpl_error_code on failure

  Since cpl_propertylist_update_long_long() still fails if the type of the
  property in the list is CPL_TYPE_INT or CPL_TYPE_LONG instead of
  CPL_TYPE_LONG_LONG, this function makes it easier to update properties that
  can be any of those three. The user should take care that the value cannot
  overflow the actual variable type.

  @error{set and return CPL_ERROR_NULL_INPUT, aHeader and/or aKeyword are NULL}
  @error{set and return CPL_ERROR_DATA_NOT_FOUND,
         no property named aKeyword was found}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplpropertylist_update_long_long(cpl_propertylist *aHeader,
                                      const char *aKeyword, cpl_size aValue)
{
  cpl_ensure_code(aHeader && aKeyword, CPL_ERROR_NULL_INPUT);
  cpl_property *p = cpl_propertylist_get_property(aHeader, aKeyword);
  cpl_ensure_code(p, CPL_ERROR_DATA_NOT_FOUND);
  cpl_error_code rc = CPL_ERROR_NONE;
  switch (cpl_property_get_type(p)) {
  case CPL_TYPE_LONG_LONG:
    rc = cpl_property_set_long_long(p, aValue);
    break;
  case CPL_TYPE_LONG:
    rc = cpl_property_set_long(p, aValue);
    break;
  default:
    rc = cpl_property_set_int(p, aValue);
  } /* switch */
  return rc;
} /* muse_cplpropertylist_update_long_long() */

/*----------------------------------------------------------------------------*/
/**
  @brief  Update a floating-point property irrespective of the real type.
  @param  aHeader    the property list
  @param  aKeyword   the keyword to update
  @param  aValue     the value to set
  @return CPL_ERROR_NONE on success another cpl_error_code on failure

  Since cpl_propertylist_update_float() still fails if the type of the property
  in the list is CPL_TYPE_DOUBLE (ans vice versa), this function makes it easier
  to update properties that can be either. The user should take care that the
  value cannot overflow the actual variable type.

  If the property does not yet exist, a new one of CPL_TYPE_FLOAT is appended
  (this is different from what @ref muse_cplpropertylist_update_long_long()
  does!).

  @error{set and return CPL_ERROR_NULL_INPUT, aHeader and/or aKeyword are NULL}
  @error{set and return CPL_ERROR_TYPE_MISMATCH,
         the property is neither float nor double}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplpropertylist_update_fp(cpl_propertylist *aHeader,
                               const char *aKeyword, double aValue)
{
  cpl_ensure_code(aHeader && aKeyword, CPL_ERROR_NULL_INPUT);
  if (!cpl_propertylist_has(aHeader, aKeyword)) {
    return cpl_propertylist_append_float(aHeader, aKeyword, aValue);
  }
  cpl_property *p = cpl_propertylist_get_property(aHeader, aKeyword);
  cpl_error_code rc = CPL_ERROR_NONE;
  switch (cpl_property_get_type(p)) {
  case CPL_TYPE_FLOAT:
    rc = cpl_property_set_float(p, aValue);
    break;
  case CPL_TYPE_DOUBLE:
    rc = cpl_property_set_double(p, aValue);
    break;
  default:
    return cpl_error_set(__func__, CPL_ERROR_TYPE_MISMATCH);
  } /* switch */
  return rc;
} /* muse_cplpropertylist_update_fp() */

/*----------------------------------------------------------------------------*/
/**
  @brief  Erase all frames in a frameset.
  @param  aFrames    the frame set to clean out
  @return CPL_ERROR_NONE on success another cpl_error_code on failure

  @warning This function is not threadsafe when used on the same frame set.

  @error{set and return CPL_ERROR_NULL_INPUT, aFrames is NULL}
  @error{propagate return code, cpl_frameset_erase_frame() fails}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplframeset_erase_all(cpl_frameset *aFrames)
{
  cpl_ensure_code(aFrames, CPL_ERROR_NULL_INPUT);
  cpl_error_code rc = CPL_ERROR_NONE;
  /* always get and erase the first frame until we are done */
  while (cpl_frameset_get_size(aFrames) > 0 && rc == CPL_ERROR_NONE) {
    cpl_frame *frame = cpl_frameset_get_position(aFrames, 0);
    rc = cpl_frameset_erase_frame(aFrames, frame);
  } /* while */
  return rc;
} /* muse_cplframeset_erase_all() */

/*----------------------------------------------------------------------------*/
/**
  @brief  Erase all duplicate frames from a frameset.
  @param  aFrames    the frame set to clean up
  @return CPL_ERROR_NONE on success another cpl_error_code on failure

  This function loops through all frames except the last one in the input
  frameset and compares this "reference" frame to all following frames. If it
  finds a frame for which all properties match, it uses the reference frame to
  erase one. (If it erased one frame in this way, it stays are the same
  position, because CPL always erases the first frame that it finds.)

  @warning This function is not threadsafe when used on the same frame set.

  @error{set and return CPL_ERROR_NULL_INPUT, aFrames is NULL}
  @error{propagate return code, cpl_frameset_erase_frame() fails}
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
muse_cplframeset_erase_duplicate(cpl_frameset *aFrames)
{
  cpl_ensure_code(aFrames, CPL_ERROR_NULL_INPUT);
#if 0
  printf("\n\n\n%s input frameset (with duplicates):\n", __func__);
  cpl_frameset_dump(aFrames, stdout);
  printf("---------------------------------------------------------------------------\n");
  fflush(stdout);
#endif
  cpl_error_code rc = CPL_ERROR_NONE;
  /* Loop through all frames but the last, and compare all frame properties *
   * to all following frames. Delete the frame if they are all the same.    */
  cpl_size i;
  for (i = 0; i < cpl_frameset_get_size(aFrames) - 1; i++) {
    cpl_frame *fref = cpl_frameset_get_position(aFrames, i);
    cpl_size j;
    for (j = i + 1; j < cpl_frameset_get_size(aFrames); j++) {
      cpl_frame *fother = cpl_frameset_get_position(aFrames, j);
      cpl_boolean areequal = CPL_FALSE;
      cpl_errorstate state = cpl_errorstate_get();
      const char *fn1 = cpl_frame_get_filename(fref),
                 *fn2 = cpl_frame_get_filename(fother);
      if (!cpl_errorstate_is_equal(state)) {
        cpl_errorstate_set(state);
      }
      if ((!fn1 && fn2) || (fn1 && !fn2)) {
        areequal = CPL_FALSE;
      } else if (!fn1 && !fn2) {
        areequal = CPL_TRUE;
      } else {
        areequal = !strcmp(fn1, fn2);
      }
      areequal = areequal
               && !strcmp(cpl_frame_get_tag(fref), cpl_frame_get_tag(fother));
      areequal = areequal
               && (cpl_frame_get_group(fref) == cpl_frame_get_group(fother));
      areequal = areequal
               && (cpl_frame_get_level(fref) == cpl_frame_get_level(fother));
      areequal = areequal
               && (cpl_frame_get_type(fref) == cpl_frame_get_type(fother));
      if (areequal) {
#if 0
        printf("%ld/%ld are equal: %s/%s, %s/%s, %d/%d, %d/%d, %d/%d\n", i, j,
               fn1, fn2, tag1, tag2,
               cpl_frame_get_group(fref), cpl_frame_get_group(fother),
               cpl_frame_get_level(fref), cpl_frame_get_level(fother),
               cpl_frame_get_type(fref), cpl_frame_get_type(fother));
        fflush(stdout);
#endif
        /* would really like to erase the other frame,  *
         * but it's not possible to delete by position! */
        rc = cpl_frameset_erase_frame(aFrames, fref);
        i--; /* stay at the same reference position in the frameset */
        break;
      } /* if equal */
    } /* for j (all following frames) */
  } /* for i (all frames but the last) */
#if 0
  printf("---------------------------------------------------------------------------\n");
  printf("%s input frameset (without duplicates):\n", __func__);
  cpl_frameset_dump(aFrames, stdout);
  printf("^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n\n\n");
  fflush(stdout);
#endif
  return rc;
} /* muse_cplframeset_erase_duplicate() */

/*----------------------------------------------------------------------------*/
/**
  @brief    Dump some CPL errors.
  @param    aCurrent   The number of the current error to be dumped
  @param    aFirst     The number of the first error to be dumped
  @param    aLast      The number of the last error to be dumped
  @see cpl_errorstate_dump_one

  By default, the last 20 error messages are dumped. This can be changed by
  setting the environment variable MUSE_CPL_ERRORSTATE_NDUMP to a positive
  value.
 */
/*----------------------------------------------------------------------------*/
void
muse_cplerrorstate_dump_some(unsigned aCurrent, unsigned aFirst, unsigned aLast)
{
  const cpl_boolean is_reverse = aFirst > aLast ? CPL_TRUE : CPL_FALSE;
  const char *revmsg = is_reverse ? " in reverse order" : "";
  const unsigned newest = is_reverse ? aFirst : aLast,
                 nmax = labs((long int)aLast - (long int)aFirst) + 1;
  unsigned ndump = 20;
  if (getenv("MUSE_CPL_ERRORSTATE_NDUMP") &&
      atoi(getenv("MUSE_CPL_ERRORSTATE_NDUMP")) > 0) {
    ndump = atoi(getenv("MUSE_CPL_ERRORSTATE_NDUMP"));
  }
  ndump = nmax < ndump ? nmax : ndump;

  if (newest) { /* there are errors to dump */
    if (aCurrent == aLast - (ndump-1)) {
      cpl_msg_error(__func__, "Dumping the %u most recent error(s) out of a "
                    "total of %u errors%s:", ndump, newest, revmsg);
      cpl_msg_indent_more();
    }
    if (aCurrent >= aLast - (ndump-1)) {
      cpl_msg_error(__func__, "[%u/%u] '%s' (%u) at %s", aCurrent, newest,
                    cpl_error_get_message(), cpl_error_get_code(),
                    cpl_error_get_where());
    }
    if (aCurrent == aLast) {
      cpl_msg_indent_less();
    }
  } else {
    cpl_msg_info(__func__, "No error(s) to dump");
  }
} /* muse_cplerrorstate_dump_some() */


/*----------------------------------------------------------------------------*/
/**
  @brief  Return the CPL framework the recipe is run under.
  @retval MUSE_CPLFRAMEWORK_ESOREX The recipe was called from EsoRex.
  @retval MUSE_CPLFRAMEWORK_PYTHONCPL The recipe was called from python-cpl, or
                                      another Python-based framework.
  @retval MUSE_CPLFRAMEWORK_GASGANO The recipe was called from Gasgano, or
                                    another Java-based framework.
  @retval MUSE_CPLFRAMEWORK_UNKNOWN The framework is unknown.

  This function currently works properly only under Linux. Under MacOSX, it
  will always return MUSE_CPLFRAMEWORK_UNKNOWN.
 */
/*----------------------------------------------------------------------------*/
muse_cplframework_type muse_cplframework(void) {
#ifdef HAVE_READLINK
  char buffer[FILENAME_MAX] = "\0";
  int length = readlink("/proc/self/exe", buffer, sizeof(buffer) - 1);
  if (length != -1) {
    buffer[length] = '\0';
  }
  if (strstr(buffer, "esorex")) {
    return MUSE_CPLFRAMEWORK_ESOREX;
  } else if (strstr(buffer, "python")) {
    return MUSE_CPLFRAMEWORK_PYTHONCPL;
  } else if (strstr(buffer, "jre")) {
    return MUSE_CPLFRAMEWORK_GASGANO;
  } else {
    return MUSE_CPLFRAMEWORK_UNKNOWN;
  }
#else
  return MUSE_CPLFRAMEWORK_UNKNOWN;
#endif
}

/**@}*/
