[User]
The binomial transform is a bijective sequence transform based on convolution with binomial coefficients.

It may be thought of as an *nth* forward difference with odd differences carrying a negative sign.

There are two common variants of binomial transforms, one of which is self-inverting; *reapplying the transform to a transformed sequence returns the original sequence,* and one which has separate "forward" and "inverse" transform operations.

The two variants only differ in placement and quantity of signs. The variant standardized on by OEIS, *with the 'forward' and 'inverse' complementary operations*, will be used here.

In this variant, to transform the sequence *a* to sequence *b* and back:

the forward binomial transform is defined as:

b

n
=

∑

k
=
0

n

(

n
k

)

a

k
.
{\displaystyle {\displaystyle b\_{n}=\sum \_{k=0}^{n}{n \choose k}a\_{k}.}}

and the inverse binomial transform is defined as:

a

n
=

∑

k
=
0

n
(
−
1

)

n
−
k

(

n
k

)

b

k
{\displaystyle {\displaystyle a\_{n}=\sum \_{k=0}^{n}(-1)^{n-k}{n \choose k}b\_{k}}}

where

(

n
k

)
{\displaystyle {\displaystyle {n \choose k}}}
 is the binomial operator 'n choose k'

*For reference, the self inverting binomial transform is defined as:*

b

n
=

∑

k
=
0

n
(
−
1

)

k

(

n
k

)

a

k
{\displaystyle {\displaystyle b\_{n}=\sum \_{k=0}^{n}(-1)^{k}{n \choose k}a\_{k}}}

Task

* Implement both a forward, and inverse binomial transform routine.
* Use those routines to compute the forward binomial transform, the inverse binomial transform, and the inverse of the forward transform *(should return original sequence)* of a few representative sequences.
* Show at least the first 15 values in each sequence.

:   *You may generate the sequences, or may choose to just hard code the values.*

:   Use the following sequences for testing:

    :   Catalan numbers: `1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900 2674440`
    :   Prime flip flop sequence: (for an: 1 if prime, 0 otherwise): `0 1 1 0 1 0 1 0 0 0 1 0 1 0 0`
    :   Fibonacci sequence: `0 1 1 2 3 5 8 13 21 34 55 89 144 233 377`
    :   Padovan sequence: (starting with values 1,0,0): `1 0 0 1 0 1 1 1 2 2 3 4 5 7 9`

See also

* Wikipedia: Binomial transform * OEIS wiki: Binomial transform * Related task: Evaluate binomial coefficients * Related task: Catalan numbers * Related task: Riordan numbers * Related task: Fibonacci sequence * Related task: Padovan sequence

:   *first sequence*

* OEIS:A007317 - Binomial transform of Catalan numbers * OEIS:A005043 - Riordan numbers (Inverse binomial transform of Catalan numbers)

:   *second sequence*

* OEIS:A052467 - Binomial transform of {b(n)}, where b(n)=1 for prime n and b(n)=0 otherwise (Binomial transform of Prime flip-flop sequence

:   *third sequence*

* OEIS:A001906 - F(2n) = bisection of Fibonacci sequence (Binomial transform of Fibonacci sequence) * OEIS:A039834 - a(n+2) = -a(n+1) + a(n) (signed Fibonacci numbers) with a(-2) = a(-1) = 1 (Inverse binomial transform of Fibonacci sequence)

:   *fourth sequence*

* OEIS:A034943 - Binomial transform of Padovan sequence * OEIS:A144413 - a(n) = Sum\_{k=0..n} (-1)^k \* binomial(n, k) \* A000931(n-k+4) (Inverse binomial transform of Padovan sequence)

[Assistant]
Generates the sequences on the fly.

```
sub binomial { [×] ($^n … 0) Z/ 1 .. $^p }

sub binomial-transform (*@seq) {
    @seq.keys.map: -> \n { sum (0..n).map: -> \k { binomial(n,k) × @seq[k] } }
}

sub inverse-binomial-transform (*@seq) {
    @seq.keys.map: -> \n { sum (0..n).map: -> \k { binomial(n,k) × @seq[k] × exp(n - k, -1) } }
}

sub si-binomial-transform (*@seq) { #self inverting
    @seq.keys.map: -> \n { sum (0..n).map: -> \k { binomial(n,k) × @seq[k] × exp(k, -1) } }
}

my $upto = 20;

for 'Catalan number',   (1, {[+] @_ Z× @_.reverse}…*),
    'Prime flip-flop',  (1..*).map({.is-prime ?? 1 !! 0}),
    'Fibonacci number', (0,1,*+*…*),
    'Padovan number',   (1,0,0, -> $c,$b,$ {$b+$c}…*)
  -> $name, @seq {
    say qq:to/BIN/;
    $name sequence:
    {@seq[^$upto]}
    Forward binomial transform:
    {binomial-transform(@seq)[^$upto]}
    Inverse binomial transform:
    {inverse-binomial-transform(@seq)[^$upto]}
    Round trip:
    {inverse-binomial-transform(binomial-transform(@seq))[^$upto]}
    Self inverting:
    {si-binomial-transform(@seq)[^$upto]}
    Re inverted:
    {si-binomial-transform(si-binomial-transform(@seq))[^$upto]}
    BIN
}

```

Output:

```
Catalan number sequence:
1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900 2674440 9694845 35357670 129644790 477638700 1767263190
Forward binomial transform:
1 2 5 15 51 188 731 2950 12235 51822 223191 974427 4302645 19181100 86211885 390248055 1777495635 8140539950 37463689775 173164232965
Inverse binomial transform:
1 0 1 1 3 6 15 36 91 232 603 1585 4213 11298 30537 83097 227475 625992 1730787 4805595
Round trip:
1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900 2674440 9694845 35357670 129644790 477638700 1767263190
Self inverting:
1 0 1 -1 3 -6 15 -36 91 -232 603 -1585 4213 -11298 30537 -83097 227475 -625992 1730787 -4805595
Re inverted:
1 1 2 5 14 42 132 429 1430 4862 16796 58786 208012 742900 2674440 9694845 35357670 129644790 477638700 1767263190

Prime flip-flop sequence:
0 1 1 0 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0
Forward binomial transform:
0 1 3 6 11 20 37 70 134 255 476 869 1564 2821 5201 9948 19793 40562 84271 174952
Inverse binomial transform:
0 1 -1 0 3 -10 25 -56 118 -237 456 -847 1540 -2795 5173 -9918 19761 -40528 84235 -174914
Round trip:
0 1 1 0 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0
Self inverting:
0 -1 -1 0 3 10 25 56 118 237 456 847 1540 2795 5173 9918 19761 40528 84235 174914
Re inverted:
0 1 1 0 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0

Fibonacci number sequence:
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181
Forward binomial transform:
0 1 3 8 21 55 144 377 987 2584 6765 17711 46368 121393 317811 832040 2178309 5702887 14930352 39088169
Inverse binomial transform:
0 1 -1 2 -3 5 -8 13 -21 34 -55 89 -144 233 -377 610 -987 1597 -2584 4181
Round trip:
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181
Self inverting:
0 -1 -1 -2 -3 -5 -8 -13 -21 -34 -55 -89 -144 -233 -377 -610 -987 -1597 -2584 -4181
Re inverted:
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181

Padovan number sequence:
1 0 0 1 0 1 1 1 2 2 3 4 5 7 9 12 16 21 28 37
Forward binomial transform:
1 1 1 2 5 12 28 65 151 351 816 1897 4410 10252 23833 55405 128801 299426 696081 1618192
Inverse binomial transform:
1 -1 1 0 -3 10 -24 49 -89 145 -208 245 -174 -176 1121 -3185 7137 -13920 24301 -37926
Round trip:
1 0 0 1 0 1 1 1 2 2 3 4 5 7 9 12 16 21 28 37
Self inverting:
1 1 1 0 -3 -10 -24 -49 -89 -145 -208 -245 -174 176 1121 3185 7137 13920 24301 37926
Re inverted:
1 0 0 1 0 1 1 1 2 2 3 4 5 7 9 12 16 21 28 37
```

You may Attempt This Online!


[User]
Given this string representing ordered DNA bases:

```
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT

```

Task
:   * "Pretty print" the sequence followed by a summary of the counts of each of the bases:   (**A**, **C**, **G**, and **T**)   in the sequence
    * print the total count of each base in the string.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

It's the Letter frequency task all over again, just simpler and dressed up in different clothes.

The specs for what "pretty print" means are sadly lacking. Ah well, just makes it easily defensible if I do *anything at all*.

```
my $dna = join '', lines q:to/END/;
    CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
    CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
    AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
    GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
    CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
    TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
    TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
    CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
    TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
    GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT
    END

put pretty($dna, 80);
put "\nTotal bases: ", +my $bases = $dna.comb.Bag;
put $bases.sort(~*.key).join: "\n";

sub pretty ($string, $wrap = 50) {
    $string.comb($wrap).map( { sprintf "%8d: %s", $++ * $wrap, $_ } ).join: "\n"
}

```

Output:

```
       0: CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATGCTCGTGCTTTCCAATTATGTAAGCGTTCCG
      80: AGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTC
     160: GTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGT
     240: TCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATATTTAATTTTTCTATATAGCG
     320: ATCTGTATTTAAGCAATTCATTTAGGTTATCGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
     400: TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGACGACCGGGGACTTGCATGATGGGAGCAGCTT
     480: TGTTAAACTACGAACGTAAT

Total bases: 500
A	129
C	97
G	119
T	155
```


[User]
Global alignment is designed to search for highly similar regions in two or more DNA sequences, where the
sequences appear in the same order and orientation, fitting the sequences in as pieces in a puzzle.

Current DNA sequencers find the sequence for multiple small segments of DNA which have mostly randomly formed by splitting a much larger DNA molecule into shorter segments. When re-assembling such segments of DNA sequences into a larger sequence to form, for example, the DNA coding for the relevant gene, the overlaps between multiple shorter sequences are commonly used to decide how the longer sequence is to be assembled. For example, "AAGATGGA", GGAGCGCATC", and "ATCGCAATAAGGA" can be assembled into the sequence "AAGATGGAGCGCATCGCAATAAGGA" by noting that "GGA" is at the tail of the first string and head of the second string and "ATC" likewise is at the tail
of the second and head of the third string.

When looking for the best global alignment in the output strings produced by DNA sequences, there are
typically a large number of such overlaps among a large number of sequences. In such a case, the ordering
that results in the shortest common superstring is generrally preferred.

Finding such a supersequence is an NP-hard problem, and many algorithms have been proposed to
shorten calculations, especially when many very long sequences are matched.

The shortest common superstring as used in bioinfomatics here differs from the string task
Shortest\_common\_supersequence. In that task, a supersequence
may have other characters interposed as long as the characters of each subsequence appear in order,
so that (abcbdab, abdcaba) -> abdcabdab. In this task, (abcbdab, abdcaba) -> abcbdabdcaba.

Task
:   * Given N non-identical strings of characters A, C, G, and T representing N DNA sequences, find the shortest DNA sequence containing all N sequences.

:   * Handle cases where two sequences are identical or one sequence is entirely contained in another.

:   * Print the resulting sequence along with its size (its base count) and a count of each base in the sequence.

:   * Find the shortest common superstring for the following four examples:

```
("TA", "AAG", "TA", "GAA", "TA")

```

```
("CATTAGGG", "ATTAG", "GGG", "TA")

```

```
("AAGAUGGA", "GGAGCGCAUC", "AUCGCAAUAAGGA")

```

```
("ATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTAT",
"GGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGT",
"CTATGTTCTTATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA",
"TGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC",
"AACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT",
"GCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTC",
"CGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATTCTGCTTATAACACTATGTTCT",
"TGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC",
"CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATGCTCGTGC",
"GATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATT",
"TTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC",
"CTATGTTCTTATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA",
"TCTCTTAAACTCCTGCTAAATGCTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGA")

```

Related tasks
:   * Bioinformatics base count.
    * Bioinformatics sequence mutation.

[Assistant]
**Translation of**: Go

**Translation of**: Julia

```
# 20210209 Raku programming solution

sub printCounts(\seq) {
   my $bases = seq.comb.Bag ;
   say "\nNucleotide counts for ", seq, " :";
   say $bases.kv, " and total length = ", $bases.total
}

sub stringCentipede(\s1, \s2) {
   loop ( my $offset = 0, my \S1 = $ = '' ; ; $offset++ ) {
      S1 = s1.substr: $offset ;
      with S1.index(s2.substr(0,1)) -> $p { $offset += $p } else { return False }
      return s1.chars - $offset if s2.starts-with: s1.substr: $offset
   }
}

sub deduplicate {
   my @sorted = @_.unique.sort: *.chars; # by length
   gather while ( my $target = shift @sorted ) {
      take $target unless @sorted.grep: { .contains: $target }
   }
}

sub shortestCommonSuperstring {
   my \ß = $ = [~] my @ss = deduplicate @_ ;           # ShortestSuper
   for @ss.permutations -> @perm {
      my \sup = $ = @perm[0];
      for @perm.rotor(2 => -1) { sup ~= @_[1].substr: stringCentipede |@_ }
      ß = sup if sup.chars < ß.chars ;
   }
   ß
}

.&shortestCommonSuperstring.&printCounts for (

   <TA AAG TA GAA TA>,

   <CATTAGGG ATTAG GGG TA>,

   <AAGAUGGA GGAGCGCAUC AUCGCAAUAAGGA> ,

   <ATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTAT
    GGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGT
    CTATGTTCTTATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
    TGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC
    AACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
    GCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTC
    CGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATTCTGCTTATAACACTATGTTCT
    TGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC
    CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATGCTCGTGC
    GATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATT
    TTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATC
    CTATGTTCTTATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
    TCTCTTAAACTCCTGCTAAATGCTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGA
   >,
)

```

Output:

```

Nucleotide counts for TAAGAA :
(T 1 A 4 G 1) and total length = 6

Nucleotide counts for CATTAGGG :
(G 3 A 2 T 2 C 1) and total length = 8

Nucleotide counts for AAGAUGGAGCGCAUCGCAAUAAGGA :
(A 10 U 3 C 4 G 8) and total length = 25

Nucleotide counts for CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATGCTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTGAGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGATGGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTTCGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGGTCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA :
(C 57 G 75 A 74 T 94) and total length = 300

```


[User]
Task

Given a string of characters A, C, G, and T representing a DNA sequence write a routine to mutate the sequence, (string) by:

1. Choosing a random base position in the sequence.
2. Mutate the sequence by doing one of either:
   1. **S**wap the base at that position by changing it to one of A, C, G, or T. (which has a chance of swapping the base for the same base)
   2. **D**elete the chosen base at the position.
   3. **I**nsert another base randomly chosen from A,C, G, or T into the sequence at that position.
3. Randomly generate a test DNA sequence of at least 200 bases
4. "Pretty print" the sequence and a count of its size, and the count of each base in the sequence
5. Mutate the sequence ten times.
6. "Pretty print" the sequence after all mutations, and a count of its size, and the count of each base in the sequence.

Extra credit

* Give more information on the individual mutations applied.
* Allow mutations to be weighted and/or chosen.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

Unweighted mutations at this point. The mutated DNA strand has a "diff" operation performed on it which (in this specific case) renders the mutated base in lower case so it may be picked out more easily.

```
my @bases = <A C G T>;

# The DNA strand
my $dna = @bases.roll(200).join;

# The Task
put "ORIGINAL DNA STRAND:";
put pretty $dna;
put "\nTotal bases: ", +my $bases = $dna.comb.Bag;
put $bases.sort( ~*.key ).join: "\n";

put "\nMUTATED DNA STRAND:";
my $mutate = $dna.&mutate(10);
put pretty diff $dna, $mutate;
put "\nTotal bases: ", +my $mutated = $mutate.comb.Bag;
put $mutated.sort( ~*.key ).join: "\n";

# Helper subs
sub pretty ($string, $wrap = 50) {
    $string.comb($wrap).map( { sprintf "%8d: %s", $++ * $wrap, $_ } ).join: "\n"
}

sub mutate ($dna is copy, $count = 1) {
    $dna.substr-rw((^$dna.chars).roll, 1) = @bases.roll for ^$count;
    $dna
}

sub diff ($orig, $repl) {
    ($orig.comb Z $repl.comb).map( -> ($o, $r) { $o eq $r ?? $o !! $r.lc }).join
}

```

Output:

```
ORIGINAL DNA STRAND:
       0: ACGGATAGACCGTTCCTGCAAGCTGGTACGGTTCGAATGTTGACCTTATT
      50: CTCCGCAGCGCACTACCCGATCGGGTAACGTACTCTATATGATGCCTATT
     100: TTCCCCGCCTTACATCGGCGATCAATGTTCTTTTACGCTAACTAGGCGCA
     150: CGTCGTGCCTTACCGAGAGCCAGTTCGAAATCGTGCTGAAAATATCTGGA

Total bases: 200
A	45
C	55
G	45
T	55

MUTATED DNA STRAND:
       0: ACGGATAGcCCGTTCCTGCAAGCTGGTACGGTTCGAATGTTGACCTTATT
      50: CTCCGCAGCGCACTACCCGATCGGGTcACtcACTCTATATGAcGCCTAaT
     100: TTCCCCGCCTTACATCGGCGATCAATGTTCTTTTACGCTAACTAGGCGCA
     150: CGTCGTGCCTTACCcAGAGCCAGTTCGAAATCGTGCTGAAAATATCTGGA

Total bases: 200
A	44
C	60
G	43
T	53
```


[User]
Task

Randomly generate a string of   **200**   DNA bases   (represented by   **A,  C,  G,**  and  **T**).

Write a routine to find all the positions of a randomly generated subsequence   (four letters).

[Assistant]
Chances are actually pretty small that a random 4 codon string will show up at all in a random 200 codon sequence. Bump up the sequence size to get a reasonable chance of multiple matches.

```
use String::Splice:ver<0.0.3+>;

my $line = 80;

my $haystack = [~] <A C G T>.roll($line * 8);

say 'Needle: ' ~ my $needle = [~] <A C G T>.roll(4);

my $these = $haystack ~~ m:g/<$needle>/;

my @match = $these.map: { .from, .pos }

printf "From: %3s to %3s\n", |$_ for @match;

my $disp = $haystack.comb.batch($line)».join.join("\n");

for @match.reverse {
    $disp.=&splice(.[1] + .[1] div $line, "\e[0m" );
    $disp.=&splice(.[0] + .[0] div $line, "\e[31m");
}

say $disp;

```

Output:

Show in custom div to better display highlighting.

Needle: TAGC
From: 159 to 163
From: 262 to 266
From: 315 to 319
From: 505 to 509
From: 632 to 636
CATATGTGACACTGACAGCTCGCGCGAAAATCCGTGTGACGGTCTGAACACTATACTATAGGCCCGGTCGGCATTTGTGG
CTCCCCAGTGGAGAGACCACTCGTCAATTGCTGACGACTTAACACAAATCGAGTCGCCCTTAGTGCCAGACGGGACTCCT
AGCAAAGGGCGGCACGTGGTGACTCCCAATATGTGAGCATGCCATCTAATTGATCTGGGGGGTTTCGCGGGAATACCTAG
GGGCGTTCTGTCCATGGATCTCTAGCCCTGCGAAGAGATACCCGCAGTGAGTTGCACGTGCAAAGAACTTGTAACTAGCG
TATTCTGTATCCGCCGCGCGATATGCTTCTGCGGGATGTACTTCTTGTGACTAAGACTTTGTTATCCAAATTGACCAATA
TTCAACGGTCGACTCTCCGAGGCAGTATCGGTACGCCGAAAAATGGTTACTTCGGCCATACGTAACCTCTCAAGTCACGA
TTACAGCCCACGGGGGCTTACAGCATAGCTCCAAAGACATTCCAATTGAGCTACAACGTGTTCAGTGCGGAGCAGTATCC
AGTACTCGACTGTTATGGTAAAAGGGCATCGTGATCGTTTATATTAATCATTGGGACAGGTGGTTAATGTCATAGCTTAG


[User]
For a while in the late 70s, the pseudoscience of biorhythms was popular enough to rival astrology, with kiosks in malls that would give you your weekly printout. It was also a popular entry in "Things to Do with your Pocket Calculator" lists. You can read up on the history at Wikipedia, but the main takeaway is that unlike astrology, the math behind biorhythms is dead simple.

It's based on the number of days since your birth. The premise is that three cycles of unspecified provenance govern certain aspects of everyone's lives – specifically, how they're feeling physically, emotionally, and mentally. The best part is that not only do these cycles somehow have the same respective lengths for all humans of any age, gender, weight, genetic background, etc, but those lengths are an exact number of days. And the pattern is in each case a perfect sine curve. Absolutely miraculous!

To compute your biorhythmic profile for a given day, the first thing you need is the number of days between that day and your birth, so the answers in Days between dates are probably a good starting point. (Strictly speaking, the biorhythms start at 0 at the moment of your birth, so if you know time of day you can narrow things down further, but in general these operate at whole-day granularity.) Then take the residue of that day count modulo each of the the cycle lengths to calculate where the day falls on each of the three sinusoidal journeys.

The three cycles and their lengths are as follows:

:   :   :   | Cycle | Length |
            | --- | --- |
            | Physical | 23 days |
            | Emotional | 28 days |
            | Mental | 33 days |

The first half of each cycle is in "plus" territory, with a peak at the quarter-way point; the second half in "minus" territory, with a valley at the three-quarters mark. You can calculate a specific value between -1 and +1 for the *k*th day of an *n*-day cycle by computing **sin( 2π*k* / *n* )**. The days where a cycle crosses the axis in either direction are called "critical" days, although with a cycle value of 0 they're also said to be the most neutral, which seems contradictory.

The task: write a subroutine, function, or program that will, given a birthdate and a target date, output the three biorhythmic values for the day. You may optionally include a text description of the position and the trend (e.g. "up and rising", "peak", "up but falling", "critical", "down and falling", "valley", "down but rising"), an indication of the date on which the next notable event (peak, valley, or crossing) falls, or even a graph of the cycles around the target date. Demonstrate the functionality for dates of your choice.

Example run of my Raku implementation:

```
raku br.raku 1943-03-09 1972-07-11

```

Output:

```
Day 10717:
Physical day 22: -27% (down but rising, next transition 1972-07-12)
Emotional day 21: valley
Mental day 25: valley

```

Double valley! This was apparently not a good day for Mr. Fischer to begin a chess tournament...

[Assistant]
```
#!/usr/bin/env raku
unit sub MAIN($birthday=%*ENV<BIRTHDAY>, $date = Date.today()) {

my %cycles = ( :23Physical, :28Emotional, :33Mental );
my @quadrants = [ ('up and rising',    'peak'),
                  ('up but falling',   'transition'),
                  ('down and falling', 'valley'),
                  ('down but rising',  'transition') ];

if !$birthday {
    die "Birthday not specified.\n" ~
        "Supply --birthday option or set \$BIRTHDAY in environment.\n";
}

my ($bday, $target) = ($birthday, $date).map: { Date.new($_) };
my $days = $target - $bday;

say "Day $days:";
for %cycles.sort(+*.value)».kv -> ($label, $length) {
    my $position = $days % $length;
    my $quadrant = floor($position / $length * 4);
    my $percentage = floor(sin($position / $length * 2 * π )*1000)/10;
    my $description;
    if $percentage > 95 {
        $description = 'peak';
    } elsif $percentage < -95 {
        $description = 'valley';
    } elsif abs($percentage) < 5 {
        $description = 'critical transition'
    } else {
        my $transition = $target + floor(($quadrant + 1)/4 * $length) - $position;
        my ($trend, $next) = @quadrants[$quadrant];
        $description = "$percentage% ($trend, next $next $transition)";
    }
    say "$label day $position: $description";
  }
}

```

Output:

```
$ br 1809-01-12 1863-11-19
Day 20034:
Physical day 1: 26.9% (up and rising, next peak 1863-11-23)
Emotional day 14: critical transition
Mental day 3: 54% (up and rising, next peak 1863-11-24)

```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The current wikipedia article is at Birthday Problem. The original RosettaCode article was extracted from the wikipedia article № 296054030 of 21:44, 12 June 2009 . The list of authors can be seen in the page history. As with Rosetta Code, the pre **5 June 2009** text of Wikipedia is available under the GNU FDL. (See links for details on variance) |

In probability theory, the **birthday problem**, or **birthday paradox** This is not a paradox in the sense of leading to a logical contradiction, but is called a paradox because the mathematical truth contradicts naïve intuition: most people estimate that the chance is much lower than 50%. pertains to the probability that in a set of randomly chosen people some pair of them will have the same birthday. In a group of at least 23 randomly chosen people, there is more than 50% probability that some pair of them will both have been born on the same day. For 57 or more people, the probability is more than 99%, and it reaches 100% when the number of people reaches 366 (by the pigeon hole principle, ignoring leap years). The mathematics behind this problem leads to a well-known cryptographic attack called the birthday attack.

Task

Using simulation, estimate the number of independent people required in a group before we can expect a *better than even chance* that at least 2 independent people in a group share a common birthday. Furthermore: Simulate and thus estimate when we can expect a *better than even chance* that at least 3, 4 & 5 independent people of the group share a common birthday. For simplicity assume that all of the people are alive...

Suggestions for improvement

* Estimating the error in the estimate to help ensure the estimate is accurate to 4 decimal places.
* Converging to the

  n
  {\displaystyle {\displaystyle n}}
  th solution using a root finding method, as opposed to using an extensive search.
* Kudos (κῦδος) for finding the solution by proof (in a programming language) rather than by construction and simulation.

See also

* Wolfram entry:   Birthday Problem

[Assistant]
(formerly Perl 6)
Gives correct answers, but more of a proof-of-concept at this point, even with max-trials at 250K it is too slow to be practical.

```
sub simulation ($c) {
    my $max-trials = 250_000;
    my $min-trials =   5_000;
    my $n = floor 47 * ($c-1.5)**1.5; # OEIS/A050256: 16 86 185 307
    my $N = min $max-trials, max $min-trials, 1000 * sqrt $n;

    loop {
        my $p = $N R/ elems grep { .elems > 0 }, ((grep { $_>=$c }, values bag (^365).roll($n)) xx $N);
        return($n, $p) if $p > 0.5;
        $N = min $max-trials, max $min-trials, floor 1000/(0.5-$p);
        $n++;
   }
}

printf "$_ people in a group of %s share a common birthday. (%.3f)\n", simulation($_) for 2..5;

```

Output:

```
2 people in a group of 23 share a common birthday. (0.506)
3 people in a group of 88 share a common birthday. (0.511)
4 people in a group of 187 share a common birthday. (0.500)
5 people in a group of 313 share a common birthday. (0.507)
```


[User]
|  |
| --- |
| **Warning:** Many of these snippets are incomplete. It is recommended that you use an established library for any projects that are likely to see external use |

Task

Write a program that takes a bitcoin address as argument,
and checks whether or not this address is valid.

A bitcoin address uses a base58 encoding, which uses an alphabet of the characters 0 .. 9, A ..Z, a .. z, but without the four characters:

:   :   :   * 0   zero
            * O   uppercase oh
            * I   uppercase eye
            * l   lowercase ell

With this encoding, a bitcoin address encodes 25 bytes:

* the first byte is the version number, which will be zero for this task ;
* the next twenty bytes are a RIPEMD-160 digest, but you don't have to know that for this task: you can consider them a pure arbitrary data ;
* the last four bytes are a checksum check. They are the first four bytes of a double SHA-256 digest of the previous 21 bytes.

To check the bitcoin address, you must read the first twenty-one bytes, compute the checksum, and check that it corresponds to the last four bytes.

The program can either return a boolean value or throw an exception when not valid.

You can use a digest library for SHA-256.

Example of a bitcoin address

```
1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i

```

It doesn't belong to anyone and is part of the test suite of the bitcoin software.

You can change a few characters in this string and check that it'll fail the test.

[Assistant]
(formerly Perl 6)

```
sub sha256(blob8 $b) returns blob8 {
  given run <openssl dgst -sha256 -binary>, :in, :out, :bin {
    .in.write: $b;
    .in.close;
    return .out.slurp;
  }
}

my $bitcoin-address = rx/
    << <+alnum-[0IOl]> ** 26..* >>  # an address is at least 26 characters long
    <?{
        .subbuf(21, 4) eq sha256(sha256 .subbuf(0, 21)).subbuf(0, 4) given
        blob8.new: <
            1 2 3 4 5 6 7 8 9
            A B C D E F G H   J K L M N   P Q R S T U V W X Y Z
            a b c d e f g h i j k   m n o p q r s t u v w x y z
        >.pairs.invert.hash{$/.comb}
        .reduce(* * 58 + *)
        .polymod(256 xx 24)
        .reverse;
    }>
/;

say "Here is a bitcoin address: 1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i" ~~ $bitcoin-address;

```

Output:

```
｢1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i｣
```


[User]
Bitcoin uses a specific encoding format to encode the digest of an elliptic curve public point into a short ASCII string. The purpose of this task is to perform such a conversion.

The encoding steps are:

* take the X and Y coordinates of the given public point, and concatenate them in order to have a 64 byte-longed string ;
* add one byte prefix equal to 4 (it is a convention for this way of encoding a public point) ;
* compute the SHA-256 of this string ;
* compute the RIPEMD-160 of this SHA-256 digest ;
* compute the checksum of the concatenation of the version number digit (a single zero byte) and this RIPEMD-160 digest, as described in bitcoin/address validation ;
* Base-58 encode (see below) the concatenation of the version number (zero in this case), the ripemd digest and the checksum

The base-58 encoding is based on an alphabet of alphanumeric characters (numbers, upper case and lower case, in that order) but without the four characters 0, O, l and I.

Here is an example public point:

```
X = 0x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352
Y = 0x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6
```

The corresponding address should be:
16UwLL9Risc3QfPqBUvKofHmBQ7wMtjvM

Nb. The leading '1' is not significant as 1 is zero in base-58. It is however often added to the bitcoin address for various reasons. There can actually be several of them. You can ignore this and output an address without the leading 1.

*Extra credit:* add a verification procedure about the public point, making sure it belongs to the secp256k1 elliptic curve

[Assistant]
(formerly Perl 6)

```
sub dgst(blob8 $b, Str :$dgst) returns blob8 {
  given run «openssl dgst "-$dgst" -binary», :in, :out, :bin {
    .in.write: $b;
    .in.close;
    return .out.slurp;
  }
}
sub sha256($b) { dgst $b, :dgst<sha256> }
sub rmd160($b) { dgst $b, :dgst<rmd160> }

sub public_point_to_address( UInt $x, UInt $y ) {
    my @bytes = flat ($y,$x).map: *.polymod( 256 xx * )[^32];
    my $hash = rmd160 sha256 blob8.new: 4, @bytes.reverse;
    my $checksum = sha256(sha256 blob8.new: 0, $hash.list).subbuf: 0, 4;
    [R~] <
        1 2 3 4 5 6 7 8 9
      A B C D E F G H   J K L M N   P Q R S T U V W X Y Z
      a b c d e f g h i j k   m n o p q r s t u v w x y z
    >[ .polymod: 58 xx * ] given
    reduce * * 256 + * , flat 0, ($hash, $checksum)».list
}

say public_point_to_address
  0x50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352,
  0x2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6;

```

Output:

```
6UwLL9Risc3QfPqBUvKofHmBQ7wMtjvM
```


[User]
Show a basic storage type to handle a simple RGB raster graphics image,
and some primitive associated functions.

If possible provide a function to allocate an uninitialised image,
given its width and height, and provide 3 additional functions:

:   :   * one to fill an image with a plain RGB color,
        * one to set a given pixel with a color,
        * one to get the color of a pixel.

(If there are specificities about the storage or the allocation, explain those.)

*These functions are used as a base for the articles in the category raster graphics operations,*
and a basic output function to check the results
is available in the article write ppm file.

[Assistant]
(formerly Perl 6)

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	$i where ^$!width,
	$j where ^$!height
	--> Pixel
    ) is rw { @!data[$i + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
	self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	self.pixel($i, $j);
    }
}

my Bitmap $b = Bitmap.new( width => 10, height => 10);

$b.fill( Pixel.new( R => 0, G => 0, B => 200) );

$b.set-pixel( 7, 5, Pixel.new( R => 100, G => 200, B => 0) );

say $b.perl;

```

Thanks to the rw trait on the pixel method, we don't actually need to define two separate methods, set-pixel and get-pixel, but that is an explicit requirement of the task. (Beware your presuppositions! In Raku, accessors only determine identity, not use. In particular, identity is considered orthogonal to lvalue/rvalue context.)


[User]
Task

Using the data storage type defined on the Bitmap page for raster graphics images,

draw a line given two points with Bresenham's line algorithm.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

Bitmap class from Bitmap task.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	$i where ^$!width,
	$j where ^$!height
	--> Pixel
    ) is rw { @!data[$i + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
	self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	self.pixel($i, $j);
    }
}

sub line(Bitmap $bitmap, $x0 is copy, $x1 is copy, $y0 is copy, $y1 is copy) {
    my $steep = abs($y1 - $y0) > abs($x1 - $x0);
    if $steep {
        ($x0, $y0) = ($y0, $x0);
        ($x1, $y1) = ($y1, $x1);
    }
    if $x0 > $x1 {
        ($x0, $x1) = ($x1, $x0);
        ($y0, $y1) = ($y1, $y0);
    }
    my $Δx = $x1 - $x0;
    my $Δy = abs($y1 - $y0);
    my $error = 0;
    my $Δerror = $Δy / $Δx;
    my $y-step = $y0 < $y1 ?? 1 !! -1;
    my $y = $y0;
    for $x0 .. $x1 -> $x {
        my $pix = Pixel.new(R => 100, G => 200, B => 0);
        if $steep {
            $bitmap.set-pixel($y, $x, $pix);
        } else {
            $bitmap.set-pixel($x, $y, $pix);
        }
        $error += $Δerror;
        if $error >= 0.5 {
            $y += $y-step;
            $error -= 1.0;
        }
    }
}

```


[User]
Using the data storage type defined on this page for raster images, and the draw\_line function defined in this other one, draw a **cubic bezier curve**
(definition on Wikipedia).

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.09

Uses pieces from Bitmap, and Bresenham's line algorithm tasks. They are included here to make a complete, runnable program.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	  $i where ^$!width,
	  $j where ^$!height
	  --> Pixel
    ) is rw { @!data[$i + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
        self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	    self.pixel($i, $j);
    }

    method line(($x0 is copy, $y0 is copy), ($x1 is copy, $y1 is copy), $pix) {
        my $steep = abs($y1 - $y0) > abs($x1 - $x0);
        if $steep {
            ($x0, $y0) = ($y0, $x0);
            ($x1, $y1) = ($y1, $x1);
        }
        if $x0 > $x1 {
            ($x0, $x1) = ($x1, $x0);
            ($y0, $y1) = ($y1, $y0);
        }
        my $Δx = $x1 - $x0;
        my $Δy = abs($y1 - $y0);
        my $error = 0;
        my $Δerror = $Δy / $Δx;
        my $y-step = $y0 < $y1 ?? 1 !! -1;
        my $y = $y0;
        for $x0 .. $x1 -> $x {
            if $steep {
                self.set-pixel($y, $x, $pix);
            } else {
                self.set-pixel($x, $y, $pix);
            }
            $error += $Δerror;
            if $error >= 0.5 {
                $y += $y-step;
                $error -= 1.0;
            }
        }
    }

    method dot (($px, $py), $pix, $radius = 2) {
        for $px - $radius .. $px + $radius -> $x {
            for $py - $radius .. $py + $radius -> $y {
                self.set-pixel($x, $y, $pix) if ( $px - $x + ($py - $y) * i ).abs <= $radius;
            }
        }
    }

    method cubic ( ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4), $pix, $segments = 30 ) {
        my @line-segments = map -> $t {
            my \a = (1-$t)³;
            my \b = $t  * (1-$t)² * 3;
            my \c = $t² * (1-$t)  * 3;
            my \d = $t³;
            (a*$x1 + b*$x2 + c*$x3 + d*$x4).round(1),(a*$y1 + b*$y2 + c*$y3 + d*$y4).round(1)
        }, (0, 1/$segments, 2/$segments ... 1);
        for @line-segments.rotor(2=>-1) -> ($p1, $p2) { self.line( $p1, $p2, $pix) };
    }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub color( $r, $g, $b) { Pixel.new(R => $r, G => $g, B => $b) }

my Bitmap $b = Bitmap.new( width => 600, height => 400) but PPM;

$b.fill( color(2,2,2) );

my @points = (85,390), (5,5), (580,370), (270,10);

my %seen;
my $c = 0;
for @points.permutations -> @this {
    %seen{@this.reverse.join.Str}++;
    next if %seen{@this.join.Str};
    $b.cubic( |@this, color(255-$c,127,$c+=22) );
}

@points.map: { $b.dot( $_, color(255,0,0), 3 )}

$*OUT.write: $b.P6;

```

See example image here, (converted to a .png as .ppm format is not widely supported).


[User]
Using the data storage type defined on this page for raster images, and the draw\_line function defined in this one, draw a *quadratic bezier curve*
(definition on Wikipedia).

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.09

Uses pieces from Bitmap, and Bresenham's line algorithm tasks. They are included here to make a complete, runnable program.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	  $i where ^$!width,
	  $j where ^$!height
	  --> Pixel
    ) is rw { @!data[$i + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
        return if $j >= $!height;
        self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	    self.pixel($i, $j);
    }

    method line(($x0 is copy, $y0 is copy), ($x1 is copy, $y1 is copy), $pix) {
        my $steep = abs($y1 - $y0) > abs($x1 - $x0);
        if $steep {
            ($x0, $y0) = ($y0, $x0);
            ($x1, $y1) = ($y1, $x1);
        }
        if $x0 > $x1 {
            ($x0, $x1) = ($x1, $x0);
            ($y0, $y1) = ($y1, $y0);
        }
        my $Δx = $x1 - $x0;
        my $Δy = abs($y1 - $y0);
        my $error = 0;
        my $Δerror = $Δy / $Δx;
        my $y-step = $y0 < $y1 ?? 1 !! -1;
        my $y = $y0;
        for $x0 .. $x1 -> $x {
            if $steep {
                self.set-pixel($y, $x, $pix);
            } else {
                self.set-pixel($x, $y, $pix);
            }
            $error += $Δerror;
            if $error >= 0.5 {
                $y += $y-step;
                $error -= 1.0;
            }
        }
    }

    method dot (($px, $py), $pix, $radius = 2) {
        for $px - $radius .. $px + $radius -> $x {
            for $py - $radius .. $py + $radius -> $y {
                self.set-pixel($x, $y, $pix) if ( $px - $x + ($py - $y) * i ).abs <= $radius;
            }
        }
    }

    method quadratic ( ($x1, $y1), ($x2, $y2), ($x3, $y3), $pix, $segments = 30 ) {
        my @line-segments = map -> $t {
            my \a = (1-$t)²;
            my \b = $t * (1-$t) * 2;
            my \c = $t²;
            (a*$x1 + b*$x2 + c*$x3).round(1),(a*$y1 + b*$y2 + c*$y3).round(1)
        }, (0, 1/$segments, 2/$segments ... 1);
        for @line-segments.rotor(2=>-1) -> ($p1, $p2) { self.line( $p1, $p2, $pix) };
    }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub color( $r, $g, $b) { Pixel.new(R => $r, G => $g, B => $b) }

my Bitmap $b = Bitmap.new( width => 600, height => 400) but PPM;

$b.fill( color(2,2,2) );

my @points = (65,25), (85,380), (570,15);

my %seen;
my $c = 0;
for @points.permutations -> @this {
    %seen{@this.reverse.join.Str}++;
    next if %seen{@this.join.Str};
    $b.quadratic( |@this, color(255-$c,127,$c+=80) );
}

@points.map: { $b.dot( $_, color(255,0,0), 3 )}

$*OUT.write: $b.P6;

```

See example image here, (converted to a .png as .ppm format is not widely supported).


[User]
Implement a flood fill.

A flood fill is a way of filling an area using *color banks* to define the contained area or a *target color* which "determines" the area (the *valley* that can be flooded; Wikipedia uses the term *target color*). It works almost like a water flooding from a point towards the banks (or: inside the valley): if there's a hole in the banks, the flood is not contained and all the image (or all the "connected valleys") get filled.

To accomplish the task, you need to implement just one of the possible algorithms (examples are on Wikipedia). Variations on the *theme* are allowed (e.g. adding a tolerance parameter or argument for color-matching of the *banks* or *target* color).

**Testing**: the basic algorithm is not suitable for *truecolor* images; a possible test image is the one shown on the right box; you can try to fill the white area, or the black inner circle.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.11

Using bits and pieces from various other bitmap tasks.

```
class Pixel { has Int ($.R, $.G, $.B) }
class Bitmap {
    has Int ($.width, $.height);
    has Pixel @.data;

    method pixel(
	    $i where ^$!width,
	    $j where ^$!height
	    --> Pixel
      ) is rw { @!data[$i + $j * $!width] }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.get;
    my ($width, $height) = $fh.get.split: ' ';
    my $depth = $fh.get;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub color-distance (Pixel $c1, Pixel $c2) {
    sqrt( ( ($c1.R - $c2.R)² + ($c1.G - $c2.G)² + ($c1.B - $c2.B)² ) / ( 255 * sqrt(3) ) );
}

sub flood ($img, $x, $y, $c1) {
    my $c2 = $img.pixel($x, $y);
    my $max-distance = 10;
    my @queue;
    my %checked;
    check($x, $y);
    for @queue -> [$x, $y] {
        $img.pixel($x, $y) = $c1.clone;
    }

    sub check ($x, $y) {
        my $c3 = $img.pixel($x, $y);

        if color-distance($c2, $c3) < $max-distance {
            @queue.push: [$x,$y];
            @queue.elems;
            %checked{"$x,$y"} = 1;
            check($x - 1, $y) if $x > 0               and %checked{"{$x - 1},$y"}:!exists;
            check($x + 1, $y) if $x < $img.width - 1  and %checked{"{$x + 1},$y"}:!exists;
            check($x, $y - 1) if $y > 0               and %checked{"$x,{$y - 1}"}:!exists;
            check($x, $y + 1) if $y < $img.height - 1 and %checked{"$x,{$y + 1}"}:!exists;
        }
    }
}

my $infile = './Unfilled-Circle.ppm';

my Bitmap $b = load-ppm( $infile ) but PPM;

flood($b, 5,     5, Pixel.new(:255R, :0G, :0B));
flood($b, 5,   125, Pixel.new(:255R, :0G, :0B));
flood($b, 125,   5, Pixel.new(:255R, :0G, :0B));
flood($b, 125, 125, Pixel.new(:255R, :0G, :0B));
flood($b, 50,   50, Pixel.new(:0R, :0G, :255B));

my $outfile = open('./Bitmap-flood-perl6.ppm', :w, :bin);

$outfile.write: $b.P6;

```

See output image Bitmap-flood-perl6 (offsite image file, converted to PNG for ease of viewing)


[User]
Extend the basic bitmap storage defined on this page to support dealing with image histograms. The image histogram contains for each luminance the count of image pixels having this luminance. Choosing a histogram representation take care about the data type used for the counts. It must have range of at least 0..NxM, where N is the image width and M is the image height.

**Test task**

Histogram is useful for many image processing operations. As an example, use it to convert an image into black and white art. The method works as follows:

* Convert image to grayscale;
* Compute the histogram
* Find the median: defined as the luminance such that the image has an approximately equal number of pixels with lesser and greater luminance.
* Replace each pixel of luminance lesser than the median to black, and others to white.

Use read/write ppm file, and grayscale image solutions.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.09

Uses pieces from Bitmap, Write a PPM file and Grayscale image tasks. Included here to make a complete, runnable program.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @.data;
}

role PBM {
    has @.BM;
    method P4 returns Blob {
	"P4\n{self.width} {self.height}\n".encode('ascii')
	~ Blob.new: self.BM
    }
}

sub getline ( $fh ) {
    my $line = '#'; # skip comments when reading image file
    $line = $fh.get while $line.substr(0,1) eq '#';
    $line;
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.&getline;
    my ($width, $height) = $fh.&getline.split: ' ';
    my $depth = $fh.&getline;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub grayscale ( Bitmap $bmp ) {
    map { (.R*0.2126 + .G*0.7152 + .B*0.0722).round(1) min 255 }, $bmp.data;
}

sub histogram ( Bitmap $bmp ) {
    my @gray = grayscale($bmp);
    my $threshold = @gray.sum / @gray;
    for @gray.rotor($bmp.width) {
        my @row = $_.list;
        @row.push(0) while @row % 8;
        $bmp.BM.append: @row.rotor(8).map: { :2(($_ X< $threshold)».Numeric.join) }
    }
}

my $filename = './Lenna.ppm';

my Bitmap $b = load-ppm( $filename ) but PBM;

histogram($b);

'./Lenna-bw.pbm'.IO.open(:bin, :w).write: $b.P4;

```

See Lenna, and Lenna-bw images. (converted to .png as .ppm format is not widely supported).


[User]
Task

Using the data storage type defined on this page for raster images,
write an implementation of the **midpoint circle algorithm**   (also known as **Bresenham's circle algorithm**).

(definition on Wikipedia).

[Assistant]
(formerly Perl 6)

**Translation of**: C

We'll augment the Pixel and Bitmap classes from the Bitmap task.

```
use MONKEY-TYPING;

class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel \p) {
        @!data = p xx ($!width × $!height)
    }

    method pixel( \i where ^$!width, \j where ^$!height --> Pixel) is rw {
        @!data[i × $!width + j]
    }

    method set-pixel (\i, \j, Pixel \p) {
        self.pixel(i, j) = p;
    }

    method get-pixel (\i, \j) returns Pixel {
        self.pixel(i, j);
    }
}

augment class Pixel  { method Str { "$.R $.G $.B" } }
augment class Bitmap {
    method P3 {
        join "\n", «P3 "$.width $.height" 255»,
        do for ^($.width × $.height) { join ' ', @!data[$_] }
    }

    method raster-circle ( \x0, \y0, \r, Pixel \value ) {
        my $ddF_x   =  0;
        my $ddF_y   = -2 × r;
        my $f       =  1 - r;
        my ($x, $y) =  0,  r;
        for flat (0 X 1,-1),(1,-1 X 0) -> \i, \j {
            self.set-pixel(x0 + i×r, y0 + j×r, value)
        }

        while $x < $y {
            ($y--; $f +=     ($ddF_y += 2)) if $f ≥ 0;
             $x++; $f += 1 + ($ddF_x += 2);
            for flat (1,-1) X (1,-1) -> \i, \j {
                self.set-pixel(x0 + i×$x, y0 + j×$y, value);
                self.set-pixel(x0 + i×$y, y0 + j×$x, value);
            }
        }
    }
}

my Bitmap $b = Bitmap.new( width => 32, height => 32);
$b.fill( Pixel.new( R => 0, G => 0, B => 0) );
$b.raster-circle(16, 16, 15, Pixel.new(R=>0, G=>0, B=>100));
say $b.P3;

```


[User]
Using the data storage type defined on this page for raster images, delegate writing a JPEG file through a **pipe** using the output\_ppm function defined on this other page.

There are various utilities that can be used for this task, for example: **cjpeg** (package *"jpeg-progs"* on Linux, or *"media-libs/libjpeg-turbo"* on Gentoo), **ppmtojpeg** (package *"netpbm"* on Linux), **convert** (from *ImageMagick*, multi-platform).

[Assistant]
(formerly Perl 6)

```
# Reference:
# https://rosettacode.org/wiki/Bitmap/Write_a_PPM_file#Raku

use v6;

class Pixel { has uint8 ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
          $i where ^$!width,
          $j where ^$!height
          --> Pixel
      ) is rw { @!data[$i*$!height + $j] }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
        "P6\n{self.width} {self.height}\n255\n".encode('ascii')
        ~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

my Bitmap $b = Bitmap.new(width => 125, height => 125) but PPM;
for flat ^$b.height X ^$b.width -> $i, $j {
    $b.pixel($i, $j) = Pixel.new: :R($i*2), :G($j*2), :B(255-$i*2);
}

my $proc = run '/usr/bin/convert','-','output_piped.jpg', :in;
$proc.in.write: $b.P6;
$proc.in.close;

```

Output:

```
file output_piped.jpg
output_piped.jpg: JPEG image data, JFIF standard 1.01, aspect ratio, density 1x1, segment length 16, baseline, precision 8, 125x125, frames 3
```


[User]
Using the data storage type defined on this page for raster images, read an image from a PPM file (binary P6 prefered).
(Read the definition of PPM file on Wikipedia.)

**Task**: Use write ppm file solution and grayscale image solution with this one in order to convert a color image to grayscale one.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.09

Uses pieces from Bitmap, Write a PPM file and Grayscale image tasks. Included here to make a complete, runnable program.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @.data;
}

role PGM {
    has @.GS;
    method P5 returns Blob {
	"P5\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: self.GS
    }
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.get;
    my ($width, $height) = $fh.get.split: ' ';
    my $depth = $fh.get;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub grayscale ( Bitmap $bmp ) {
    $bmp.GS = map { (.R*0.2126 + .G*0.7152 + .B*0.0722).round(1) min 255 }, $bmp.data;
}

my $filename = './camelia.ppm';

my Bitmap $b = load-ppm( $filename ) but PGM;

grayscale($b);

'./camelia-gs.pgm'.IO.open(:bin, :w).write: $b.P5;

```

See camelia, and camelia-gs images. (converted to .png as .ppm format is not widely supported).


[User] This task is the *opposite* of the PPM conversion through a pipe. In this task, using a delegate tool (like **cjpeg**, one of the netpbm package, or **convert** of the ImageMagick package) we read an image file and load it into the data storage type defined here. We can also use the code from Read ppm file, so that we can use PPM format like a (natural) bridge between the foreign image format and our simple data storage.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.09

Uses pieces from Bitmap and Read a PPM file tasks. Included here to make a complete, runnable program.

Uses imagemagick convert to pipe the image in.

```
class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @.data;
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub getline ( $proc ) {
    my $line = '#'; # skip comment when reading a .png
    $line = $proc.out.get while $line.substr(0,1) eq '#';
    $line;
}

my $filename = './camelia.png';

my $proc = run 'convert', $filename, 'ppm:-', :enc('ISO-8859-1'), :out;

my $type = getline($proc);
my ($width, $height) = getline($proc).split: ' ';
my $depth = getline($proc);

my Bitmap $b = Bitmap.new( width => $width.Int, height => $height.Int) but PPM;

$b.data = $proc.out.slurp.ords.rotor(3).map:
  { Pixel.new(R => .[0], G => .[1], B => .[2]) };

'./camelia.ppm'.IO.open(:bin, :w).write: $b.P6;

```

See camelia image here.


[User]
Using the data storage type defined on this page for raster images, write the image to a PPM file (binary P6 preferred).

(Read the definition of PPM file on Wikipedia.)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016-01

```
class Pixel { has uint8 ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	  $i where ^$!width,
	  $j where ^$!height
	  --> Pixel
      ) is rw { @!data[$i*$!height + $j] }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

my Bitmap $b = Bitmap.new(width => 125, height => 125) but PPM;
for flat ^$b.height X ^$b.width -> $i, $j {
    $b.pixel($i, $j) = Pixel.new: :R($i*2), :G($j*2), :B(255-$i*2);
}

$*OUT.write: $b.P6;

```

Converted to a png. (ppm files not locally supported)


[User]
The aim of this task is to write functions (or create a class if your

language is Object Oriented and you prefer) for reading and writing sequences of
bits, most significant bit first. While the output of a asciiprint "STRING" is the ASCII byte sequence
"S", "T", "R", "I", "N", "G", the output of a "print" of the bits sequence
0101011101010 (13 bits) must be 0101011101010; real I/O is performed always
*quantized* by byte (avoiding endianness issues and relying on underlying
buffering for performance), therefore you must obtain as output the bytes
0101 0111 0101 0**000** (bold bits are padding bits), i.e. in hexadecimal 57 50.

As test, you can implement a **rough** (e.g. don't care about error handling or
other issues) compression/decompression program for ASCII sequences
of bytes, i.e. bytes for which the most significant bit is always unused, so that you can write
seven bits instead of eight (each 8 bytes of input, we write 7 bytes of output).

These bit oriented I/O functions can be used to implement compressors and
decompressors; e.g. Dynamic and Static Huffman encodings use variable length
bits sequences, while LZW (see LZW compression) use fixed or variable *words*
nine (or more) bits long.

* Limits in the maximum number of bits that can be written/read in a single read/write operation are allowed.
* Errors handling is not mandatory

[Assistant]
(formerly Perl 6)

```
sub encode-ascii(Str $s) {
    my @b = flat $s.ords».fmt("%07b")».comb;
    @b.push(0) until @b %% 8;   # padding
    Buf.new: gather while @b { take reduce * *2+*, (@b.pop for ^8) }
}

sub decode-ascii(Buf $b) {
    my @b = flat $b.list».fmt("%08b")».comb;
    @b.shift until @b %% 7;   # remove padding
    @b = gather while @b { take reduce * *2+*, (@b.pop for ^7) }
    return [~] @b».chr;
}
say my $encode = encode-ascii 'STRING';
say decode-ascii $encode;

```

Output:

```
Buf:0x<03 8b 99 29 4a e5>
STRING
```


[User]
Task

Write a routine to perform a bitwise AND, OR, and XOR on two integers, a bitwise NOT on the first integer, a left shift, right shift, right arithmetic shift, left rotate, and right rotate.

All shifts and rotates should be done on the first integer with a shift/rotate amount of the second integer.

If any operation is not available in your language, note it.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.05

```
constant MAXINT = uint.Range.max;
constant BITS = MAXINT.base(2).chars;

# define rotate ops for the fun of it
multi sub infix:<⥁>(Int:D \a, Int:D \b) { :2[(a +& MAXINT).polymod(2 xx BITS-1).list.rotate(b).reverse] }
multi sub infix:<⥀>(Int:D \a, Int:D \b) { :2[(a +& MAXINT).polymod(2 xx BITS-1).reverse.list.rotate(b)] }

sub int-bits (Int $a, Int $b) {
    say '';
    say_bit "$a", $a;
    say '';
    say_bit "1's complement (not) $a", +^$a;
    say_bit "2's complement $a", +^$a + 1;
    say_bit "$a and $b", $a +& $b;
    say_bit "$a or $b",  $a +| $b;
    say_bit "$a xor $b", $a +^ $b;
    say_bit "$a unsigned shift right $b", ($a +& MAXINT) +> $b;
    say_bit "$a signed shift right $b", $a +> $b;
    say_bit "$a rotate right $b", $a ⥁ $b;
    say_bit "$a shift left $b", $a +< $b;
    say_bit "$a rotate left $b", $a ⥀ $b;
}

int-bits(7,2);
int-bits(-65432,31);

sub say_bit ($message, $value) {
    printf("%30s: %{'0' ~ BITS}b\n", $message, $value +& MAXINT);
}
```

Output:

```
                             7: 0000000000000000000000000000000000000000000000000000000000000111

        1's complement (not) 7: 1111111111111111111111111111111111111111111111111111111111111000
              2's complement 7: 1111111111111111111111111111111111111111111111111111111111111001
                       7 and 2: 0000000000000000000000000000000000000000000000000000000000000010
                        7 or 2: 0000000000000000000000000000000000000000000000000000000000000111
                       7 xor 2: 0000000000000000000000000000000000000000000000000000000000000101
      7 unsigned shift right 2: 0000000000000000000000000000000000000000000000000000000000000001
        7 signed shift right 2: 0000000000000000000000000000000000000000000000000000000000000001
              7 rotate right 2: 1100000000000000000000000000000000000000000000000000000000000001
                7 shift left 2: 0000000000000000000000000000000000000000000000000000000000011100
               7 rotate left 2: 0000000000000000000000000000000000000000000000000000000000011100

                        -65432: 1111111111111111111111111111111111111111111111110000000001101000

   1's complement (not) -65432: 0000000000000000000000000000000000000000000000001111111110010111
         2's complement -65432: 0000000000000000000000000000000000000000000000001111111110011000
                 -65432 and 31: 0000000000000000000000000000000000000000000000000000000000001000
                  -65432 or 31: 1111111111111111111111111111111111111111111111110000000001111111
                 -65432 xor 31: 1111111111111111111111111111111111111111111111110000000001110111
-65432 unsigned shift right 31: 0000000000000000000000000000000111111111111111111111111111111111
  -65432 signed shift right 31: 1111111111111111111111111111111111111111111111111111111111111111
        -65432 rotate right 31: 1111111111111110000000001101000111111111111111111111111111111111
          -65432 shift left 31: 1111111111111111100000000011010000000000000000000000000000000000
         -65432 rotate left 31: 1111111111111111100000000011010001111111111111111111111111111111
```


[User]
The Blossom Algorithm
:   The Blossom algorithm, developed by Jack Edmonds in 1965, is a seminal algorithm that solves the maximum matching problem for general graphs by extending the augmenting path concept to handle odd cycles.

Core Idea
:   Shrinking Blossoms
:   The key insight of the Blossom algorithm is to identify an odd cycle (a blossom) when encountered during the search for an augmenting path. When a blossom is detected, the algorithm *contracts* or *shrinks* the entire cycle into a single "pseudo-vertex". This creates a smaller, auxiliary graph.
:   The search for an augmenting path then continues in this contracted graph. If an augmenting path is found in the contracted graph that involves a pseudo-vertex (representing a shrunk blossom), this path can be "lifted" back to the original graph. The structure of the blossom allows the algorithm to find a corresponding augmenting path in the original graph that utilizes edges within the blossom.
:   This process of shrinking blossoms, searching for augmenting paths in the contracted graph, and expanding blossoms to find paths in the original graph is repeated until no more augmenting paths are found, at which point the current matching is maximum.

Problem
:   Maximum Matching in General Graphs
:   The problem addressed by the Blossom algorithm is finding a Maximum matching|maximum matching in a Graph (discrete mathematics)|general graph. Unlike Bipartite graph|bipartite graphs, general graphs can contain Cycle (graph theory)|odd-length cycles.

Graph and Matching Definition
:   A Graph (discrete mathematics)|graph **G** is formally defined by a set of Vertex (graph theory)|vertices **V** and a set of Edge (graph theory)|edges **E**, denoted as

    G
    =
    (
    V
    ,
    E
    )
    {\displaystyle {\displaystyle G=(V,E)}}
    . An edge connects two vertices.
:   A Matching (graph theory)|matching **M** in **G** is a subset of the edges **E** such that no two edges in **M** share a common vertex. That is, for any two distinct edges

    e

    1
    =

    u

    1
    ,

    v

    1
    ∈
    M
    {\displaystyle {\displaystyle e\_{1}={u\_{1},v\_{1}}\in M}}
     and

    e

    2
    =

    u

    2
    ,

    v

    2
    ∈
    M
    {\displaystyle {\displaystyle e\_{2}={u\_{2},v\_{2}}\in M}}
    , the sets of vertices

    u

    1
    ,

    v

    1
    {\displaystyle {\displaystyle {u\_{1},v\_{1}}}}
     and

    u

    2
    ,

    v

    2
    {\displaystyle {\displaystyle {u\_{2},v\_{2}}}}
     are disjoint.

Maximum Matching
:   A Maximum matching|maximum matching is a matching **M** with the largest possible number of edges among all possible matchings in the graph **G**. The size of the matching is

    |
    M

    |
    {\displaystyle {\displaystyle |M|}}
    .
:   The objective of the maximum matching problem is to find a matching **M** such that

    |
    M

    |
    {\displaystyle {\displaystyle |M|}}
     is maximized.

Challenge in General Graphs
:   Odd Cycles
:   For Bipartite graph|bipartite graphs, efficient algorithms exist (e.g., Hopcroft-Karp algorithm) that rely on finding Augmenting path|augmenting paths. An augmenting path with respect to a matching **M** is a path that starts and ends at unmatched vertex|unmatched vertices, and its edges alternate between being outside **M** and inside **M**. If such a path exists, the matching can be increased by one edge by flipping the edges along the path (taking edges not in **M** and removing edges in **M** along the path). Berge's lemma states that a matching is maximum if and only if it has no augmenting path.
:   However, the presence of Cycle (graph theory)|odd-length cycles in general graphs complicates the search for augmenting paths. Standard Breadth-first search|BFS techniques used for bipartite graphs can get "confused" by odd cycles, which are sometimes called *blossoms* or *flowers* in this context. An odd cycle can contain an even number of matched edges and an odd number of unmatched edges with respect to an alternating path leading into it, potentially preventing the discovery of a true augmenting path using simple methods.

Objective
:   Given a general graph

    G
    =
    (
    V
    ,
    E
    )
    {\displaystyle {\displaystyle G=(V,E)}}
    , the problem is to compute a matching

    M
    ⊆
    E
    {\displaystyle {\displaystyle M\subseteq E}}
     such that its size

    |
    M

    |
    {\displaystyle {\displaystyle |M|}}
     is maximum. The Blossom algorithm provides a polynomial-time solution to this problem.

Complexity
:   The original Blossom algorithm by Edmonds has a time complexity of

    O
    (

    |
    V

    |

    2

    |
    E

    |
    )
    {\displaystyle {\displaystyle O(|V|^{2}|E|)}}
    . Subsequent improvements by Edmonds and others, including Robert Tarjan|Tarjan, led to more efficient versions. Modern implementations using advanced data structures achieve a time complexity of

    O
    (

    |
    E

    |

    |
    V

    |
    )
    {\displaystyle {\displaystyle O(|E|{\sqrt {|V|}})}}
    , which is generally considered very efficient for this problem. An

    O
    (

    |
    V

    |

    3
    )
    {\displaystyle {\displaystyle O(|V|^{3})}}
     variant is also commonly cited and easier to implement.

[Assistant]
**Translation of**: Phix

**Translation of**: Python

```
# 20250512 Raku programming solution

# least common ancestor of x and y in the alternating forest
sub lca($x is copy, $y is copy, @bases, @matches, @paths, $n) {
   my @usedPath = False xx $n;
   loop {
      @usedPath[$x = @bases[$x]] = True;
      @matches[$x] < 0 ?? ( last ) !! $x = @paths[@matches[$x]]
   }
   loop {
      @usedPath[$y = @bases[$y]].Bool ?? ( last ) !! $y = @paths[@matches[$y]]
   }
   return $y;
}

# mark path from v up to base0, setting parents to x
sub markPath($v is copy, $base0, $x is copy, @bases, @matches, @paths, @blossom) {
   while @bases[$v] != $base0 {
      my $mv = @matches[$v];
      @blossom[@bases[$mv]] = @blossom[@bases[$v]] = True;
      @paths[$v] = $x;
      $v = @paths[ $x = $mv ];
   }
}

# attempt to find an augmenting path from root
sub findPath(@adj, $root, $n, @matches is copy) {
   my @paths = -1 xx $n;
   my @bases = ^$n;
   my @queue = ($root);
   my (@used, @blossom) is default( False );
   @used[$root] = True;

   while my $v = @queue.shift {
      for @adj[$v].flat -> $u {
         next unless @bases[$v] != @bases[$u] && @matches[$v] != $u;
         if $u == $root || (@matches[$u] != -1 && @paths[@matches[$u]] != -1) {
            # Found a blossom; contract it
            my $curbase = lca($v, $u, @bases, @matches, @paths, $n);
            markPath($v, $curbase, $u, @bases, @matches, @paths, @blossom);
            markPath($u, $curbase, $v, @bases, @matches, @paths, @blossom);
            @queue.push: gather for ^$n -> $i {
               if @blossom[@bases[$i]] {
                  @bases[$i] = $curbase;
                  unless @used[$i] { @used[take $i] = True }
               }
            }
         } elsif @paths[$u] == -1 { # extend tree
            @paths[$u] = $v;
            if @matches[$u] == -1 { # augmenting path found
               my $v = $u;
               while $v != -1 {
                  my $prev = @paths[$v];
                  my $next = ( $prev != -1 ) ?? @matches[$prev] !! -1;
                  @matches[$v] = $prev;
                  @matches[$prev] = $v if $prev != -1;
                  $v = $next;
               }
               return (@matches, True);
            }
            @used[@matches[$u]] = True;
            @queue.push: @matches[$u];
         }
      }
   }
   return (@matches, False);
}

# find and return the matching array and the size of the matching
sub solve(@adj) {
   my @matches = -1 xx ( my $n = @adj.elems );
   my $res = 0;

   for ^$n -> $v {
      if @matches[$v] == -1 {
         my ($new_matches, $found) = findPath(@adj, $v, $n, @matches);
         if $found {
            @matches = @$new_matches;
            $res++;
         }
      }
   }
   return (@matches, $res);
}

# Example: 5-cycle (0–1–2–3–4–0)
my $n = 5;
my @edges = (0,1), (1,2), (2,3), (3,4), (4,0);
my @adj = [ [] xx $n ];
for @edges -> ($u, $v) {
   @adj[$u].push($v);
   @adj[$v].push($u);
}

my ($matches, $msize) = solve(@adj);
say "Maximum matching size: $msize";
say "Matched pairs:";
for $matches.kv -> $u, $v { say "  $u – $v" if $v != -1 && $u < $v }

```

You may Attempt This Online!


[User]
Definition

A positive integer **n** is a **Blum integer** if *n = p x q* is a semi-prime for which *p* and *q* are distinct primes congruent to 3 mod 4. In other words, *p* and *q* must be of the form 4*t* + 3 where *t* is some non-negative integer.

Example

21 is a Blum integer because it has two prime factors: 3 (= 4 x 0 + 3) and 7 (= 4 x 1 + 3).

Task

Find and show on this page the first **50** Blum integers.

Also show the **26,828**th.

Stretch

Find and show the **100,000**th, **200,000**th, **300,000**th and **400,000**th Blum integers.

For the first **400,000** Blum integers, show the percentage distribution by final decimal digit (to 3 decimal places). Clearly, such integers can only end in 1, 3, 7 or 9.

Related task

* Semiprime

References

* Wikipedia article Blum integer
* OEIS sequence A016105: Blum integers

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

sub is-blum(Int $n ) {
    return False if $n.is-prime;
    my $factor = find-factor($n);
    return True if ($factor.is-prime && ( my $div = $n div $factor ).is-prime && ($div != $factor)
    && ($factor % 4 == 3) && ($div % 4 == 3));
    False;
}

sub find-factor ( Int $n, $constant = 1 ) {
    my $x      = 2;
    my $rho    = 1;
    my $factor = 1;
    while $factor == 1 {
        $rho *= 2;
        my $fixed = $x;
        for ^$rho {
            $x = ( $x * $x + $constant ) % $n;
            $factor = ( $x - $fixed ) gcd $n;
            last if 1 < $factor;
        }
    }
    $factor = find-factor( $n, $constant + 1 ) if $n == $factor;
    $factor;
}

my @blum = lazy (2..Inf).hyper(:1000batch).grep: &is-blum;
say "The first fifty Blum integers:\n" ~
  @blum[^50].batch(10)».fmt("%3d").join: "\n";
say '';

printf "The %9s Blum integer: %9s\n", .&ordinal-digit(:c), comma @blum[$_-1] for 26828, 1e5, 2e5, 3e5, 4e5;

say "\nBreakdown by last digit:";
printf "%d => %%%7.4f:\n", .key, +.value / 4e3 for sort @blum[^4e5].categorize: {.substr(*-1)}

```

Output:

```
The first fifty Blum integers:
 21  33  57  69  77  93 129 133 141 161
177 201 209 213 217 237 249 253 301 309
321 329 341 381 393 413 417 437 453 469
473 489 497 501 517 537 553 573 581 589
597 633 649 669 681 713 717 721 737 749

The  26,828th Blum integer:   524,273
The 100,000th Blum integer: 2,075,217
The 200,000th Blum integer: 4,275,533
The 300,000th Blum integer: 6,521,629
The 400,000th Blum integer: 8,802,377

Breakdown by last digit:
1 => %25.0013:
3 => %25.0168:
7 => %24.9973:
9 => %24.9848:
```


[User]
Task

Show how to represent the boolean states "**true**" and "**false**" in a language.

If other objects represent "**true**" or "**false**" in conditionals, note it.

Related tasks

* Logical operations

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015.12

Raku provides an enumeration `Bool` with two values, `True` and `False`. Values of enumerations can be used as ordinary values or as mixins:

```
my Bool $crashed = False;
my $val = 0 but True;

```

For a discussion of Boolean context (how Raku decides whether something is True or False): https://docs.raku.org/language/contexts#index-entry-Boolean\_context.


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at Boustrophedon transform. 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 boustrophedon transform is a procedure which maps one sequence to another using a series of integer additions.

Generally speaking, given a sequence:

(

a

0
,

a

1
,

a

2
,
…
)
{\displaystyle {\displaystyle (a\_{0},a\_{1},a\_{2},\ldots )}}
, the boustrophedon transform yields another sequence:

(

b

0
,

b

1
,

b

2
,
…
)
{\displaystyle {\displaystyle (b\_{0},b\_{1},b\_{2},\ldots )}}
, where

b

0
{\displaystyle {\displaystyle b\_{0}}}
 is likely defined equivalent to

a

0
{\displaystyle {\displaystyle a\_{0}}}
.

There are a few different ways to effect the transform. You may construct a boustrophedon triangle and read off the edge values, or, may use the recurrence relationship:

:   T

    k
    ,
    0
    =

    a

    k
    {\displaystyle {\displaystyle T\_{k,0}=a\_{k}}}
:   T

    k
    ,
    n
    =

    T

    k
    ,
    n
    −
    1
    +

    T

    k
    −
    1
    ,
    k
    −
    n
    {\displaystyle {\displaystyle T\_{k,n}=T\_{k,n-1}+T\_{k-1,k-n}}}
:   with
    {\displaystyle {\displaystyle {\text{with }}}}
:   k
    ,
    n
    ∈

    N
    {\displaystyle {\displaystyle \quad k,n\in \mathbb {N} }}
:   k
    ≥
    n
    >
    0
    {\displaystyle {\displaystyle \quad k\geq n>0}}
    .

The transformed sequence is defined by

b

n
=

T

n
,
n
{\displaystyle {\displaystyle b\_{n}=T\_{n,n}}}
 (for

T

2
,
2
{\displaystyle {\displaystyle T\_{2,2}}}
 and greater indices).

You are free to use a method most convenient for your language. If the boustrophedon transform is provided by a built-in, or easily and freely available library, it is acceptable to use that (with a pointer to where it may be obtained).

Task

* Write a procedure (routine, function, subroutine, whatever it may be called in your language) to perform a boustrophedon transform to a given sequence.
* Use that routine to perform a boustrophedon transform on a few representative sequences. Show the first fifteen values from the transformed sequence.

:   *Use the following sequences for demonstration:*

    * (
      1
      ,
      0
      ,
      0
      ,
      0
      ,
      …
      )
      {\displaystyle {\displaystyle (1,0,0,0,\ldots )}}
       ( one followed by an infinite series of zeros )
    * (
      1
      ,
      1
      ,
      1
      ,
      1
      ,
      …
      )
      {\displaystyle {\displaystyle (1,1,1,1,\ldots )}}
       ( an infinite series of ones )
    * (
      1
      ,
      −
      1
      ,
      1
      ,
      −
      1
      ,
      …
      )
      {\displaystyle {\displaystyle (1,-1,1,-1,\ldots )}}
       ( (-1)^n: alternating 1, -1, 1, -1 )
    * (
      2
      ,
      3
      ,
      5
      ,
      7
      ,
      11
      ,
      …
      )
      {\displaystyle {\displaystyle (2,3,5,7,11,\ldots )}}
       ( sequence of prime numbers )
    * (
      1
      ,
      1
      ,
      2
      ,
      3
      ,
      5
      ,
      …
      )
      {\displaystyle {\displaystyle (1,1,2,3,5,\ldots )}}
       ( sequence of Fibonacci numbers )
    * (
      1
      ,
      1
      ,
      2
      ,
      6
      ,
      24
      ,
      …
      )
      {\displaystyle {\displaystyle (1,1,2,6,24,\ldots )}}
       ( sequence of factorial numbers )

Stretch

If your language supports big integers, show the first and last 20 digits, and the digit count of the 1000th element of each sequence.

See also

* Wikipedia - Boustrophedon transform * OEIS:A000111 - Euler, or up/down numbers * OEIS:A000667 - Boustrophedon transform of all-1's sequence * OEIS:A062162 - Boustrophedon transform of (-1)^n * OEIS:A000747 - Boustrophedon transform of primes * OEIS:A000744 - Boustrophedon transform of Fibonacci numbers * OEIS:A230960 - Boustrophedon transform of factorials

[Assistant]
```
sub boustrophedon-transform (@seq) { map *.tail, (@seq[0], {[[\+] flat @seq[++$ ], .reverse]}…*) }

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

for '1 followed by 0\'s A000111', (flat 1, 0 xx *),
    'All-1\'s           A000667', (flat 1 xx *),
    '(-1)^n             A062162', (flat 1, [\×] -1 xx *),
    'Primes             A000747', (^∞ .grep: &is-prime),
    'Fibonaccis         A000744', (1,1,*+*…*),
    'Factorials         A230960', (1,|[\×] 1..∞)
  -> $name, $seq
{ say "\n$name:\n" ~ (my $b-seq = boustrophedon-transform $seq)[^15] ~ "\n1000th term: " ~ abbr $b-seq[999] }

```

Output:

```
1 followed by 0's A000111:
1 1 1 2 5 16 61 272 1385 7936 50521 353792 2702765 22368256 199360981
1000th term: 61065678604283283233…63588348134248415232 (2369 digits)

All-1's           A000667:
1 2 4 9 24 77 294 1309 6664 38177 243034 1701909 13001604 107601977 959021574
1000th term: 29375506567920455903…86575529609495110509 (2370 digits)

(-1)^n             A062162:
1 0 0 1 0 5 10 61 280 1665 10470 73621 561660 4650425 41441530
1000th term: 12694307397830194676…15354198638855512941 (2369 digits)

Primes             A000747:
2 5 13 35 103 345 1325 5911 30067 172237 1096319 7677155 58648421 485377457 4326008691
1000th term: 13250869953362054385…82450325540640498987 (2371 digits)

Fibonaccis         A000744:
1 2 5 14 42 144 563 2526 12877 73778 469616 3288428 25121097 207902202 1852961189
1000th term: 56757474139659741321…66135597559209657242 (2370 digits)

Factorials         A230960:
1 2 5 17 73 381 2347 16701 134993 1222873 12279251 135425553 1627809401 21183890469 296773827547
1000th term: 13714256926920345740…19230014799151339821 (2566 digits)
```


[User]
Avast me hearties!

There be many a land lubber that knows naught of the pirate ways and gives direction by degree!
They know not how to box the compass!

Task description

1. Create a function that takes a heading in degrees and returns the correct 32-point compass heading.
2. Use the function to print and display a table of Index, Compass point, and Degree; rather like the corresponding columns from, the first table of the wikipedia article, but use only the following 33 headings as input:

:   `[0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38]`. (They should give the same order of points but are spread throughout the ranges of acceptance).

Notes;

* The headings and indices can be calculated from this pseudocode:

```
for i in 0..32 inclusive:
    heading = i * 11.25
    case i %3:
      if 1: heading += 5.62; break
      if 2: heading -= 5.62; break
    end
    index = ( i mod 32) + 1
```

* The column of indices can be thought of as an enumeration of the thirty two cardinal points (see talk page)..

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015.12

```
sub point (Int $index) {
    my $ix = $index % 32;
    if $ix +& 1
        { "&point(($ix + 1) +& 28) by &point(((2 - ($ix +& 2)) * 4) + $ix +& 24)" }
    elsif $ix +& 2
        { "&point(($ix + 2) +& 24)-&point(($ix +| 4) +& 28)" }
    elsif $ix +& 4
        { "&point(($ix + 8) +& 16)&point(($ix +| 8) +& 24)" }
    else
        { <north east south west>[$ix div 8]; }
}

sub test-angle ($ix) { $ix * 11.25 + (0, 5.62, -5.62)[ $ix % 3 ] }
sub angle-to-point(\𝜽) { floor 𝜽 / 360 * 32 + 0.5 }

for 0 .. 32 -> $ix {
    my \𝜽 = test-angle($ix);
    printf "  %2d %6.2f° %s\n",
              $ix % 32 + 1,
                  𝜽,
                         tc point angle-to-point 𝜽;
}

```

Output:

```
   1   0.00° North
   2  16.87° North by east
   3  16.88° North-northeast
   4  33.75° Northeast by north
   5  50.62° Northeast
   6  50.63° Northeast by east
   7  67.50° East-northeast
   8  84.37° East by north
   9  84.38° East
  10 101.25° East by south
  11 118.12° East-southeast
  12 118.13° Southeast by east
  13 135.00° Southeast
  14 151.87° Southeast by south
  15 151.88° South-southeast
  16 168.75° South by east
  17 185.62° South
  18 185.63° South by west
  19 202.50° South-southwest
  20 219.37° Southwest by south
  21 219.38° Southwest
  22 236.25° Southwest by west
  23 253.12° West-southwest
  24 253.13° West by south
  25 270.00° West
  26 286.87° West by north
  27 286.88° West-northwest
  28 303.75° Northwest by west
  29 320.62° Northwest
  30 320.63° Northwest by north
  31 337.50° North-northwest
  32 354.37° North by west
   1 354.38° North
```


[User]
Task

This algorithm is designed for pattern searching on certain types of devices which are backtracking-unfriendly such as Tape drives and Hard disks.

It works by first caching a segment of data from storage and match it against the pattern from the highest position backward to the lowest. If the matching fails, it will cache next segment of data and move the start point forward to skip the portion of data which will definitely fail to match. This continues until we successfully match the pattern or the pointer exceeds the data length.

Follow this link for more information about this algorithm.

To properly test this algorithm, it would be good to search for a string which contains repeated subsequences, such as `alfalfa` and the text being searched should not only include a match but that match should be preceded by words which partially match, such as `alfredo`, `behalf`, `calfskin`, `halfhearted`, `malfunction` or `severalfold`.

[Assistant]
**Translation of**: Phix

```
# 20220818 Raku programming solution

sub suffixes (@pat,\m) {
   loop (my ($i,$f,$g,@suff)=m-2, 0, m-1, |flat 0 xx m-1,m; $i >= 0; --$i) {
      if $i > $g and @suff[$i + m - 1 - $f] < $i - $g {
         @suff[$i] = @suff[$i + m - 1 - $f]
      } else {
	 $g = $i if $i < $g;
         $f = $i;
	 while $g >= 0 and @pat[$g] eq @pat[$g + m - 1 - $f] { $g-- }
         @suff[$i] = $f - $g
      }
   }
   return @suff;
}

sub preBmGs (@pat,\m) {
   my (@suff, @bmGs) := suffixes(@pat,m), [m xx m];

   for m-1 ... 0 -> \k {
      if @suff[k] == k + 1 {
         loop (my $j=0; $j < m-1-k; $j++) { @bmGs[k]=m-1-k if @bmGs[$j] == m }
      }
   }
   for ^(m-1) { @bmGs[m - 1 - @suff[$_]] = m - 1 - $_ }
   return @bmGs;
}

sub BM (@txt,@pat) {
   my (\m, \n, $j)    = +@pat, +@txt, 0;
   my (@bmGs, %bmBc) := preBmGs(@pat,m), hash @pat Z=> ( m-1 ... 1 );

   return gather while $j <= n - m {
      loop (my $i = m - 1; $i >= 0 and @pat[$i] eq @txt[$i + $j]; ) { $i-- }
      if $i < 0 {
	 take $j;
         $j += @bmGs[0]
      } else {
         $j += max @bmGs[$i], (%bmBc{@txt[$i + $j]} // m)-m+$i
      }
   }
}

my @texts = [
   "GCTAGCTCTACGAGTCTA",
   "GGCTATAATGCGTA",
   "there would have been a time for such a word",
   "needle need noodle needle",
   "BharôtভাৰতBharôtভারতIndiaBhāratભારતBhāratभारतBhārataಭಾರತBhāratभारतBhāratamഭാരതംBhāratभारतBhāratभारतBharôtôଭାରତBhāratਭਾਰਤBhāratamभारतम्Bārataபாரதம்BhāratamഭാരതംBhāratadēsamభారతదేశం",
   "InhisbookseriesTheArtofComputerProgrammingpublishedbyAddisonWesleyDKnuthusesanimaginarycomputertheMIXanditsassociatedmachinecodeandassemblylanguagestoillustratetheconceptsandalgorithmsastheyarepresented",
   "Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk.",
];

my @pats = [ "TCTA", "TAATAAA", "word", "needle", "ഭാരതം", "put", "and", "alfalfa"];

say "text$_ = @texts[$_]" for @texts.keys ;
say();

for @pats.keys {
   my \j = $_ < 6 ?? $_ !! $_-1 ; # for searching text5 twice
   say "Found '@pats[$_]' in 'text{j}' at indices ", BM @texts[j].comb, @pats[$_].comb
}

```

Output is the same as the Knuth-Morris-Pratt\_string\_search#Raku entry.