cluster1.c

it is the Data Mining Algorithm source code.

      && (clscnt > 0));         /* (at least one dim., one cluster) */
  clset = _create(incnt,clscnt);/* create the base structure */
  if (!clset) return NULL;      /* and initialize the variables */
  clset->cls = c = (CLUSTER*)malloc(clscnt *sizeof(CLUSTER));
  if (!clset->cls) { cls_delete(clset); return NULL; }
  for (c += i = clscnt; --i >= 0; ) { /* clear pointers for cleanup */
    --c; c->cov = c->inv = c->smp = c->chv = c->grv = NULL; }
  clset->vec = (double*)malloc(3 *incnt *sizeof(double));
  if (!clset->vec) { cls_delete(clset); return NULL; }
  clset->buf = clset->vec +incnt;  /* create the numeric vectors */
  clset->nst = nst_create(incnt);  /* and the input statistics */
  clset->mat = mat_create(incnt, incnt);
  if (!clset->nst || !clset->mat)  { cls_delete(clset); return NULL; }
  for (c += i = clscnt; --i >= 0; ) {
    if (_initcls(--c, incnt) != 0) { cls_delete(clset); return NULL; }
    c->buf = clset->buf;        /* initialize the clusters and */
    c->mat = clset->mat;        /* note the computation buffers */
  }                             /* in all clusters */
  #ifdef CLS_EXTFN              /* if extended function set, */
  clset->attset = NULL;         /* clear the attribute set and */
  clset->attmap = NULL;         /* attribute map pointers as a flag */
  #endif                        /* for a normal cluster set */
  clset->setup = 0;             /* cluster set is not yet set up */
  return clset;                 /* return created set of clusters */
}  /* cls_create() */

/*--------------------------------------------------------------------*/

void cls_delete (CLSET *clset)
{                               /* --- delete a set of clusters */
  int     i;                    /* loop variable */
  CLUSTER *c;                   /* to traverse the clusters */

  assert(clset);                /* check the function argument */
  if (clset->mat) mat_delete(clset->mat);
  if (clset->nst) nst_delete(clset->nst);
  if (clset->vec) free(clset->vec);
  if (clset->cls) {             /* if there is a cluster array */
    for (c = clset->cls +(i = clset->clscnt); --i >= 0; ) {
      --c;                      /* traverse the clusters */
      if (c->cov) mat_delete(c->cov);
      if (c->inv) mat_delete(c->inv);
      if (c->smp) mat_delete(c->smp);
      if (c->chv) mat_delete(c->chv);
      if (c->grv) mat_delete(c->grv);
    }                           /* delete all matrices */
    free(clset->cls);           /* and the cluster array */
  }
  free(clset);                  /* delete the base structure */
}  /* cls_delete() */

/*--------------------------------------------------------------------*/
#ifdef CLS_EXTFN

CLSET* cls_createx (ATTMAP *attmap, int clscnt)
{                               /* --- create a cluster set */
  CLSET *clset;                 /* created cluster set */

  assert(attmap && (clscnt > 0));  /* check the function arguments */
  clset = cls_create(am_incnt(attmap), clscnt);
  if (!clset) return NULL;      /* create a cluster set */
  clset->attset = am_attset(attmap);
  clset->attmap = attmap;       /* note the attribute set and map */
  return clset;                 /* return the created cluster set */
}  /* cls_createx() */

/*--------------------------------------------------------------------*/

void cls_deletex (CLSET *clset, int delas)
{                               /* --- delete a set of clusters */
  if (delas) {                  /* delete attribute map/set */
    am_delete(clset->attmap); as_delete(clset->attset); }
  cls_delete(clset);            /* delete the cluster set */
}  /* cls_deletex() */

#endif
/*--------------------------------------------------------------------*/

void cls_reg (CLSET *clset, const double *vec, double weight)
{                               /* --- register a data point */
  #ifdef CLS_EXTFN              /* if to compile extended functions */
  int i, k, off;                /* loop variables, offset */
  #endif

  assert(clset);                /* check the function argument */
  nst_reg(clset->nst, vec, weight);
  #ifdef CLS_EXTFN              /* if to compile extended functions */
  if (vec || !clset->attmap)    /* if not termination or non-extended */
    return;                     /* function used, abort the function */
  for (i = am_attcnt(clset->attmap); --i >= 0; ) {
    if (am_type(clset->attmap, i) < 0) continue;
    off = am_off(clset->attmap, i);
    k   = am_cnt(clset->attmap, i);
    while (--k >= 0) nst_scale(clset->nst, off+k, 0, 1);
  }                             /* set scaling for nominal attributes */
  #endif                        /* (prevent distortion by scaling) */
}  /* cls_reg() */

/*--------------------------------------------------------------------*/

void cls_value (CLSET *clset, int index, double value)
{                               /* --- set an input value */
  clset->vec[index] = (value -nst_offset(clset->nst, index))
                             *nst_factor(clset->nst, index);
}  /* cls_value() */

/*--------------------------------------------------------------------*/
#ifdef CLS_EXTFN

void cls_regx (CLSET *clset, const TUPLE *tpl)
{                               /* --- register a data point */
  assert(clset);                /* check the function arguments */
  if (!tpl) {                   /* if to terminate registration */
    nst_reg(clset->nst, NULL, 0); return; }
  am_exec(clset->attmap, tpl, AM_INPUTS, clset->vec);
  nst_reg(clset->nst, clset->vec, tpl_getwgt(tpl));
}  /* cls_regx() */             /* set the data values and register */

/*--------------------------------------------------------------------*/

void cls_valuex (CLSET *clset, const TUPLE *tpl)
{                               /* --- set input values */
  assert(clset);                /* check the function arguments */
  am_exec(clset->attmap, tpl, AM_INPUTS, clset->vec);
  nst_norm(clset->nst, clset->vec, clset->vec);
}  /* cls_valuex() */           /* normalize the input values */

#endif
/*--------------------------------------------------------------------*/

void cls_type (CLSET *clset, int type, double size)
{                               /* --- set the cluster type */
  int     i;                    /* loop variable */
  CLUSTER *c;                   /* to traverse the clusters */

  assert(clset);                /* check the function arguments */
  clset->setup = 0;             /* cluster set needs to be set up */
  if (type >= 0) {              /* if a new cluster type is given */
    if (clset->incnt <= 1) type &= ~(CLS_VARS|CLS_COVARS);
    if (type & CLS_COVARS) type |=   CLS_VARS;
    if ((clset->clscnt < 2) || !(type & (CLS_COVARS|CLS_VARS|CLS_SIZE)))
      type &= ~CLS_JOINT;       /* make cluster type consistent */
    clset->tnew = type & CLS_ALL;
  }                             /* note the new cluster type */
  if (size < 0) return;         /* check the initial cluster size */
  for (c = clset->cls +(i = clset->clscnt); --i >= 0; )
    (--c)->size = size;         /* store the given cluster size */
  clset->resized = -1;          /* set flag for resized clusters */
}  /* cls_type() */

/*--------------------------------------------------------------------*/

void cls_radfn (CLSET *clset, RADFN radfn, DERIVFN drvfn,
                const double *params)
{                               /* --- set the membership function */
  assert(clset);                /* check the function arguments */
  clset->setup = 0;             /* cluster set needs to be set up */
  if (radfn) clset->radfn = radfn;  /* note the radial function */
  if (drvfn) clset->drvfn = drvfn;  /* and its derivative (if given) */
  if (!params) return;          /* check for function parameters */
  clset->rfnps[0] = params[0];  /* note the function parameters and */
  clset->rfnps[1] = params[1];  /* compute the unit integral factor */
}  /* cls_radfn() */

/*--------------------------------------------------------------------*/

void cls_norm (CLSET *clset, int mode, const double *params)
{                               /* --- set normalization mode */
  assert(clset);                /* check the function arguments */
  clset->setup = 0;             /* cluster set needs to be set up */
  if (mode >= 0)                /* if the norm. mode is valid, */
    clset->norm = mode;         /* note the normalization mode */
  if (!params) return;          /* if normalization parameters */
  clset->nrmps[0] = params[0];  /* are given, copy them */
  clset->nrmps[1] = params[1];  /* to the cluster set */
}  /* cls_norm() */

/*--------------------------------------------------------------------*/

void cls_msexp (CLSET *clset, double msexp)
{                               /* --- set the membership exponent */
  assert(clset);                /* check the function arguments */
  clset->setup = 0;             /* cluster set needs to be set up */
  if (msexp == 0) {             /* if to use a corresponding value */
    if      (clset->nrmps[0] >= 1) msexp = 1 /clset->nrmps[0] +1;
    else if (clset->nrmps[0] >  0) msexp =    clset->nrmps[0]; 
    else                           msexp = 2;
  }                             /* compute the membership exponent */
  clset->msexp = msexp;         /* store the membership exponent */
}  /* cls_msexp() */

/*--------------------------------------------------------------------*/

int cls_setup (CLSET *clset)
{                               /* --- set up a cluster set */
  int     i, k, n;              /* loop variables, buffers */
  CLUSTER *c;                   /* to traverse the clusters */
  double  t;                    /* buffer for computations */

  assert(clset);                /* check the function argument */
  t = clset->noise;             /* compute raw noise cluster ms.deg. */
  clset->ncmsd[0] = (t >= 0) ? t : clset->radfn(t*t, clset->rfnps);
  clset->unit     = clset->radfn(-clset->incnt, clset->rfnps);
  if (clset->fwexp < 0) clset->fwexp = 0;

  /* --- compute cluster weights --- */
  c = clset->cls;               /* get the cluster array */
  if (!(clset->type & CLS_WEIGHT)) {
    t = 1.0/clset->clscnt;      /* if no adaptable cluster weight */
    for (c += i = clset->clscnt; --i >= 0; )
      mat_setwgt((--c)->cov,t);}/* set same weight for all clusters */
  else {                        /* if the clusters have a weight */
    for (t = 0, c += i = clset->clscnt; --i >= 0; )
      t += mat_getwgt((--c)->cov);   /* sum the cluster weights */
    t = (t > 0) ? 1/t : 1;      /* and compute the norm. factor */
    for (c += i = clset->clscnt; --i >= 0; )
      mat_mulwgt((--c)->cov,t); /* normalize the cluster weights */
  }                             /* (ensure a unit sum) */

  /* --- gauge cluster sizes --- */
  if ((clset->tnew & CLS_JOINT) && !(clset->type & CLS_JOINT)) {
    clset->type |= CLS_JOINT;   /* if (co)variances are to be joined, */
    cls_combine(clset);         /* combine the (co)variances */
  }                             /* then decompose cov. matrices and */
  cls_vars (clset, 0);          /* compute the isotropic variances */
  cls_gauge(clset);             /* and measure the cluster sizes */

  /* --- adapt type and rescale clusters --- */
  k = clset->type & clset->tnew & (CLS_COVARS|CLS_VARS);
  i = n = (clset->type & CLS_JOINT) ? 1 : clset->clscnt;
  c = clset->cls +i;            /* get the cluster array */
  if (k & CLS_COVARS) {         /* if covars to covars */
    while (--i >= 0) { --c;     /* traverse the clusters */
      if ((clset->tnew & CLS_SIZE) || (c->size <= 0)) {
        c->size = c->scale; c->scale = 1; }
      else {                    /* if rescaling is needed */
        c->scale = t = c->size /c->scale;
        if (t == 1) continue;   /* compute the scaling factor */
        if (clset->eigen) vec_muls(c->dif, clset->incnt, c->dif, t);
        else mat_mulsx(c->inv, c->inv, sqrt(t), MAT_LOWER);
      }                         /* rescale the decomposition */
    } }                         /* of the covariance matrix */
  else {                        /* if no covariances */
    while (--i >= 0) { --c;     /* traverse the clusters */
      if ((clset->tnew & CLS_SIZE) || (c->size <= 0)) {
        c->size  = c->scale; c->scale = 1; }
      else                      /* if rescaling is needed, */
        c->scale = c->size /c->scale; /* compute the scaling factor */
      if (!(k & CLS_VARS))      /* distribute isotropic variance */
        mat_diasetx(c->cov, c->size);
      if (!(clset->type & CLS_COVARS)) continue;
      mat_crop(c->cov, MAT_DIAG);
      mat_crop(c->inv, MAT_DIAG);
    }                           /* clear covariances if necessary */
  }                             /* (keep cov and inv consistent) */