|
end</lang>
=={{header|Perl 6}}==
{{works with|Rakudo|20112012.0705}}
Perl 6 doesn't have algebraic data types (yet), but it does have pretty good pattern matching in multi signatures.
<lang perl6>protoenum balanceRedBlack ($,<R @, $, @) {*}B>;
multi balance('B',['R',['R',$a,$x,$b],$y,$c],$z,$d) { ['R',['B',$a,$x,$b],$y,['B',$c,$z,$d]] }
multi balance('B',['R',$a,$x,['R',$b,$y,$c]],$z,$d) { ['R',['B',$a,$x,$b],$y,['B',$c,$z,$d]] }
multi balance('B',$a,$x,['R',['R',$b,$y,$c],$z,$d]) { ['R',['B',$a,$x,$b],$y,['B',$c,$z,$d]] }
multi balance('B',$a,$x,['R',$b,$y,['R',$c,$z,$d]]) { ['R',['B',$a,$x,$b],$y,['B',$c,$z,$d]] }
multi balance($col, $a, $x, $b) is default { [$col, $a, $x, $b] }
protomulti ins ( $x, @s [$col, $a, $y, $b] ) {*}
multi ins( $x, [] ) { ['R', [], $x, []] } ▼multi ins( $x, $s [$col, $a, $y, $b] ) {
when $x before $y { balance $col, ins($x, $a), $y, $b }
when $x after $y { balance $col, $a, $y, ins($x, $b) }
default { $@s }
}
▲multi ins( $x, []Any:U ) { [ 'R ', []Any, $x, []Any] }
submulti insert( $x, $s ) {
my ([$B, $a, $y, $b]) := ins($x, $s)[1..3]];
}
}</lang>
This is implemented with string tags instead of enums because [[rakudo]] does not yet properly treat enums as constants, and thus treats the multi dispatch as ambiguous. Also, in order to correctly parameterize the generic tree type, we'd currently have use a parametric role in a class, which would have been a bit more cluttery, so we don't check the type of tree insertions here.
It does, however, use the generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type. ▼
Here we test the code by inserting 10 integers in random order:
▲ ['B',my $ a,t $y,= $b]Any;
my $t = [];
$t = insert($_, $t) for (1..10).pick(*);
say $t.perl;
}</lang>
▲ItThis does,code however, use theuses generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type.
Output:
{{out}}
<pre>["RedBlack::B", ["B", ["RedBlack::R", ["RedBlack::B", []RedBlack::R, Any, 1, []Any], 2, ["B", [Any], 3, []]]RedBlack::B, Any, 4, ["B"RedBlack::R, []Any, 5, [Any]]], 6, ["B"RedBlack::R, ["RedBlack::B", []Any, 7, []Any], 8, ["RedBlack::B", []Any, 9, ["RedBlack::R", []Any, 10, []Any]]]]</pre>
After we get enums and non-class generic scopes sorted out, we hope to be able to write the proto signatures with better parametric types. It'll look more like this:
<lang perl6>role Tree[::A] {
enum Color <R B>;
proto balance (Color, Tree[A], A, Tree[A]) {*}
multi balance(B,[R,[R,$a,$x,$b],$y,$c],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
...
}</lang>
And we can, if fact, write that and get it to parse currently. It's just the ability to instantiate that role in a non-class scope that is missing.
=={{header|PicoLisp}}==
|