Logo Search packages:      
Sourcecode: tcllib version File versions  Download package

filter.c

/* struct::graph - critcl - layer 1 definitions
 * (c) Graph functions
 */

#include <nacommon.h>
#include <util.h>
#include <node.h>

/* .................................................. */

typedef enum NA_MODE {
    NA_ADJ, NA_EMBEDDING, NA_IN, NA_INNER,
    NA_OUT, NA_NONE
} NA_MODE;

typedef struct NA {
    NA_MODE   mode;
    int       nc;
    Tcl_Obj** nv;
    Tcl_Obj*  key;
    Tcl_Obj*  value;
    Tcl_Obj*  filter;
} NA;

typedef struct NARES {
    int       c;
    Tcl_Obj** v;
} NARES;

/* .................................................. */

static int  filter_setup  (NA* na, Tcl_Interp* interp, int oc, Tcl_Obj* const* ov, G* g);
static int  filter_run    (NA* na, Tcl_Interp* interp, int nodes, GCC* gx, GN_GET_GC* gf,
                     Tcl_Obj* go, G* g);
static void filter_none   (Tcl_Interp* interp, GCC* gx, NARES* l);
static void filter_kv     (Tcl_Interp* interp, GCC* gx, NARES* l,
                     GN_GET_GC* gf, G*g, Tcl_Obj* k, Tcl_Obj* v);
static void filter_k      (Tcl_Interp* interp, GCC* gx, NARES* l,
                     GN_GET_GC* gf, G* g, Tcl_Obj* k);
static int  filter_cmd    (Tcl_Interp* interp, GCC* gx, NARES* l,
                     Tcl_Obj* cmd, Tcl_Obj* g);

static void filter_mode_n (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_n_adj           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_n_emb           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_n_in            (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_n_inn           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_n_out           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a_adj           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a_emb           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a_in            (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a_inn           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);
static void filter_mode_a_out           (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g);

/* .................................................. */

int
gc_filter (int nodes, Tcl_Interp* interp,
         int oc, Tcl_Obj* const* ov,
         GCC* gx, GN_GET_GC* gf, G* g)
{
    NA na;

    if (filter_setup (&na, interp, oc, ov, g) != TCL_OK) {
      return TCL_ERROR;
    }

    return filter_run (&na, interp, nodes, gx, gf, ov [0], g);
}

/* .................................................. */

static int
filter_setup (NA* na, Tcl_Interp* interp, int oc, Tcl_Obj* const* ov, G* g)
{
    /* Syntax: graph arcs                       | all arcs
     *         graph arcs -adj       NODE...    | arcs start|end in node in list
     *         graph arcs -embedding NODE...    | arcs start^end in node in list
     *         graph arcs -filter    CMDPREFIX  | arcs for which CMD returns True.
     *         graph arcs -in        NODE...    | arcs end in node in list
     *         graph arcs -inner     NODE...    | arcs start&end in node in list
     *         graph arcs -key       KEY        | arcs have attribute KEY
     *         graph arcs -out       NODE...    | arcs start in node in list
     *         graph arcs -value     VALUE      | arcs have KEY and VALUE
     *             [0]   [1]  [2]        [3]
     */

    static const char* restr [] = {
      "-adj",   "-embedding", "-filter", "-in",
      "-inner", "-key",       "-out",    "-value",
      NULL
    };
    enum restr {
      R_ADJ,   R_EMB, R_CMD, R_IN,
      R_INNER, R_KEY, R_OUT, R_VAL
    };
    static const int mode [] = {
      NA_ADJ,   NA_EMBEDDING, -1,     NA_IN,
      NA_INNER, -1,           NA_OUT, -1
    };

    int             ac = oc;
    Tcl_Obj* const* av = ov;
    int             r;

    na->mode   = NA_NONE;
    na->nc     = 0;
    na->nv     = NALLOC (oc, Tcl_Obj*);
    na->key    = NULL;
    na->value  = NULL;
    na->filter = NULL;

    oc -= 2; /* Skip 'graph arcs' */
    ov += 2;

    while (oc) {
      if ('-' == Tcl_GetString (ov[0])[0]) {
          if (Tcl_GetIndexFromObj (interp, ov [0], restr,
                             "restriction", 0, &r) != TCL_OK) {
            goto abort;
          }
          switch (r) {
          case R_ADJ:
          case R_EMB:
          case R_IN:
          case R_INNER:
          case R_OUT:
            if (na->mode != NA_NONE) {
                Tcl_SetObjResult (interp,
                  Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-in\"|\"-out\"|\"-adj\"|\"-inner\"|\"-embedding\"", -1));
                goto abort;
            }
            na->mode = mode [r];
            break;
          case R_CMD:
            if (oc < 2) goto wrongargs;
            if (na->filter) {
                Tcl_SetObjResult (interp,
                  Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-filter\"", -1));
                goto abort;
            }
            na->filter = ov [1];
            oc --;
            ov ++;
            break;
          case R_KEY:
            if (oc < 2) goto wrongargs;
            if (na->key) {
                Tcl_SetObjResult (interp,
                  Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-key\"", -1));
                goto abort;
            }
            na->key = ov [1];
            oc --;
            ov ++;
            break;
          case R_VAL:
            if (oc < 2) goto wrongargs;
            if (na->value) {
                Tcl_SetObjResult (interp,
                  Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-value\"", -1));
                goto abort;
            }
            na->value = ov [1];
            oc --;
            ov ++;
            break;
          }
          oc --;
          ov ++;
      } else {
          /* Save non-options for the list of nodes */
          ASSERT_BOUNDS (na->nc, ac);
          na->nv [na->nc] = ov[0];
          na->nc ++;
          oc --;
          ov ++;
      }
    }

    if (na->value && !na->key) {
      Tcl_SetObjResult (interp,
        Tcl_NewStringObj ("invalid restriction: use of \"-value\" without \"-key\"", -1));
      goto abort;
    }

    if ((na->mode != NA_NONE) && !na->nc) {
    wrongargs:
      Tcl_WrongNumArgs (interp, 2, av,
        "?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?");
      goto abort;
    }

    if (!na->nc) {
      ckfree((char*) na->nv);
      na->nv = NULL;
    } else {
      /* Check that the nodes exist, and
       * remove duplicates in the same pass
       */

      int i, j, new;
      Tcl_HashTable cn;
      GN* n;

      Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS);

      j=0;
      for (i=0; i < na->nc; i++) {
          ASSERT_BOUNDS(i, na->nc);
          n = gn_get_node (g, na->nv[i], interp, av[0]);
          if (!n) {
            Tcl_DeleteHashTable(&cn);
            goto abort;
          }
          if (Tcl_FindHashEntry (&cn, (char*) n)) continue;
          ASSERT_BOUNDS(j, na->nc);
          Tcl_CreateHashEntry (&cn, (char*) n, &new);
          if (j < i) { na->nv[j] = na->nv[i]; }
          j ++;
      }

      Tcl_DeleteHashTable(&cn);
      na->nc = j;
    }
    return TCL_OK;

 abort:
    ckfree((char*) na->nv);
    return TCL_ERROR;
}

/* .................................................. */

static int
filter_run (NA* na, Tcl_Interp* interp, int nodes, GCC* gx, GN_GET_GC* gf, Tcl_Obj* go, G* g)
{
    NARES l;

    if (!gx->n) {
      /* Nothing to filter, ignore the filters */

      Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL));
      return TCL_OK;
    }

    l.c = -1;
    l.v = NALLOC (gx->n, Tcl_Obj*);

    if (!na->key &&
      !na->filter &&
      (na->mode == NA_NONE)) {
      filter_none (interp, gx, &l);
    } else {
      if (na->mode != NA_NONE) {
          if (nodes) {
            filter_mode_n (na->mode, gx, &l, na->nc, na->nv, g);
          } else {
            filter_mode_a (na->mode, gx, &l, na->nc, na->nv, g);
          }
      }
      if (na->key && na->value) {
          filter_kv (interp, gx, &l, gf, g, na->key, na->value);
      } else if (na->key) {
          filter_k  (interp, gx, &l, gf, g, na->key);
      }
      if (na->filter) {
          if (filter_cmd (interp, gx, &l, na->filter, go) != TCL_OK) {
            ckfree ((char*) l.v);
            return TCL_ERROR;
          }
      }
    }

    ASSERT(l.c > -1, "No filters applied");
    Tcl_SetObjResult (interp, Tcl_NewListObj (l.c, l.v));
    ckfree ((char*) l.v);
    return TCL_OK;
}

/* .................................................. */

static void
filter_none (Tcl_Interp* interp, GCC* gx, NARES* l)
{
    int i;
    GC* iter;

    for (i = 0, iter = gx->first;
       iter != NULL;
       iter = iter->next, i++) {
      ASSERT_BOUNDS (i, gx->n);
      l->v [i] = iter->name;
    }

    ASSERT (i == gx->n, "Bad list of nodes");
    l->c = i;
}

/* .................................................. */

static void
filter_mode_a (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NS = {node ...}, a set of nodes
     *
     * ARC/in  (NS) := { a | target(a) in NS }     "Arcs going into the node set"
     * ARC/out (NS) := { a | source(a) in NS }     "Arcs coming from the node set"
     * ARC/adj (NS) := ARC/in  (NS) + ARC/out (NS) "Arcs touching the node set"
     * ARC/inn (NS) := ARC/in  (NS) * ARC/out (NS) "Arcs connecting nodes in the set"
     * ARC/emb (NS) := ARC/adj (NS) - ARC/inn (NS) "Arcs touching, yet not connecting"
     *               = ARC/in  (NS) / ARc/out (NS) 'symmetric difference'
     *
     * Note: None of the iterations has to be concerned about space. It is
     * bounded by the number of arcs in the graph, and the list has enough
     * slots.
     */

    switch (mode) {
    case NA_ADJ:       filter_mode_a_adj (gx, l, nc, nv, g); break;
    case NA_EMBEDDING: filter_mode_a_emb (gx, l, nc, nv, g); break;
    case NA_IN:        filter_mode_a_in  (gx, l, nc, nv, g); break;
    case NA_INNER:     filter_mode_a_inn (gx, l, nc, nv, g); break;
    case NA_OUT:       filter_mode_a_out (gx, l, nc, nv, g); break;
    }
}

/* .................................................. */

static void
filter_mode_a_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /* ARC/adj (NS) := ARC/in  (NS) + ARC/out (NS)
     * "Arcs touching the node set"
     */

    /* Iterate over the nodes and collect all incoming and outgoing arcs. We
     * use a hash table to prevent us from entering arcs twice. If we find
     * that all arcs are in the result we stop immediately.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable ht;
    GN*           n;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a, &new);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n, "Overrun");

    if (j < (gx->n-1)) {
      for (i=0; i < nc; i++) {
          ASSERT_BOUNDS(i, nc);
          n = gn_get_node (g, nv[i], NULL, NULL);
          for (il = n->out.first; il != NULL; il = il->next) {
            /* Skip if already present - union */
            if (Tcl_FindHashEntry (&ht, (char*) il->a)) continue;
            ASSERT_BOUNDS(j, gx->n);
            Tcl_CreateHashEntry (&ht, (char*) il->a, &new);
            l->v[j] = il->a->base.name;
            j ++;
          }
          if (j == gx->n) break;
      }
    }

    ASSERT(j <= gx->n, "Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
}

/* .................................................. */

static void
filter_mode_a_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /* ARC/emb (NS) := ARC/adj (NS) - ARC/inn (NS)
     *               = ARC/in  (NS) / ARc/out (NS)
     * "Arcs touching, yet not connecting"
     */

    /* For the embedding we have to iterate several times. First to collect
     * the relevant arcs in hashtables, then a last time using the hashtables
     * to weed out the inner arcs, i.e the intersection, and collect the
     * others.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable hti;
    Tcl_HashTable hto;
    GN*           n;

    Tcl_InitHashTable (&hti, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable (&hto, TCL_ONE_WORD_KEYS);

    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          Tcl_CreateHashEntry (&hti, (char*) il->a, &new);
      }
    }
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->out.first; il != NULL; il = il->next) {
          Tcl_CreateHashEntry (&hto, (char*) il->a, &new);
      }
    }

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          /* Incoming arcs, skip if also outgoing */
          if (Tcl_FindHashEntry (&hto, (char*) il->a)) continue;
          ASSERT_BOUNDS(j, gx->n);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->out.first; il != NULL; il = il->next) {
          /* Outgoing arcs, skip if also incoming */
          if (Tcl_FindHashEntry (&hti, (char*) il->a)) continue;
          ASSERT_BOUNDS(j, gx->n);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&hti);
    Tcl_DeleteHashTable(&hto);
}

/* .................................................. */

static void
filter_mode_a_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /* ARC/in  (NS) := { a | target(a) in NS }
     * "Arcs going into the node set"
     */

    /* Iterate over the nodes and collect all incoming arcs.  */

    int i, j;
    GL* il;
    GN* n;

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          ASSERT_BOUNDS(j, gx->n);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;
}

/* .................................................. */

static void
filter_mode_a_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /* ARC/inn (NS) := ARC/in  (NS) * ARC/out (NS)
     * "Arcs connecting nodes in the set"
     */

    /* Iterate over the nodes and collect all incoming arcs first, in a
     * hashtable. Then iterate a second time to find all outgoing arcs which
     * are also incoming. We skip the second iteration if the first one found all
     * arcs, because then the intersection will remove nothing.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable ht;
    GN*           n;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);

    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          Tcl_CreateHashEntry (&ht, (char*) il->a, &new);
      }
    }

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->out.first; il != NULL; il = il->next) {
          /* Note the !. This is the intersect */
          if (!Tcl_FindHashEntry (&ht, (char*) il->a)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a, &new);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
}

/* .................................................. */

static void
filter_mode_a_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /* ARC/out (NS) := { a | source(a) in NS }
     * "Arcs coming from the node set"
     */

    /* Iterate over the nodes and collect all outcoming arcs.  */

    int i, j;
    GL* il;
    GN* n;

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->out.first; il != NULL; il = il->next) {
          ASSERT_BOUNDS(j, gx->n);
          l->v[j] = il->a->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;
}

/* .................................................. */

static void
filter_mode_n (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/in  (NS) = { source(a) | a in ARC/in  (NS) }
     * NODES/out (NS) = { target(a) | a in ARC/out (NS) }
     * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS)
     * NODES/inn (NS) = NODES/adj (NS) * NS
     * NODES/emb (NS) = NODES/adj (NS) - NS
     */

    switch (mode) {
    case NA_ADJ:       filter_mode_n_adj (gx, l, nc, nv, g); break;
    case NA_EMBEDDING: filter_mode_n_emb (gx, l, nc, nv, g); break;
    case NA_IN:        filter_mode_n_in  (gx, l, nc, nv, g); break;
    case NA_INNER:     filter_mode_n_inn (gx, l, nc, nv, g); break;
    case NA_OUT:       filter_mode_n_out (gx, l, nc, nv, g); break;
    }
}

/* .................................................. */

static void
filter_mode_n_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS)
     *
     * using:
     *            NODES/in  (NS) = { source(a) | a in ARC/in  (NS) }
     *            NODES/out (NS) = { target(a) | a in ARC/out (NS) }
     */

    /* Iterate over the nodes and collect all incoming and outgoing nodes. We
     * use a hash table to prevent us from entering nodes twice. Should we
     * find that all nodes are in the result during the iteration we stop
     * immediately, it cannot get better.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable ht;
    GN*           n;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      /* foreach n in cn */

      for (il = n->in.first; il != NULL; il = il->next) {
          /* foreach a in ARC/in (n) */
          /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */

          if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new);
          l->v[j] = il->a->start->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
      for (il = n->out.first; il != NULL; il = il->next) {
          /* foreach a in ARC/out (n) */
          /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */

          if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new);
          l->v[j] = il->a->end->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
    }

    ASSERT(j <= gx->n, "Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
}

/* .................................................. */

static void
filter_mode_n_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/emb (NS) = NODES/adj (NS) - NS
     *
     * using:
     *            NODES/adj (NS) = NODES/in (NS) + NODES/out (NS)
     *
     * using:
     *            NODES/in  (NS) = { source(a) | a in ARC/in  (NS) }
     *            NODES/out (NS) = { target(a) | a in ARC/out (NS) }
     */

    /* Iterate over the nodes and collect all incoming and outgoing nodes. We
     * use a hash table to prevent us from entering nodes twice. A second hash
     * table is used to skip over the nodes in the set itself.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable ht;
    Tcl_HashTable cn;
    GN*           n;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS);

    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      /* foreach n in cn */
      Tcl_CreateHashEntry (&cn, (char*) n, &new);
    }

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      /* foreach n in cn */

      for (il = n->in.first; il != NULL; il = il->next) {
          /* foreach a in ARC/in (n) */
          /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */
          /* - NS */

          if (Tcl_FindHashEntry (&cn, (char*) il->a->start->n)) continue;
          if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new);
          l->v[j] = il->a->start->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
      for (il = n->out.first; il != NULL; il = il->next) {
          /* foreach a in ARC/out (n) */
          /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */
          /* - NS */

          if (Tcl_FindHashEntry (&cn, (char*) il->a->end->n)) continue;
          if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new);
          l->v[j] = il->a->end->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
    }

    ASSERT(j <= gx->n, "Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
    Tcl_DeleteHashTable(&cn);
}

/* .................................................. */

static void
filter_mode_n_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/in (NS) = { source(a) | a in ARC/in (NS) }
     */

    int           i, j, new;
    GL*           il;
    GN*           n;
    Tcl_HashTable ht;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->in.first; il != NULL; il = il->next) {
          /* il->a in INa (NS) => il->a->start in INn (NS),
           * modulo already recorded
           */
          if (Tcl_FindHashEntry (&ht, (char*) il->a->start)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->start, &new);
          l->v[j] = il->a->start->n->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
}

/* .................................................. */

static void
filter_mode_n_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/inn (NS) = NODES/adj (NS) * NS
     *
     * using:
     *            NODES/adj (NS) = NODES/in (NS) + NODES/out (NS)
     *
     * using:
     *            NODES/in  (NS) = { source(a) | a in ARC/in  (NS) }
     *            NODES/out (NS) = { target(a) | a in ARC/out (NS) }
     */

    /* Iterate over the nodes and collect all incoming and outgoing nodes. We
     * use a hash table to prevent us from entering nodes twice. A second hash
     * table is used to skip over the nodes _not_ in the set itself.
     */

    int           i, j, new;
    GL*           il;
    Tcl_HashTable ht;
    Tcl_HashTable cn;
    GN*           n;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS);

    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      /* foreach n in cn */
      Tcl_CreateHashEntry (&cn, (char*) n, &new);
    }

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      /* foreach n in cn */

      for (il = n->in.first; il != NULL; il = il->next) {
          /* foreach a in ARC/in (n) */
          /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */
          /* * NS */

          if (!Tcl_FindHashEntry (&cn, (char*) il->a->start->n)) continue;
          if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new);
          l->v[j] = il->a->start->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
      for (il = n->out.first; il != NULL; il = il->next) {
          /* foreach a in ARC/out (n) */
          /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */
          /* * NS */

          if (!Tcl_FindHashEntry (&cn, (char*) il->a->end->n)) continue;
          if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new);
          l->v[j] = il->a->end->n->base.name;
          j ++;
      }
      if (j == gx->n) break;
    }

    ASSERT(j <= gx->n, "Overrun");
    l->c = j;

    Tcl_DeleteHashTable(&ht);
    Tcl_DeleteHashTable(&cn);
}

/* .................................................. */

static void
filter_mode_n_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g)
{
    /*
     * NODES/out (NS) = { target(a) | a in ARC/out (NS) }
     */

    int           i, j, new;
    GL*           il;
    GN*           n;
    Tcl_HashTable ht;

    Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS);

    j = 0;
    for (i=0; i < nc; i++) {
      ASSERT_BOUNDS(i, nc);
      n = gn_get_node (g, nv[i], NULL, NULL);
      for (il = n->out.first; il != NULL; il = il->next) {
          /* il->a in OUTa (NS) => il->a->end in OUTn (NS),
           * modulo already recorded
           */
          if (Tcl_FindHashEntry (&ht, (char*) il->a->end)) continue;
          ASSERT_BOUNDS(j, gx->n);
          Tcl_CreateHashEntry (&ht, (char*) il->a->end, &new);
          l->v[j] = il->a->end->n->base.name;
          j ++;
      }
    }

    ASSERT(j <= gx->n,"Overrun");
    l->c = j;

    Tcl_DeleteHashTable (&ht);
}

/* .................................................. */

static void
filter_kv (Tcl_Interp* interp, GCC* gx, NARES* l, GN_GET_GC* gf, G* g, Tcl_Obj* k, Tcl_Obj* v)
{
    /* 2 modes:
     * (a) l->c == -1 => Fill with matching entities
     * (b) l->c == 0  => Nothing to do.
     * (c) otherwise  => Filter found entities
     */

    Tcl_HashEntry* he;
    const char*    key;
    const char*    value;
    int            vlen;
    const char*    cmp;
    int            clen;

    /* Skip the step if there is nothing which can be filtered.  */
    if (l->c == 0) return;

    key   = Tcl_GetString (k);
    value = Tcl_GetStringFromObj (v, &vlen);

    if (l->c > 0) {
      /* Filter an existing set of nodes/arcs down to the set of nodes/arcs
       * passing the filter.
       */

      int src, dst;
      GC* c;

      for (src = 0, dst = 0; src < l->c; src++) {
          c = gf (g, l->v [src], NULL, NULL);

          if (!c->attr) continue;
          if (!c->attr->numEntries) continue;
          he = Tcl_FindHashEntry (c->attr, key);
          if (!he) continue;
          cmp = Tcl_GetStringFromObj ((Tcl_Obj*) Tcl_GetHashValue(he), &clen);
          if ((vlen != clen) ||
            (strcmp(value, cmp) != 0)) continue;

          ASSERT_BOUNDS (dst, l->c);
          ASSERT_BOUNDS (src, l->c);

          l->v [dst] = l->v [src];
          dst++;
      }

      ASSERT (dst <= l->c, "Overrun");
      l->c = dst;

    } else {
      /* There is no set, iterate over nodes/arcs and fill the result with
       * all nodes/arcs passing the filter.
       */

      int i;
      GC* iter;

      for (i = 0, iter = gx->first;
           iter != NULL;
           iter = iter->next) {
          ASSERT_BOUNDS (i, gx->n);

          if (!iter->attr) continue;
          if (!iter->attr->numEntries) continue;
          he = Tcl_FindHashEntry (iter->attr, key);
          if (!he) continue;
          cmp = Tcl_GetStringFromObj ((Tcl_Obj*) Tcl_GetHashValue(he), &clen);
          if ((vlen != clen) ||
            (strcmp(value, cmp) != 0)) continue;

          ASSERT_BOUNDS (i, gx->n);
          l->v [i] = iter->name;
          i++;
      }

      ASSERT (i <= gx->n, "Overrun");
      l->c = i;
    }
}

/* .................................................. */

static void
filter_k (Tcl_Interp* interp, GCC* gx, NARES* l, GN_GET_GC* gf, G* g, Tcl_Obj* k)
{
    /* 2 modes:
     * (a) l->c == -1 => Fill with matching entities
     * (b) l->c == 0  => Nothing to do.
     * (c) otherwise  => Filter found entities
     */

    Tcl_HashEntry* he;
    const char*    key;

    /* Skip the step if there is nothing which can be filtered.  */
    if (l->c == 0) return;

    key = Tcl_GetString (k);

    if (l->c > 0) {
      /* Filter an existing set of nodes/arcs down to the set of nodes/arcs
       * passing the filter.
       */

      int src, dst;
      GC* c;

      for (src = 0, dst = 0; src < l->c; src++) {
          c = gf (g, l->v [src], NULL, NULL);

          if (!c->attr) continue;
          if (!c->attr->numEntries) continue;
          he = Tcl_FindHashEntry (c->attr, key);
          if (!he) continue;

          ASSERT_BOUNDS (dst, l->c);
          ASSERT_BOUNDS (src, l->c);

          l->v [dst] = l->v [src];
          dst++;
      }

      ASSERT (dst <= l->c, "Overrun");
      l->c = dst;

    } else {
      /* There is no set, iterate over nodes/arcs and fill the result with
       * all nodes/arcs passing the filter.
       */

      int i;
      GC* iter;

      for (i = 0, iter = gx->first;
           iter != NULL;
           iter = iter->next) {
          ASSERT_BOUNDS (i, gx->n);

          if (!iter->attr) continue;
          if (!iter->attr->numEntries) continue;
          he = Tcl_FindHashEntry (iter->attr, key);
          if (!he) continue;

          ASSERT_BOUNDS (i, gx->n);
          l->v [i] = iter->name;
          i++;
      }

      ASSERT (i <= gx->n, "Overrun");
      l->c = i;
    }
}

/* .................................................. */

static int
filter_cmd (Tcl_Interp* interp, GCC* gx, NARES* l, Tcl_Obj* cmd, Tcl_Obj* g)
{
    /* 2 modes:
     * (a) l->c == -1 => Fill with matching entities
     * (b) l->c == 0  => Nothing to do.
     * (c) otherwise  => Filter found entities
     */

    int       cmdc;
    Tcl_Obj** cmdv;
    int       code = TCL_ERROR;
    int           ec;
    Tcl_Obj** ev;
    int       flag;
    int       res;
    int       i;

    if (Tcl_ListObjGetElements (interp, cmd, &cmdc, &cmdv) != TCL_OK) {
      return TCL_ERROR;
    }

    /* Skip the step if there is nothing which can be filtered.  */
    if (l->c == 0) return;

    /* -------------------- */
    /* Set up the command vector for the callback. Two placeholders for graph
     * and node/arc arguments.
     */

    ec = cmdc + 2;
    ev = NALLOC (ec, Tcl_Obj*);

    for (i = 0; i < cmdc; i++) {
      ASSERT_BOUNDS (i, ec);
      ev [i] = cmdv [i];
      Tcl_IncrRefCount (ev [i]);
    }

    ASSERT_BOUNDS (cmdc, ec);
    ev [cmdc] = g; /* Graph */
    Tcl_IncrRefCount (ev [cmdc]);

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

    if (l->c > 0) {
      /* Filter an existing set of nodes/arcs down to the set of nodes/arcs
       * passing the filter.
       */

      int src, dst;

      for (src = 0, dst = 0; src < l->c; src++) {
          /* Fill the placeholders */

          ASSERT_BOUNDS (cmdc+1, ec);
          ASSERT_BOUNDS (src, l->c);
          ev [cmdc+1] = l->v [src]; /* Node/Arc */

          /* Run the callback */
          Tcl_IncrRefCount (ev [cmdc+1]);
          res = Tcl_EvalObjv (interp, ec, ev, 0);
          Tcl_DecrRefCount (ev [cmdc+1]);

          /* Process the result */
          if (res != TCL_OK) {
            goto abort;
          }
          if (Tcl_GetBooleanFromObj (interp,
                               Tcl_GetObjResult (interp),
                               &flag) != TCL_OK) {
            goto abort;
          }

          /* Result is valid, use this to decide retain/write over */
          if (!flag) continue;

          ASSERT_BOUNDS (dst, l->c);
          ASSERT_BOUNDS (src, l->c);

          l->v [dst] = l->v [src];
          dst++;
      }

      ASSERT (dst <= l->c, "Overrun");
      l->c = dst;

    } else {
      /* There is no set, iterate over nodes/arcs and fill the result with
       * all nodes/arcs passing the filter.
       */

      int i;
      GC* iter;

      for (i = 0, iter = gx->first;
           iter != NULL;
           iter = iter->next) {
          ASSERT_BOUNDS (i, gx->n);

          /* Fill the placeholders */

          ASSERT_BOUNDS (cmdc+1, ec);
          ev [cmdc+1] = iter->name; /* Node/Arc */

          /* Run the callback */
          Tcl_IncrRefCount (ev [cmdc+1]);
          res = Tcl_EvalObjv (interp, ec, ev, 0);
          Tcl_DecrRefCount (ev [cmdc+1]);

          /* Process the result */
          if (res != TCL_OK) {
            goto abort;
          }
          if (Tcl_GetBooleanFromObj (interp,
                               Tcl_GetObjResult (interp),
                               &flag) != TCL_OK) {
            goto abort;
          }

          /* Result is valid, use this to decide retain/write over */
          if (!flag) continue;

          ASSERT_BOUNDS (i, gx->n);
          l->v [i] = iter->name;
          i++;
      }

      ASSERT (i <= gx->n, "Overrun");
      l->c = i;
    }

    /* -------------------- */
    /* Cleanup state */

    Tcl_ResetResult (interp);
    code = TCL_OK;

 abort:
    /* We do not reset the interp result. It either contains the non-boolean
     * result, or the error message.
     */

    for (i = 0; i < cmdc; i++) {
      ASSERT_BOUNDS (i, ec);
      Tcl_DecrRefCount (ev [i]);
    }

    ASSERT_BOUNDS (cmdc, ec);
    Tcl_DecrRefCount (ev [cmdc]); /* Graph */
    ckfree ((char*) ev);

    /* -------------------- */
    return code;
}

/* .................................................. */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Generated by  Doxygen 1.6.0   Back to index