[User]
Given some text you suspect has been encrypted with a Vigenère cipher, extract the key and plaintext. There are several methods for doing this. See the Wikipedia entry for more information. Use the following encrypted text:

```
MOMUD EKAPV TQEFM OEVHP AJMII CDCTI FGYAG JSPXY ALUYM NSMYH
VUXJE LEPXJ FXGCM JHKDZ RYICU HYPUS PGIGM OIYHF WHTCQ KMLRD
ITLXZ LJFVQ GHOLW CUHLO MDSOE KTALU VYLNZ RFGBX PHVGA LWQIS
FGRPH JOOFW GUBYI LAPLA LCAFA AMKLG CETDW VOELJ IKGJB XPHVG
ALWQC SNWBU BYHCU HKOCE XJEYK BQKVY KIIEH GRLGH XEOLW AWFOJ
ILOVV RHPKD WIHKN ATUHN VRYAQ DIVHX FHRZV QWMWV LGSHN NLVZS
JLAKI FHXUF XJLXM TBLQV RXXHR FZXGV LRAJI EXPRV OSMNP KEPDT
LPRWM JAZPK LQUZA ALGZX GVLKL GJTUI ITDSU REZXJ ERXZS HMPST
MTEOE PAPJH SMFNB YVQUZ AALGA YDNMP AQOWT UHDBV TSMUE UIMVH
QGVRW AEFSP EMPVE PKXZY WLKJA GWALT VYYOB YIXOK IHPDS EVLEV
RVSGB JOGYW FHKBL GLXYA MVKIS KIEHY IMAPX UOISK PVAGN MZHPW
TTZPV XFCCD TUHJH WLAPF YULTB UXJLN SIJVV YOVDJ SOLXG TGRVO
SFRII CTMKO JFCQF KTINQ BWVHG TENLH HOGCS PSFPV GJOKM SIFPR
ZPAAS ATPTZ FTPPD PORRF TAXZP KALQA WMIUD BWNCT LEFKO ZQDLX
BUXJL ASIMR PNMBF ZCYLV WAPVF QRHZV ZGZEF KBYIO OFXYE VOWGB
BXVCB XBAWG LQKCM ICRRX MACUO IKHQU AJEGL OIJHH XPVZW JEWBA
FWAML ZZRXJ EKAHV FASMU LVVUT TGK

```

Letter frequencies for English can be found here.

Specifics for this task:

* Take only the ciphertext as input. You can assume it's all capitalized and has no punctuation, but it might have whitespace.
* Assume the plaintext is written in English.
* Find and output the key.
* Use that key to decrypt and output the original plaintext. Maintaining the whitespace from the ciphertext is optional.
* The algorithm doesn't have to be perfect (which may not be possible) but it should work when given enough ciphertext. The example above is fairly long, and should be plenty for any algorithm.

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

```
# from Wikipedia
constant %English-letter-freq = (
     E => 12.70,  L => 4.03,  Y => 1.97,  P => 1.93,  T => 9.06,  A => 8.17,  O => 7.51,  I => 6.97,  N => 6.75,
     S =>  6.33,  H => 6.09,  R => 5.99,  D => 4.25,  C => 2.78,  U => 2.76,  M => 2.41,  W => 2.36,  F => 2.23,
     G =>  2.02,  B => 1.29,  V => 0.98,  K => 0.77,  J => 0.15,  X => 0.15,  Q => 0.10,  Z => 0.07
);
constant @alphabet = %English-letter-freq.keys.sort;
constant max_key_lengths = 5; # number of keylengths to try

sub myguess ($text) {
    my ($seqtext, @spacing, @factors, $pos, %freq, %Keys);

    # Kasiski examination
    $seqtext = $text;
    while ($seqtext ~~ /$<sequence>=[...].*$<sequence>/) {
        $seqtext = substr($seqtext, 1+index($seqtext, $<sequence>));
        push @spacing, 1 + index($seqtext, $<sequence>);
    }
    for @spacing -> $j {
        %freq{$_}++ for grep { $j %% $_ }, 2..$j;
    }

    # discard very short keys, and test only the most likely remaining key lengths
    (%freq.keys.grep(* > 3).sort({%freq{$_}}).tail(max_key_lengths)).race(:1batch).map: -> $keylen {
        my $key-guess = '';
        loop (my $i = 0; $i < $keylen; $i++) {
            my ($mykey, %chi-square, $best-guess);
            loop (my $j = 0; $j < $text.chars; $j += $keylen) {
                $mykey ~= substr($text, ($j+$i) % $text.chars, 1);
            }

            for @alphabet -> $subkey {
                my $decrypted = mycrypt($mykey, $subkey);
                my $length    = $decrypted.chars;
                for @alphabet -> $char {
                    my $expected = %English-letter-freq{$char} * $length / 100;
                    my $observed = $decrypted.comb.grep(* eq $char).elems;
                    %chi-square{$subkey} += ($observed - $expected)² / $expected if $observed;
                }
            }
            %Keys{$keylen}{'score'} = %chi-square{@alphabet[0]};
            for %chi-square.keys.sort -> $sk {
                if (%chi-square{$sk} <= %Keys{$keylen}{'score'}) {
                    $best-guess = $sk;
                    %Keys{$keylen}{'score'} = %chi-square{$sk};
                }
            }
            $key-guess ~= $best-guess;
        }
        %Keys{$keylen}{'key'} = $key-guess;
    }
    %Keys.keys.sort({ %Keys{$_}{'score'} }).map:{ %Keys{$_}{'key'} };
}

sub mycrypt ($text, $key) {
    constant %values-numbers = @alphabet Z=> ^@alphabet;
    constant %values-letters = %values-numbers.invert;

    my ($new-text);
    my $keylen = $key.chars;
    loop (my $i = 0; $i < $text.chars; $i++) {
        my $val =  -1 * %values-numbers{substr( $key, $i%$keylen, 1)} # negative shift for decode
                 +      %values-numbers{substr($text, $i,         1)};
        $new-text ~= %values-letters{ $val % @alphabet };
    }
    return $new-text;
}

my $cipher-text = .uc.trans(@alphabet => '', :c) given q:to/EOD/;
    MOMUD EKAPV TQEFM OEVHP AJMII CDCTI FGYAG JSPXY ALUYM NSMYH
    VUXJE LEPXJ FXGCM JHKDZ RYICU HYPUS PGIGM OIYHF WHTCQ KMLRD
    ITLXZ LJFVQ GHOLW CUHLO MDSOE KTALU VYLNZ RFGBX PHVGA LWQIS
    FGRPH JOOFW GUBYI LAPLA LCAFA AMKLG CETDW VOELJ IKGJB XPHVG
    ALWQC SNWBU BYHCU HKOCE XJEYK BQKVY KIIEH GRLGH XEOLW AWFOJ
    ILOVV RHPKD WIHKN ATUHN VRYAQ DIVHX FHRZV QWMWV LGSHN NLVZS
    JLAKI FHXUF XJLXM TBLQV RXXHR FZXGV LRAJI EXPRV OSMNP KEPDT
    LPRWM JAZPK LQUZA ALGZX GVLKL GJTUI ITDSU REZXJ ERXZS HMPST
    MTEOE PAPJH SMFNB YVQUZ AALGA YDNMP AQOWT UHDBV TSMUE UIMVH
    QGVRW AEFSP EMPVE PKXZY WLKJA GWALT VYYOB YIXOK IHPDS EVLEV
    RVSGB JOGYW FHKBL GLXYA MVKIS KIEHY IMAPX UOISK PVAGN MZHPW
    TTZPV XFCCD TUHJH WLAPF YULTB UXJLN SIJVV YOVDJ SOLXG TGRVO
    SFRII CTMKO JFCQF KTINQ BWVHG TENLH HOGCS PSFPV GJOKM SIFPR
    ZPAAS ATPTZ FTPPD PORRF TAXZP KALQA WMIUD BWNCT LEFKO ZQDLX
    BUXJL ASIMR PNMBF ZCYLV WAPVF QRHZV ZGZEF KBYIO OFXYE VOWGB
    BXVCB XBAWG LQKCM ICRRX MACUO IKHQU AJEGL OIJHH XPVZW JEWBA
    FWAML ZZRXJ EKAHV FASMU LVVUT TGK
EOD

for myguess($cipher-text) -> $key {
    say "Key        $key\n" ~
        "Key length {$key.chars}\n" ~
        "Plaintext  {substr(mycrypt($cipher-text, $key), 0, 80)}...\n";
}

```

Output:

```
Key        THECHESHIRECAT
Key length 14
Plaintext  THISWASTHEPOEMTHATALICEREADJABBERWOCKYTWASBRILLIGANDTHESLITHYTOVESDIDGYREANDGIMB...

Key        THECHESCIRECATTHECHESHIRECAT
Key length 28
Plaintext  THISWASYHEPOEMTHATALICEREADJABBERWOHKYTWASBRILLIGANDTHESLITHYTOAESDIDGYREANDGIMB...

Key        TJGGAHET
Key length 8
Plaintext  TFGODXGHWMNKEYIVLMBJACIPPTXWTBBNFRADSITFHCOSMGOTFYPOXCASLGRDFQCJTABEDSNFPTOBYIQZ...

Key        THECSAS
Key length 7
Plaintext  THISLESHIRRYENTHATPPIQFEGKDKABBEGAOQLLVGATBRILAMGOOQVRETLITHNXOJFFFSDHYREACHGWNO...

Key        THEC
Key length 4
Plaintext  THISKXGYWOPOLYIMLODNHCIGPVZAABBEFTCHZITWHEQWTGOKFARSECAJLITHMQCATCDIKSNWPVQFFIQQ...
```


[User]
Description

In object oriented programming, the Visitor design pattern is a way of separating an algorithm from an object structure on which it operates. A practical result of this separation is the ability to add new operations to existing object structures without modifying the structures.

It is one way to follow the open/closed principle which states that: "software entities (classes, modules, functions, etc.) should be open for extension, but closed for modification".

The Visitor pattern is one of the twenty-three Gang of Four design patterns that facilitate the solution of recurring design problems in object-oriented software.

Operation

Consider two objects, each of some class type; one is termed the *element*, and the other is the *visitor*.

The visitor declares a *visit* method, which takes the element as an argument, for each class of element. Concrete visitors are derived from the visitor class and implement these visit methods, each of which implements part of the algorithm operating on the object structure. The state of the algorithm is maintained locally by the concrete visitor class.

The element declares an *accept* method to accept a visitor, taking the visitor as an argument. Concrete elements, derived from the element class, implement the accept method. Composite elements, which maintain a list of child objects, typically iterate over these, calling each child's accept method.

Having created the object structure, a program should first instantiate the concrete visitors. When an operation is to be performed which is implemented using the Visitor pattern, it should then call the accept method of the top-level element(s) passing the visitor(s) as arguments.

Examples

The Wikipedia article contains examples of the Visitor pattern written in: C#, Smalltalk, Go (partial), Java, Common Lisp and Python.

Task

Demonstrate the workings of the Visitor pattern in your language by translating one (or more) of the Wikipedia examples. If your language is one of those for which an example already exists, try to translate one of the other examples.

If you don't know any of the example languages or prefer to use your own example, then this is also acceptable.

If your language does not support the object oriented paradigm at all (or only to a limited extent), then try to emulate the intent of the pattern with the tools it does have by writing a program which produces the same output as one of the Wikipedia examples.

References

* Wikipedia: Visitor pattern
* Code Project - The Visitor Pattern Explained

[Assistant]
Raku implements multiple dispatch so the visitor pattern is perhaps not as useful/necessary there. That said, it can be done fairly easily.

(Largely based on an example published by Johnathan Stowe.)

```
role CarElementVisitor { ... }

class CarElement {
    method accept(CarElementVisitor $visitor) {
        $visitor.visit: self
    }
}

class Body is CarElement { }

class Engine is CarElement { }

class Wheel is CarElement {
    has Str $.name is required;
}

class Car is CarElement {
    has CarElement @.elements = (
        Wheel.new(name => "front left"),
        Wheel.new(name => "front right"),
        Wheel.new(name => "rear left"),
        Wheel.new(name => "rear right"),
        Body.new,
        Engine.new
    );

    method accept(CarElementVisitor $visitor) {
        for @.elements -> $element { $element.accept: $visitor };
        $visitor.visit: self;
    }
}

role CarElementVisitor {
    method visit(CarElement $e) { ... }
}

class CarElementDoVisitor does CarElementVisitor {
    multi method visit(Body $e) {
        say "Moving my body.";
    }
    multi method visit(Car $e) {
        say "Starting my car.";
    }
    multi method visit(Wheel $e) {
        say "Kicking my { $e.name } wheel.";
    }
    multi method visit(Engine $e) {
        say "Starting my engine.";
    }
}

class CarElementPrintVisitor does CarElementVisitor {
    multi method visit(Body $e) {
        say "Visiting body.";
    }
    multi method visit(Car $e) {
        say "Visiting car.";
    }
    multi method visit(Wheel $e) {
        say "Visiting { $e.name } wheel.";
    }
    multi method visit(Engine $e) {
        say "Visiting engine.";
    }
}

my Car $car = Car.new;

$car.accept: CarElementPrintVisitor.new;
$car.accept: CarElementDoVisitor.new;

```

Output:

```
Visiting front left wheel.
Visiting front right wheel.
Visiting rear left wheel.
Visiting rear right wheel.
Visiting body.
Visiting engine.
Visiting car.
Kicking my front left wheel.
Kicking my front right wheel.
Kicking my rear left wheel.
Kicking my rear right wheel.
Moving my body.
Starting my engine.
Starting my car.
```


[User]
A tree structure   (i.e. a rooted, connected acyclic graph)   is often used in programming.

It's often helpful to visually examine such a structure.

There are many ways to represent trees to a reader, such as:

:   :   :   * indented text   (à la unix  `tree`  command)
            * nested HTML tables
            * hierarchical GUI widgets
            * 2D   or   3D   images
            * etc.

Task

Write a program to produce a visual representation of some tree.

The content of the tree doesn't matter, nor does the output format, the only requirement being that the output is human friendly.

Make do with the vague term "friendly" the best you can.

[Assistant]
(formerly Perl 6)

```
sub visualize-tree($tree, &label, &children,
                   :$indent = '',
                   :@mid = ('├─', '│ '),
                   :@end = ('└─', '  '),
) {
    sub visit($node, *@pre) {
        | gather {
            take @pre[0] ~ label($node);
            my @children := children($node);
            my $end = @children.end;
            for @children.kv -> $_, $child {
                when $end { take visit($child, (@pre[1] X~ @end)) }
                default   { take visit($child, (@pre[1] X~ @mid)) }
            }
        }
    }
    visit($tree, $indent xx 2);
}

# example tree built up of pairs
my $tree = root=>[a=>[a1=>[a11=>[]]],b=>[b1=>[b11=>[]],b2=>[],b3=>[]]];

.map({.join("\n")}).join("\n").say for visualize-tree($tree, *.key, *.value.list);

```

Output:

```
root
├─a
│ └─a1
│   └─a11
└─b
  ├─b1
  │ └─b11
  ├─b2
  └─b3
```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at VList. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |

In computer science, the **VList** is a persistent data structure that combines the fast indexing of arrays with the easy extension of cons-based (or singly-linked) linked lists.

Like arrays, VLists have constant-time lookup on average and are highly compact, requiring only O(log *n*) storage for pointers, allowing them to take advantage of locality of reference.
Like singly-linked or cons-based lists, they are persistent, and elements can be added to or removed from the front in constant time. Length can also be found in O(log *n*) time.

The primary operations of a VList are:

* Locate the *k*th element (O(1) average, O(log *n*) worst-case)
* Add an element to the front of the VList (O(1) average, with an occasional allocation)
* Obtain a new array beginning at the second element of an old array (O(1))
* Compute the length of the list (O(log *n*))

Task

The task is to demonstrate creation of a VList and how to perform the primary operations.

[Assistant]
(formerly Perl 6)

**Translation of**: Go

**Translation of**: Kotlin

```
class vList {

   subset vEle of Any; # or Str

   class vSeg {
      has      $.next is rw is default(Nil) ;
      has vEle @.ele  is rw ;
   }

   has vSeg $.base   is rw is default(vSeg.new(ele=>()));
   has Int  $.offset is rw is default(0) ;

   method Index(Int $i is copy --> vEle) { # method to locate the kth element
      if $i ≥ 0 {
         loop ( $i += self.offset, $_ = self.base; $_.defined; $_ := $_.next) {
            ($i < my $len = .ele.elems) ?? return .ele[$i] !! $i -= $len
         }
      }
      die "index out of range"
   }

   method cons(vEle \a --> vList) { # method to add an element to the front
      if not self.base.ele.Bool {   # probably faster than .elems ?
         self.base.ele.push: a ;
         return self;
      } elsif self.offset == 0 {
         my \L2offset = (self.base.ele.elems * 2) - 1 ;
         my \s = vSeg.new(next => self.base, ele => flat Nil xx L2offset, a);
         return vList.new(base => s, offset => L2offset )
      }
      self.base.ele[--self.offset] = a;
      return self
   }

   # obtain a new array beginning at the second element of an old array
   method cdr(--> vList) {
      die "cdr on empty vList" unless self.base.defined;
      return self if ++self.offset < self.base.ele.elems;
      return vList.new(base => self.base.next)
   }

   method Length(--> Int) { # method to  compute the length of the list
      return 0 unless self.base.defined;
      return self.base.ele.elems*2 - self.offset - 1
   }

   method gist { # (mis)used to create output similar to Go/Kotlin
      return '[]' unless self.base.ele.Bool;
      my @sl = self.base.ele[self.offset .. *];
      loop ($_=self.base.next; $_.defined; $_:=$_.next) { @sl.append: .ele }
      return  "[" ~ @sl.Str ~ "]"
   }

   method printStructure {  # One more method for demonstration purposes
      say "offset: ", self.offset;
      loop ( $_ = self.base; $_.defined ; $_ := $_.next ) { .ele.say }
   }
}

my $v := vList.new;
say "zero value for type.  empty vList: ", $v;
$v.printStructure;
say " ";
$v := $v.cons($_.Str) for 6 … 1;
say "demonstrate cons. 6 elements added: ", $v;
$v.printStructure;
say " ";
$v := $v.cdr;
say "demonstrate cdr. 1 element removed: ", $v;
$v.printStructure;
say " ";
say "demonstrate length. length = ", $v.Length;
say " ";
say "demonstrate element access. v[3] = ", $v.Index(3) ;
say " ";
$v := $v.cdr.cdr;
say "show cdr releasing segment. 2 elements removed: ", $v;
$v.printStructure;

```

Output:

```
zero value for type.  empty vList: []
offset: 0
[]

demonstrate cons. 6 elements added: [1 2 3 4 5 6]
offset: 1
[(vEle) 1 2 3]
[4 5]
[6]

demonstrate cdr. 1 element removed: [2 3 4 5 6]
offset: 2
[(vEle) 1 2 3]
[4 5]
[6]

demonstrate length. length = 5

demonstrate element access. v[3] = 5

show cdr releasing segment. 2 elements removed: [4 5 6]
offset: 0
[4 5]
[6]

```


[User]
Vogel's Approximation Method (VAM) is a technique for finding a good initial feasible solution to an allocation problem.

The powers that be have identified 5 tasks that need to be solved urgently. Being imaginative chaps, they have called them “A”, “B”, “C”, “D”, and “E”. They estimate that:

* A will require 30 hours of work,
* B will require 20 hours of work,
* C will require 70 hours of work,
* D will require 30 hours of work, and
* E will require 60 hours of work.

They have identified 4 contractors willing to do the work, called “W”, “X”, “Y”, and “Z”.

* W has 50 hours available to commit to working,
* X has 60 hours available,
* Y has 50 hours available, and
* Z has 50 hours available.

The cost per hour for each contractor for each task is summarized by the following table:

```
   A  B  C  D  E
W 16 16 13 22 17
X 14 14 13 19 15
Y 19 19 20 23 50
Z 50 12 50 15 11

```

The task is to use VAM to allocate contractors to tasks. It scales to large problems, so ideally keep sorts out of the iterative cycle. It works as follows:

:   Step 1: Balance the given transportation problem if either (total supply>total demand) or (total supply<total demand)
:   Step 2: Determine the penalty cost for each row and column by subtracting the lowest cell cost in the row or column from the next lowest cell cost in the same row or column.
:   Step 3: Select the row or column with the highest penalty cost (breaking ties arbitrarily or choosing the lowest-cost cell).
:   Step 4: Allocate as much as possible to the feasible cell with the lowest transportation cost in the row or column with the highest penalty cost.
:   Step 5: Repeat steps 2, 3 and 4 until all requirements have been meet.
:   Step 6: Compute total transportation cost for the feasible allocations.

For this task assume that the model is balanced.

For each task and contractor (row and column above) calculating the difference between the smallest two values produces:

```
        A       B       C       D       E       W       X       Y       Z
1       2       2       0       4       4       3       1       0       1   E-Z(50)

```

Determine the largest difference (D or E above). In the case of ties I shall choose the one with the lowest price (in this case E because the lowest price for D is Z=15, whereas for E it is Z=11). For your choice determine the minimum cost (chosen E above so Z=11 is chosen now). Allocate as much as possible from Z to E (50 in this case limited by Z's supply).
Adjust the supply and demand accordingly. If demand or supply becomes 0 for a given task or contractor it plays no further part. In this case Z is out of it. If you choose arbitrarily, and chose D see here for the working.

Repeat until all supply and demand is met:

```
2       2       2       0       3       2       3       1       0       -   C-W(50)
3       5       5       7       4      35       -       1       0       -   E-X(10)
4       5       5       7       4       -       -       1       0       -   C-X(20)
5       5       5       -       4       -       -       0       0       -   A-X(30)
6       -      19       -      23       -       -       -       4       -   D-Y(30)
        -       -       -       -       -       -       -       -       -   B-Y(20)

```

Finally calculate the cost of your solution. In the example given it is £3100:

```
   A  B  C  D  E
W       50
X 30    20    10
Y    20    30
Z             50

```

The optimal solution determined by GLPK is £3100:

```
   A  B  C  D  E
W       50
X 10 20 20    10
Y 20       30
Z             50

```

Cf.

* Transportation problem

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03.1

**Translation of**: Sidef

```
my  %costs =
    :W{:16A, :16B, :13C, :22D, :17E},
    :X{:14A, :14B, :13C, :19D, :15E},
    :Y{:19A, :19B, :20C, :23D, :50E},
    :Z{:50A, :12B, :50C, :15D, :11E};

my %demand = :30A, :20B, :70C, :30D, :60E;
my %supply = :50W, :60X, :50Y, :50Z;

my @cols = %demand.keys.sort;

my %res;
my %g = (|%supply.keys.map: -> $x { $x => [%costs{$x}.sort(*.value)».key]}),
   (|%demand.keys.map: -> $x { $x => [%costs.keys.sort({%costs{$_}{$x}})]});

while (+%g) {
    my @d = %demand.keys.map: -> $x
      {[$x, my $z = %costs{%g{$x}[0]}{$x},%g{$x}[1] ?? %costs{%g{$x}[1]}{$x} - $z !! $z]}

    my @s = %supply.keys.map: -> $x
      {[$x, my $z = %costs{$x}{%g{$x}[0]},%g{$x}[1] ?? %costs{$x}{%g{$x}[1]} - $z !! $z]}

    @d = |@d.grep({ (.[2] == max @d».[2]) }).&min: :by(*.[1]);
    @s = |@s.grep({ (.[2] == max @s».[2]) }).&min: :by(*.[1]);

    my ($t, $f) = @d[2] == @s[2] ?? (@s[1],@d[1]) !! (@d[2],@s[2]);
    my ($d, $s) = $t > $f ?? (@d[0],%g{@d[0]}[0]) !! (%g{@s[0]}[0], @s[0]);

    my $v = %supply{$s} min %demand{$d};

    %res{$s}{$d} += $v;
    %demand{$d} -= $v;

    if (%demand{$d} == 0) {
        %supply.grep( *.value != 0 )».key.map: -> $v
          { %g{$v}.splice((%g{$v}.first: * eq $d, :k),1) };
        %g{$d}:delete;
        %demand{$d}:delete;
    }

    %supply{$s} -= $v;

    if (%supply{$s} == 0) {
        %demand.grep( *.value != 0 )».key.map: -> $v
          { %g{$v}.splice((%g{$v}.first: * eq $s, :k),1) };
        %g{$s}:delete;
        %supply{$s}:delete;
    }
}

say join "\t", flat '', @cols;
my $total;
for %costs.keys.sort -> $g {
    print "$g\t";
    for @cols -> $col {
        print %res{$g}{$col} // '-', "\t";
        $total += (%res{$g}{$col} // 0) * %costs{$g}{$col};
    }
    print "\n";
}
say "\nTotal cost: $total";

```

Output:

```
	A	B	C	D	E
W	-	-	50	-	-
X	30	-	20	-	10
Y	-	20	-	30	-
Z	-	-	-	-	50

Total cost: 3100
```


[User]
A Voronoi diagram is a diagram consisting of a number of sites.

Each Voronoi site *s* also has a Voronoi cell consisting of all points closest to *s*.

Task

Demonstrate how to generate and display a Voroni diagram.

See algo K-means++ clustering.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

**Translation of**: Python

Perhaps "Inspired by Python" would be more accurate.

Generates a Euclidean, a Taxicab and a Minkowski Voronoi diagram using the same set of domain points and colors.

```
use Image::PNG::Portable;

my @bars = '▁▂▃▅▆▇▇▆▅▃▂▁'.comb;

my %type = ( # Voronoi diagram type distance calculation
    'Taxicab'   => sub ($px, $py, $x, $y) { ($px - $x).abs  + ($py - $y).abs  },
    'Euclidean' => sub ($px, $py, $x, $y) { ($px - $x)²     + ($py - $y)²     },
    'Minkowski' => sub ($px, $py, $x, $y) { ($px - $x)³.abs + ($py - $y)³.abs },
);

my $width  = 400;
my $height = 400;
my $dots   = 30;

my @domains = map { Hash.new(
    'x' => (5..$width-5).roll,
    'y' => (5..$height-5).roll,
    'rgb' => [(64..255).roll xx 3]
) }, ^$dots;

for %type.keys -> $type {
    print "\nGenerating $type diagram...    ", ' ' x @bars;
    my $img = voronoi(@domains, :w($width), :h($height), :$type);
    @domains.map: *.&dot($img);
    $img.write: "Voronoi-{$type}-perl6.png";
}

sub voronoi (@domains, :$w, :$h, :$type) {
    my $png = Image::PNG::Portable.new: :width($w), :height($h);
    (^$w).race.map: -> $x {
        print "\b" x 2+@bars, @bars.=rotate(1).join , '  ';
        for ^$h -> $y {
            my ($, $i) = min @domains.map: { %type{$type}(%($_)<x>, %($_)<y>, $x, $y), $++ };
            $png.set: $x, $y, |@domains[$i]<rgb>
        }
    }
    $png
}

sub dot (%h, $png, $radius = 3) {
    for (%h<x> X+ -$radius .. $radius) X (%h<y> X+ -$radius .. $radius) -> ($x, $y) {
            $png.set($x, $y, 0, 0, 0) if ( %h<x> - $x + (%h<y> - $y) * i ).abs <= $radius;
    }
}

```

See Euclidean, Taxicab & Minkowski Voronoi diagram example images.


[User]
Definition

A *Wagstaff prime* is a prime number of the form *(2^p + 1)/3* where the exponent *p* is an odd prime.

Example

(2^5 + 1)/3 = 11 is a Wagstaff prime because both 5 and 11 are primes.

Task

Find and show here the first *10* Wagstaff primes and their corresponding exponents *p*.

Stretch (requires arbitrary precision integers)

Find and show here the exponents *p* corresponding to the next *14* Wagstaff primes (not the primes themselves) and any more that you have the patience for.

When testing for primality, you may use a method which determines that a large number is probably prime with reasonable certainty.

Note

It can be shown (see talk page) that *(2^p + 1)/3* is always integral if *p* is odd. So there's no need to check for that prior to checking for primality.

References

* Wikipedia - Wagstaff prime
* OEIS:A000979 - Wagstaff primes

[Assistant]
```
# First 20

my @wagstaff = (^∞).grep: { .is-prime && ((1 + 1 +< $_)/3).is-prime };

say ++$ ~ ": $_ - {(1 + 1 +< $_)/3}" for @wagstaff[^20];

say .fmt("\nTotal elapsed seconds: (%.2f)\n") given (my $elapsed = now) - INIT now;

# However many I have patience for

my atomicint $count = 20;

hyper for @wagstaff[20] .. * {
    next unless .is-prime;
    say ++⚛$count ~ ": $_ ({sprintf "%.2f", now - $elapsed})" and $elapsed = now if is-prime (1 + 1 +< $_)/3;
}

```

Output:

*Turns out, "however many I have patience for" is 9 (29).*

```
1: 3 - 3
2: 5 - 11
3: 7 - 43
4: 11 - 683
5: 13 - 2731
6: 17 - 43691
7: 19 - 174763
8: 23 - 2796203
9: 31 - 715827883
10: 43 - 2932031007403
11: 61 - 768614336404564651
12: 79 - 201487636602438195784363
13: 101 - 845100400152152934331135470251
14: 127 - 56713727820156410577229101238628035243
15: 167 - 62357403192785191176690552862561408838653121833643
16: 191 - 1046183622564446793972631570534611069350392574077339085483
17: 199 - 267823007376498379256993682056860433753700498963798805883563
18: 313 - 5562466239377370006237035693149875298444543026970449921737087520370363869220418099018130434731
19: 347 - 95562442332919646317117537304253622533190207882011713489066201641121786503686867002917439712921903606443
20: 701 - 3506757267698915671493993255253419110366893201882115906332187268712488102864720548075777690851725634151321979237452145142012954833455869242085209847101253899970149114085629732127775838589548478180862167823854251

Total elapsed seconds: (0.09)

21: 1709 (0.87)
22: 2617 (0.92)
23: 3539 (2.03)
24: 5807 (13.18)
25: 10501 (114.14)
26: 10691 (114.14)
27: 11279 (48.13)
28: 12391 (92.99)
29: 14479 (179.87)
^C
```


[User]
Task

Walk a given directory and print the *names* of files matching a given pattern.

(How is "pattern" defined? substring match? DOS pattern? BASH pattern? ZSH pattern? Perl regular expression?)

**Note:** This task is for non-recursive methods.   These tasks should read a *single directory*, not an entire directory tree.

**Note:** Please be careful when running any code presented here.

Related task

* Walk Directory Tree   (read entire directory tree).

[Assistant]
(formerly Perl 6)
The `dir` function takes the directory to traverse, and optionally a named parameter `test`, which is smart-matched against the basename of each file (so for example we can use a regex):

```
.say for dir ".", :test(/foo/);

```


[User]
Task

Walk a given directory *tree* and print files matching a given pattern.

**Note:** This task is for recursive methods.   These tasks should read an entire directory tree, not a *single directory*.

**Note:** Please be careful when running any code examples found here.

Related task

* Walk a directory/Non-recursively   (read a *single directory*).

[Assistant]
(formerly Perl 6)

Using the File::Find module:

```
use File::Find;

.say for find dir => '.', name => /'.txt' $/;

```

Alternatively, a custom solution that provides the same interface as the built-in (non-recursive) dir function, and uses gather/take to return a lazy sequence:

```
sub find-files ($dir, Mu :$test) {
    gather for dir $dir -> $path {
        if $path.basename ~~ $test { take $path }
        if $path.d                 { .take for find-files $path, :$test };
    }
}

.put for find-files '.', test => /'.txt' $/;

```

Or if you value performance over portability, here's a function that runs the GNU find program and returns a lazy sequence of the files it finds. Parameters are not subjected to shell expansion, and the null-byte (which cannot be present in file paths) is used as the path delimiter, so it should be pretty safe.

```
sub find-files ($dir, :$pattern) {
    run('find', $dir, '-iname', $pattern, '-print0', :out, :nl«\0»).out.lines;
}

.say for find-files '.', pattern => '*.txt';

```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at Walsh matrix. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |

A **Walsh matrix** is a specific square matrix of dimensions 2*n*, where *n* is some particular natural number. The elements of the matrix are either **+1** or **−1** and its rows as well as columns are orthogonal, *i.e. dot product is zero*. Each row of a Walsh matrix corresponds to a Walsh function.

Walsh matrices are a special case of Hadamard matrices. The *naturally ordered* Hadamard (Walsh) matrix is defined by the recursive formula below, and the *sequency-ordered* Hadamard (Walsh) matrix is formed by rearranging the rows so that the number of sign changes in a row is in increasing order.

To generate a naturally ordered Walsh matrix

Matrices of dimension 2*k* for *k* ∈ *N* are given by the recursive formula:

:   W

    (

    2

    1
    )

    =

    [

    1

    1

    1

    −
    1
    ]
    ,

    W

    (

    2

    2
    )

    =

    [

    1

    1

    1

    1

    1

    −
    1

    1

    −
    1

    1

    1

    −
    1

    −
    1

    1

    −
    1

    −
    1

    1
    ]
    ,
    {\displaystyle {\displaystyle {\begin{aligned}W\left(2^{1}\right)&={\begin{bmatrix}1&1\\1&-1\end{bmatrix}},\\W\left(2^{2}\right)&={\begin{bmatrix}1&1&1&1\\1&-1&1&-1\\1&1&-1&-1\\1&-1&-1&1\\\end{bmatrix}},\end{aligned}}}}

and in general

:   W

    (

    2

    k
    )
    =

    [

    W

    (

    2

    k
    −
    1
    )

    W

    (

    2

    k
    −
    1
    )

    W

    (

    2

    k
    −
    1
    )

    −
    W

    (

    2

    k
    −
    1
    )
    ]
    =
    W
    (
    2
    )
    ⊗
    W

    (

    2

    k
    −
    1
    )
    ,
    {\displaystyle {\displaystyle W\left(2^{k}\right)={\begin{bmatrix}W\left(2^{k-1}\right)&W\left(2^{k-1}\right)\\W\left(2^{k-1}\right)&-W\left(2^{k-1}\right)\end{bmatrix}}=W(2)\otimes W\left(2^{k-1}\right),}}

for 2 ≤ *k* ∈ *N*, where ⊗ denotes the Kronecker product.

Task

* Write a routine that, given a natural number **k**, returns a **naturally ordered** Walsh matrix of order 2*k*. * Display a few sample generated matrices.
:   :   *Traditionally, Walsh matrices use **1** & **-1** to denote the different cell values in text mode, or **green** and **red** blocks in image mode. You may use whichever display mode is most convenient for your particular language.*

Stretch

* Also, optionally generate **sequency ordered** Walsh matrices.
:   :   *A sequency ordered Walsh matrix has the rows sorted by number of sign changes.*

See also

* Wikipedia: Walsh matrix * Related task: Kronecker product

[Assistant]
```
sub walsh (\m) { (map {$_?? -1 !! ' 1'}, map { :3(.base: 2) % 2 }, [X+&] ^2**m xx 2 ).batch: 2**m }

sub natural (@row) { Same }

sub sign-changes (@row) { sum (1..^@row).map: { 1 if @row[$_] !== @row[$_ - 1] } }

use SVG;

for &natural, 'natural', &sign-changes, 'sequency' -> &sort, $sort {
    for 2,4,5 -> $order {
        # ASCII text
        .put for "\nWalsh matrix - order $order ({exp($order,2)} x {exp($order,2)}), $sort order:", |walsh($order).sort: &sort;

        # SVG image
        my $side = 600;
        my $scale = $side / 2**$order;
        my $row = 0;
        my @blocks;
        my %C = ' 1' => '#0F0', '-1' => '#F00';

        for walsh($order).sort: &sort -> @row {
            my \x = $row++ * $scale;
            for @row.kv {
                my \y = $^k * $scale;
                @blocks.push: (:rect[:x(x),:y(y),:width($scale),:height($scale),:fill(%C{$^v})]);
            }
        }

        "walsh-matrix--order-{$order}--{$sort}-sort-order--raku.svg".IO.spurt:
          SVG.serialize(:svg[:width($side),:height($side),:stroke<black>,:stroke-width<1>,|@blocks])
    }
}

```

Output:

```
Walsh matrix - order 2 (4 x 4), natural order:
 1  1  1  1
 1 -1  1 -1
 1  1 -1 -1
 1 -1 -1  1

Walsh matrix - order 4 (16 x 16), natural order:
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1

Walsh matrix - order 5 (32 x 32), natural order:
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1

Walsh matrix - order 2 (4 x 4), sequency order:
 1  1  1  1
 1  1 -1 -1
 1 -1 -1  1
 1 -1  1 -1

Walsh matrix - order 4 (16 x 16), sequency order:
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1

Walsh matrix - order 5 (32 x 32), sequency order:
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1
 1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1
 1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1  1  1  1  1 -1 -1 -1 -1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1
 1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1
 1  1 -1 -1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1
 1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1
 1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1  1  1 -1 -1  1  1 -1 -1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1
 1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1
 1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1
 1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1
 1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1  1 -1 -1  1 -1  1  1 -1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1
 1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1
 1 -1  1 -1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1
 1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1
 1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1  1 -1  1 -1  1 -1  1 -1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1
 1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1  1 -1
```

| Natural order | Sequency order |
| --- | --- |
| File:Walsh-matrix--order-2--natural-sort-order--raku.svg | File:Walsh-matrix--order-2--sign-changes-sort-order--raku.svg |
| File:Walsh-matrix--order-4--natural-sort-order--raku.svg | File:Walsh-matrix--order-4--sign-changes-sort-order--raku.svg |
| File:Walsh-matrix--order-5--natural-sort-order--raku.svg | File:Walsh-matrix--order-5--sign-changes-sort-order--raku.svg |


[User]
War Card Game

Simulate the card game War. Use the Bicycle playing card manufacturer's rules. Show a game as played. User input is optional.

References:

:   * Bicycle card company: War game site

:   * Wikipedia: War (card game)

Related tasks:

* Playing cards
* Card shuffles
* Deal cards for FreeCell
* Poker hand\_analyser
* Go Fish

[Assistant]
The linked Bicycle cards site has slightly different rules for War! than how I used to play when I was but a lad. Implement it both ways.

Some rules are not nailed down very well. Here is how I interpreted it:

* The values of the cards 2-10 are face value; Jack, Queen, King and Ace may effectively be treated as: 11, 12, 13 & 14.
* Each player plays one card face up. The player whose card is the highest value takes both of the played cards and adds them to the bottom of his deck.
* When one player runs out of cards and is not able to place enough cards to finish a round, he loses.
* If both players play a card of the same value, it is then War!
  + **Bicycle rules:** each player then plays another card face down then another face up.
  + **thundergnat rules:** each player then plays *three* cards face down then another face up. (Tends to make for shorter games.)
  + If the final face-up cards are different, the player playing the higher value card takes all of the played cards and adds them to the bottom of his deck
  + If they are the same, continue with rounds of War! until one player plays a higher value war card or a player runs out of cards.
* When the winning player picks up his cards. the cards are randomized when added to the bottom of his deck. (Cuts a typical game from multi thousands of rounds to multi hundreds of rounds)

Pass in which variant you want to play 2 down, (Bicycle), `--war=2`, 4 down (thundergnat), (default), `--war=4` or 3 down (????) , `--war=3`. By default, there is a short delay (.1 seconds) between rounds so you can watch what is going on. Pass in a larger/smaller value to slow down or speed up how long the game takes. `--sleep=0` or whatever.

In glorious ANSI color! (The output loses much when pasted in as text so show output as screenshot images.)

```
unit sub MAIN (:$war where 2..4 = 4, :$sleep = .1);

my %c = ( # convenience hash of ANSI colors
    red   => "\e[38;2;255;10;0m",
    blue  => "\e[38;2;05;10;200m",
    black => "\e[38;2;0;0;0m"
);

my @cards = flat (flat
     <🂢 🂣 🂤 🂥 🂦 🂧 🂨 🂩 🂪 🂫 🂭 🂮 🂡
      🃒 🃓 🃔 🃕 🃖 🃗 🃘 🃙 🃚 🃛 🃝 🃞 🃑>.map({ "{%c<black>}$_" }),
     <🂲 🂳 🂴 🂵 🂶 🂷 🂸 🂹 🂺 🂻 🂽 🂾 🂱
      🃂 🃃 🃄 🃅 🃆 🃇 🃈 🃉 🃊 🃋 🃍 🃎 🃁>.map({ "{%c<red>}$_" })
).batch(13).map({ .flat Z 2..14 })».map: { .[1] but .[0] };

my $back = "{%c<blue>}🂠";
my @won  = <👈 👉>;

sub shuffle (@cards) { @cards.pick: * }
sub deal    (@cards) { [@cards[0,*+2 … *], @cards[1,*+2 … *]] }

my ($rows, $cols) = qx/stty size/.words».Int; # get the terminal size
note "Terminal is only $cols characters wide, needs to be at least 80, 120 or more recommended."
  and exit if $cols < 80;

sub clean-up {
    reset-scroll-region;
    show-cursor;
    print-at $rows, 1, '';
    print "\e[0m";
    exit(0)
}

signal(SIGINT).tap: { clean-up() }

my @index  = ($cols div 2 - 5, $cols div 2 + 4);
my @player = (deal shuffle @cards)».Array;
my $lose   = False;

sub take (@player, Int $cards) {
    if +@player >= $cards {
        return @player.splice(0, $cards);
    }
    else {
         $lose = True;
         return @player.splice(0, +@player);
    }
}

use Terminal::ANSI;

clear-screen;
hide-cursor;
# Set background color
print "\e[H\e[J\e[48;2;245;245;245m", ' ' xx $rows * $cols + 1;

# Add header
print-at 1, $cols div 2 - 1, "{%c<red>}WAR!";
print-at 2, 1, '━' x $cols;

my $row = 3;
my $height = $rows - $row - 2;
set-scroll-region($row, $height);

# footer
print-at $height + 1, 1, '━' x $cols;

my $round = 0;
my @round;

loop {
    @round = [@player[0].&take(1)], [@player[1].&take(1)] unless +@round;
    print-at $row, $cols div 2, "{%c<red>}┃";
    print-at $row, @index[0], @round[0;0] // ' ';
    print-at $row, @index[1], @round[1;0] // ' ';
    if $lose {
        if @player[0] < @player[1] {
            print-at $row, $cols div 2 + 1, @won[1] unless +@round[1] == 1;
            print-at $height + 3, $cols div 2 - 10, "{%c<red>} Player 1 is out of cards "
        } else {
            print-at $row, $cols div 2 - 2, @won[0] unless +@round[0] == 1;
            print-at $height + 3, $cols div 2 - 10, "{%c<red>} Player 2 is out of cards "
        }

    }
    if (@round[0].tail // 0) > (@round[1].tail // 0) {
        print-at $row, $cols div 2 - 2, @won[0];
        @player[0].append: flat (|@round[0],|@round[1]).pick: *;
        @round = ();
    }
    elsif (@round[0].tail // 0) < (@round[1].tail // 0) {
        print-at $row, $cols div 2 + 1, @won[1];
        @player[1].append: flat (|@round[0],|@round[1]).pick: *;
        @round = ();
    }
    else {
        @round[0].append: @player[0].&take($war);
        @round[1].append: @player[1].&take($war);
        print-at $row, @index[0] - $_ * 2, ($_ %% $war) ?? @round[0; $_] !! $back for ^@round[0];
        print-at $row, @index[1] + $_ * 2, ($_ %% $war) ?? @round[1; $_] !! $back for ^@round[1];
        next
    }
    last if $lose;
    print-at $height + 2, $cols div 2 - 4,  "{%c<blue>} Round {++$round} ";
    print-at $height + 2, $cols div 2 - 40, "{%c<blue>} Player 1: {+@player[0]} cards ";
    print-at $height + 2, $cols div 2 + 21, "{%c<blue>} Player 2: {+@player[1]} cards ";
    sleep $sleep if +$sleep;
    if $row >= $height { scroll-up } else { ++$row }
}

# game over
print-at $height + 2, $cols div 2 - 40, "{%c<blue>} Player 1: {+@player[0] ?? '52' !! "{%c<red>}0"}{%c<blue>} cards ";
print-at $height + 2, $cols div 2 + 20, "{%c<blue>} Player 2: {+@player[1] ?? '52' !! "{%c<red>}0"}{%c<blue>} cards ";
clean-up;

```

Sample outout Bicycle:

Pass in `:war=2` on the command line.
See Bicycle variation (offsite png image)

Sample outout using defaults:

See thundergnat variation (offsite png image)


[User]
Definitions

Let **n** be a positive integer and **l(n)** be the number of its digits in base **b**.

Express **n** as the product of its prime factors raised to the appropriate powers. Let **D(n)** be the total number of its base **b** digits in all its prime factors and in all their exponents that are greater than 1.

Then **n** is defined to be:

1. a wasteful (or extravagant) number if l(n) **<** D(n); or

2. an equidigital number if l(n) **=** D(n); or

3. a frugal (or economical) number if l(n) **>** D(n)

in base **b**.

By convention, the number **1** is considered to be an **equidigital** number in **any** base even though it has no prime factors.

For the avoidance of any doubt, the number **0** is not a positive integer (and arguably not a natural number either) and so is excluded from all 3 categories.

An **economical** number is sometimes defined as being one for which l(n) **>=** D(n) though this usage won't be followed here.

Examples

In base 10, the number 30 has a prime factorization of 2 x 3 x 5. The total number of digits is 3 (all exponents being 1) which is more than the 2 digits 30 has. So 30 is wasteful in base 10.

In base 10, the number 49 has a prime factorization of 7². The total number of digits, including those of the exponent, is 2 which is the same as the 2 digits 49 has. So 49 is equidigital in base 10.

In base 10, the number 125 has a prime factorization of 5³. The total number of digits, including those of the exponent, is 2 which is less than the 3 digits 125 has. So 125 is frugal in base 10.

In base 2, the number 100000 (32 decimal) has a prime factorization of 10^101 (2^5 decimal). The total number of binary digits, including those of the exponent, is 5 which is less than the 6 binary digits 100000 has. So 32 is frugal in base 2 (but equidigital in base 10).

Task

Compute and show here the first **50** and the **10,000th** number in base **10** for each of the three categories of number defined above.

Also compute and show how many numbers less than **1,000,000** fall into each of the three categories.

Bonus

Do the same for base **11**, but show the results in base **10**.

References

* OEIS: A046760 - Wasteful numbers
* OEIS: A046758 - Equidigital numbers
* OEIS: A046759 - Economical numbers

[Assistant]
```
use Prime::Factor;
use Lingua::EN::Numbers;

my %cache;

sub factor-char-sum ($n, $base = 10) { sum $n.&prime-factors.Bag.map: { .key.base($base).chars + (.value > 1 ?? .value.base($base).chars !! 0) } }

sub economical  ($n, $base = 10) { ($n >  1) && $n.base($base).chars >  (%cache{$base}[$n] //= factor-char-sum $n, $base) }
sub equidigital ($n, $base = 10) { ($n == 1) || $n.base($base).chars == (%cache{$base}[$n] //= factor-char-sum $n, $base) }
sub extravagant ($n, $base = 10) {              $n.base($base).chars <  (%cache{$base}[$n] //= factor-char-sum $n, $base) }

for 10, 11 -> $base {
    %cache{$base}[3e6] = Any; # preallocate to avoid concurrency issues
    say "\nIn Base $base:";
    for &extravagant, &equidigital, &economical -> &sub {
        say "\nFirst 50 {&sub.name} numbers:";
        say (^∞).grep( {.&sub($base)} )[^50].batch(10)».&comma».fmt("%6s").join: "\n";
        say "10,000th: " ~ (^∞).hyper(:2000batch).grep( {.&sub($base)} )[9999].,
    }

    my $upto = 1e6.Int;
    my atomicint ($extravagant, $equidigital, $economical);
    say "\nOf the positive integers up to {$upto.&cardinal}:";
    (1..^$upto).race(:5000batch).map: { .&extravagant($base) ?? ++⚛$extravagant !! .&equidigital($base) ?? ++⚛$equidigital !! ++⚛$economical };
    say " Extravagant: {comma $extravagant}\n Equidigital: {comma $equidigital}\n  Economical: {comma $economical}";
    %cache{$base} = Empty;
}

```

Output:

```
In Base 10:

First 50 extravagant numbers:
     4      6      8      9     12     18     20     22     24     26
    28     30     33     34     36     38     39     40     42     44
    45     46     48     50     51     52     54     55     56     57
    58     60     62     63     65     66     68     69     70     72
    74     75     76     77     78     80     82     84     85     86
10,000th: 14,346

First 50 equidigital numbers:
     1      2      3      5      7     10     11     13     14     15
    16     17     19     21     23     25     27     29     31     32
    35     37     41     43     47     49     53     59     61     64
    67     71     73     79     81     83     89     97    101    103
   105    106    107    109    111    112    113    115    118    119
10,000th: 33,769

First 50 economical numbers:
   125    128    243    256    343    512    625    729  1,024  1,029
 1,215  1,250  1,280  1,331  1,369  1,458  1,536  1,681  1,701  1,715
 1,792  1,849  1,875  2,048  2,187  2,197  2,209  2,401  2,560  2,809
 3,125  3,481  3,584  3,645  3,721  4,096  4,374  4,375  4,489  4,802
 4,913  5,041  5,103  5,329  6,241  6,250  6,561  6,859  6,889  7,203
10,000th: 1,953,125

Of the positive integers up to one million:
 Extravagant: 831,231
 Equidigital: 165,645
  Economical: 3,123

In Base 11:

First 50 extravagant numbers:
     4      6      8      9     10     12     18     20     22     24
    26     28     30     33     34     36     38     39     40     42
    44     45     46     48     50     51     52     54     55     56
    57     58     60     62     63     65     66     68     69     70
    72     74     75     76     77     78     80     82     84     85
10,000th: 12,890

First 50 equidigital numbers:
     1      2      3      5      7     11     13     14     15     16
    17     19     21     23     25     27     29     31     32     35
    37     41     43     47     49     53     59     61     64     67
    71     73     79     81     83     89     97    101    103    107
   109    113    121    122    123    127    129    131    133    134
10,000th: 33,203

First 50 economical numbers:
   125    128    243    256    343    512    625    729  1,024  1,331
 1,369  1,458  1,536  1,681  1,701  1,715  1,792  1,849  1,875  2,048
 2,187  2,197  2,209  2,401  2,560  2,809  3,072  3,125  3,481  3,584
 3,645  3,721  4,096  4,374  4,375  4,489  4,802  4,913  5,041  5,103
 5,120  5,329  6,241  6,250  6,561  6,859  6,889  7,168  7,203  7,921
10,000th: 2,659,171

Of the positive integers up to one million:
 Extravagant: 795,861
 Equidigital: 200,710
  Economical: 3,428
```


[User]
Task

In a two-dimensional world, we begin with any bar-chart (or row of close-packed 'towers', each of unit width), and then it rains,
completely filling all convex enclosures in the chart with water.

```
9               ██           9               ██
8               ██           8               ██
7     ██        ██           7     ██≈≈≈≈≈≈≈≈██
6     ██  ██    ██           6     ██≈≈██≈≈≈≈██
5 ██  ██  ██  ████           5 ██≈≈██≈≈██≈≈████
4 ██  ██  ████████           4 ██≈≈██≈≈████████
3 ██████  ████████           3 ██████≈≈████████
2 ████████████████  ██       2 ████████████████≈≈██
1 ████████████████████       1 ████████████████████
```

In the example above, a bar chart representing the values [5, 3, 7, 2, 6, 4, 5, 9, 1, 2] has filled, collecting 14 units of water.

Write a function, in your language, from a given array of heights, to the number of water units that can be held in this way, by a corresponding bar chart.

Calculate the number of water units that could be collected by bar charts representing each of the following seven series:

```
   [[1, 5, 3, 7, 2],
    [5, 3, 7, 2, 6, 4, 5, 9, 1, 2],
    [2, 6, 3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1],
    [5, 5, 5, 5],
    [5, 6, 7, 8],
    [8, 7, 7, 6],
    [6, 7, 10, 7, 6]]
```

See, also:

* Four Solutions to a Trivial Problem – a Google Tech Talk by Guy Steele
* Water collected between towers on Stack Overflow, from which the example above is taken)
* An interesting Haskell solution, using the Tardis monad, by Phil Freeman in a Github gist.

[Assistant]
(formerly Perl 6)

**Translation of**: Haskell

```
sub max_l ( @a ) {  [\max] @a }
sub max_r ( @a ) { ([\max] @a.reverse).reverse }

sub water_collected ( @towers ) {
    return 0 if @towers <= 2;

    my @levels = max_l(@towers) »min« max_r(@towers);

    return ( @levels »-« @towers ).grep( * > 0 ).sum;
}

say map &water_collected,
    [ 1, 5,  3, 7, 2 ],
    [ 5, 3,  7, 2, 6, 4, 5, 9, 1, 2 ],
    [ 2, 6,  3, 5, 2, 8, 1, 4, 2, 2, 5, 3, 5, 7, 4, 1 ],
    [ 5, 5,  5, 5 ],
    [ 5, 6,  7, 8 ],
    [ 8, 7,  7, 6 ],
    [ 6, 7, 10, 7, 6 ],
;

```

Output:

```
(2 14 35 0 0 0 0)
```


[User]
This task has been flagged for clarification. Code on this page in its current state may be flagged incorrect once this task has been clarified. See this page's Talk page for discussion.

The **Wave Function Collapse** algorithm is a heuristic for generating tiled images.

The algorithm begins with a collection of equal sized image blocks and randomly places them, one at a time, within a grid subject to the tiling constraint and an entropy constraint, and it wraps (the top row of blocks in the grid is treated as *adjacent* to the bottom row of blocks, and similarly the left and right columns of blocks are treated as adjacent to each other).

The blocks are tiled within the grid. *Tiled* means they are placed with a one pixel overlap and the tiling constraint requires that the pixels overlapping border between two adjacent blocks match.

*Entropy*, here, means the number of blocks eligible to be placed in an unassigned grid location. The entropy constraint here is that each block is placed in a grid location with minimum entropy. (Placing a block may constrain the entropy of its four nearest neighbors -- up, down, left, right.)

For this task, we start with five blocks of 3x3 pixels and place them in an 8x8 grid to form a 17x17 tile. A tile is a block which may be tiled with itself. Here, we show these five blocks adjacent but not *tiled*:

|  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |
| --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- |
| |  |  |  | | --- | --- | --- | |  |  |  | |  |  |  | |  |  |  | | |  |  |  | | --- | --- | --- | |  |  |  | |  |  |  | |  |  |  | | |  |  |  | | --- | --- | --- | |  |  |  | |  |  |  | |  |  |  | | |  |  |  | | --- | --- | --- | |  |  |  | |  |  |  | |  |  |  | | |  |  |  | | --- | --- | --- | |  |  |  | |  |  |  | |  |  |  | |

Note that this algorithm sometimes does not succeed. If an unassigned grid location has an entropy of 0, the algorithm fails and returns an empty or null result. We'll ignore those failure cases for this task.

Reference WFC explained and another WFC explained

[Assistant]
**Translation of**: C

```
# 20220728 Raku programming solution

my @Blocks = ( [   <0 0 0>,
                   <0 0 0>,
		   <0 0 0>    ],
               [   <0 0 0>,
	           <1 1 1>,
		   <0 1 0>    ],
               [   <0 1 0>,
	           <0 1 1>,
	       	   <0 1 0>    ],
               [   <0 1 0>,
	           <1 1 1>,
	       	   <0 0 0>    ],
               [   <0 1 0>,
	           <1 1 0>,
	       	   <0 1 0>    ], );

sub XY(\row, \col, \width) { col+row*width }
sub XYZ(\page, \row, \col, \height, \width) {
   XY( XY(page, row, height), col, width)
}

sub wfc(@blocks, @bdim, @tdim) {

   my \N  = [*] my (\td0,\td1) = @tdim[0,1];
   my @adj; # indices in R of the four adjacent blocks
   for ^td0 X ^td1 -> (\i,\j) {                        # in a 3x3 grid
      @adj[XYZ(i,j,0,td1,4)]= XY((i-1)%td0,j%td1,td1); # above (index 1)
      @adj[XYZ(i,j,1,td1,4)]= XY(i%td0,(j-1)%td1,td1); # left  (index 3)
      @adj[XYZ(i,j,2,td1,4)]= XY(i%td0,(j+1)%td1,td1); # right (index 5)
      @adj[XYZ(i,j,3,td1,4)]= XY((i+1)%td0,j%td1,td1); # below (index 7)
   }

   my (\bd0,\bd1,\bd2) = @bdim[0..2];
   my @horz; # blocks which can sit next to each other horizontally
   for ^bd0 X ^bd0 -> (\i,\j) {
      @horz[XY(i,j,bd0)] = 1;
      for ^bd1 -> \k {
         @horz[XY(i, j, bd0)]= 0 if @blocks[XYZ(i, k,     0, bd1, bd2)] !=
	                            @blocks[XYZ(j, k, bd2-1, bd1, bd2)]
      }
   }

   my @vert; # blocks which can sit next to each other vertically */
   for  ^bd0 X ^bd0 -> (\i,\j) {
      @vert[XY(i,j,bd0)] = 1;
      for ^bd2 -> \k {
         if @blocks[XYZ(i,     0, k, bd1, bd2)] !=
	    @blocks[XYZ(j, bd1-1, k, bd1, bd2)] {
	    @vert[XY(i, j, bd0)]= 0 andthen last;
	 }
      }
   }

   my @allow = 1 xx 4*(bd0+1)*bd0; # all block constraints, based on neighbors
   for  ^bd0 X ^bd0 -> (\i,\j) {
      @allow[XYZ(0, i, j, bd0+1, bd0)] = @vert[XY(j, i, bd0)]; # above (north)
      @allow[XYZ(1, i, j, bd0+1, bd0)] = @horz[XY(j, i, bd0)]; # left  (west)
      @allow[XYZ(2, i, j, bd0+1, bd0)] = @horz[XY(i, j, bd0)]; # right (east)
      @allow[XYZ(3, i, j, bd0+1, bd0)] = @vert[XY(i, j, bd0)]; # below (south)
   }

   my (@R, @todo, @wave, @entropy, @indices, $min, @possible) = bd0 xx N;
   loop {
      my $c = 0;
      for ^N { @todo[$c++] = $_ if bd0 == @R[$_] }
      last unless $c;
      $min = bd0;
      for ^$c -> \i {
         @entropy[i]= 0;
         for ^bd0 -> \j {
            @entropy[i] +=
               @wave[XY(i, j, bd0)] =
                  @allow[XYZ(0, @R[@adj[XY(@todo[i],0,4)]], j, bd0+1, bd0)] +&
                  @allow[XYZ(1, @R[@adj[XY(@todo[i],1,4)]], j, bd0+1, bd0)] +&
                  @allow[XYZ(2, @R[@adj[XY(@todo[i],2,4)]], j, bd0+1, bd0)] +&
                  @allow[XYZ(3, @R[@adj[XY(@todo[i],3,4)]], j, bd0+1, bd0)]
         }
	 $min = @entropy[i] if @entropy[i] < $min
      }

      unless $min { @R=[] andthen last } # original behaviour
      #unless $min { @R = bd0 xx N andthen redo } # if failure is not an option

      my $d = 0;
      for ^$c { @indices[$d++] = $_ if $min == @entropy[$_] }
      my \ind = bd0 * my \ndx = @indices[ ^$d .roll ];
      $d = 0;
      for ^bd0 { @possible[$d++] = $_ if @wave[ind+$_]  }
      @R[@todo[ndx]] = @possible[ ^$d .roll ];
   }

   exit unless @R.Bool;

   my @tile;
   for ^td0 X ^bd1 X ^td1 X ^bd2 -> (\i0,\i1,\j0,\j1) {
      @tile[XY(XY(j0, j1, bd2-1), XY(i0, i1, bd1-1), 1+td1*(bd2-1))] =
         @blocks[XYZ(@R[XY(i0, j0, td1)], i1, j1, bd1, bd2)]
   }

   return @tile
}

my (@bdims,@size) := (5,3,3), (8,8);

my @tile = wfc @Blocks».List.flat, @bdims, @size  ;

say .join.trans( [ '0', '1' ] => [ '  ', '# ' ] ) for @tile.rotor(17)

```

Output:

```
          #           #   #
# # # # # # # # # # # # # # # # #
  #   #       #   #           #
  # # # # # # #   # # # # # # #
  #       #   #   #   #   #   #
  # # # # #   # # #   # # # # #
  #   #   #   #   #   #       #
# #   # # # # #   # # #       # #
  #   #       #   #   #       #
# #   # # # # # # # # #       # #
  #   #   #           #       #
# #   # # #           # # # # # #
  #   #   #           #   #
# #   # # #           # # # # # #
  #   #   #           #       #
# # # # # #           # # # # # #
          #           #   #

```


[User]
Analyse a given section of monophonic audio waveform, for average pitch and output one of the sol-fa trigraphs (like these, except each has three letters) corresponding to average pitch level: Doh, Ray, Mee, Fah, Soh, Lah, Tee, doh.

Optionally, follow the trigraph with a plus or minus symbol, to indicate whether the note falls above or below the solfa. Extend the scale to cover 21 notes: DOH, RAY, MEE, FAH, SOH, LAH, TEE, Doh, Ray, Mee, Fah, Soh, Lah, Tee, doh, ray, mee, fah, soh, lah, tee.

A calibration parameter can be provided to suit different voices. This can be provided as a variable defined within the code.

[Assistant]
The input .wav file (notes.wav) is created by the [Musical Scale#Go] entry.

**Translation of**: Go

```
# 20200721 Raku programming solution

my \freqs = < 261.6 293.6 329.6 349.2 392.0 440.0 493.9 523.3 >;
my \notes = < Doh Ray Mee Fah Soh Lah Tee doh >;

sub getNote (\freq) {
   my $index = freqs;
   for (0..^$index) { $index = $_ and last if freq ≤ freqs[$_] }
   given $index {
      when 0     { "Doh-" }
      when freqs { "doh+" }
      default    { freqs[$index] - freq ≤ freq - freqs[$index-1]
                       ?? notes[$index] ~ "-" !! notes[$index-1] ~ "+" }
   }
}

my $file = slurp "./notes.wav", :bin or die;

# http://www.topherlee.com/software/pcm-tut-wavformat.html
# https://stackoverflow.com/a/49081648/3386748

my $sampleRate = Blob.new(@$file[24..27]).read-uint32(0,LittleEndian);
# self-ref: [+] @$file[24..27].pairs.map: {$_.value*256**$_.key};
say "Sample Rate    : ", $sampleRate;

my $dataLength = Blob.new(@$file[40..43]).read-uint32(0,LittleEndian);
# self-ref: [+] @$file[40..43].pairs.map: {$_.value*256**$_.key};
my $duration = $dataLength / $sampleRate;
say "Duration       : ", $duration;

my ( $sum, $sampleRateF )  =  ( 0, $sampleRate.Num ) ;
my $nbytes = 20;

say "Bytes examined : ", $nbytes, " per sample";

for @$file[44..*].rotor($sampleRate) -> $data {
   for (1..$nbytes) -> $k {
      my $bf = @$data[$k] / 32;
      $sum += $bf.asin × $sampleRateF / ( 2 × π × $k );
   }
}

my $cav = $sum / ( $duration * $nbytes );
say "Computed average frequency = {$cav.fmt('%.1f')} Hz ({getNote($cav)})";

my $aav = ([+] freqs) / freqs;
say "Actual   average frequency = {$aav.fmt('%.1f')} Hz ({getNote($aav)})";

```

Output:

```
go run Musical_scale.go
file notes.wav
notes.wav: RIFF (little-endian) data, WAVE audio, Microsoft PCM, 8 bit, mono 44100 Hz
./Doh_ray_me.raku
Sample Rate    : 44100
Duration       : 8
Bytes examined : 20 per sample
Computed average frequency = 387.1 Hz (Soh-)
Actual   average frequency = 385.4 Hz (Soh-)

```


[User]
Task

Create a program that downloads the time from this URL:   http://tycho.usno.navy.mil/cgi-bin/timer.pl   and then prints the current UTC time by extracting just the UTC time from the web page's HTML. Alternatively, if the above url is not working, grab the first date/time off this page's talk page.

If possible, only use libraries that come at no *extra* monetary cost with the programming language and that are widely available and popular such as CPAN for Perl or Boost for C++.

[Assistant]
(formerly Perl 6)

```
# 20210301 Updated Raku programming solution

use HTTP::Client; # https://github.com/supernovus/perl6-http-client/

#`[ Site inaccessible since 2019 ?
my $site = "http://tycho.usno.navy.mil/cgi-bin/timer.pl";
HTTP::Client.new.get($site).content.match(/'<BR>'( .+? <ws> UTC )/)[0].say
# ]

my $site = "https://www.utctime.net/";
my $matched = HTTP::Client.new.get($site).content.match(
   /'<td>UTC</td><td>'( .*Z )'</td>'/
)[0];

say $matched;
#$matched = '12321321:412312312 123';
with DateTime.new($matched.Str) {
   say 'The fetch result seems to be of a valid time format.'
} else {
   CATCH { put .^name, ': ', .Str }
}

```

Note that the string between '<' and '>' refers to regex tokens, so to match a literal '<BR>' you need to quote it, while <ws> refers to the built-in token whitespace.
Also, whitespace is ignored by default in Raku regexes.

Output:

```
｢2021-03-01T17:02:37Z｣
The fetch result seems to be of a valid time format.

```


[User]
In number theory, a weird number is a natural number that is abundant but *not* semiperfect (and therefore not perfect either).

In other words, the sum of the proper divisors of the number (divisors including 1 but not itself) is greater than the number itself (the number is *abundant*), but no subset of those divisors sums to the number itself (the number is not *semiperfect*).

For example:

* **12** is *not* a weird number.
  + It is abundant; its proper divisors **1, 2, 3, 4, 6** sum to **16** (which *is* > 12),
  + but it *is* semiperfect, e.g.:     **6 + 4 + 2 == 12**.
* **70** *is* a weird number.
  + It is abundant; its proper divisors **1, 2, 5, 7, 10, 14, 35** sum to **74** (which *is* > 70),
  + and there is no subset of proper divisors that sum to **70**.

Task

Find and display, here on this page, the first **25** weird numbers.

Related tasks
:   * Abundant, deficient and perfect number classifications
    * Proper divisors

See also
:   * OEIS: A006037 weird numbers
    * Wikipedia: weird number
    * MathWorld: weird number

[Assistant]
(formerly Perl 6)

```
sub abundant (\x) {
    my @l = x.is-prime ?? 1 !! flat
    1, (2 .. x.sqrt.floor).map: -> \d {
         my \y = x div d;
         next if y * d !== x;
         d !== y ?? (d, y) !! d
    };
    (my $s = @l.sum) > x ?? ($s, |@l.sort(-*)) !! ();
}

my @weird = (2, 4, {|($_ + 4, $_ + 6)} ... *).map: -> $n {
    my ($sum, @div) = $n.&abundant;
    next unless $sum;        # Weird number must be abundant, skip it if it isn't.
    next if $sum / $n > 1.1; # There aren't any weird numbers with a sum:number ratio greater than 1.08 or so.
    if $n >= 10430 and ($n %% 70) and ($n div 70).is-prime {
        # It's weird. All numbers of the form 70 * (a prime 149 or larger) are weird
    } else {
        my $next;
        my $l = @div.shift;
        ++$next and last if $_.sum == $n - $l for @div.combinations;
        next if $next;
    }
    $n
}

put "The first 25 weird numbers:\n", @weird[^25];

```

Output:

```
The first 25 weird numbers:
70 836 4030 5830 7192 7912 9272 10430 10570 10792 10990 11410 11690 12110 12530 12670 13370 13510 13790 13930 14770 15610 15890 16030 16310
```


[User]
Given two lists of data, calculate the p-value used for Welch's t-test. This is meant to translate R's `t.test(vector1, vector2, alternative="two.sided", var.equal=FALSE)` for calculation of the p-value.

**Task Description**

Given two sets of data, calculate the p-value:

```
   x = {3.0,4.0,1.0,2.1}
   y = {490.2,340.0,433.9}

```

Your task is to discern whether or not the difference in means between the two sets is statistically significant and worth further investigation. P-values are significance tests to gauge the probability that the difference in means between two data sets is significant, or due to chance. A threshold level, alpha, is usually chosen, 0.01 or 0.05, where p-values below alpha are worth further investigation and p-values above alpha are considered not significant. The p-value is not considered a final test of significance, only whether the given variable should be given further consideration.

There is more than one way of calculating the t-statistic, and you must choose which method is appropriate for you. Here we use Welch's t-test, which assumes that the variances between the two sets `x` and `y` are not equal. Welch's t-test statistic can be computed:

t

=

X
¯

1
−

X
¯

2

s

1

2

N

1

+

s

2

2

N

2

{\displaystyle {\displaystyle t\quad =\quad {\;{\overline {X}}\_{1}-{\overline {X}}\_{2}\; \over {\sqrt {\;{s\_{1}^{2} \over N\_{1}}\;+\;{s\_{2}^{2} \over N\_{2}}\quad }}}}}

where

X
¯

n
{\displaystyle {\displaystyle {\overline {X}}\_{n}}}
 is the mean of set

n
{\displaystyle {\displaystyle n}}
,

and

N

n
{\displaystyle {\displaystyle N\_{n}}}
 is the number of observations in set

n
{\displaystyle {\displaystyle n}}
,

and

s

n
{\displaystyle {\displaystyle s\_{n}}}
 is the square root of the unbiased sample variance of set

n
{\displaystyle {\displaystyle n}}
, i.e.

s

n
=

1

N

n
−
1

∑

i
=
1

N

n

(

X

i
−

X
¯

n
)

2
{\displaystyle {\displaystyle s\_{n}={\sqrt {{\frac {1}{N\_{n}-1}}\sum \_{i=1}^{N\_{n}}\left(X\_{i}-{\overline {X}}\_{n}\right)^{2}}}}}

and the degrees of freedom,

ν
{\displaystyle {\displaystyle \nu }}
 can be approximated:

ν

≈

(

s

1

2

N

1

+

s

2

2

N

2

)

2

s

1

4

N

1

2
(

N

1
−
1
)

+

s

2

4

N

2

2
(

N

2
−
1
)

{\displaystyle {\displaystyle \nu \quad \approx \quad {{\left(\;{s\_{1}^{2} \over N\_{1}}\;+\;{s\_{2}^{2} \over N\_{2}}\;\right)^{2}} \over {\quad {s\_{1}^{4} \over N\_{1}^{2}(N\_{1}-1)}\;+\;{s\_{2}^{4} \over N\_{2}^{2}(N\_{2}-1)}\quad }}}}

The two-tailed p-value,

p
{\displaystyle {\displaystyle p}}
, can be computed as a cumulative distribution function

p

2
−
t
a
i
l
=

I

ν

t

2
+
ν

(

ν
2
,

1
2
)
{\displaystyle {\displaystyle p\_{2-tail}=I\_{\frac {\nu }{t^{2}+\nu }}\left({\frac {\nu }{2}},{\frac {1}{2}}\right)}}

where I is the regularized incomplete beta function. This is the same as:

p

2
−
t
a
i
l
=

B
(

ν

t

2
+
ν
;

ν
2
,

1
2
)

B
(

ν
2
,

1
2
)
{\displaystyle {\displaystyle p\_{2-tail}={\frac {\mathrm {B} ({\frac {\nu }{t^{2}+\nu }};{\frac {\nu }{2}},{\frac {1}{2}})}{\mathrm {B} ({\frac {\nu }{2}},{\frac {1}{2}})}}}}

Keeping in mind that

B
(
x
;
a
,
b
)
=

∫

0

x

r

a
−
1

(
1
−
r

)

b
−
1

d
r
.

{\displaystyle {\displaystyle \mathrm {B} (x;a,b)=\int \_{0}^{x}r^{a-1}\,(1-r)^{b-1}\,\mathrm {d} r.\!}}

and

B
(
x
,
y
)
=

Γ
(
x
)

Γ
(
y
)

Γ
(
x
+
y
)
=
exp

(
ln

Γ
(
x
)

Γ
(
y
)

Γ
(
x
+
y
)
)
=
exp

(
(
ln

(
Γ
(
x
)
)
+
ln

(
Γ
(
y
)
)
−
ln

(
Γ
(
x
+
y
)
)
)

{\displaystyle {\displaystyle \mathrm {B} (x,y)={\dfrac {\Gamma (x)\,\Gamma (y)}{\Gamma (x+y)}}=\exp(\ln {\dfrac {\Gamma (x)\,\Gamma (y)}{\Gamma (x+y)}})=\exp((\ln(\Gamma (x))+\ln(\Gamma (y))-\ln(\Gamma (x+y)))\!}}

p

2
−
t
a
i
l
{\displaystyle {\displaystyle p\_{2-tail}}}
 can be calculated in terms of gamma functions and integrals more simply:

p

2
−
t
a
i
l
=

∫

0

ν

t

2
+
ν

r

ν
2
−
1

(
1
−
r

)

−
0.5

d
r

exp

(
(
ln

(
Γ
(

ν
2
)
)
+
ln

(
Γ
(
0.5
)
)
−
ln

(
Γ
(

ν
2
+
0.5
)
)
)
{\displaystyle {\displaystyle p\_{2-tail}={\frac {\int \_{0}^{\frac {\nu }{t^{2}+\nu }}r^{{\frac {\nu }{2}}-1}\,(1-r)^{-0.5}\,\mathrm {d} r}{\exp((\ln(\Gamma ({\frac {\nu }{2}}))+\ln(\Gamma (0.5))-\ln(\Gamma ({\frac {\nu }{2}}+0.5)))}}}}

which simplifies to

p

2
−
t
a
i
l
=

∫

0

ν

t

2
+
ν

r

ν
2
−
1

1
−
r

d
r

exp

(
(
ln

(
Γ
(

ν
2
)
)
+
ln

(
Γ
(
0.5
)
)
−
ln

(
Γ
(

ν
2
+
0.5
)
)
)
{\displaystyle {\displaystyle p\_{2-tail}={\frac {\int \_{0}^{\frac {\nu }{t^{2}+\nu }}{\frac {r^{{\frac {\nu }{2}}-1}}{\sqrt {1-r}}}\,\mathrm {d} r}{\exp((\ln(\Gamma ({\frac {\nu }{2}}))+\ln(\Gamma (0.5))-\ln(\Gamma ({\frac {\nu }{2}}+0.5)))}}}}

The definite integral can be approximated with Simpson's Rule but other methods are also acceptable.

The

ln

(
Γ
(
x
)
)
{\displaystyle {\displaystyle \ln(\Gamma (x))}}
, or `lgammal(x)` function is necessary for the program to work with large `a` values, as Gamma functions can often return values larger than can be handled by `double` or `long double` data types. The `lgammal(x)` function is standard in `math.h` with C99 and C11 standards.

[Assistant]
(formerly Perl 6)

### Integration using Simpson's Rule

**Works with**: Rakudo version 2019.11

**Translation of**: C

Perhaps "inspired by C example" may be more accurate. Gamma subroutine from Gamma function task.

```
sub Γ(\z) {
    constant g = 9;
    z < .5 ?? π / sin(π × z) / Γ(1 - z) !!
    τ.sqrt × (z + g - 1/2)**(z - 1/2) ×
    exp(-(z + g - 1/2)) ×
    [+] <
        1.000000000000000174663
     5716.400188274341379136
   -14815.30426768413909044
    14291.49277657478554025
    -6348.160217641458813289
     1301.608286058321874105
     -108.1767053514369634679
        2.605696505611755827729
       -0.7423452510201416151527e-2
        0.5384136432509564062961e-7
       -0.4023533141268236372067e-8
    > Z× 1, |map 1/(z + *), 0..*
}

sub p-value (@A, @B) {
    return 1 if @A <= 1 or @B <= 1;

    my $a-mean = @A.sum / @A;
    my $b-mean = @B.sum / @B;
    my $a-variance = @A.map( { ($a-mean - $_)² } ).sum / (@A - 1);
    my $b-variance = @B.map( { ($b-mean - $_)² } ).sum / (@B - 1);
    return 1 unless $a-variance && $b-variance;

    my \Welchs-𝒕-statistic = ($a-mean - $b-mean)/($a-variance/@A + $b-variance/@B).sqrt;

    my $DoF = ($a-variance / @A + $b-variance / @B)² /
              (($a-variance² / (@A³ - @A²)) + ($b-variance² / (@B³ - @B²)));

    my $sa = $DoF / 2 - 1;
    my $x = $DoF / (Welchs-𝒕-statistic² + $DoF);
    my $N = 65355;
    my $h = $x / $N;
    my ( $sum1, $sum2 );

    for ^$N »×» $h -> $i {
        $sum1 += (($i + $h / 2) ** $sa) / (1 - ($i + $h / 2)).sqrt;
        $sum2 +=   $i           ** $sa  / (1 -  $i).sqrt;
    }

    (($h / 6) × ( $x ** $sa / (1 - $x).sqrt + 4 × $sum1 + 2 × $sum2)) /
     ( Γ($sa + 1) × π.sqrt / Γ($sa + 1.5) );
}

# Testing
for (
  [<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>],
  [<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>],

  [<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>],
  [<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>],

  [<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>],
  [<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>],

  [<30.02 29.99 30.11 29.97 30.01 29.99>],
  [<29.89 29.93 29.72 29.98 30.02 29.98>],

  [<3.0 4.0 1.0 2.1>],
  [<490.2 340.0 433.9>]
) -> @left, @right { say p-value @left, @right }

```

Output:

```
0.0213780014628669
0.148841696605328
0.0359722710297969
0.0907733242856673
0.010751534033393

```

### Using Burkhardt's 'incomplete beta'

**Works with**: Rakudo version 2019.11

**Translation of**: Perl

This uses the Soper reduction formula to evaluate the integral, which converges much more quickly than Simpson's formula.

```
sub lgamma ( Num(Real) \n --> Num ){
  use NativeCall;
  sub lgamma (num64 --> num64) is native {}
  lgamma( n )
}

sub p-value (@a, @b) {
    return 1 if @a.elems | @b.elems ≤ 1;
    my $mean1 = @a.sum / @a.elems;
    my $mean2 = @b.sum / @b.elems;
    return 1 if $mean1 == $mean2;

    my $variance1 = sum (@a «-» $mean1) X**2;
    my $variance2 = sum (@b «-» $mean2) X**2;
    return 1 if $variance1 | $variance2 == 0;

    $variance1 /= @a.elems - 1;
    $variance2 /= @b.elems - 1;
    my $Welchs-𝒕-statistic = ($mean1-$mean2)/sqrt($variance1/@a.elems+$variance2/@b.elems);
    my $DoF = ($variance1/@a.elems + $variance2/@b.elems)² /
               (($variance1 × $variance1)/(@a.elems × @a.elems × (@a.elems-1)) +
                ($variance2 × $variance2)/(@b.elems × @b.elems × (@b.elems-1))
               );
    my $A     = $DoF / 2;
    my $value = $DoF / ($Welchs-𝒕-statistic² + $DoF);
    return $value if $A | $value ≤ 0 or $value ≥ 1;

    # from here, translation of John Burkhardt's C
    my $beta  = lgamma($A) + 0.57236494292470009 - lgamma($A+0.5); # constant is logΓ(.5), more precise than 'lgamma' routine
    my $eps   = 10**-15;
    my $psq = $A + 0.5;
    my $cx = 1 - $value;
    my ($xx,$pp,$qq,$indx);
    if $A < $psq × $value { ($xx, $cx, $pp, $qq, $indx) = $cx, $value, 0.5,  $A, 1 }
    else                  { ($xx,      $pp, $qq, $indx) =      $value,  $A, 0.5, 0 }
    my $term = my $ai = $value = 1;
    my $ns = floor $qq + $cx × $psq;

    # Soper reduction formula
    my $qq-ai = $qq - $ai;
    my $rx = $ns == 0 ?? $xx !! $xx / $cx;
    loop {
        $term  ×= $qq-ai × $rx / ($pp + $ai);
        $value += $term;
        $qq-ai  = $term.abs;
        if $qq-ai ≤ $eps & $eps×$value {
            $value = $value × ($pp × $xx.log + ($qq - 1) × $cx.log - $beta).exp / $pp;
            $value = 1 - $value if $indx;
            last
        }
        $ai++;
        $ns--;
        if $ns ≥ 0 {
            $qq-ai = $qq - $ai;
            $rx    = $xx if $ns == 0;
        } else {
            $qq-ai = $psq;
            $psq  += 1;
        }
    }
    $value
}

my $error = 0;
my @answers = (
0.021378001462867,
0.148841696605327,
0.0359722710297968,
0.090773324285671,
0.0107515611497845,
0.00339907162713746,
0.52726574965384,
0.545266866977794,
);

for (
    [<27.5 21.0 19.0 23.6 17.0 17.9 16.9 20.1 21.9 22.6 23.1 19.6 19.0 21.7 21.4>],
    [<27.1 22.0 20.8 23.4 23.4 23.5 25.8 22.0 24.8 20.2 21.9 22.1 22.9 20.5 24.4>],

    [<17.2 20.9 22.6 18.1 21.7 21.4 23.5 24.2 14.7 21.8>],
    [<21.5 22.8 21.0 23.0 21.6 23.6 22.5 20.7 23.4 21.8 20.7 21.7 21.5 22.5 23.6 21.5 22.5 23.5 21.5 21.8>],

    [<19.8 20.4 19.6 17.8 18.5 18.9 18.3 18.9 19.5 22.0>],
    [<28.2 26.6 20.1 23.3 25.2 22.1 17.7 27.6 20.6 13.7 23.2 17.5 20.6 18.0 23.9 21.6 24.3 20.4 24.0 13.2>],

    [<30.02 29.99 30.11 29.97 30.01 29.99>],
    [<29.89 29.93 29.72 29.98 30.02 29.98>],

    [<3.0 4.0 1.0 2.1>],
    [<490.2 340.0 433.9>],

    [<0.010268 0.000167 0.000167>],
    [<0.159258 0.136278 0.122389>],

    [<1.0/15 10.0/62.0>],
    [<1.0/10 2/50.0>],

    [<9/23.0 21/45.0 0/38.0>],
    [<0/44.0 42/94.0 0/22.0>],
) -> @left, @right {
    my $p-value = p-value @left, @right;
    printf("p-value = %.14g\n",$p-value);
    $error += abs($p-value - shift @answers);
}
printf("cumulative error is %g\n", $error);

```

Output:

```
p-value = 0.021378001462867
p-value = 0.14884169660533
p-value = 0.035972271029797
p-value = 0.090773324285667
p-value = 0.010751561149784
p-value = 0.0033990716271375
p-value = 0.52726574965384
p-value = 0.54526686697779
cumulative error is 5.30131e-15
```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at Wieferich prime. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |

In number theory, a **Wieferich prime** is a prime number  ***p***  such that  ***p2***  evenly divides  ***2(p − 1) − 1*** .

It is conjectured that there are infinitely many Wieferich primes, but as of March 2021,only two have been identified.

Task

* Write a routine (function procedure, whatever) to find Wieferich primes.

* Use that routine to identify and display all of the Wieferich primes less than 5000.

See also

* OEIS A001220 - Wieferich primes

[Assistant]
```
put "Wieferich primes less than 5000: ", join ', ', ^5000 .grep: { .is-prime and not ( exp($_-1, 2) - 1 ) % .² };

```

Output:

```
Wieferich primes less than 5000: 1093, 3511
```


[User]
Task

Make a file that can be useful with spell checkers like Ispell and Aspell.

Use the wiktionary dump (input) to create a file equivalent to "/usr/share/dict/spanish" (output). The input file is an XML dump of the Wiktionary that is a bz2'ed file of about 800MB. The output file should be a file similar to "/usr/share/dict/spanish", a simple text file each line of which is one word in the given language. An example of such a file is available in Ubuntu with the package **wspanish**.

[Assistant]
I misunderstood the data format and now just copy verbatim from Julia entry the processing logics ..

```
# 20211209 Raku programming solution

use LWP::Simple;
use Compress::Bzip2;
use IO::Socket::SSL;

my $LanguageMark = "==French==";
my $Target       = 5; # words
my $URL          = 'https://dumps.wikimedia.org/enwiktionary/latest/enwiktionary-latest-pages-articles.xml.bz2';

class CustomLWP is LWP::Simple { has $.URL ;

   method CustomRequest {

      my Blob $resp          = Buf.new;
      my $bzip               = Compress::Bzip2::Stream.new;
      my ( $tail, %needles ) = '';

      my ($host, $port, $path) = self.parse_url($.URL)[1..3];
      my $sock = IO::Socket::SSL.new: :$host, :$port;

      $sock.print( "GET {$path} HTTP/1.1\r\n" ~ self.stringify_headers( {
         'Connection'  => 'close',
         'User-Agent'  => "LWP::Simple/{LWP::Simple::<$VERSION>} " ~
                          "Raku/{$*RAKU.compiler.gist}",
         'Host'        => $host
      } ) ~ "\r\n" ) or die ;       # request string

      while !self.got-header($resp) { $resp ~= $sock.read(2048) }

      my $bzip-stream = supply {
         emit self.parse_response($resp)[2]; # $resp_content @ parent class
         loop {
            done if %needles.elems >= $Target ;
            ( my $chunk = $sock.read(4096) ) ?? emit $chunk !! done
         }
      }

      react {
         whenever $bzip-stream -> $crypt {
            my $plain     = ( [~] $bzip.decompress: $crypt ).decode('utf8-c8');
            my @haystacks = $plain.split: "\n";
            @haystacks[0] = $tail ~ @haystacks[0];
            $tail         = @haystacks[*-1];

            my ($title,$got_text_last) = '', False ;

            for @haystacks[0..*-2] {
               if / '<title>' (\w+?) '</title>' / {
                  ($title,$got_text_last) = $0, False;
               } elsif /   '<text'     / {
                  $got_text_last = True
               } elsif / $LanguageMark / {
                  %needles{$title}++ if ( $got_text_last and $title.Bool );
                  last if ( %needles.elems >= $Target ) ;
                  $got_text_last = False;
               } elsif /  '</text>'    / { $got_text_last = False }
            }
         }
      }
      return %needles.keys[^$Target]
   }
}

my $ua = CustomLWP.new: URL => $URL ;

$ua.CustomRequest>>.say

```

Output:

```
chien
gratuit
gratis
pond
livre

```


[User]
Definition

A Wilson prime of order n is a prime number   **p**   such that   **p2**   exactly divides:

```
     (n − 1)! × (p − n)! − (− 1)n

```

If   **n**   is   **1**,   the latter formula reduces to the more familiar:   **(p - n)! + 1**   where the only known examples for   **p**   are   **5**,   **13**,   and   **563**.

Task

Calculate and show on this page the Wilson primes, if any, for orders **n = 1 to 11 inclusive** and for primes **p < 18**   or,

if your language supports *big integers*, for **p < 11,000**.

Related task
:   * Primality by Wilson's theorem

[Assistant]
```
# Factorial
sub postfix:<!> (Int $n) { (constant f = 1, |[\×] 1..*)[$n] }

# Invisible times
sub infix:<> is tighter(&infix:<**>) { $^a * $^b };

# Prime the iterator for thread safety
sink 11000!;

my @primes = ^1.1e4 .grep: *.is-prime;

say
'  n: Wilson primes
────────────────────';

.say for (1..40).hyper(:1batch).map: -> \𝒏 {
    sprintf "%3d: %s", 𝒏, @primes.grep( -> \𝒑 { (𝒑 ≥ 𝒏) && ((𝒏 - 1)!(𝒑 - 𝒏)! - (-1) ** 𝒏) %% 𝒑² } ).Str
}

```

Output:

```
  n: Wilson primes
────────────────────
  1: 5 13 563
  2: 2 3 11 107 4931
  3: 7
  4: 10429
  5: 5 7 47
  6: 11
  7: 17
  8:
  9: 541
 10: 11 1109
 11: 17 2713
 12:
 13: 13
 14:
 15: 349
 16: 31
 17: 61 251 479
 18:
 19: 71
 20: 59 499
 21:
 22:
 23:
 24: 47 3163
 25:
 26:
 27: 53
 28: 347
 29:
 30: 137 1109 5179
 31:
 32: 71
 33: 823 1181 2927
 34: 149
 35: 71
 36:
 37: 71 1889
 38:
 39: 491
 40: 59 71 1171
```


[User] Display a GUI window. The window need not have any contents, but should respond to requests to be closed.

[Assistant]
(formerly Perl 6)
**Library** GTK

Exit either by clicking the button or the close window control in the upper corner.

```
use GTK::Simple;
use GTK::Simple::App;

my GTK::Simple::App $app .= new(title => 'Simple GTK Window');

$app.size-request(250, 100);

$app.set-content(
    GTK::Simple::VBox.new(
        my $button = GTK::Simple::Button.new(label => 'Exit'),
    )
);

$app.border-width = 40;

$button.clicked.tap: { $app.exit }

$app.run;

```


[User]
Task

Create a simple **X11** application,   using an **X11** protocol library such as Xlib or XCB,   that draws a box and   "Hello World"   in a window.

Implementations of this task should   *avoid using a toolkit*   as much as possible.

[Assistant]
(formerly Perl 6)

**Translation of**: C

There is not yet a X11 library in Raku but we can write the minimal C mappings for this task.

```
use NativeCall;

class Display is repr('CStruct') {
    has int32 $!screen;
    has int32 $!window;
 }
class GC      is repr('CStruct') {
    has int32 $!context;
}
class XEvent  is repr('CStruct') {
    has int32 $.type;
    method init { $!type = 0 }
}

sub XOpenDisplay(Str $name = ':0') returns Display is native('X11') { * }
sub XDefaultScreen(Display $) returns int32 is native('X11') { * }
sub XRootWindow(Display $, int32 $screen_number) returns int32 is native('X11') { * }
sub XBlackPixel(Display $, int32 $screen_number) returns int32 is native('X11') { * }
sub XWhitePixel(Display $, int32 $screen_number) returns int32 is native('X11') { * }
sub XCreateSimpleWindow(
    Display $, int32 $parent_window, int32 $x, int32 $y,
    int32 $width, int32 $height, int32 $border_width,
    int32 $border, int32 $background
) returns int32 is native('X11') { * }
sub XMapWindow(Display $, int32 $window) is native('X11') { * }
sub XSelectInput(Display $, int32 $window, int32 $mask) is native('X11') { * }
sub XFillRectangle(
    Display $, int32 $window, GC $, int32 $x, int32 $y, int32 $width, int32 $height
) is native('X11') { * }
sub XDrawString(
    Display $, int32 $window, GC $, int32 $x, int32 $y, Str $, int32 $str_length
) is native('X11') { * }
sub XDefaultGC(Display $, int32 $screen) returns GC is native('X11') { * }
sub XNextEvent(Display $, XEvent $e)              is native('X11') { * }
sub XCloseDisplay(Display $)                      is native('X11') { * }

my Display $display = XOpenDisplay()
    or die "Can not open display";

my int $screen = XDefaultScreen($display);
my int $window = XCreateSimpleWindow(
    $display,
    XRootWindow($display, $screen),
    10, 10, 100, 100, 1,
    XBlackPixel($display, $screen), XWhitePixel($display, $screen)
);
XSelectInput($display, $window, 1 +< 15 +| 1);
XMapWindow($display, $window);

my Str $msg = 'Hello, World!';
my XEvent $e .= new; $e.init;
loop {
    XNextEvent($display, $e);
    if $e.type == 12 {
	    XFillRectangle($display, $window, XDefaultGC($display, $screen), 20, 20, 10, 10);
	    XDrawString($display, $window, XDefaultGC($display, $screen), 10, 50, $msg, my int $ = $msg.chars);
    }
    elsif $e.type == 2 {
	    last;
    }
}
XCloseDisplay($display);

```


[User]
Treat windows or at least window identities as first class objects.

* Store window identities in variables, compare them for equality.
* Provide examples of performing some of the following:
  + hide,
  + show,
  + close,
  + minimize,
  + maximize,
  + move,     and
  + resize a window.

The window of interest may or may not have been created by your program.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.12

This are generic window handling routines. They work for any window managed by the X11 display server, not just windows created by the program.

```
use X11::libxdo;

my $xdo = Xdo.new;

say 'Visible windows:';
printf "Class: %-21s ID#: %10d  pid: %5d  Name: %s\n", $_<class ID pid name>
    for $xdo.get-windows.sort(+*.key)».value;
sleep 2;

my $id = $xdo.get-active-window;

my ($w,  $h ) = $xdo.get-window-size( $id );
my ($wx, $wy) = $xdo.get-window-location( $id );
my ($dw, $dh) = $xdo.get-desktop-dimensions( 0 );

$xdo.move-window( $id, 150, 150 );

$xdo.set-window-size( $id, 350, 350, 0 );

sleep .25;

for flat 1 .. $dw - 350, $dw - 350, {$_ - 1} … 1 -> $mx { #
    my $my = (($mx / $dw * τ).sin * 500).abs.Int;
    $xdo.move-window( $id, $mx, $my );
    $xdo.activate-window($id);
}

sleep .25;

$xdo.move-window( $id, 150, 150 );

my $dx = $dw - 300;
my $dy = $dh - 300;

$xdo.set-window-size( $id, $dx, $dy, 0 );

sleep .25;

my $s = -1;

loop {
    $dx += $s * ($dw / 200).ceiling;
    $dy += $s * ($dh / 200).ceiling;
    $xdo.set-window-size( $id, $dx, $dy, 0 );
    $xdo.activate-window($id);
    sleep .005;
    $s *= -1 if $dy < 200;
    last if $dx >= $dw;
}

sleep .25;

$xdo.set-window-size( $id, $w, $h, 0 );
$xdo.move-window( $id, $wx, $wy );
$xdo.activate-window($id);

sleep .25;

$xdo.minimize($id);
$xdo.activate-window($id);
sleep 1;
$xdo.raise-window($id);
sleep .25;

```


[User]
Wireworld is a cellular automaton with some similarities to Conway's Game of Life.

It is capable of doing sophisticated computations with appropriate programs
(it is actually Turing complete),
and is much simpler to program for.

A Wireworld arena consists of a Cartesian grid of cells,
each of which can be in one of four states.
All cell transitions happen simultaneously.

The cell transition rules are this:

:   :   | Input State | Output State | Condition |
        | --- | --- | --- |
        | empty | empty |  |
        | electron head | electron tail |  |
        | electron tail | conductor |  |
        | conductor | electron head | if 1 or 2 cells in the neighborhood of the cell are in the state “electron head” |
        | conductor | conductor | otherwise |

Task

Create a program that reads a Wireworld program from a file and displays an animation of the processing. Here is a sample description file (using "H" for an electron head, "t" for a tail, "." for a conductor and a space for empty) you may wish to test with, which demonstrates two cycle-3 generators and an inhibit gate:

```
tH.........
.   .
   ...
.   .
Ht.. ......

```

While text-only implementations of this task are possible, mapping cells to pixels is advisable if you wish to be able to display large designs. The logic is not significantly more complex.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

```
class Wireworld {
    has @.line;
    method height returns Int { @!line.elems }
    method width  returns Int { max @!line».chars }

    multi method new(@line) { samewith :@line }
    multi method new($str ) { samewith $str.lines }

    method gist { join "\n", @.line }

    method !neighbors($i where ^$.height, $j where ^$.width)
    {
        my @i = grep ^$.height, $i «+« (-1, 0, 1);
        my @j = grep ^$.width,  $j «+« (-1, 0, 1);
        gather for @i X @j -> (\i, \j) {
            next if [ i, j ] ~~ [ $i, $j ];
            take @!line[i].comb[j];
        }
    }
    method succ {
        my @succ;
        for ^$.height X ^$.width -> ($i, $j) {
            @succ[$i] ~=
            do given @.line[$i].comb[$j] {
                when 'H' { 't' }
                when 't' { '.' }
                when '.' {
                    grep('H', self!neighbors($i, $j)) == 1|2 ?? 'H' !! '.'
                }
                default { ' ' }
            }
        }
        return self.new: @succ;
    }
}

my %*SUB-MAIN-OPTS;
%*SUB-MAIN-OPTS<named-anywhere> = True;

multi sub MAIN (
    IO()      $filename,
    Numeric:D :$interval = 1/4,
    Bool      :$stop-on-repeat,
) {
    run-loop :$interval, :$stop-on-repeat, Wireworld.new: $filename.slurp;
}

#| run a built-in example
multi sub MAIN (
    Numeric:D :$interval = 1/4,
    Bool      :$stop-on-repeat,
) {
    run-loop
      :$interval,
      :$stop-on-repeat,
      Wireworld.new:
	Q:to/§/
	tH.........
	.   .
	   ...
	.   .
	Ht.. ......
	§
}

sub run-loop (
    Wireworld:D     $initial,
    Real:D(Numeric) :$interval = 1/4,
    Bool            :$stop-on-repeat
){
    my %seen is SetHash;

    print "\e7";                # save cursor position
    for $initial ...^ * eqv * { # generate a sequence (uses .succ)
      print "\e8";              # restore cursor position
      .say;
      last if $stop-on-repeat and %seen{ .gist }++;
      sleep $interval;
    }
}

```

When run with `--stop-on-repeat`

Output:

```
H.tH.tH.tH.
t   .
   ttt
t   .
.H.t ......
```


[User]
A Wolstenholme number is a number that is the fully reduced numerator of a second order harmonic number:

H

n
,
2
=

∑

k
=
1

n

1

k

2
.
{\displaystyle H\_{n,2}=\sum \_{k=1}^{n}{\frac {1}{k^{2}}}.}

Prime Wolstenholme numbers are Wolstenholme numbers that are prime.

(Oddly enough, there is also a class of numbers called Wolstenholme primes that are **not** Wolstenholme numbers that are prime. This is not them.)

Task

* Find and display the first 20 Wolstenholme numbers. (Or as many as reasonably supported by your language if it is fewer.)
* Find and display the first 4 prime Wolstenholme numbers. (Or as many as reasonably supported by your language if it is fewer.)

Stretch

* Find and display the digit count of the 500th, 1000th, 2500th, 5000th, 10000th Wolstenholme numbers.
* Find and display the digit count of the first 15 prime Wolstenholme numbers.

See also

* Wikipedia: Wolstenholme number * OEIS:A007406 - Wolstenholme numbers * OEIS:A123751 - Prime Wolstenholme numbers

[Assistant]
```
use Lingua::EN::Numbers;

sub abbr ($_) { .chars < 41 ?? $_ !! .substr(0,20) ~ '..' ~ .substr(*-20) ~ " (digits: {.chars})" }

my @wolstenholme = lazy ([\+] (1..∞).hyper.map: {FatRat.new: 1, .²}).map: *.numerator;

say 'Wolstenholme numbers:';
printf "%8s: %s\n", .&ordinal-digit(:c), abbr @wolstenholme[$_-1] for flat 1..20, 5e2, 1e3, 2.5e3, 5e3, 1e4;

say "\nPrime Wolstenholme numbers:";
printf "%8s: %s\n", .&ordinal-digit(:c), @wolstenholme.grep(&is-prime)[$_-1]».&abbr for 1..15;

```

Output:

```
Wolstenholme numbers:
     1st: 1
     2nd: 5
     3rd: 49
     4th: 205
     5th: 5269
     6th: 5369
     7th: 266681
     8th: 1077749
     9th: 9778141
    10th: 1968329
    11th: 239437889
    12th: 240505109
    13th: 40799043101
    14th: 40931552621
    15th: 205234915681
    16th: 822968714749
    17th: 238357395880861
    18th: 238820721143261
    19th: 86364397717734821
    20th: 17299975731542641
   500th: 40989667509417020364..48084984597965892703 (digits: 434)
 1,000th: 83545938483149689478..99094240207812766449 (digits: 866)
 2,500th: 64537911900230612090..12785535902976933153 (digits: 2164)
 5,000th: 34472086597488537716..22525144829082590451 (digits: 4340)
10,000th: 54714423173933343999..49175649667700005717 (digits: 8693)

Prime Wolstenholme numbers:
     1st: 5
     2nd: 266681
     3rd: 40799043101
     4th: 86364397717734821
     5th: 36190908596780862323..79995976006474252029 (digits: 104)
     6th: 33427988094524601237..48446489305085140033 (digits: 156)
     7th: 22812704758392002353..84405125167217413149 (digits: 218)
     8th: 28347687473208792918..45794572911130248059 (digits: 318)
     9th: 78440559440644426017..30422337523878698419 (digits: 520)
    10th: 22706893975121925531..02173859396183964989 (digits: 649)
    11th: 27310394808585898968..86311385662644388271 (digits: 935)
    12th: 13001072736642048751..08635832246554146071 (digits: 984)
    13th: 15086863305391456002..05367804007944918693 (digits: 1202)
    14th: 23541935187269979100..02324742766220468879 (digits: 1518)
    15th: 40306783143871607599..58901192511859288941 (digits: 1539)
```