Recursive generator - manual zip vs operator

Question

Here is exercise 5.F.2 from Charles C. Pinter's Book of Abstract Algebra:

Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} generators satisfy a^2 = e , b^4 = e , ba = ab^3 . Write table G ( G is called the dihedral group of D4.)

Here is a small Perl 6 program that introduces the solution:

 sub generate(%eqs, $s) { my @results = (); for %eqs.kv -> $key, $val { if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); } if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); } } for @results -> $result { take $result; } my @arrs = @results.map({ gather generate(%eqs, $_) }); my $i = 0; while (1) { for @arrs -> @arr { take @arr[$i]; } $i++; } } sub table(@G, %eqs) { printf " |"; for @G -> $y { printf "%-5s|", $y; }; say ''; printf "-----|"; for @G -> $y { printf "-----|"; }; say ''; for @G -> $x { printf "%-5s|", $x; for @G -> $y { my $result = (gather generate(%eqs, "$x$y")).first(* (elem) @G); printf "%-5s|", $result; } say '' } } # ---------------------------------------------------------------------- # Pinter 5.F.2 my @G = <eab bb bbb ab abb abbb>; my %eqs = <aa e bbbb e ba abbb>; %eqs<e> = ''; table @G, %eqs; 

Here's what the resulting table looks like:

Focus on these specific lines from generate :

 my @arrs = @results.map({ gather generate(%eqs, $_) }); my $i = 0; while (1) { for @arrs -> @arr { take @arr[$i]; } $i++; } 

A recursive call to generate is performed for each of the elements in @results . Then we efficiently execute manual "zip" in the resulting sequences. However, Perl 6 has zip and the Z operator.

Instead of the above lines, I would like to do something like this:

 for ([Z] @results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; } 

So here is the full generate using Z :

 sub generate(%eqs, $s) { my @results = (); for %eqs.kv -> $key, $val { if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); } if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); } } for @results -> $result { take $result; } for ([Z] @results.map({ gather generate(%eqs, $_) })).flat -> $elt { take $elt; } } 

The problem with the generation version of Z is that it freezes ...

So my question is, is there a way to write generate in terms of Z ?

Besides this basic question, feel free to share alternative solutions that explore and demonstrate Perl 6.

---

As another example, here run 5.F.3 from the same book:

Let G be the group {e, a, b, b^2, b^3, ab, ab^2, ab^3} , the generators satisfy a^4 = e , a^2 = b^2 , ba = ab^3 . Write a table G (G is called a group of quaternions.)

And the above program displays a table:

---

Aside, this program has been converted from version to C #. Here's how generate looks there using LINQ and the ZipMany version, courtesy of Eric Lippert .

  static IEnumerable<string> generate(Dictionary<string,string> eqs, string s) { var results = new List<string>(); foreach (var elt in eqs) { if (new Regex(elt.Key).IsMatch(s)) results.Add(new Regex(elt.Key).Replace(s, elt.Value, 1)); if (new Regex(elt.Value).IsMatch(s)) results.Add(new Regex(elt.Value).Replace(s, elt.Key, 1)); } foreach (var result in results) yield return result; foreach (var elt in ZipMany(results.Select(elt => generate(eqs, elt)), elts => elts).SelectMany(elts => elts)) yield return elt; } 

The whole C # program: link .

Answer 1

Why your use of zip does not work

Your code assumes that [Z] ("abbreviation using the zip operator") can be used to get transpose list-of-lists.

Unfortunately, this does not work in the general case.
It usually works, but breaks down on one edge: Namely, when a list of lists is a list of only one list. Note:

 my @a = <ab c>, <1 2 3>, <XY Z>; put [Z~] @a; # a1X b2Y c3Z my @a = <ab c>, <1 2 3>; put [Z~] @a; # a1 b2 c3 my @a = <ab c>,; put [Z~] @a; # abc my @a; put [Z~] @a; # 

In the first two examples (3 and 2 subscriptions) you can see that the transposition of @a was returned just fine. The fourth example (0 subscriptions) also does the right thing.
But the third example (1 sub-list) did not print abc , as expected, i.e. He did not return transposition of @a in this case, but rather (it seems) transposition of @a[0] .

Unfortunately, this is not a Rakudo error (in this case, it can simply be fixed), but the unexpected interaction of two Perl 6 design solutions, namely:

• The meta- reduce [ ] operator processes the input list with one element, invoking the operator to which it is applied, with one argument (the specified element).
  In case you are interested, the infix operator can be called with only one argument by calling its function object: &infix:<Z>( <ab c>, ) .
• The zip Z operator and the zip function (like other built-in elements that accept nested lists) follow the so-called “one-argument rule” - that is, its signature uses the parameter parameter of a single argument . This means that when it is called with a single argument, it will go down into it and consider its elements as actual arguments for use. (See also Negligence Agreements .)
  So, zip(<ab c>,) considered as zip("a", "b", "c") .

Both functions provide pleasant convenience in many other cases, but in this case, their interaction, unfortunately, creates a trap.

How to make it work with zip

You can check the number of @arrs elements, and in the special case “exactly 1 sub-list”:

 my @arrs = @results.map({ gather generate(%eqs, $_) }); if @arrs.elems == 1 { .take for @arrs[0][]; } else { .take for flat [Z] @arrs } 

[] is zen slice "- it returns the list without changes, but without the item container that completes the parent array it is necessary. This is necessary because the for loop will consider something enclosed in the element container as a separate element and will do only one iteration.

Of course, this if-else solution is not very elegant, which probably negates your reason for using zip in the first place.

How to write code more elegantly without zip

Contact Christoph .

Answer 2

This may be possible with Z , but for my poor little brain there are too many recursively generated lazy lists.

Instead, I made some other simplifications:

 sub generate($s, %eqs) { take $s; # the given equations normalize the string, ie there no need to apply # the inverse relation for %eqs.kv -> $k, $v { # make copy of $s so we can use s/// instead of .subst my $t = $s; generate $t, %eqs if $t ~~ s/$k/$v/; } } sub table(@G, %eqs) { # compute the set only once instead of implicitly on each call to (elem) my $G = set @G; # some code golfing put ['', |@G]>>.fmt('%-5s|').join; put '-----|' x @G + 1; for @G -> $x { printf '%-5s|', $x; for @G -> $y { printf '%-5s|', (gather generate("$x$y", %eqs)).first(* (elem) $G); } put ''; } } my @G = <eab bb bbb ab abb abbb>; # use double brackets so we can have empty strings my %eqs = <<aa e bbbb e ba abbb e ''>>; table @G, %eqs; 

---

Here is a compact generate rework that does bi-directional lookup, but without an explicit zip:

 sub generate($s, %eqs) { my @results = do for |%eqs.pairs, |%eqs.antipairs -> (:$key, :$value) { take $s.subst($key, $value) if $s ~~ /$key/; } my @seqs = @results.map: { gather generate($_, %eqs) } for 0..* -> $i { take .[$i] for @seqs } } 

Answer 3

Here is the generate version using the approach demonstrated by smls :

 sub generate(%eqs, $s) { my @results = (); for %eqs.kv -> $key, $val { if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); } if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); } } for @results -> $result { take $result; } my @arrs = @results.map({ gather generate(%eqs, $_) }); if @arrs.elems == 1 { .take for @arrs[0][]; } else { .take for flat [Z] @arrs; } } 

I tested it and it works on exercises 2 and 3.

As smls mentions in his answer, zip does not do what we expect when a given array of arrays contains only one array. So, create a zip version that works with one or more arrays:

 sub zip-many (@arrs) { if @arrs.elems == 1 { .take for @arrs[0][]; } else { .take for flat [Z] @arrs; } } 

And now generate in terms of zip-many :

 sub generate(%eqs, $s) { my @results = (); for %eqs.kv -> $key, $val { if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); } if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); } } for @results -> $result { take $result; } zip-many @results.map({ gather generate(%eqs, $_) }); } 

It looks good.

Thanks smls !

---

smls suggests in the comment below that zip-many does not call take , leaving this to generate . Let also move flat from zip-many to generate .

Reduced zip-many :

 sub zip-many (@arrs) { @arrs == 1 ?? @arrs[0][] !! [Z] @arrs } 

And generate to agree with it:

 sub generate(%eqs, $s) { my @results; for %eqs.kv -> $key, $val { if $s ~~ /$key/ { @results.push($s.subst(/$key/, $val)); } if $s ~~ /$val/ { @results.push($s.subst(/$val/, $key)); } } .take for @results; .take for flat zip-many @results.map({ gather generate(%eqs, $_) }); } 

Answer 4

Testing keys and values ​​separately seems a little silly; your lines are not really regular expressions, so there is no need to // anywhere in your code.

 sub generate($s, @eqs) { my @results = do for @eqs.kv -> $i, $equation { take $s.subst($equation, @eqs[ $i +^ 1 ]) if $s.index: $equation } my @seqs = @results.map: { gather generate($_, @eqs) } for 0..* -> $i { take .[$i] for @seqs } } 

Obviously, with this version of generate you have to rewrite table to use @eqs instead of %eqs .