view release on metacpan or  search on metacpan

Permute.xs  view on Meta::CPAN

            p[i + 1] = p[i];
        /* adjust both extremes */
        p[1] = n;
        loc[n] = 1;
    }
#endif
    return is_done;
}


/* permute_engine() and afp_destructor() are from Robin Houston
 * <robin@kitsite.com> */
void permute_engine(
AV* av, 
SV** array, 
I32 level, 
I32 len, SV*** tmparea, OP* callback)
{
    SV** copy    = tmparea[level];
    int  index   = level;
    bool calling = (index + 1 == len);
    SV*  tmp;
    
    Copy(array, copy, len, SV*);
    
    if (calling)
        AvARRAY_set(av, copy);

    do {
        if (calling) {
            PL_op = callback;
            CALLRUNOPS(aTHX);
        }
        else {
            permute_engine(av, copy, level + 1, len, tmparea, callback);
        }
        if (index != 0) {
            tmp = copy[index];
            copy[index] = copy[index - 1];
            copy[index - 1] = tmp;
        }
    } while (index-- > 0);
}

struct afp_cache {
    SV***         tmparea;
    AV*           array;
    I32           len;
    SV**          array_array;
    U32           array_flags;
    SSize_t       array_fill;
    SV**          copy;          /* Non-magical SV list for magical array */
};

static
void afp_destructor(void *cache)
{
    struct afp_cache *c = cache;
    I32               x;
    
    /* PerlIO_stdoutf("DESTROY!\n"); */

    for (x = c->len; x >= 0; x--) free(c->tmparea[x]);
    free(c->tmparea);
    if (c->copy) {
        for (x = 0; x < c->len; x++) SvREFCNT_dec(c->copy[x]);
        free(c->copy);
    }
    
    AvARRAY_set(c->array, c->array_array);
    SvFLAGS(c->array) = c->array_flags;
    AvFILLp(c->array) = c->array_fill;
    free(c);
}

static
bool reset_combination(Permute *self, AV *av, UV r) {
    UV n;
    COMBINATION *c = NULL;
    if ((n = av_len(av) + 1) == 0) 
        return 0;

    c = init_combination(n, r, av);
    /* PerlIO_stdoutf("passed init_combination()\n"); */
    if (c == NULL) {
        warn("Unable to initialize combination");
        return 0;
    }
    self->c = c;

    coollex(self->c);
    coollex_visit(self->c, self->items + 1); /* base of items is 1 */
    return 1;
}

MODULE = Algorithm::Permute     PACKAGE = Algorithm::Permute        
PROTOTYPES: DISABLE

Permute* 
new(CLASS, av, ...)
    char *CLASS
    AV *av
    PREINIT:
    UV i, num;
    UV r, n;
    UV has_combination;
#ifdef USE_LINKEDLIST
    listrecord *q; /* temporary holder */
#endif
    
    CODE:
    RETVAL = (Permute*) safemalloc(sizeof(Permute));
    if (RETVAL == NULL) {
        warn("Unable to create an instance of Algorithm::Permute");
        XSRETURN_UNDEF;
    }

    RETVAL->is_done = FALSE;
    if ((n = av_len(av) + 1) == 0) 
        XSRETURN_UNDEF;

    /* init combination if necessary */
    has_combination = 0;
    RETVAL->c = NULL;
    num = n;
    if (items > 2) {
        r = SvUV(ST(2));
        if (r > n) {
            warn("Number of combination must be less or equal the number of elements");
            XSRETURN_UNDEF;
        }
        if (r < n) {
            has_combination = 1;
            num = r;
        } 
    }

    RETVAL->aryref = newRV_inc((SV*) av);
    RETVAL->num = num;

    if ((RETVAL->items = (SV**) safemalloc(sizeof(SV*) * (num + 1))) == NULL)
        XSRETURN_UNDEF;
#ifdef USE_LINKEDLIST
    RETVAL->ptr_head = safemalloc(sizeof(listrecord));

Permute.xs  view on Meta::CPAN

    if (RETVAL->loc == NULL)
        XSRETURN_UNDEF;
#endif

    /* initialize items, p, and loc */
    for (i = 1; i <= num; i++) {
        if (has_combination) {
            *(RETVAL->items + i) = &PL_sv_undef;
        } else {
            *(RETVAL->items + i) = av_shift(av);
        }
#ifdef USE_LINKEDLIST
        q->link = safemalloc(sizeof(listrecord));
        if (q->link == NULL)
            XSRETURN_UNDEF;
        q = q->link;

        q->info = num - i + 1;
        RETVAL->ptr[q->info] = q;
        RETVAL->pred[i] = RETVAL->ptr_head; /* all predecessors point to ptr_head */
#else
        *(RETVAL->p + i) = num - i + 1;
        *(RETVAL->loc + i) = 1;
#endif
    }
#ifdef USE_LINKEDLIST
    q->link = NULL; /* the tail of list points to NULL */
#endif

    if (has_combination) {
        if(!reset_combination(RETVAL, av, r)) {
            XSRETURN_UNDEF;
        }
    }

    OUTPUT:
    RETVAL

void
next(self)
    Permute *self
    PREINIT:
    int i;
#ifdef USE_LINKEDLIST
    listrecord *q; /* temporary holder */
#endif
    PPCODE:
    if (self->is_done) { /* done permutation for all combination */
        if (self->c) {
            free_combination(self->c);
            self->c = NULL;
        }
        XSRETURN_EMPTY;
    }
    else {
        EXTEND(sp, self->num);  
#ifdef USE_LINKEDLIST
        q = self->ptr_head->link;
        while (q) {
            PUSHs(sv_2mortal(newSVsv(*(self->items + q->info))));
            /* PerlIO_stdoutf("%d\n", q->info); */
            q = q->link;
        }
        self->is_done = _next(self->num, self->ptr_head, self->ptr, self->pred);
#else
        for (i = 1; i <= self->num; i++) {
            PUSHs(sv_2mortal(newSVsv(*(self->items + *(self->p + i)))));
        }
        self->is_done = _next(self->num, self->p, self->loc);
#endif
    }
    /* generate next combination if necessary */
    if (self->is_done && self->c) { /* permutation done */
        self->is_done = coollex(self->c); /* generate next combination */
#ifdef USE_LINKEDLIST
        q = self->ptr_head;
        for (i = 1; i <= self->num; i++) {
            q = q->link;
            q->info = self->num - i + 1;
            self->pred[i] = self->ptr_head;
        }
        /* q->link = NULL; */ 
        assert(q->link == NULL); /* should point to NULL */
#else
        /* reset self->p and self->loc */
        for (i = 1; i <= self->num; i++) {
            *(self->p + i) = self->num - i + 1;
            *(self->loc + i) = 1;
        }
#endif
        /* and update self->items */
        coollex_visit(self->c, self->items + 1);
    }

void
DESTROY(self)
    Permute *self
    PREINIT:
    int i;
#ifdef USE_LINKEDLIST
    listrecord *q;
#endif
    CODE:
    SvREFCNT_dec(self->aryref);
#ifdef USE_LINKEDLIST
    q = self->ptr_head;
    for (i = 1; i <= self->num; i++) {
        safefree(self->ptr[i]);
        /* No need to deallocate this, in fact, it would be disaster */
        /* safefree(self->pred[i]); */
        SvREFCNT_dec(*(self->items + i));
    }
    safefree(self->ptr);
    safefree(self->pred);
    safefree(self->ptr_head);
#else
    safefree(self->p); /* must free elements first? */
    safefree(self->loc); 
    for (i = 1; i <= self->num; i++) { /* leakproof! */
        SvREFCNT_dec(*(self->items + i));
    }