示例#1
0
/* build the arc set out of a "bn.fit" object. */
SEXP fit2arcs(SEXP bn) {

int i = 0, j = 0, k = 0, narcs = 0;
SEXP labels, node_data, children, result;

  /* get the nodes' labels. */
  labels = getAttrib(bn, R_NamesSymbol);

  /* first pass: count the number of arcs. */
  for (i = 0; i <  LENGTH(bn); i++) {

    /* get the node's data. */
    node_data = VECTOR_ELT(bn, i);
    /* count its children. */
    narcs += LENGTH(getListElement(node_data, "children"));

  }/*FOR*/

  /* allocate the arc set. */
  PROTECT(result = allocMatrix(STRSXP, narcs, 2));
  /* set the column names. */
  finalize_arcs(result);

  /* second pass: initialize the return value. */
  for (i = 0; i <  LENGTH(bn); i++) {

    /* get the node's data. */
    node_data = VECTOR_ELT(bn, i);
    /* get its children. */
    children = getListElement(node_data, "children");

    for (j = 0; j < LENGTH(children); j++) {

      /* set the labels of the nodes incident on the arc. */
      SET_STRING_ELT(result, k, STRING_ELT(labels, i));
      SET_STRING_ELT(result, k + narcs, STRING_ELT(children, j));
      /* go to the next arc. */
      k++;

    }/*FOR*/

  }/*FOR*/

  UNPROTECT(1);

  return result;

}/*FIT2ARCS*/
示例#2
0
文件: bind.c 项目: aogbechie/DBN
/* faster rbind() implementation for arc sets. */
SEXP arcs_rbind (SEXP matrix1, SEXP matrix2, SEXP reverse2) {

int i = 0, j = 0, m1 = length(matrix1)/2, m2 = length(matrix2)/2;
SEXP res;

  /* allocate the return value. */
  PROTECT(res = allocMatrix(STRSXP, m1 + m2, 2));
  /* allocate and initialize the column names. */
  finalize_arcs(res);

  /* copy the elements of the first matrix. */
  for (i  = 0; i < m1; i++)
    for (j = 0; j < 2; j++)
      SET_STRING_ELT(res, CMC(i, j, m1 + m2), STRING_ELT(matrix1, CMC(i, j, m1)));

  /* copy the elements of the second matrix, reversing the order of the
   * columns as needed. */
  if (isTRUE(reverse2)) {

    for (i = 0; i < m2; i++)
      for(j = 0; j < 2; j++)
        SET_STRING_ELT(res, CMC(i + m1, j, m1 + m2), STRING_ELT(matrix2, CMC(i, 1 - j, m2)));

  }/*THEN*/
  else {

    for (i = 0; i < m2; i++)
      for(j = 0; j < 2; j++)
        SET_STRING_ELT(res, CMC(i + m1, j, m1 + m2), STRING_ELT(matrix2, CMC(i, j, m2)));

  }/*ELSE*/

  UNPROTECT(1);

  return res;

}/*ARCS_RBIND*/
示例#3
0
/* C-level interface to unique_arcs. */
SEXP c_unique_arcs(SEXP arcs, SEXP nodes, int warnlevel) {

    int i = 0, j = 0, k = 0, nrows = 0, uniq_rows = 0, n = length(nodes);
    int *checklist = NULL;
    SEXP result, try, node, dup;

    if (isNull(arcs)) {

        /* use NULL as a special jolly value which returns all possible arcs
         * given the specified node ordering. */
        nrows = n * (n - 1)/2;

        /* allocate the return value. */
        PROTECT(result = allocMatrix(STRSXP, nrows, 2));

        /* fill in the nodes' labels. */
        for (i = 0; i < n; i++) {

            node = STRING_ELT(nodes, i);

            for (j = i + 1; j < n; j++) {

                SET_STRING_ELT(result, CMC(k, 0, nrows), node);
                SET_STRING_ELT(result, CMC(k, 1, nrows), STRING_ELT(nodes, j));
                k++;

            }/*FOR*/

        }/*FOR*/

    }/*THEN*/
    else if (length(arcs) == 0) {

        /* the arc set is empty, nothing to do. */
        return arcs;

    }/*THEN*/
    else {

        /* there really is a non-empty arc set, process it. */
        nrows = length(arcs)/2;

        /* match the node labels in the arc set. */
        PROTECT(try = arc_hash(arcs, nodes, FALSE, FALSE));
        /* check which are duplicated. */
        PROTECT(dup = duplicated(try, FALSE));
        checklist = INTEGER(dup);

        /* count how many are not. */
        for (i = 0; i < nrows; i++)
            if (checklist[i] == 0)
                uniq_rows++;

        /* if there is no duplicate arc simply return the original arc set. */
        if (uniq_rows == nrows) {

            UNPROTECT(2);
            return arcs;

        }/*THEN*/
        else {

            /* warn the user if told to do so. */
            if (warnlevel > 0)
                warning("removed %d duplicate arcs.", nrows - uniq_rows);

            /* allocate and initialize the return value. */
            PROTECT(result = allocMatrix(STRSXP, uniq_rows, 2));

            /* store the correct arcs in the return value. */
            for (i = 0, k = 0; i < nrows; i++) {

                if (checklist[i] == 0) {

                    SET_STRING_ELT(result, k, STRING_ELT(arcs, i));
                    SET_STRING_ELT(result, k + uniq_rows, STRING_ELT(arcs, i + nrows));
                    k++;

                }/*THEN*/

            }/*FOR*/

        }/*ELSE*/

    }/*ELSE*/

    /* allocate, initialize and set the column names. */
    finalize_arcs(result);

    if (uniq_rows == 0)
        UNPROTECT(1);
    else
        UNPROTECT(3);

    return result;

}/*C_UNIQUE_ARCS*/
示例#4
0
文件: tiers.c 项目: jhabap18/bnlearn
SEXP tiers(SEXP nodes, SEXP debug) {

int i = 0, j = 0, k = 0, narcs = 0, nnodes = 0, ntiers = LENGTH(nodes);
int *tier_size = NULL, *debuglevel = LOGICAL(debug), tier_start = 0, cur = 0;
SEXP flattened, blacklist, temp;

  /* allocate the counters for tiers' sizes.*/
  tier_size = alloc1dcont(ntiers);

  if (!isString(nodes)) {

    /* "node" is a list, each tier is an element. */
    for (i = ntiers - 1; i >= 0; i--) {

      temp = VECTOR_ELT(nodes, i);
      tier_size[i] = LENGTH(temp);
      nnodes += tier_size[i];
      narcs += (nnodes - tier_size[i]) * tier_size[i];

    }/*FOR*/

    /* flatten the tiers to keep manipulation later on simple. */
    PROTECT(flattened = allocVector(STRSXP, nnodes));

    for (i = 0, k = 0; i < ntiers; i++) {

      temp = VECTOR_ELT(nodes, i);

      for (j = 0; j < tier_size[i]; j++)
        SET_STRING_ELT(flattened, k++, STRING_ELT(temp, j));

    }/*FOR*/

  }/*THEN*/
  else {

    /* "node" is a character vector, which means that each node is in its own tier
     * and that there is no need to flatted it. */
    flattened = nodes;
    nnodes = LENGTH(nodes);
    for (i = 0; i < ntiers; i++)
      tier_size[i] = 1;

    /* the blacklist is the one resulting from a complete node ordering. */
    narcs = ntiers * (ntiers - 1) / 2;

  }/*ELSE*/

  /* allocate the return value. */
  PROTECT(blacklist = allocMatrix(STRSXP, narcs, 2));

  for (k = 0, i = 0; k < nnodes; k++) {

    temp = STRING_ELT(flattened, k);

    if (*debuglevel > 0)
      Rprintf("* current node is %s in tier %d.\n", CHAR(temp), i + 1);

    for (j = tier_start + tier_size[i]; j < nnodes; j++) {

      if (*debuglevel)
        Rprintf("  > blacklisting %s -> %s\n", CHAR(STRING_ELT(flattened, j)), CHAR(temp));

      SET_STRING_ELT(blacklist, cur, STRING_ELT(flattened, j));
      SET_STRING_ELT(blacklist, cur + narcs, temp);
      cur++;

    }/*FOR*/

    if (k >= tier_start + tier_size[i] - 1)
      tier_start += tier_size[i++];

    if (i == ntiers)
      break;

  }

  /* allocate, initialize and set the column names. */
  finalize_arcs(blacklist);

  if (!isString(nodes))
    UNPROTECT(2);
  else
    UNPROTECT(1);

  return blacklist;

}/*TIERS*/