cluster1.c

聚类算法全集以及内附数据集

      if (sc_token(scan) != ',')/* if there is no comma, */
        break;                  /* only cluster centers are used */
      GET_TOK();                /* consume ',' */
      if (sc_token(scan) != '[') {  /* no '[', so only a weight */
        clset->type |= CLS_WEIGHT; break; }
      GET_TOK();                /* consume '[' */
      if (sc_token(scan) != T_NUM) ERROR(E_NUMEXP);
      t = strtod(sc_value(scan), NULL);
      if (t < 0) ERROR(E_ILLNUM);
      if (t < MINVAR) t = MINVAR;
      if (t > MAXVAR) t = MAXVAR;
      c->var = t; GET_TOK(); i++;   /* get and consume a variance */
      if (sc_token(scan) == ',') {  /* a comma, so only variances */
        clset->type |= CLS_VARS; break; }
      GET_CHR(']');             /* consume ']' */
      if (sc_token(scan) != ',') {  /* no comma, so only size */
        clset->type |= CLS_SIZE; break; }
      GET_TOK();                /* consume ',' */
      if (sc_token(scan) == '[')    /* a '[' follows, so there must */
        clset->type |= CLS_COVARS;  /* be a full covariance matrix */
      else                          /* no '[' follows, so this is */
        clset->type |= CLS_SIZE;    /* only an isotropic variance */
      sc_back(scan); break;     /* put back the consumed ',' */
    }                           /* (which is consumed again below) */
    if ((clset->clscnt > 1)     /* if the cluster type is known */
    &&  (clset->type & (CLS_SIZE|CLS_VARS|CLS_COVARS))) {
      GET_CHR(','); }           /* check for a separating ',' */
    if      (clset->type & CLS_COVARS) {
      if (i > 0)                /* if it was read for type determ., */
        mat_set(c->cov, 0, 0, c->var);  /* set the first variance */
      for ( ; i < clset->incnt; i++) {  /* traverse the rows */
        if (i > 0) { GET_CHR(','); }    /* consume separating ',' */
        GET_CHR('[');                   /* consume opening '[' */
        for (k = 0; k <= i; k++) {      /* traverse the columns */
          if (k > 0) { GET_CHR(','); }  /* consume separating ',' */
          if (sc_token(scan) != T_NUM) ERROR(E_NUMEXP);
          t = strtod(sc_value(scan), NULL);
          if ((k == i) && (t < 0)) ERROR(E_ILLNUM);
          mat_set(c->cov, k, i, t);
          GET_TOK();            /* get and consume the */
        }                       /* covariances and the variance */
        GET_CHR(']');           /* consume closing ']' */
      }
      for (t = MINVAR, i = 40; --i >= 0; t += t) {
        if (mat_chdecom(c->inv, c->cov) == 0) break;
        mat_diaadds(c->cov, t); /* decompose the covariance matrix */
      }                         /* and on failure shift eigenvalues */
      if (i < 0) ERROR(E_ILLMAT);
      t = mat_chdet(c->inv);    /* compute the isotropic variance */
      c->var = ((t >= MINDET) && (t <= MAXDET))
             ? pow(t,              1.0/clset->incnt)
             : exp(mat_chlogd(c->inv) /clset->incnt);
      if (c->var < MINVAR) c->var = MINVAR;
      if (c->var > MAXVAR) c->var = MAXVAR;
      mat_chinv(c->inv,c->inv); /* invert the covariance matrix */
      mat_tr2sym(c->cov, c->cov, MAT_UPPER);
      mat_tr2sym(c->inv, c->inv, MAT_UPPER); }
    else if (clset->type & CLS_VARS) {
      if (i > 0) {              /* if it was read for type determ., */
        mat_set(c->cov, 0, 0, c->var);    /* set the first variance */
        mat_set(c->inv, 0, 0, 1/c->var); }
      else                      /* if it was not read yet */
        GET_CHR('[');           /* consume opening '[' */
      for ( ; i < clset->incnt; i++) {
        if (i > 0) { GET_CHR(','); }  /* consume ',' */
        if (sc_token(scan) != T_NUM) ERROR(E_NUMEXP);
        t = strtod(sc_value(scan), NULL);
        if (t < 0) ERROR(E_ILLNUM);
        if (t < MINVAR) t = MINVAR;
        if (t > MAXVAR) t = MAXVAR;
        mat_set(c->cov, i, i, t);
        mat_set(c->inv, i, i, 1/t);
        GET_TOK();              /* get and consume the variances */
      }                         /* and store them in the diagonal */
      GET_CHR(']');             /* consume closing ']' */
      t = mat_diaprod(c->cov);  /* compute the isotropic variance */
      c->var = ((t >= MINDET) && (t <= MAXDET))
             ? pow(t,              1.0/clset->incnt)
             : exp(mat_dialog(c->cov) /clset->incnt);
      if (c->var < MINVAR) c->var = MINVAR;
      if (c->var > MAXVAR) c->var = MAXVAR; }
    else if (clset->type & CLS_SIZE) {
      if (i <= 0) {             /* if to use cluster size */
        GET_CHR('[');           /* consume opening '[' */
        if (sc_token(scan) != T_NUM) ERROR(E_NUMEXP);
        c->var = strtod(sc_value(scan), NULL);
        if (c->var <= 0)             ERROR(E_ILLNUM);
        GET_TOK();              /* get and consume the variance */
        GET_CHR(']');           /* and consume the closing ']' */
      }
    }
    if ((clset->type & (CLS_SIZE|CLS_VARS|CLS_COVARS))
    &&  (clset->clscnt <= 1)    /* if the cluster type is yet unknown */
    &&  (sc_token(scan) == ',')) {             /* and a comma follows */
      clset->type |= CLS_WEIGHT;/* a cluster weight is used */
      GET_TOK();                /* consume the separating comma */
    }
    if (clset->type & CLS_WEIGHT) {
      if (clset->clscnt > 1) {  /* if the cluster type is known, */
        GET_CHR(','); }         /* consume the separating comma */
      if (sc_token(scan) != T_NUM) ERROR(E_NUMEXP);
      c->wgt = strtod(sc_value(scan), NULL);
      if (c->wgt < 0)              ERROR(E_ILLNUM);
      GET_TOK();                /* get and consume the weight */
    }                           /* and store it in the cluster */
    GET_CHR('}');               /* consume '}' */
    if (sc_token(scan) != ',') break;
    GET_TOK();                  /* if at end of cluster list, abort */
  }                             /* the loop, otherwise consume ',' */
  GET_CHR('}');                 /* consume '}' and ';' */
  GET_CHR(';');                 /* (end of the parameters section) */
  return err;                   /* return the error status */
}  /* _params() */

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

static CLSET* _parse (SCAN *scan, int incnt)
{                               /* --- parse a set of clusters */
  int     i, err;               /* loop variable, error status */
  double  s;                    /* sum of the cluster weights */
  double  *v;                   /* to resize the numeric vectors */
  CLUSTER *c;                   /* to traverse the clusters */
  CLSET   *clset = NULL;        /* created set of clusters */

  assert(scan);                 /* check the function argument */
  pa_init(scan);                /* start parsing */
  clset = (CLSET*)malloc(sizeof(CLSET));
  if (!clset) return NULL;      /* create the base structure */
  _init(clset, incnt, 0);       /* and initialize the variables */
  err      = _scales(clset, scan);   /* read the scaling parameters */
  if (err && (sc_recover(scan, ';', 0, 0, 0) == T_EOF)) {
    cls_delete(clset); return NULL; }
  err |= i = _function(clset, scan); /* read the function desc. */
  if (i   && (sc_recover(scan, ';', 0, 0, 0) == T_EOF)) {
    cls_delete(clset); return NULL; }
  err |= i = _radius(clset, scan);   /* read the uniform radius */
  if (i   && (sc_recover(scan, ';', 0, 0, 0) == T_EOF)) {
    cls_delete(clset); return NULL; }
  err |= i = _norm(clset, scan);     /* read the normalization mode */
  if (i   && (sc_recover(scan, ';', 0, 0, 0) == T_EOF)) {
    cls_delete(clset); return NULL; }
  err |= i = _params(clset, scan);   /* read the cluster parameters */
  if (i   && (sc_recover(scan, ';', 0, 0, 0) == T_EOF)) {
    cls_delete(clset); return NULL; }
  err |=     _scales(clset, scan);   /* read the scaling parameters */
  if (err) { cls_delete(clset); return NULL; }
  if (!clset->nst) clset->nst = nst_create(clset->incnt);
  if (!clset->nst) { cls_delete(clset); return NULL; }
  clset->cls =                  /* try to shrink the cluster vector */
  c = (CLUSTER*)realloc(clset->cls,    clset->clscnt *sizeof(CLUSTER));
  v = (double*) realloc(clset->vec, 3 *clset->incnt  *sizeof(double));
  if (!v) { cls_delete(clset); return NULL; }
  clset->vec = v;               /* create the numeric vectors */
  clset->buf = v +clset->incnt; /* and organize them */
  clset->mat = mat_create(clset->incnt, clset->incnt);
  if (!clset->mat) { cls_delete(clset); return NULL; }
  clset->norm = clset->radfn(-clset->incnt, clset->rfnps);
  s = 0;                        /* process the cluster weights */
  for (c += i = clset->clscnt; --i >= 0; )
    s += (--c)->wgt;            /* sum the (absolute) cluster weights */
  s = (s > 0) ? 1/s : 1;        /* and compute the norm. factor */
  for (c += i = clset->clscnt; --i >= 0; )
    (--c)->wgt *= s;            /* normalize the cluster weights */
  s = clset->msd[1];            /* if a uniform radius is given */
  if ((s > 0) && !(clset->type & (CLS_SIZE|CLS_VARS|CLS_COVARS)))
    cls_type(clset, clset->type, s*s);
  #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 */
  return clset;                 /* return the created set of clusters */
}  /* _parse() */

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

CLSET* cls_parse (SCAN *scan)
{ return _parse(scan, 0); }

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

static int _header (SCAN *scan)
{                               /* --- parse header */
  assert(scan);                 /* check the function argument */
  if ((sc_token(scan) != T_ID)
  ||  ((strcmp(sc_value(scan), "clset")  != 0)
  &&   (strcmp(sc_value(scan), "lvqnet") != 0)))
    ERR_STR("clset");           /* check for 'clset' */
  GET_TOK();                    /* consume 'clset' */
  GET_CHR('=');                 /* consume '=' */
  GET_CHR('{');                 /* consume '{' */
  return 0;                     /* return 'ok' */
}  /* _header() */

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

static int _trailer (SCAN *scan)
{                               /* --- parse trailer */
  assert(scan);                 /* check the function argument */
  GET_CHR('}');                 /* consume '}' */
  GET_CHR(';');                 /* consume ';' */
  return 0;                     /* return 'ok' */
}  /* _trailer() */

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

CLSET* cls_parsex (SCAN *scan, ATTSET *attset, int marked)
{                               /* --- parse a cluster set */
  CLSET  *clset;                /* created cluster set */
  ATTMAP *attmap;               /* created attribute map */

  assert(scan && attset);       /* check the function arguments */
  pa_init(scan);                /* initialize parsing */
  if (_header(scan) != 0) return NULL; /* parse the header */
  attmap = am_create(attset, marked, -1);
  if (!attmap) return NULL;     /* create an attribute map */
  clset = _parse(scan, am_incnt(attmap));
  if (!clset) {                 /* parse the cluster set description */
    am_delete(attmap); return NULL; }
  if (_trailer(scan) != 0) {    /* parse the trailer */
    cls_delete(clset); return NULL; }
  clset->attset = attset;       /* note the attribute set */
  clset->attmap = attmap;       /* and  the attribute map */
  return clset;                 /* return the parsed cluster set */
}  /* cls_parsex() */

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

CLSET* cls_pa4sup (SCAN *scan, ATTMAP *attmap, int hdr)
{                               /* --- parse a cluster set */
  CLSET  *clset;                /* created cluster set */

  assert(scan && attmap);       /* check the function arguments */
  pa_init(scan);                /* initialize parsing */
  if (hdr && (_header(scan) != 0))
    return NULL;                /* parse the header if necessary */
  clset = _parse(scan, am_incnt(attmap));
  if (!clset) return NULL;      /* parse the cluster set description */
  if (hdr && (_trailer(scan) != 0)) {
    cls_delete(clset); return NULL; }
  clset->attset = am_attset(attmap);
  clset->attmap = attmap;       /* note the attribute set and map */
  return clset;                 /* return the parsed cluster set */
}  /* cls_pa4sup() */

#endif  /* #ifdef CLS_EXTFN */
#endif  /* #ifdef CLS_PARSE */