Group the elements of a list

[cameyo]

I use this function to group the elements of a list:

Code: Select all

(define (take n lst) (slice lst 0 n))
(define (drop n lst) (slice lst n))

(define (group-by-num n lst)
   (if (null? lst) '()
      (cons (take n lst) (group-by-num n (drop n lst)))
   )
)

(setq lst '(0 1 2 3 4 5 6 7 8 9))

(group-by-num 2 lst)
;-> ((0 1) (2 3) (4 5) (6 7) (8 9))

(group-by-num 3 lst)
;-> ((0 1 2) (3 4 5) (6 7 8) (9))

(setq lst '(1 2 3 4 5 6 7 8 9 10 11 12))

(group-by-num 2 (group-by-num 2 lst))
;-> (((1 2) (3 4)) ((5 6) (7 8)) ((9 10) (11 12)))

Please, post your version.

[fdb]

HI, cameyo, also here you can use a standard function: explode, see below:

Code: Select all

> (setq lst (sequence 0 9))
(0 1 2 3 4 5 6 7 8 9)
> (explode lst 2)
((0 1) (2 3) (4 5) (6 7) (8 9))
> (explode lst 3)
((0 1 2) (3 4 5) (6 7 8) (9))

> (setq lst (sequence 1 12))
(1 2 3 4 5 6 7 8 9 10 11 12)
> (explode (explode lst 2)2)
(((1 2) (3 4)) ((5 6) (7 8)) ((9 10) (11 12)))

[rickyboy]

Right on, fdb! Lutz wins this round! :)

[cameyo]

damn :-)

[ralph.ronnquist]

How about "transitive closure", then? I.e. given a list of pairs that notionally would, say, represent links in a graph, determine the lists of transitively connected "nodes", or in other words, join all sub-lists that share some element (transitively).

A recursive solution could be something like this:

Code: Select all

(define (trans s (x s) (f (and s (curry intersect (first s)))))
  (if s (trans (rest s) (cons (unique (flat (filter f x))) (clean f x))) x))

> (trans '((13 1) (9 19) (4 13) (4 12) (15 8) (3 15) (7 5) (9 4) (11 0) (0 5)))
((7 5 0 11) (9 19 4 13 1 12) (15 8 3))

Perhaps there is something faster.

[cameyo]

Thanks to all. I have learned a lot.

[rickyboy]

A recursive solution could be something like this:

Code: Select all

(define (trans s (x s) (f (and s (curry intersect (first s)))))
  (if s (trans (rest s) (cons (unique (flat (filter f x))) (clean f x))) x))

Perhaps there is something faster.

Looks good, Ralph! I don't think I could do it faster. I prefer your code anyway because it's understandable.

This is what I see. The input s is a list of sets where each member set relates each of its members to one another. For instance, if one of the members of s is (1 2 3) each of 1, 2 and 3 are related to any other. In math terms, if the input s describes a (symmetric) relation R, then it is the case that 1R2, 2R1, 1R3, 3R1, 2R3 and 3R2 are all true.

So, for instance, the first member of your example input (13 1) implies both 13R1 and 1R13 (when example input describes R). This is because, I don't see the input to trans as any different kind of "stuff" as its eventual output -- they are both relation "descriptions" -- except that the output is guaranteed to describe a transitive relation.

Now, when looking at the input set instead as a set of "links" of a graph (as you described them), then your function trans has to be assuming that all the "links" it finds in the input are bi-directional, or in other words, the "links" describe non-directed edges. Here I note that this assumption does not go unmentioned in your posting, because your posting said "join all sub-lists that share some element (transitively)" which to me says "the links are non-directed edges." Just an observation in case someone else didn't catch that.

The recursive step of trans conses the partial transitive relation descriptor member (set) containing link (first s) (by absorption/subsumption), namely (unique (flat (filter f acc))), to the subset of partial transitive relation descriptor members in x which are mutually exclusive to link (first s), namely (clean f acc). (Whew! <wipes-brow/>)

When I use your trans to compute transitive closures in the future, I will pair it with something like the following which generates a predicate for it.

Code: Select all

(define (make-symmetric-relation S)
  (letex ([S] S)
    (fn (x y)
      (exists (fn (s) (and (member x s) (member y s)))
              '[S]))))

Here's a terrible test that shows it in action.

Code: Select all

(define (test-trans input x y)
  (let (R     (make-symmetric-relation input)
        Rt    (make-symmetric-relation (trans input))
        yesno (fn (x) (if x 'yes 'no)))
    (list ;; is (x,y) in the original relation?
          (yesno (R x y))
          ;; is (x,y) in the transitive closure?
          (yesno (Rt x y)))))

For instance, (8 15) is in the original relation; so, it will also be in the transitive closure. (9 13) is not in the original relation, but it is in the transitive closure. (9 15) is in neither.

Code: Select all

> (define input
    '((13 1) (9 19) (4 13) (4 12) (15 8) (3 15) (7 5) (9 4) (11 0) (0 5)))
> (test-trans input 8 15)
(yes yes)
> (test-trans input 9 13)
(no yes)
> (test-trans input 9 15)
(no no)

Thanks again! Your function is now added to my quiver! :)

[ralph.ronnquist]

Thanks. Yes, as you say, the trans function really treats its input list s as a collection of equivalence classes, and combines those that overlap into the smallest collection of classes.

The similar function for non-reflexive relations (or directed arcs) would rather concern transitive reachability, from one element to those that are reachable when following the articulated relation (links) in the forward direction only. I came up with the following for that, which is two functions: one that determines the individual reach from a given element, and an outer function that makes the map of all those for all the elements:

Code: Select all

(define (reach s n (f (fn (x) (= n (x 0)))))
  (cons n (if s (flat (map (curry reach (clean f s))
                           (map (curry nth 1) (filter f s)))))))

(define (reachability s)
  (map (fn (x) (reach s x)) (sort (unique (flat s)))))

> (reachability '((13 1) (9 19) (4 13) (4 12) (15 8) (3 15) (7 5) (9 4) (11 0) (0 5)))
((0 5) (1) (3 15 8) (4 13 1 12) (5) (7 5) (8)
 (9 19 4 13 1 12) (11 0 5) (12) (13  1) (15 8) (19))

(I added a line break for readability)

The "reachability map" in each sub list tells which elements are reachable from the first according to the original directed relation. So then it's a matter of inflating the map into pair-wise associations to make the directed transitive closure, e.g.:

Code: Select all

(define (transD s)
  (flat (map (fn (x) (if (1 x) (map (curry list (x 0)) (1 x)) '())) (reachability s)) 1))

> (transD '((13 1) (9 19) (4 13) (4 12) (15 8) (3 15) (7 5) (9 4) (11 0) (0 5)))
((0 5) (3 15) (3 8) (4 13) (4 1) (4 12) (7 5) (9 19) (9 4) (9 13) (9 1) (9 12) (11  0) (11 5)  (13 1)  (15 8))
; i.e. the input plus implied reach: (3 8) (4 1) (9 13) (9 1) (9 12) (11 5)

Then, how do you go the other way? I.e. how do you reduce into the smallest number of pairs, or at least find a sub list so that implied relationships are omitted from the list?

newlisp is fun :)

[rickyboy]

Then, how do you go the other way? I.e. how do you reduce into the smallest number of pairs, or at least find a sub list so that implied relationships are omitted from the list?

Well, I perceive that you know the answer already, so I thank you for letting us share in the fun. :)

Here is a function untransD which removes the implied relationships. It does so by considering each edge edge in s which can be viewed as the pair (src dst) (although dst is not needed here). The clean fn answers the question "Is edge implied?" That will be true when the reach of src, after we remove edge from s, is the same is the reach of src under s.

Code: Select all

(define (untransD s)
  (clean (fn (edge)
           (let (src (edge 0)
                 remove (fn () (apply replace (args))))
             (= (reach s src)
                (reach (remove edge s) src))))
         s))

Aside. For people not familiar with newLISP, note the remove function (defined in the let bindings). It appears as if it is only doing what the intrinsic replace does; so, why not just say (replace edge s) instead of (remove edge s)? The reason for not doing that is subtle. The replace primitive is destructive, and we don't want s to change during the runtime of untransD. Defining remove as we've done here turns it into a non-destructive removal function (because of the calling model of newLISP: a copy gets passed the a function, not a reference).

But perhaps from a (software engineering) contracts point-of-view, we shouldn't rely on the order of the outputs of the reach calls (i.e., its stability). Even though we can see the code of reach, we can also "play it safe" by assuming that we cannot see the implementation and thus replace the usage of = with the usage of another equality predicate where the order doesn't matter. There may be a better way to do this, but here's one.

Code: Select all

(define (set-equal? A B)
  (= (sort A) (sort B)))

The primitive sort is also destructive; however, we don't need A and B (which are copies themselves) for anything else in the scope of this function (after we are done "smashing" them :). Happily, we can reuse set-equal? in our testing.

First, let's recall what running transD on the example input (input) does.

Code: Select all

> input
((13 1) (9 19) (4 13) (4 12) (15 8) (3 15) (7 5)
 (9 4) (11 0) (0 5))
> (transD input)
((0 5) (3 15) (3 8) (4 13) (4 1) (4 12) (7 5)
 (9 19) (9 4) (9 13) (9 1) (9 12) (11 0) 
 (11 5) (13 1) (15 8))

Now, let's see untransD in action.

Code: Select all

> (untransD (transD input))
((0 5) (3 15) (4 13) (4 12) (7 5) (9 19) (9 4)
 (11 0) (13 1) (15 8))

Well, the order is different, but it sorta looks a lot like input (by "eyeballing" it). So, how can we test this a little better? It seems that we should be able to say that transD and untransD are inverses of each other. Let's try that.

First, note that the example input itself is devoid of implied relationships.

Code: Select all

> (set-equal? input (untransD input))
true

That means the following identity should hold.

Code: Select all

> (set-equal? input (untransD (transD input)))
true

newlisp is fun :)

Indeed! :)

[rickyboy]

While I was exploring all the code, I believe that I found a bug.

The following identity should hold: the reachability of the transitive closure of input is the same as the reachability of input.

Code: Select all

> 
(set-equal? (reachability input)
            (reachability (transD input)))

nil

Hmmm. What's going on?

Code: Select all

> (reachability (transD input))
((0 5) (1) (3 15 8 8) (4 13 1 1 12) (5) (7 5)
 (8) (9 19 4 13 1 1 12 13 1 1 12) (11 0 5 5) 
 (12) (13 1) (15 8) (19))

Ok, looks like some of the reaches don't have unique elements. Here's one in particular.

Code: Select all

> (reach (transD input) 9)
(9 19 4 13 1 1 12 13 1 1 12)

Looks like we need a unique in the reach function.

Code: Select all

(define (reach s n (f (fn (x) (= n (x 0)))))
  (cons n (if s (unique (flat (map (curry reach (clean f s))
                                   (map (curry nth 1) (filter f s))))))))

Now, it works.

Code: Select all

> (reach (transD input) 9)
(9 19 4 13 1 12)

And the identity in fact holds, as expected.

Code: Select all

> 
(set-equal? (reachability input)
            (reachability (transD input)))

true

[cameyo]

I need more time to understand all this...