[User]
Find the numbers **k** whose divisor sum is equal to the divisor sum of **k + 1**.

*Divisor sum is also known as sigma-sum.*

For example

```
   14 has divisors 1, 2, 7, 14 that sum to 24.
   15 has divisors 1, 3, 5, 15 that sum to 24.

```

So 14 is a member of this sequence.

Task

Find the first 25 members of this sequence.

Stretch

Find the first 50 members of this sequence.

See also

:   * **OEIS A002961 - Numbers k such that k and k+1 have same sum of divisors**

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

say ++$, ': ', .&comma for (^Inf).hyper.grep( {
    state $next = .&sigma-sum;
    my $test = $next == my $this = ($_ + 1).&sigma-sum;
    $next = $this;
    $test
})[^50];

```

Output:

```
1: 14
2: 206
3: 957
4: 1,334
5: 1,364
6: 1,634
7: 2,685
8: 2,974
9: 4,364
10: 14,841
11: 18,873
12: 19,358
13: 20,145
14: 24,957
15: 33,998
16: 36,566
17: 42,818
18: 56,564
19: 64,665
20: 74,918
21: 79,826
22: 79,833
23: 84,134
24: 92,685
25: 109,214
26: 111,506
27: 116,937
28: 122,073
29: 138,237
30: 147,454
31: 161,001
32: 162,602
33: 166,934
34: 174,717
35: 190,773
36: 193,893
37: 201,597
38: 230,390
39: 274,533
40: 289,454
41: 347,738
42: 383,594
43: 416,577
44: 422,073
45: 430,137
46: 438,993
47: 440,013
48: 445,874
49: 455,373
50: 484,173
```


[User]
Integer squares are the set of integers multiplied by themselves: 1 x 1 = **1**, 2 × 2 = **4**, 3 × 3 = **9**, etc. ( 1, 4, 9, 16 ... )

Most positive integers can be generated as the sum of 1 or more distinct integer squares.

```
     1 == 1
     5 == 4 + 1
    25 == 16 + 9
    77 == 36 + 25 + 16
   103 == 49 + 25 + 16 + 9 + 4

```

Many can be generated in multiple ways:

```
    90 == 36 + 25 + 16 + 9 + 4 == 64 + 16 + 9 + 1 == 49 + 25 + 16 == 64 + 25 + 1 == 81 + 9
   130 == 64 + 36 + 16 + 9 + 4 + 1 == 49 + 36 + 25 + 16 + 4 == 100 + 16 + 9 + 4 + 1 == 81 + 36 + 9 + 4 == 64 + 49 + 16 + 1 == 100 + 25 + 4 + 1 == 81 + 49 == 121 + 9

```

The number of positive integers that **cannot** be generated by any combination of distinct squares is in fact finite:

```
   2, 3, 6, 7, etc.

```

Task

Find and show here, on this page, **every** positive integer than cannot be generated as the sum of distinct squares.

Do not use magic numbers or pre-determined limits. Justify your answer mathematically.

See also

* OEIS: A001422 Numbers which are not the sum of distinct squares

[Assistant]
Try it online!

**Spoiler:** *(highlight to read)*
Once the longest run of consecutive generated sums is longer the the next square, every number after can be generated by adding the next square to every number in the run. Find the *new* longest run, add the *next* square, etc.

```
my @squares = ^∞ .map: *²; # Infinite series of squares

for 1..∞ -> $sq {          # for every combination of all squares
    my @sums = @squares[^$sq].combinations».sum.unique.sort;
    my @run;
    for @sums {
        @run.push($_) and next unless @run.elems;
        if $_ == @run.tail + 1 { @run.push: $_ } else { last if @run.elems > @squares[$sq]; @run = () }
    }
    put grep * ∉ @sums, 1..@run.tail and last if @run.elems > @squares[$sq];
}

```

Output:

```
2 3 6 7 8 11 12 15 18 19 22 23 24 27 28 31 32 33 43 44 47 48 60 67 72 76 92 96 108 112 128
```


[User]
Example

Consider the number 24. Its proper divisors are: 1, 2, 3, 4, 6, 8 and 12. Their product is 13,824 and the cube root of this is 24. So 24 satisfies the definition in the task title.

Task

Compute and show here the first **50** positive integers which are the cube roots of the product of their proper divisors.

Also show the **500th** and **5,000th** such numbers.

Stretch

Compute and show the **50,000th** such number.

Reference

* OEIS:A111398 - Numbers which are the cube roots of the product of their proper divisors.

Note

OEIS considers 1 to be the first number in this sequence even though, strictly speaking, it has no proper divisors. Please therefore do likewise.

[Assistant]
```
use Prime::Factor;
use Lingua::EN::Numbers;
my @cube-div = lazy 1, |(2..∞).hyper.grep: { .³ == [×] .&proper-divisors }

put "First 50 numbers which are the cube roots of the products of their proper divisors:\n" ~
  @cube-div[^50]».fmt("%3d").batch(10).join: "\n";

printf "\n%16s: %s\n", .Int.&ordinal.tc, comma @cube-div[$_ - 1] for 5e2, 5e3, 5e4;

```

Output:

```
First 50 numbers which are the cube roots of the products of their proper divisors:
  1  24  30  40  42  54  56  66  70  78
 88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297

  Five hundredth: 2,526

 Five thousandth: 23,118

Fifty thousandth: 223,735
```


[User]
Task

Show positive integers   **n**   whose binary and ternary digits sum are prime,   where   **n   <   200**.

[Assistant]
```
say (^200).grep(-> $n {all (2,3).map({$n.base($_).comb.sum.is-prime}) }).batch(10)».fmt('%3d').join: "\n";

```

Output:

```
  5   6   7  10  11  12  13  17  18  19
 21  25  28  31  33  35  36  37  41  47
 49  55  59  61  65  67  69  73  79  82
 84  87  91  93  97 103 107 109 115 117
121 127 129 131 133 137 143 145 151 155
157 162 167 171 173 179 181 185 191 193
199
```


[User]
Task

Find positive integers   **n**   which count of divisors is prime,   but not equal to  **2**,   where   **n   <   1,000**.

Stretch goal:   (as above),   but where   **n   <   100,000**.

[Assistant]
```
use Prime::Factor;

my $ceiling = ceiling sqrt 1e5;

say display :10cols, :fmt('%6d'), (^$ceiling)».² .grep: { .&divisors.is-prime };

sub display ($list, :$cols = 10, :$fmt = '%6d', :$title = "{+$list} matching:\n" )   {
    cache $list;
    $title ~ $list.batch($cols)».fmt($fmt).join: "\n"
}

```

Output:

```
79 matching:
     4      9     16     25     49     64     81    121    169    289
   361    529    625    729    841    961   1024   1369   1681   1849
  2209   2401   2809   3481   3721   4096   4489   5041   5329   6241
  6889   7921   9409  10201  10609  11449  11881  12769  14641  15625
 16129  17161  18769  19321  22201  22801  24649  26569  27889  28561
 29929  32041  32761  36481  37249  38809  39601  44521  49729  51529
 52441  54289  57121  58081  59049  63001  65536  66049  69169  72361
 73441  76729  78961  80089  83521  85849  94249  96721  97969
```


[User]
When a number is written in base 10,   adjacent digits may "rise" or "fall" as the number is read   (usually from left to right).

Definition

Given the decimal digits of the number are written as a series   d:

:   * A   *rise*   is an index   i   such that    d(i)  <  d(i+1)
    * A   *fall*    is an index   i   such that    d(i)  >  d(i+1)

Examples
:   * The number   **726,169**   has   **3**   rises and   **2**   falls,   so it isn't in the sequence.
    * The number     **83,548**   has   **2**   rises and   **2**   falls,   so it   is   in the sequence.

Task
:   * Print the first   **200**   numbers in the sequence
    * Show that the   **10 millionth**   (10,000,000th)   number in the sequence is   **41,909,002**

See also

* OEIS Sequence  A296712   describes numbers whose digit sequence in base 10 have equal "rises" and "falls".

Related tasks

* Esthetic numbers

[Assistant]
**Works with**: Rakudo version 2020.09

```
use Lingua::EN::Numbers;
use Base::Any;

sub rf (int $base = 10, $batch = Any, &op = &infix:<==>) {
    my %batch = batch => $batch if $batch;
    flat (1 .. ∞).hyper(|%batch).map: {
        my int ($this, $last) = $_, $_ % $base;
        my int ($rise, $fall) = 0, 0;
        while $this {
            my int $rem = $this % $base;
            $this = $this div $base;
            if    $rem > $last { $fall = $fall + 1 }
            elsif $rem < $last { $rise = $rise + 1 }
            $last = $rem
        }
        next unless &op($rise, $fall);
        $_
    }
}

# The task
my $upto = 200;
put "Rise = Fall:\nFirst {$upto.&cardinal} (base 10):";
.put for rf[^$upto]».fmt("%3d").batch(20);

$upto = 10_000_000;
put "\nThe {$upto.&ordinal} (base 10): ", comma rf(10, 65536)[$upto - 1];

# Other bases and comparisons
put "\n\nGeneralized for other bases and other comparisons:";
$upto = ^5;
my $which = "{tc $upto.map({.exp(10).&ordinal}).join: ', '}, values in some other bases:";

put "\nRise = Fall: $which";
for <3 296691 4 296694 5 296697 6 296700 7 296703 8 296706 9 296709 10 296712
     11 296744 12 296747 13 296750 14 296753 15 296756 16 296759 20 296762 60 296765>
  -> $base, $oeis {
    put "Base {$base.fmt(<%2d>)} (https://oeis.org/A$oeis): ",
    $upto.map({rf(+$base, Any)[.exp(10) - 1].&to-base($base)}).join: ', '
}

put "\nRise > Fall: $which";
for <3 296692 4 296695 5 296698 6 296701 7 296704 8 296707 9 296710 10 296713
     11 296745 12 296748 13 296751 14 296754 15 296757 16 296760 20 296763 60 296766>
  -> $base, $oeis {
     put "Base {$base.fmt(<%2d>)} (https://oeis.org/A$oeis): ",
     $upto.map({rf(+$base, Any, &infix:«>»)[.exp(10) - 1].&to-base($base)}).join: ', '
 }

put "\nRise < Fall: $which";
for <3 296693 4 296696 5 296699 6 296702 7 296705 8 296708 9 296711 10 296714
     11 296746 12 296749 13 296752 14 296755 15 296758 16 296761 20 296764 60 296767>
  -> $base, $oeis {
     put "Base {$base.fmt(<%2d>)} (https://oeis.org/A$oeis): ",
     $upto.map({rf(+$base, Any, &infix:«<»)[.exp(10) - 1].&to-base($base)}).join: ', '
 }

```

Output:

```
Rise = Fall:
First two hundred (base 10):
  1   2   3   4   5   6   7   8   9  11  22  33  44  55  66  77  88  99 101 102
103 104 105 106 107 108 109 111 120 121 130 131 132 140 141 142 143 150 151 152
153 154 160 161 162 163 164 165 170 171 172 173 174 175 176 180 181 182 183 184
185 186 187 190 191 192 193 194 195 196 197 198 201 202 203 204 205 206 207 208
209 212 213 214 215 216 217 218 219 222 230 231 232 240 241 242 243 250 251 252
253 254 260 261 262 263 264 265 270 271 272 273 274 275 276 280 281 282 283 284
285 286 287 290 291 292 293 294 295 296 297 298 301 302 303 304 305 306 307 308
309 312 313 314 315 316 317 318 319 323 324 325 326 327 328 329 333 340 341 342
343 350 351 352 353 354 360 361 362 363 364 365 370 371 372 373 374 375 376 380
381 382 383 384 385 386 387 390 391 392 393 394 395 396 397 398 401 402 403 404

The ten millionth (base 10): 41,909,002

Generalized for other bases and other comparisons:

Rise = Fall: First, tenth, one hundredth, one thousandth, ten thousandth, values in some other bases:
Base  3 (https://oeis.org/A296691): 1, 201, 22112, 10101111, 1100022001
Base  4 (https://oeis.org/A296694): 1, 111, 3333, 221012, 13002120
Base  5 (https://oeis.org/A296697): 1, 102, 1441, 40011, 1431201
Base  6 (https://oeis.org/A296700): 1, 55, 512, 20424, 400402
Base  7 (https://oeis.org/A296703): 1, 44, 365, 12620, 155554
Base  8 (https://oeis.org/A296706): 1, 33, 316, 7466, 60404
Base  9 (https://oeis.org/A296709): 1, 22, 275, 5113, 40217
Base 10 (https://oeis.org/A296712): 1, 11, 252, 3396, 29201
Base 11 (https://oeis.org/A296744): 1, A, 216, 2240, 21718
Base 12 (https://oeis.org/A296747): 1, A, 201, 10AA, 19723
Base 13 (https://oeis.org/A296750): 1, A, 1B8, A0A, 172A7
Base 14 (https://oeis.org/A296753): 1, A, 1B5, 8B9, 14B81
Base 15 (https://oeis.org/A296756): 1, A, 1B2, 7D4, 11BBA
Base 16 (https://oeis.org/A296759): 1, A, 1A9, 716, 10424
Base 20 (https://oeis.org/A296762): 1, A, 196, 523, 8011
Base 60 (https://oeis.org/A296765): 1, A, ff, 1f2, 63Q

Rise > Fall: First, tenth, one hundredth, one thousandth, ten thousandth, values in some other bases:
Base  3 (https://oeis.org/A296692): 12, 1222, 122202, 12222001, 2001200001
Base  4 (https://oeis.org/A296695): 12, 233, 12113, 1003012, 13131333
Base  5 (https://oeis.org/A296698): 12, 122, 2302, 112013, 1342223
Base  6 (https://oeis.org/A296701): 12, 45, 1305, 20233, 333134
Base  7 (https://oeis.org/A296704): 12, 34, 1166, 11612, 140045
Base  8 (https://oeis.org/A296707): 12, 26, 1013, 4557, 106756
Base  9 (https://oeis.org/A296710): 12, 25, 348, 2808, 36781
Base 10 (https://oeis.org/A296713): 12, 24, 249, 2345, 23678
Base 11 (https://oeis.org/A296745): 12, 23, 223, 1836, 15806
Base 12 (https://oeis.org/A296748): 12, 1B, 166, 1623, 12534
Base 13 (https://oeis.org/A296751): 12, 1B, 145, 149B, A069
Base 14 (https://oeis.org/A296754): 12, 1B, 12B, 1393, 6BC9
Base 15 (https://oeis.org/A296757): 12, 1B, 11A, 12B7, 568E
Base 16 (https://oeis.org/A296760): 12, 1B, CD, 1206, 466A
Base 20 (https://oeis.org/A296763): 12, 1B, 7E, 6BF, 2857
Base 60 (https://oeis.org/A296766): 12, 1B, 2i, Lp, 66U

Rise < Fall: First, tenth, one hundredth, one thousandth, ten thousandth, values in some other bases:
Base  3 (https://oeis.org/A296693): 10, 221, 22220, 10021001, 1012110000
Base  4 (https://oeis.org/A296696): 10, 210, 3330, 231210, 13132000
Base  5 (https://oeis.org/A296699): 10, 43, 2420, 43033, 2030042
Base  6 (https://oeis.org/A296702): 10, 43, 1540, 25543, 403531
Base  7 (https://oeis.org/A296705): 10, 43, 1010, 10051, 206260
Base  8 (https://oeis.org/A296708): 10, 43, 660, 5732, 75051
Base  9 (https://oeis.org/A296711): 10, 43, 643, 5010, 60873
Base 10 (https://oeis.org/A296714): 10, 43, 621, 4120, 44100
Base 11 (https://oeis.org/A296746): 10, 43, 544, 3243, 31160
Base 12 (https://oeis.org/A296749): 10, 43, 520, 2A71, 18321
Base 13 (https://oeis.org/A296752): 10, 43, 422, 2164, B624
Base 14 (https://oeis.org/A296755): 10, 43, 310, 1CA3, A506
Base 15 (https://oeis.org/A296758): 10, 43, E8, 1A20, 9518
Base 16 (https://oeis.org/A296761): 10, 43, E8, 10D0, 860D
Base 20 (https://oeis.org/A296764): 10, 43, E8, G33, 5F43
Base 60 (https://oeis.org/A296767): 10, 43, E8, j9, ZUT
```


[User] Find all the positive integers whose decimal digits are all primes and sum to   **13**.

[Assistant]
```
put join ', ', sort +*, unique flat
   < 2 2 2 2 2 3 3 3 5 5 7 >.combinations
   .grep( *.sum == 13 )
   .map( { .join => $_ } )
   .map: { .value.permutations».join }

```

Output:

```
337, 355, 373, 535, 553, 733, 2227, 2272, 2335, 2353, 2533, 2722, 3235, 3253, 3325, 3352, 3523, 3532, 5233, 5323, 5332, 7222, 22225, 22252, 22333, 22522, 23233, 23323, 23332, 25222, 32233, 32323, 32332, 33223, 33232, 33322, 52222, 222223, 222232, 222322, 223222, 232222, 322222
```


[User]
Task

Find decimal numbers   **n**   that when converted to **hexadecimal** produce a number that uses the same set of digits (regardless of order and ignoring duplicates) as the original number,   where   **n  <  100000**

Example

The decimal number   **2339**   is   **923**   when written in hexadecimal.

The set of digits used,   ignoring order and duplicates,   is   **{2, 3, 9}**   in both cases and hence this number satisfies the task requirements.

[Assistant]
Only bother to check numbers that could possibly match.

Several different interpretations of the (originally very vague) task instructions. It has now been clarified to mean the second.

```
say "Numbers up to 100,000 which when expressed in hexadecimal and in decimal
are composed of the same digit glyphs. (All the same glyphs, all the same
quantity.)\n";
display-numbers calculated-with &infix:<eqv>, <Bag>;

say "\nNumbers up to 100,000 which when expressed in hexadecimal and in decimal
are composed from the same digit glyphs. (All the same glyphs  are present,
possibly different quantity.)\n";
display-numbers calculated-with &infix:<eqv>, <Set>;

say "\nNumbers up to 100,000 which, when expressed in hexadecimal use glyphs
that are a subset of those used when expressed in decimal. (Every glyph in
decimal is present in hexadecimal the same or fewer (possibly zero) times)\n";
display-numbers calculated-with &infix:<⊆>, <Bag>;

say "\nNumbers up to 100,000 which, when expressed in hexadecimal use glyphs
that are a subset of those used when expressed in decimal. (Every glyph in
decimal is present in hexadecimal in some quantity, possibly zero, possibly more
than in decimal)\n";
display-numbers calculated-with &infix:<⊆>, <Set>;

sub display-numbers ($_) { say .elems ~ " found:\n" ~ .batch(20)».fmt('%5d').join: "\n" }

sub calculated-with ( &op, $container ) {
    cache ^18699 .map( {:16(.Str)} ).hyper(:1000batch).grep( {
        reduce( &op, (.fmt('%x'), $_).map: { .comb."$container"() } )
    } )
}

```

Output:

```
Numbers which when expressed in hexadecimal and in decimal are composed of
the same digit glyphs. (All the same glyphs, all the same quantity.)

34 found:
    0     1     2     3     4     5     6     7     8     9    53   371   913  4100  5141  5412  6182  8200  9241 75120
75121 75122 75123 75124 75125 75126 75127 75128 75129 75621 86150 91465 98711 99481

Numbers which when expressed in hexadecimal and in decimal are composed
from the same digit glyphs. (All the same glyphs are present, possibly
different quantity.)

69 found:
    0     1     2     3     4     5     6     7     8     9    53   371   913  1040  2080  2339  4100  5141  5412  5441
 6182  8200  9241 13593 13665 13969 16406 20530 26946 30979 32803 33638 33840 33841 33842 33843 33844 33845 33846 33847
33848 33849 34883 37943 38931 38966 38995 66310 71444 71497 71511 75120 75121 75122 75123 75124 75125 75126 75127 75128
75129 75621 86150 88165 91465 91769 96617 98711 99481

Numbers which, when expressed in hexadecimal use glyphs that are a subset
of those used when expressed in decimal. (Every glyph in decimal is present in
hexadecimal the same or fewer (possibly zero) times)

141 found:
    0     1     2     3     4     5     6     7     8     9    53   371   913  1040  1041  1042  1043  1044  1045  1046
 1047  1048  1049  1345  1937  2080  2081  2082  2083  2084  2085  2086  2087  2088  2089  2339  4100  5141  5412  6182
 8200  9241 12306 13593 13665 13969 16400 16401 16402 16403 16404 16405 16406 16407 16408 16409 16743 18453 20513 20530
20546 21025 25169 25896 25986 26370 26738 26913 26930 26946 29217 29714 30768 30784 30979 32800 32801 32802 32803 32804
32805 32806 32807 32808 32809 32850 33589 33840 33841 33842 33843 33844 33845 33846 33847 33848 33849 34868 34880 34881
34882 34883 34884 34885 34886 34887 34888 34889 36902 36950 37492 37943 38931 38960 38961 38962 38963 38964 38965 38966
38967 38968 38969 38984 38995 39298 75120 75121 75122 75123 75124 75125 75126 75127 75128 75129 75621 86150 91465 98711
99481

Numbers which, when expressed in hexadecimal use glyphs that are a subset
of those used when expressed in decimal. (Every glyph in decimal is present in
hexadecimal in some quantity, possibly zero, possibly more than in decimal)

514 found:
    0     1     2     3     4     5     6     7     8     9    17    53    85   371   853   913  1024  1040  1041  1042
 1043  1044  1045  1046  1047  1048  1049  1345  1365  1604  1633  1635  1638  1689  1937  2048  2080  2081  2082  2083
 2084  2085  2086  2087  2088  2089  2178  2184  2339  4100  4160  4371  4417  4471  4481  4721  4913  4931  5140  5141
 5412  5441  5461  6168  6182  8200  8210  8320  8721  9241  9284  9523  9625  9762  9826  9862 10248 10258 10280 10529
12304 12305 12306 12307 12320 12340 12563 12593 12643 12803 12833 12834 12835 12853 12953 13056 13057 13059 13062 13072
13073 13075 13079 13080 13104 13105 13107 13124 13171 13175 13185 13187 13209 13364 13384 13427 13448 13459 13585 13587
13589 13593 13651 13653 13654 13665 13846 13862 13926 13969 14385 14387 14388 14739 16400 16401 16402 16403 16404 16405
16406 16407 16408 16409 16420 16480 16640 16704 16740 16742 16743 17408 17409 17425 17426 17428 17431 17442 17463 17473
17476 17479 17480 17495 17524 17745 18247 18440 18449 18452 18453 18456 18472 18483 18497 18504 18564 20485 20501 20512
20513 20514 20517 20530 20531 20533 20544 20546 20548 20549 20560 20561 20562 20563 20564 20565 20566 20567 20568 20569
20576 20597 21025 21395 21504 21524 21540 21541 21845 21905 22357 22568 22658 24608 24610 24630 24640 24680 25106 25126
25169 25186 25361 25604 25634 25684 25896 25961 25986 26129 26130 26131 26134 26145 26146 26148 26150 26163 26184 26208
26210 26214 26248 26370 26407 26470 26471 26487 26658 26728 26738 26758 26913 26914 26918 26921 26930 26931 26934 26937
26946 26948 26965 26978 26982 26984 26985 28704 28706 28740 28807 29217 29337 29714 29764 29847 30467 30471 30517 30547
30567 30576 30579 30728 30768 30784 30976 30979 31097 32800 32801 32802 32803 32804 32805 32806 32807 32808 32809 32840
32850 33280 33587 33589 33638 33689 33840 33841 33842 33843 33844 33845 33846 33847 33848 33849 33864 34678 34820 34852
34867 34868 34871 34872 34880 34881 34882 34883 34884 34885 34886 34887 34888 34889 34948 34968 36902 36950 36960 37139
37169 37492 37529 37689 37779 37924 37940 37943 37945 38195 38791 38792 38793 38920 38931 38952 38960 38961 38962 38963
38964 38965 38966 38967 38968 38969 38984 38995 39048 39185 39187 39193 39200 39201 39202 39203 39204 39205 39206 39207
39208 39209 39217 39218 39219 39225 39234 39241 39250 39251 39253 39257 39266 39267 39287 39298 39313 39315 39321 66310
67140 67190 69910 69913 69921 70001 70162 70513 71025 71206 71265 71266 71286 71440 71441 71442 71443 71444 71445 71446
71447 71448 71449 71462 71473 71489 71492 71495 71497 71504 71505 71509 71511 71526 71537 71539 71540 71541 71543 71569
71680 71748 71800 71808 71809 71815 71816 71940 71953 71957 71959 71961 71993 74129 75120 75121 75122 75123 75124 75125
75126 75127 75128 75129 75621 76129 78103 78131 78135 78136 78193 79153 79731 81940 82194 82241 82471 82514 84100 84104
86150 87315 87351 87415 88145 88152 88165 90163 91465 91665 91670 91671 91673 91682 91760 91761 91762 91763 91764 91765
91766 91767 91768 91769 92561 94617 95761 96017 96617 98581 98711 98712 98713 99481
```


[User]
If   **f**,   **a**,   and   **b**   are values with uncertainties   σf,   σa,   and   σb,   and   **c**   is a constant;

then if   **f**   is derived from   **a**,   **b**,   and   **c**   in the following ways,

then   σf   can be calculated as follows:

:   Addition/Subtraction

    * If   f = a ± c,   or   f = c ± a   then   **σf = σa**
    * If   f = a ± b   then   **σf2 = σa2 + σb2**

:   Multiplication/Division

    * If   f = ca   or   f = ac       then   **σf = |cσa|**
    * If   f = ab   or   f = a / b   then   **σf2 = f2( (σa / a)2 + (σb / b)2)**

:   Exponentiation

    * If   f = ac   then   **σf = |fc(σa / a)|**

Caution:

:   :   This implementation of error propagation does not address issues of dependent and independent values.   It is assumed that   **a**   and   **b**   are independent and so the formula for multiplication should not be applied to   **a\*a**   for example.   See   the talk page   for some of the implications of this issue.

Task details

1. Add an uncertain number type to your language that can support addition, subtraction, multiplication, division, and exponentiation between numbers with an associated error term together with 'normal' floating point numbers without an associated error term.
   Implement enough functionality to perform the following calculations.
2. Given coordinates and their errors:
   x1 = 100 ± 1.1
   y1 = 50 ± 1.2
   x2 = 200 ± 2.2
   y2 = 100 ± 2.3
    if point p1 is located at (x1, y1) and p2 is at (x2, y2); calculate the distance between the two points using the classic Pythagorean formula:
     d = √   (x1 - x2)²   +   (y1 - y2)²
3. Print and display both    **d**    and its error.

References

* A Guide to Error Propagation B. Keeney, 2005.
* Propagation of uncertainty Wikipedia.

Related task

* Quaternion type

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

**Translation of**: Perl

```
# cache of independent sources so we can make them all the same length.
# (Because Raku does not yet have a longest-zip metaoperator.)
my @INDEP;

class Approx does Numeric {
    has Real $.x;	# The mean.
    has $.c;		# The components of error.

    multi method Str  { sprintf "%g±%.3g", $!x, $.σ }
    multi method Bool { abs($!x) > $.σ }

    method variance { [+] @.c X** 2 }
    method σ { sqrt self.variance }
}

multi approx($x,$c) { Approx.new: :$x, :$c }
multi approx($x) { Approx.new: :$x, :c[0 xx +@INDEP] }

# Each ± gets its own source slot.
multi infix:<±>($a, $b) {
    .push: 0 for @INDEP; # lengthen older component lists
    my $c = [ flat 0 xx @INDEP, $b ];
    @INDEP.push: $c;	 # add new component list

    approx $a, $c;
}

multi prefix:<->(Approx $a) { approx -$a.x, [$a.c.map: -*] }

multi infix:<+>($a, Approx $b) { approx($a) + $b }
multi infix:<+>(Approx $a, $b) { $a + approx($b) }
multi infix:<+>(Approx $a, Approx $b) { approx $a.x + $b.x, [$a.c Z+ $b.c] }

multi infix:<->($a, Approx $b) { approx($a) - $b }
multi infix:<->(Approx $a, $b) { $a - approx($b) }
multi infix:<->(Approx $a, Approx $b) { approx $a.x - $b.x, [$a.c Z- $b.c] }

multi covariance(Real   $a, Real   $b) { 0 }
multi covariance(Approx $a, Approx $b) { [+] $a.c Z* $b.c }

multi infix:«<=>»(Approx $a, Approx $b) { $a.x <=> $b.x }
multi infix:<cmp>(Approx $a, Approx $b) { $a.x <=> $b.x }

multi infix:<*>($a, Approx $b) { approx($a) * $b }
multi infix:<*>(Approx $a, $b) { $a * approx($b) }
multi infix:<*>(Approx $a, Approx $b) {
    approx $a.x * $b.x,
           [$a.c.map({$b.x * $_}) Z+ $b.c.map({$a.x * $_})];
}

multi infix:</>($a, Approx $b) { approx($a) / $b }
multi infix:</>(Approx $a, $b) { $a / approx($b) }
multi infix:</>(Approx $a, Approx $b) {
    approx $a.x / $b.x,
           [ $a.c.map({ $_ / $b.x }) Z+ $b.c.map({ $a.x * $_ / $b.x / $b.x }) ];
}

multi sqrt(Approx $a) {
    my $x = sqrt($a.x);
    approx $x, [ $a.c.map: { $_ / 2 / $x } ];
}

multi infix:<**>(Approx $a, Real $b) { $a ** approx($b) }
multi infix:<**>(Approx $a is copy, Approx $b) {
	my $ax = $a.x;
	my $bx = $b.x;
	my $fbx = floor $b.x;
	if $ax < 0 {
	    if $fbx != $bx or $fbx +& 1 {
		die "Can't take power of negative number $ax";
	    }
	    $a = -$a;
	}
	exp($b * log $a);
}

multi exp(Approx $a) {
	my $x = exp($a.x);
	approx $x, [ $a.c.map: { $x * $_ } ];
}

multi log(Approx $a) {
	my $x0 = $a.x;
	approx log($x0), [ $a.c.map: { $_ / $x0 }];
}

# Each ± sets up an independent source component.
my $x1 = 100 ± 1.1;
my $x2 = 200 ± 2.2;
my $y1 = 50  ± 1.2;
my $y2 = 100 ± 2.3;

# The standard task.
my $z1 = sqrt(($x1 - $x2) ** 2 + ($y1 - $y2) ** 2);
say "distance: $z1\n";

# Just showing off.
my $a = $x1 + $x2;
my $b = $y1 - 2 * $x2;
say "covariance between $a and $b: ", covariance($a,$b);

```

Output:

```
distance: 111.803±2.49

covariance between 300±2.46 and -350±4.56: -9.68
```


[User]
Several programming languages allow separators in numerals in order to group digits together.

Task

Show the numeric separator syntax and describe its specification.

E.G.
:   * What separators are eligible?
    * Can there be multiple consecutive separators?
    * What position can a separator be in?
    * Etc.

[Assistant]
(formerly Perl 6)
Raku allows underscore as a grouping / separator character in numeric inputs, though there are a few restrictions.

```
# Any numeric input value may use an underscore as a grouping/separator character.
# May occur in nearly any position, in any* number. * See restrictions below.

# Int
say 1_2_3;  # 123

# Binary Int
say 0b1_0_1_0_1; # 21

# Hexadecimal Int
say 0xa_bc_d; # 43981

# Rat
say 1_2_3_4.2_5; # 1234.25

# Num
say 6.0_22e4; # 60220

# There are some restrictions on the placement.
# An underscore may not be on an edge boundary, or next to another underscore.
# The following are all syntax errors.

# say _1234.25;
# say 1234_.25;
# say 1234._25;
# say 1234.25_;
# say 12__34.25;

```


[User]
This task is about expressing numbers with an attached (abutted) suffix multiplier(s),   the suffix(es) could be:

:   :   * an alphabetic (named) multiplier which could be abbreviated
        * metric  multiplier(s) which can be specified multiple times
        * "binary" multiplier(s) which can be specified multiple times
        * explanation marks (**!**) which indicate a factorial or multifactorial

The (decimal) numbers can be expressed generally as:

```
             {±}   {digits}   {.}   {digits}
                                 ────── or ──────
             {±}   {digits}   {.}   {digits}   {E or e}   {±}   {digits}

```

where:

:   :   * numbers won't have embedded blanks   (contrary to the expaciated examples above where whitespace was used for readability)
        * this task will only be dealing with decimal numbers,   both in the   *mantissa*   and   *exponent*
        * ±   indicates an optional plus or minus sign   (**+**   or   **-**)
        * digits are the decimal digits   (**0** ──► **9**)
        * the digits can have comma(s) interjected to separate the   *periods*   (thousands)   such as:   **12,467,000**
        * **.**   is the decimal point, sometimes also called a   *dot*
        * **e**   or   **E**   denotes the use of decimal exponentiation   (a number multiplied by raising ten to some power)

This isn't a pure or perfect definition of the way we express decimal numbers,   but it should convey the intent for this task.

The use of the word   *periods*   (thousands) is not meant to confuse, that word (as used above) is what the **comma** separates;

the groups of decimal digits are called *periods*,   and in almost all cases, are groups of three decimal digits.

If an   **e**   or   **E**   is specified, there must be a legal number expressed before it,   and there must be a legal (exponent) expressed after it.

Also, there must be some digits expressed in all cases,   not just a sign and/or decimal point.

Superfluous signs, decimal points, exponent numbers, and zeros   need not be preserved.

I.E.:
**+7**   **007**   **7.00**   **7E-0**   **7E000**   **70e-1**     could all be expressed as **7**

All numbers to be "expanded" can be assumed to be valid and there won't be a requirement to verify their validity.

Abbreviated alphabetic suffixes to be supported   (where the capital letters signify the minimum abbreation that can be used)

```
     PAIRs         multiply the number by  2         (as in pairs of shoes or pants)
     SCOres        multiply the number by  20        (as 3score would be 60)
     DOZens        multiply the number by  12
     GRoss         multiply the number by  144       (twelve dozen)
     GREATGRoss    multiply the number by  1,728     (a dozen gross)
     GOOGOLs       multiply the number by  10^100    (ten raised to the 100&sup>th power)

```

Note that the plurals are supported, even though they're usually used when expressing exact numbers   (She has 2 dozen eggs, and dozens of quavas)

Metric suffixes to be supported   (whether or not they're officially sanctioned)

```
     K     multiply the number by  10^3              kilo      (1,000)
     M     multiply the number by  10^6              mega      (1,000,000)
     G     multiply the number by  10^9              giga      (1,000,000,000)
     T     multiply the number by  10^12             tera      (1,000,000,000,000)
     P     multiply the number by  10^15             peta      (1,000,000,000,000,000)
     E     multiply the number by  10^18             exa       (1,000,000,000,000,000,000)
     Z     multiply the number by  10^21             zetta     (1,000,000,000,000,000,000,000)
     Y     multiply the number by  10^24             yotta     (1,000,000,000,000,000,000,000,000)
     X     multiply the number by  10^27             xenta     (1,000,000,000,000,000,000,000,000,000)
     W     multiply the number by  10^30             wekta     (1,000,000,000,000,000,000,000,000,000,000)
     V     multiply the number by  10^33             vendeka   (1,000,000,000,000,000,000,000,000,000,000,000)
     U     multiply the number by  10^36             udekta    (1,000,000,000,000,000,000,000,000,000,000,000,000)

```

Binary suffixes to be supported   (whether or not they're officially sanctioned)

```
     Ki    multiply the number by  2^10              kibi      (1,024)
     Mi    multiply the number by  2^20              mebi      (1,048,576)
     Gi    multiply the number by  2^30              gibi      (1,073,741,824)
     Ti    multiply the number by  2^40              tebi      (1,099,571,627,776)
     Pi    multiply the number by  2^50              pebi      (1,125,899,906,884,629)
     Ei    multiply the number by  2^60              exbi      (1,152,921,504,606,846,976)
     Zi    multiply the number by  2^70              zeb1      (1,180,591,620,717,411,303,424)
     Yi    multiply the number by  2^80              yobi      (1,208,925,819,614,629,174,706,176)
     Xi    multiply the number by  2^90              xebi      (1,237,940,039,285,380,274,899,124,224)
     Wi    multiply the number by  2^100             webi      (1,267,650,600,228,229,401,496,703,205,376)
     Vi    multiply the number by  2^110             vebi      (1,298,074,214,633,706,907,132,624,082,305,024)
     Ui    multiply the number by  2^120             uebi      (1,329,227,995,784,915,872,903,807,060,280,344,576)

```

All of the metric and binary suffixes can be expressed in   lowercase,   uppercase,   *or*   mixed case.

All of the metric and binary suffixes can be   *stacked*   (expressed multiple times),   and also be intermixed:

I.E.:       **123k**   **123K**   **123GKi**   **12.3GiGG**   **12.3e-7T**   **.78E100e**

Factorial suffixes to be supported

```
     !      compute the (regular) factorial product:   5!   is  5 × 4 × 3 × 2 × 1  =  120
     !!     compute the  double   factorial product:   8!   is  8 × 6 × 4 × 2      =  384
     !!!    compute the  triple   factorial product:   8!   is  8 × 5 × 2          =   80
     !!!!   compute the quadruple factorial product:   8!   is  8 × 4              =   32
     !!!!!  compute the quintuple factorial product:   8!   is  8 × 3              =   24
     ··· the number of factorial symbols that can be specified is to be unlimited   (as per what can be entered/typed) ···

```

Factorial suffixes aren't, of course, the usual type of multipliers, but are used here in a similar vein.

Multifactorials aren't to be confused with   *super─factorials*     where   **(4!)!**   would be   **(24)!**.

Task
:   :   * Using the test cases (below),   show the "expanded" numbers here, on this page.
        * For each list, show the input on one line,   and also show the output on one line.
        * When showing the input line, keep the spaces (whitespace) and case (capitalizations) as is.
        * For each result (list) displayed on one line, separate each number with two blanks.
        * Add commas to the output numbers were appropriate.

Test cases

```
    2greatGRo   24Gros  288Doz  1,728pairs  172.8SCOre
    1,567      +1.567k    0.1567e-2m
    25.123kK    25.123m   2.5123e-00002G
    25.123kiKI  25.123Mi  2.5123e-00002Gi  +.25123E-7Ei
    -.25123e-34Vikki      2e-77gooGols
    9!   9!!   9!!!   9!!!!   9!!!!!   9!!!!!!   9!!!!!!!   9!!!!!!!!   9!!!!!!!!!

```

where the last number for the factorials has nine factorial symbols   (**!**)   after the   **9**

Related tasks

* Multifactorial                 (which has a clearer and more succinct definition of multifactorials.)
* Factorial

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 2018.09

Scientific notation, while supported in Raku, is limited to IEEE-754 64bit accuracy so there is some rounding on values using it. Implements a custom "high precision" conversion routine.

Unfortunately, this suffix routine is of limited use for practical everyday purposes. It focuses on handling excessively large and archaic units (googol, greatgross) and completely ignores or makes unusable (due to forcing case insensitivity) many common current ones: c(centi), m(milli), μ(micro). Ah well.

Note: I am blatantly and deliberately ignoring the task guidelines for formatting the output. It has no bearing on the core of the task. If you really, *really*, ***REALLY*** want to see badly formatted output, uncomment the last line.

```
use Rat::Precise;

my $googol = 10**100;
«PAIRs 2 SCOres 20 DOZens 12 GRoss 144  GREATGRoss 1728 GOOGOLs $googol»
  ~~ m:g/ ((<.:Lu>+) <.:Ll>*) \s+ (\S+) /;

my %abr = |$/.map: {
    my $abbrv = .[0].Str.fc;
    my $mag   = +.[1];
    |map { $abbrv.substr( 0, $_ ) => $mag },
    .[0][0].Str.chars .. $abbrv.chars
}

my %suffix = flat %abr,
(<K  M  G  T  P  E  Z  Y  X  W  V  U>».fc  Z=> (1000, * * 1000 … *)),
(<Ki Mi Gi Ti Pi Ei Zi Yi Xi Wi Vi Ui>».fc Z=> (1024, * * 1024 … *));

my $reg = %suffix.keys.join('|');

sub comma ($i is copy) {
    my $s = $i < 0 ?? '-' !! '';
    my ($whole, $frac) = $i.split('.');
    $frac = $frac.defined ?? ".$frac" !! '';
    $s ~ $whole.abs.flip.comb(3).join(',').flip ~ $frac
}

sub units (Str $str) {
    $str.fc ~~ /^(.+?)(<alpha>*)('!'*)$/;
    my ($val, $unit, $fact) = $0, $1.Str.fc, $2.Str;
    $val.=subst(',', '', :g);
    if $val ~~ m:i/'e'/ {
        my ($m,$e) = $val.split(/<[eE]>/);
        $val = ($e < 0)
            ?? $m * FatRat.new(1,10**-$e)
            !! $m * 10**$e;
    }
    my @suf = $unit;
    unless %suffix{$unit}:exists {
        $unit ~~ /(<$reg>)+/;
        @suf = $0;
    }
    my $ret = $val<>;
    $ret = [*] $ret, |@suf.map: { %suffix{$_} } if @suf[0];
    $ret = [*] ($ret, * - $fact.chars …^ * < 2) if $fact.chars;
    $ret.?precise // $ret
}

my $test = q:to '===';
2greatGRo   24Gros  288Doz  1,728pairs  172.8SCOre
1,567      +1.567k    0.1567e-2m
25.123kK    25.123m   2.5123e-00002G
25.123kiKI  25.123Mi  2.5123e-00002Gi  +.25123E-7Ei
-.25123e-34Vikki      2e-77gooGols
9!   9!!   9!!!   9!!!!   9!!!!!   9!!!!!!   9!!!!!!!   9!!!!!!!!   9!!!!!!!!!
.017k!!
===

printf "%16s: %s\n", $_, comma .&units for $test.words;

# Task required stupid layout
# say "\n In: $_\nOut: ", .words.map({comma .&units}).join('  ') for $test.lines;

```

Output:

```
       2greatGRo: 3,456
          24Gros: 3,456
          288Doz: 3,456
      1,728pairs: 3,456
      172.8SCOre: 3,456
           1,567: 1,567
         +1.567k: 1,567
      0.1567e-2m: 1,567
        25.123kK: 25,123,000
         25.123m: 25,123,000
  2.5123e-00002G: 25,123,000
      25.123kiKI: 26,343,374.848
        25.123Mi: 26,343,374.848
 2.5123e-00002Gi: 26,975,615.844352
    +.25123E-7Ei: 28,964,846,960.237816578048
-.25123e-34Vikki: -33,394.194938104441474962344775423096782848
    2e-77gooGols: 200,000,000,000,000,000,000,000
              9!: 362,880
             9!!: 945
            9!!!: 162
           9!!!!: 45
          9!!!!!: 36
         9!!!!!!: 27
        9!!!!!!!: 18
       9!!!!!!!!: 9
      9!!!!!!!!!: 9
         .017k!!: 34,459,425
```


[User]
Write functions to calculate the definite integral of a function  *ƒ(x)*  using *all* five of the following methods:

:   * rectangular
      + left
      + right
      + midpoint
    * trapezium
    * Simpson's
      + composite

Your functions should take in the upper and lower bounds (*a* and *b*), and the number of approximations to make in that range (*n*).

Assume that your example already has a function that gives values for  *ƒ(x)* .

Simpson's method is defined by the following pseudo-code:

Pseudocode: Simpson's method, composite

|  |
| --- |
| ``` procedure quad_simpson_composite(f, a, b, n)     h := (b - a) / n     sum1 := f(a + h/2)     sum2 := 0      loop on i from 1 to (n - 1)         sum1 := sum1 + f(a + h * i + h/2)         sum2 := sum2 + f(a + h * i)                                                  answer := (h / 6) * (f(a) + f(b) + 4*sum1 + 2*sum2)  ``` |

Demonstrate your function by showing the results for:

* ƒ(x) = x3,       where   **x**   is     [0,1],       with           100 approximations.   The exact result is     0.25               (or 1/4)
* ƒ(x) = 1/x,     where   **x**   is   [1,100],     with        1,000 approximations.   The exact result is     4.605170+     (natural log of 100)
* ƒ(x) = x,         where   **x**   is   [0,5000],   with 5,000,000 approximations.   The exact result is   12,500,000
* ƒ(x) = x,         where   **x**   is   [0,6000],   with 6,000,000 approximations.   The exact result is   18,000,000

See also

* Active object for integrating a function of real time.
* Special:PrefixIndex/Numerical integration for other integration methods.

[Assistant]
(formerly Perl 6)
The addition of **Promise**/**await** allows for concurrent computation, and brings a significant speed-up in running time. Which is not to say that it makes this code fast, but it does make it less slow.

Note that these integrations are done with rationals rather than floats, so should be fairly precise (though of course with so few iterations they are not terribly accurate (except when they are)). Some of the sums do overflow into Num (floating point)--currently Rakudo allows 64-bit denominators--but at least all of the interval arithmetic is exact.

**Works with**: Rakudo version 2018.09

```
use MONKEY-SEE-NO-EVAL;

sub leftrect(&f, $a, $b, $n) {
    my $h = ($b - $a) / $n;
    my $end = $b-$h;
    my $sum = 0;
    loop (my $i = $a; $i <= $end; $i += $h) { $sum += f($i) }
    $h * $sum;
}

sub rightrect(&f, $a, $b, $n) {
    my $h = ($b - $a) / $n;
    my $sum = 0;
    loop (my $i = $a+$h; $i <= $b; $i += $h) { $sum += f($i) }
    $h * $sum;
}

sub midrect(&f, $a, $b, $n) {
    my $h = ($b - $a) / $n;
    my $sum = 0;
    my ($start, $end) = $a+$h/2, $b-$h/2;
    loop (my $i = $start; $i <= $end; $i += $h) { $sum += f($i) }
    $h * $sum;
}

sub trapez(&f, $a, $b, $n) {
    my $h = ($b - $a) / $n;
    my $partial-sum = 0;
    my ($start, $end) = $a+$h, $b-$h;
    loop (my $i = $start; $i <= $end; $i += $h) { $partial-sum += f($i) * 2 }
    $h / 2 * ( f($a) + f($b) + $partial-sum );
}

sub simpsons(&f, $a, $b, $n) {
    my $h = ($b - $a) / $n;
    my $h2 = $h/2;
    my ($start, $end) = $a+$h, $b-$h;
    my $sum1 = f($a + $h2);
    my $sum2 = 0;
    loop (my $i = $start; $i <= $end; $i += $h) {
        $sum1 += f($i + $h2);
        $sum2 += f($i);
    }
    ($h / 6) * (f($a) + f($b) + 4*$sum1 + 2*$sum2);
}

sub integrate($f, $a, $b, $n, $exact) {
    my $e = 0.000001;
    my $r0 = "$f\n   in [$a..$b] / $n\n"
        ~ '              exact result: '~ $exact.round($e);

    my ($r1,$r2,$r3,$r4,$r5);
    my &f;
    EVAL "&f = $f";
    my $p1 = Promise.start( { $r1 = '     rectangle method left: '~  leftrect(&f, $a, $b, $n).round($e) } );
    my $p2 = Promise.start( { $r2 = '    rectangle method right: '~ rightrect(&f, $a, $b, $n).round($e) } );
    my $p3 = Promise.start( { $r3 = '      rectangle method mid: '~   midrect(&f, $a, $b, $n).round($e) } );
    my $p4 = Promise.start( { $r4 = 'composite trapezoidal rule: '~    trapez(&f, $a, $b, $n).round($e) } );
    my $p5 = Promise.start( { $r5 = '   quadratic simpsons rule: '~  simpsons(&f, $a, $b, $n).round($e) } );

    await $p1, $p2, $p3, $p4, $p5;
    $r0, $r1, $r2, $r3, $r4, $r5;
}

.say for integrate '{ $_ ** 3 }', 0,     1,       100,       0.25; say '';
.say for integrate '1 / *',       1,   100,      1000,   log(100); say '';
.say for integrate '*.self',      0, 5_000, 5_000_000, 12_500_000; say '';
.say for integrate '*.self',      0, 6_000, 6_000_000, 18_000_000;

```

Output:

```
{ $_ ** 3 }
   in [0..1] / 100
              exact result: 0.25
     rectangle method left: 0.245025
    rectangle method right: 0.255025
      rectangle method mid: 0.249988
composite trapezoidal rule: 0.250025
   quadratic simpsons rule: 0.25

1 / *
   in [1..100] / 1000
              exact result: 4.60517
     rectangle method left: 4.654991
    rectangle method right: 4.556981
      rectangle method mid: 4.604763
composite trapezoidal rule: 4.605986
   quadratic simpsons rule: 4.60517

*.self
   in [0..5000] / 5000000
              exact result: 12500000
     rectangle method left: 12499997.5
    rectangle method right: 12500002.5
      rectangle method mid: 12500000
composite trapezoidal rule: 12500000
   quadratic simpsons rule: 12500000

*.self
   in [0..6000] / 6000000
              exact result: 18000000
     rectangle method left: 17999997
    rectangle method right: 18000003
      rectangle method mid: 18000000
composite trapezoidal rule: 18000000
   quadratic simpsons rule: 18000000
```


[User]
Lyness's (1969) Modified Adaptive Simpson's method (doi:10.1145/321526.321537) is a numerical quadrature method that recursively bisects the interval until the precision is high enough.

Write an implementation of quadrature by adaptive Simpson’s method. Use the implementation to estimate the definite integral of sin(x) from 0 to 1. Show your output.

You can use the following pseudocode, which includes Lyness's modifications 1, 2, and 3.

Pseudocode: Simpson's method, adaptive

|  |
| --- |
| ``` ; Lyness's Adaptive Simpson's Rule, Modifications 1, 2, 3 procedure simpson_rule(f, a, fa, b, fb)     m := (a + b) / 2     fm := f(m)     h := b - a     return multiple [m, fm, (h / 6) * (fa + 4*fm + fb)]  procedure recursive_simpson(f, a, fa, b, fb, tol, whole, m, fm, depth)     lm, flm, left  := simpson_rule(f, a, fa, m, fm)     rm, frm, right := simpson_rule(f, m, fm, b, fb)     delta := left + right - whole     tol' := tol / 2     if depth <= 0 or tol' == tol or abs(delta) <= 15 * tol:         return left + right + (delta / 15)     else:         return recursive_simpson(f, a, fa, m, fm, tol', left , lm, flm, depth - 1) +                recursive_simpson(f, m, fm, b, fb, tol', right, rm, frm, depth - 1)  procedure quad_asr(f, a, b, tol, depth)    fa := f(a)    fb := f(b)    m, fm, whole := simpson_rule(f, a, fa, b, fb)    return recursive_simpson(f, a, fa, b, fb, tol, whole, m, fm, depth)  ``` |

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.10

Fairly direct translation of the Python code.

```
sub adaptive-Simpson-quadrature(&f, $left, $right, \ε = 1e-9) {
    my $lf = f($left);
    my $rf = f($right);
    my ($mid, $midf, $whole) = Simpson-quadrature-mid(&f, $left, $lf, $right, $rf);
    return recursive-Simpsons-asr(&f, $left, $lf, $right, $rf, ε, $whole, $mid, $midf);

    sub Simpson-quadrature-mid(&g, $l, $lf, $r, $rf){
        my $mid = ($l + $r) / 2;
        my $midf = g($mid);
        ($mid, $midf, ($r - $l).abs / 6 * ($lf + 4 * $midf + $rf))
    }

    sub recursive-Simpsons-asr(&h, $a, $fa, $b, $fb, $eps, $whole, $m, $fm){
        my ($lm, $flm, $left)  = Simpson-quadrature-mid(&h, $a, $fa, $m, $fm);
        my ($rm, $frm, $right) = Simpson-quadrature-mid(&h, $m, $fm, $b, $fb);
        my $delta = $left + $right - $whole;
        $delta.abs <= 15 * $eps
            ?? $left + $right + $delta / 15
            !! recursive-Simpsons-asr(&h, $a, $fa, $m, $fm, $eps/2, $left,  $lm, $flm) +
               recursive-Simpsons-asr(&h, $m, $fm, $b, $fb, $eps/2, $right, $rm, $frm)
    }
}

my ($a, $b) = 0e0, 1e0;
my $sin = adaptive-Simpson-quadrature(&sin, $a, $b, 1e-9).round(10**-9);;
say "Simpson's integration of sine from $a to $b = $sin";

```

Output:

```
Simpson's integration of sine from 0 to 1 = 0.459697694
```


[User]
|  |  |
| --- | --- |
| In a general Gaussian quadrature rule, an definite integral of       f ( x ) {\displaystyle {\displaystyle f(x)}}  is first approximated over the interval       [ − 1 , 1 ] {\displaystyle {\displaystyle [-1,1]}}  by a polynomial approximable function       g ( x ) {\displaystyle {\displaystyle g(x)}}  and a known weighting function       W ( x ) {\displaystyle {\displaystyle W(x)}} . | ∫  − 1  1 f ( x )  d x =  ∫  − 1  1 W ( x ) g ( x )  d x {\displaystyle {\displaystyle \int \_{-1}^{1}f(x)\,dx=\int \_{-1}^{1}W(x)g(x)\,dx}} |
| Those are then approximated by a sum of function values at specified points        x  i {\displaystyle {\displaystyle x\_{i}}}  multiplied by some weights        w  i {\displaystyle {\displaystyle w\_{i}}} : | ∫  − 1  1 W ( x ) g ( x )  d x ≈  ∑  i = 1  n  w  i g (  x  i ) {\displaystyle {\displaystyle \int \_{-1}^{1}W(x)g(x)\,dx\approx \sum \_{i=1}^{n}w\_{i}g(x\_{i})}} |
| In the case of Gauss-Legendre quadrature, the weighting function       W ( x ) = 1 {\displaystyle {\displaystyle W(x)=1}} , so we can approximate an integral of       f ( x ) {\displaystyle {\displaystyle f(x)}}  with: | ∫  − 1  1 f ( x )  d x ≈  ∑  i = 1  n  w  i f (  x  i ) {\displaystyle {\displaystyle \int \_{-1}^{1}f(x)\,dx\approx \sum \_{i=1}^{n}w\_{i}f(x\_{i})}} |

For this, we first need to calculate the nodes and the weights, but after we have them, we can reuse them for numerious integral evaluations, which greatly speeds up the calculation compared to more simple numerical integration methods.

|  |  |
| --- | --- |
| The       n {\displaystyle {\displaystyle n}}  evaluation points        x  i {\displaystyle {\displaystyle x\_{i}}}  for a n-point rule, also called "nodes", are roots of n-th order Legendre Polynomials        P  n ( x ) {\displaystyle {\displaystyle P\_{n}(x)}} . Legendre polynomials are defined by the following recursive rule: | P  0 ( x ) = 1 {\displaystyle {\displaystyle P\_{0}(x)=1}}   P  1 ( x ) = x {\displaystyle {\displaystyle P\_{1}(x)=x}}         n  P  n ( x ) = ( 2 n − 1 ) x  P  n − 1 ( x ) − ( n − 1 )  P  n − 2 ( x ) {\displaystyle {\displaystyle nP\_{n}(x)=(2n-1)xP\_{n-1}(x)-(n-1)P\_{n-2}(x)}} |
| There is also a recursive equation for their derivative: | P  n ′ ( x ) =   n   x  2 − 1  (  x  P  n ( x ) −  P  n − 1 ( x ) ) {\displaystyle {\displaystyle P\_{n}'(x)={\frac {n}{x^{2}-1}}\left(xP\_{n}(x)-P\_{n-1}(x)\right)}} |
| The roots of those polynomials are in general not analytically solvable, so they have to be approximated numerically, for example by Newton-Raphson iteration: | x  n + 1 =  x  n −    f (  x  n )   f ′ (  x  n ) {\displaystyle {\displaystyle x\_{n+1}=x\_{n}-{\frac {f(x\_{n})}{f'(x\_{n})}}}} |
| The first guess        x  0 {\displaystyle {\displaystyle x\_{0}}}  for the       i {\displaystyle {\displaystyle i}} -th root of a       n {\displaystyle {\displaystyle n}} -order polynomial        P  n {\displaystyle {\displaystyle P\_{n}}}  can be given by | x  0 = cos   (  π     i −   1 4  n +   1 2 ) {\displaystyle {\displaystyle x\_{0}=\cos \left(\pi \,{\frac {i-{\frac {1}{4}}}{n+{\frac {1}{2}}}}\right)}} |
| After we get the nodes        x  i {\displaystyle {\displaystyle x\_{i}}} , we compute the appropriate weights by: | w  i =   2   (  1 −  x  i  2 ) [  P  n ′ (  x  i )  ]  2 {\displaystyle {\displaystyle w\_{i}={\frac {2}{\left(1-x\_{i}^{2}\right)[P'\_{n}(x\_{i})]^{2}}}}} |
| After we have the nodes and the weights for a n-point quadrature rule, we can approximate an integral over any interval       [ a , b ] {\displaystyle {\displaystyle [a,b]}}  by | ∫  a  b f ( x )  d x ≈    b − a 2  ∑  i = 1  n  w  i f  (     b − a 2  x  i +    a + b 2 ) {\displaystyle {\displaystyle \int \_{a}^{b}f(x)\,dx\approx {\frac {b-a}{2}}\sum \_{i=1}^{n}w\_{i}f\left({\frac {b-a}{2}}x\_{i}+{\frac {a+b}{2}}\right)}} |

**Task description**

Similar to the task Numerical Integration, the task here is to calculate the definite integral of a function

f
(
x
)
{\displaystyle {\displaystyle f(x)}}
, but by applying an n-point Gauss-Legendre quadrature rule, as described here, for example. The input values should be an function f to integrate, the bounds of the integration interval a and b, and the number of gaussian evaluation points n. An reference implementation in Common Lisp is provided for comparison.

To demonstrate the calculation, compute the weights and nodes for an 5-point quadrature rule and then use them to compute:

```

              ∫

                −
                3

                3

            exp

            (
            x
            )

            d
            x
            ≈

              ∑

                i
                =
                1

                5

              w

                i

            exp

            (

              x

                i

            )
            ≈
            20.036

    {\displaystyle {\displaystyle \int _{-3}^{3}\exp(x)\,dx\approx \sum _{i=1}^{5}w_{i}\;\exp(x_{i})\approx 20.036}}

```

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015-09-24

A free translation of the OCaml solution. We save half the effort to calculate the nodes by exploiting the (skew-)symmetry of the Legendre Polynomials.
The evaluation of Pn(x) is kept linear in n by also passing Pn-1(x) in the recursion.

The quadrature function allows passing in a precalculated list of nodes for repeated integrations.

Note: The calculations of Pn(x) and P'n(x) could be combined to further reduce duplicated effort. We also could cache P'n(x) from the last Newton-Raphson step for the weight calculation.

```
multi legendre-pair(    1 , $x) { $x, 1 }
multi legendre-pair(Int $n, $x) {
    my ($m1, $m2) = legendre-pair($n - 1, $x);
    my \u = 1 - 1 / $n;
    (1 + u) * $x * $m1 - u * $m2, $m1;
}

multi legendre(    0 , $ ) { 1 }
multi legendre(Int $n, $x) { legendre-pair($n, $x)[0] }

multi legendre-prime(    0 , $ ) { 0 }
multi legendre-prime(    1 , $ ) { 1 }
multi legendre-prime(Int $n, $x) {
    my ($m0, $m1) = legendre-pair($n, $x);
    ($m1 - $x * $m0) * $n / (1 - $x**2);
}

sub approximate-legendre-root(Int $n, Int $k) {
    # Approximation due to Francesco Tricomi
    my \t = (4*$k - 1) / (4*$n + 2);
    (1 - ($n - 1) / (8 * $n**3)) * cos(pi * t);
}

sub newton-raphson(&f, &f-prime, $r is copy, :$eps = 2e-16) {
    while abs(my \dr = - f($r) / f-prime($r)) >= $eps {
        $r += dr;
    }
    $r;
}

sub legendre-root(Int $n, Int $k) {
    newton-raphson(&legendre.assuming($n), &legendre-prime.assuming($n),
                   approximate-legendre-root($n, $k));
}

sub weight(Int $n, $r) { 2 / ((1 - $r**2) * legendre-prime($n, $r)**2) }

sub nodes(Int $n) {
    flat gather {
        take 0 => weight($n, 0) if $n !%% 2;
        for 1 .. $n div 2 {
            my $r = legendre-root($n, $_);
            my $w = weight($n, $r);
            take $r => $w, -$r => $w;
        }
    }
}

sub quadrature(Int $n, &f, $a, $b, :@nodes = nodes($n)) {
    sub scale($x) { ($x * ($b - $a) + $a + $b) / 2 }
    ($b - $a) / 2 * [+] @nodes.map: { .value * f(scale(.key)) }
}

say "Gauss-Legendre $_.fmt('%2d')-point quadrature ∫₋₃⁺³ exp(x) dx ≈ ",
         quadrature($_, &exp, -3, +3) for flat 5 .. 10, 20;

```

Output:

```
Gauss-Legendre  5-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0355777183856
Gauss-Legendre  6-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357469750923
Gauss-Legendre  7-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357498197266
Gauss-Legendre  8-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357498544945
Gauss-Legendre  9-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357498548174
Gauss-Legendre 10-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357498548198
Gauss-Legendre 20-point quadrature ∫₋₃⁺³ exp(x) dx ≈ 20.0357498548198
```


[User]
|  |
| --- |
| This page uses content from **Wikipedia**. The original article was at NYSIIS. 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) |

The New York State Identification and Intelligence System phonetic code, commonly known as NYSIIS, is a phonetic algorithm for creating indices for words based on their pronunciation.

The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling.

Task

Implement the original NYSIIS algorithm, shown in Wikipedia, rather than any other subsequent modification.

Also, before the algorithm is applied the input string should be converted to upper case with all white space removed.

An optional step is to handle multiple names, including double-barrelled names or double surnames (e.g. 'Hoyle-Johnson' or 'Vaughan Williams') and unnecessary suffixes/honours that are not required for indexing purposes (e.g. 'Jnr', 'Sr', 'III', etc) - a small selection will suffice.

The original implementation is also restricted to six characters, but this is not a requirement.

Note

rules 7, 8 and 9 in the Wikipedia article are not mutually exclusive, Willis encodes to WAL, for example.

See also

* Soundex

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2017.05

This implementation removes common name suffixes similar to the reference implementation, even though it is not specified in the task description or on the linked NYSIIS page. This algorithm isn't too friendly to certain French kings. :)

```
sub no_suffix ($name) {
    $name.uc.subst: /\h (<[JS]>R) | (<[IVX]>+) $/, '';
}

sub nysiis ($name is copy) {
    given $name .= uc {
        s:g/<-[A..Z]>//;
        s/^MAC/MCC/;
        s/^P<[FH]>/FF/;
        s/^SCH/SSS/;
        s/^KN/N/;
        s/<[IE]>E$  /Y/;
        s/<[DRN]>T$ /D/;
        s/<[RN]>D$  /D/;
        s:c(1):g/EV/AF/;
        s:c(1):g/<[AEIOU]>+/A/;
        s:c(1):g/Q/G/;
        s:c(1):g/Z/S/;
        s:c(1):g/M/N/;
        s:c(1):g/KN/N/;
        s:c(1):g/K/C/;
        s:c(1):g/SCH/S/;
        s:c(1):g/PF/F/;
        s:c(1):g/K/C/;
        s:c(1):g/H(<-[AEIOU]>)/$0/;
        s:g/(<-[AEIOU]>)H/$0/;
        s:g/(.)W/$0/;
        s/ AY$ /Y/;
        s/  S$ //;
        s/  A$ //;
        s:g/ (.)$0+ /$0/;
     }
     return $name;
}

for «
    knight      mitchell        "o'daniel"      "brown  sr"     "browne III"
    "browne IV" "O'Banion"      Mclaughlin      McCormack       Chapman
    Silva       McDonald        Lawson          Jacobs          Greene
    "O'Brien"   Morrison        Larson          Willis          Mackenzie
    Carr        Lawrence        Matthews        Richards        Bishop
    Franklin    McDaniel        Harper          Lynch           Watkins
    Carlson     Wheeler         "Louis XVI"
» {
    my $nysiis = nysiis no_suffix $_;
    if $nysiis.chars > 6 {
        $nysiis .= subst: rx/ <after .**6> .+ /, -> $/ { "[$/]" };
    }
    printf "%10s,  %s\n", $_, $nysiis;
}

```

Output:

```
    knight,  NAGT
  mitchell,  MATCAL
  o'daniel,  ODANAL
  brown sr,  BRAN
browne III,  BRAN
 browne IV,  BRAN
  O'Banion,  OBANAN
Mclaughlin,  MCLAGL[AN]
 McCormack,  MCARNA[C]
   Chapman,  CAPNAN
     Silva,  SALV
  McDonald,  MCDANA[LD]
    Lawson,  LASAN
    Jacobs,  JACAB
    Greene,  GRAN
   O'Brien,  OBRAN
  Morrison,  MARASA[N]
    Larson,  LARSAN
    Willis,  WAL
 Mackenzie,  MCANSY
      Carr,  CAR
  Lawrence,  LARANC
  Matthews,  MAT
  Richards,  RACARD
    Bishop,  BASAP
  Franklin,  FRANCL[AN]
  McDaniel,  MCDANA[L]
    Harper,  HARPAR
     Lynch,  LYNC
   Watkins,  WATCAN
   Carlson,  CARLSA[N]
   Wheeler,  WALAR
 Louis XVI,  L

```


[User]
For this task, for our purposes, a cuboid is a 3 dimensional object, with six rectangular faces, where all angles are right angles, opposite faces of the cuboid are equal, and where each dimension is a positive integer unit length. It will subsequently be referred to simply as a cuboid; but be aware that it references the above definition.

The surface area of a cuboid is two times the length times the width, plus two times the length times the height, plus two times the width times the height. A cuboid will always have an even integer surface area. The minimum surface area a cuboid may have is 6; one where the **l**, **w**, and **h** measurements are all **1**.

```
  2 × ( l × w + w × h + h × l )
  2 × ( 1 × 1 + 1 × 1 + 1 × 1 ) = 6

```

Different cuboid configurations (may) yield different surface areas, but the surface area is always an integer and is always even.

A cuboid with l = 2, w = 1 h = 1 has a surface area of 10

```
  2 × ( 2 × 1 + 1 × 1 + 1 × 2 ) = 10

```

There is no configuration which will yield a surface area of 8.

There are 16 known even integer values below 1000 which can not be a surface area for any integer cuboid. It is conjectured, though not rigorously proved, that no others exist.

Task

* Find and display the sixteen even integer values larger than 6 (the minimum cuboid area) and less than 1000

that can not be the surface area of a cuboid.

See also

* Numbers Aplenty - O'Halloran numbers * OEIS:A072843 - O'Halloran numbers: even integers which cannot be the surface area of a cuboid with integer-length sides * Idoneal numbers

[Assistant]
```
my @Area;

my $threshold = 1000; # a little overboard to make sure we get them all

for 1..$threshold -> $x {
    for 1..$x -> $y {
        last if $x × $y > $threshold;
        for 1..$y -> $z {
           push @Area[my $area = ($x × $y + $y × $z + $z × $x) × 2], "$x,$y,$z";
           last if $area > $threshold;
        }
    }
}

say "Even integer surface areas NOT achievable by any regular, integer dimensioned cuboid:\n" ~
   @Area[^$threshold].kv.grep( { $^key > 6 and $key %% 2 and !$^value } )»[0];

```

Output:

```
Even integer surface areas NOT achievable by any regular, integer dimensioned cuboid:
8 12 20 36 44 60 84 116 140 156 204 260 380 420 660 924
```


[User] Create a set of data types based upon inheritance. Each data type or class should have a print command that displays the contents of an instance of that class to standard output. Create instances of each class in your inheritance hierarchy and display them to standard output. Write each of the objects to a file named *objects.dat* in binary form using serialization or marshalling. Read the file *objects.dat* and print the contents of each serialized object.

[Assistant]
(formerly Perl 6)

```
# Reference:
# https://docs.raku.org/language/classtut
# https://github.com/teodozjan/perl-store

use v6;
use PerlStore::FileStore;

class Point {
    has Int $.x;
    has Int $.y;
}

class Rectangle does  FileStore {
    has Point $.lower;
    has Point $.upper;

    method area() returns Int {
        ($!upper.x - $!lower.x) * ( $!upper.y - $!lower.y);
    }
}

my $r1 = Rectangle.new(lower => Point.new(x => 0, y => 0),
                      upper => Point.new(x => 10, y => 10));
say "Create Rectangle1 with area ",$r1.area();
say "Serialize Rectangle1 to object.dat";
$r1.to_file('./objects.dat');
say "";
say "take a peek on object.dat ..";
say slurp "./objects.dat";
say "";
say "Deserialize to Rectangle2";
my $r2 = from_file('objects.dat');
say "Rectangle2 is of type ", $r2.WHAT;
say "Rectangle2 area is ", $r2.area();

```

Output:

```
Create Rectangle1 with area 100
Serialize Rectangle1 to object.dat

take a peek on object.dat ..
Rectangle.new(lower => Point.new(x => 0, y => 0), upper => Point.new(x => 10, y => 10))

Deserialize to Rectangle2
Rectangle2 is of type (Rectangle)
Rectangle2 area is 100
```


[User]
Task

Find odd and square numbers (>99) under **1.000**

[Assistant]
Vote for deletion: trivial. But if we gotta keep it, at least make it *slightly* interesting.

```
for 1..5 {
    my $max = exp $_, 10;
    put "\n{+$_} odd squares from {$max / 10} to $max:\n{ .batch(10).join: "\n" }"
    given ({(2 × $++ + 1)²} … * > $max).grep: $max / 10 ≤ * ≤ $max
}

```

Output:

```
2 odd squares from 1 to 10:
1 9

3 odd squares from 10 to 100:
25 49 81

11 odd squares from 100 to 1000:
121 169 225 289 361 441 529 625 729 841
961

34 odd squares from 1000 to 10000:
1089 1225 1369 1521 1681 1849 2025 2209 2401 2601
2809 3025 3249 3481 3721 3969 4225 4489 4761 5041
5329 5625 5929 6241 6561 6889 7225 7569 7921 8281
8649 9025 9409 9801

108 odd squares from 10000 to 100000:
10201 10609 11025 11449 11881 12321 12769 13225 13689 14161
14641 15129 15625 16129 16641 17161 17689 18225 18769 19321
19881 20449 21025 21609 22201 22801 23409 24025 24649 25281
25921 26569 27225 27889 28561 29241 29929 30625 31329 32041
32761 33489 34225 34969 35721 36481 37249 38025 38809 39601
40401 41209 42025 42849 43681 44521 45369 46225 47089 47961
48841 49729 50625 51529 52441 53361 54289 55225 56169 57121
58081 59049 60025 61009 62001 63001 64009 65025 66049 67081
68121 69169 70225 71289 72361 73441 74529 75625 76729 77841
78961 80089 81225 82369 83521 84681 85849 87025 88209 89401
90601 91809 93025 94249 95481 96721 97969 99225
```


[User]
Task

Odd numbers of the form p\*q where p and q are distinct primes, where **p\*q < 1000**

See also
:   * OEIS:A046388

[Assistant]
```
say (3..333).grep(*.is-prime).combinations(2).map( { next if (my $p = [*] $_) > 999; $p } ).flat\
    .sort.batch(20)».fmt('%3d').join: "\n";

```

Output:

```
 15  21  33  35  39  51  55  57  65  69  77  85  87  91  93  95 111 115 119 123
129 133 141 143 145 155 159 161 177 183 185 187 201 203 205 209 213 215 217 219
221 235 237 247 249 253 259 265 267 287 291 295 299 301 303 305 309 319 321 323
327 329 335 339 341 355 365 371 377 381 391 393 395 403 407 411 413 415 417 427
437 445 447 451 453 469 471 473 481 485 489 493 497 501 505 511 515 517 519 527
533 535 537 543 545 551 553 559 565 573 579 581 583 589 591 597 611 623 629 633
635 649 655 667 669 671 679 681 685 687 689 695 697 699 703 707 713 717 721 723
731 737 745 749 753 755 763 767 771 779 781 785 789 791 793 799 803 807 813 815
817 831 835 843 849 851 865 869 871 879 889 893 895 899 901 905 913 917 921 923
933 939 943 949 951 955 959 965 973 979 985 989 993 995
```


[User]
Task

Write a program that solves the odd word problem with the restrictions given below.

Description

You are promised an input stream consisting of English letters and punctuations.

It is guaranteed that:

* the words (sequence of consecutive letters) are delimited by one and only one punctuation,
* the stream will begin with a word,
* the words will be at least one letter long,   and
* a full stop (a period, [**.**]) appears after, and only after, the last word.

Example

A stream with six words:

:   :   `what,is,the;meaning,of:life.`

The task is to reverse the letters in every other word while leaving punctuations intact, producing:

:   :   `what,si,the;gninaem,of:efil.`

while observing the following restrictions:

1. Only I/O allowed is reading or writing one character at a time, which means: no reading in a string, no peeking ahead, no pushing characters back into the stream, and no storing characters in a global variable for later use;
2. You **are not** to explicitly save characters in a collection data structure, such as arrays, strings, hash tables, etc, for later reversal;
3. You **are** allowed to use recursions, closures, continuations, threads, co-routines, etc., even if their use implies the storage of multiple characters.

Test cases

Work on both the   "life"   example given above, and also the text:

:   :   `we,are;not,in,kansas;any,more.`

[Assistant]
(formerly Perl 6)
A recursive solution, with the added feature that it treats each line separately.

```
my &in = { $*IN.getc // last }

loop {
    ew(in);
    ow(in).print;
}

multi ew ($_ where /\w/) { .print; ew(in); }
multi ew ($_)            { .print; next when "\n"; }

multi ow ($_ where /\w/) { ow(in) x .print; }
multi ow ($_)            { $_; }

```

Output:

```
$ ./oddword
we,are;not,in,kansas;any,more.
we,era;not,ni,kansas;yna,more.
what,is,the;meaning,of:life.
what,si,the;gninaem,of:efil.
```

Note how the even/oddness is reset on the line boundary; if not, the second line might have started out in an odd state and reversed "what" instead of "is". The call to next prevents that by sending the loop back to its initial state.

There is one clever trick here with the x operator; it evaluates both its arguments in order, but in this case only returns the left argument because the right one is always 1 (True). You can think of it as a reversed C-style comma operator.


[User]
Given a list of words, (use the words from the dictionary unixdict.txt).

Take the letters at odd indices letters from each word. If the result is present in the list, then display the result.
The length of the *odd word* should be **>   4**.

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]
```
my %words = 'unixdict.txt'.IO.slurp.words.map: * => 1;

my (@odds, @evens);

for %words {
    next if .key.chars < 9;
    my $odd  = .key.comb[0,2 … *].join;
    @odds.push(.key => $odd) if %words{$odd} and $odd.chars > 4;
    my $even = .key.comb[1,3 … *].join;
    @evens.push(.key => $even) if %words{$even} and $even.chars > 4;
}

.put for flat 'Odd words > 4:', @odds.sort;

.put for flat "\nEven words > 4:", @evens.sort;

```

Output:

```
Odd words > 4:
barbarian	brain
childbear	cider
corrigenda	cried
gargantuan	grata
headdress	hades
palladian	plain
propionate	point
salvation	slain
siltation	slain
slingshot	sight
statuette	saute
supersede	spree
supervene	spree
terminable	trial

Even words > 4:
cannonball	annal
importation	motto
psychopomp	scoop
starvation	train
upholstery	posey
```


[User]
Task

Present a program which emits the lyrics to the song   *I Knew an Old Lady Who Swallowed a Fly*,   taking advantage of the repetitive structure of the song's lyrics.

This song has multiple versions with slightly different lyrics, so all these programs might not emit identical output.

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)

```
my @victims =
    fly    => "  I don't know why S—",
    spider => "  That wriggled and jiggled and tickled inside her.",
    bird   => "  How absurd, T!",
    cat    => "  Fancy that, S!",
    dog    => "  What a hog, T!",
    goat   => "  She just opened her throat, and in walked the goat!",
    cow    => "  I don't know how S!",
    horse  => "  She's dead, of course...";

my @history = "I guess she'll die...\n";

for (flat @victims».kv) -> $victim, $_ is copy {
    say "There was an old lady who swallowed a $victim...";

    s/ «S» /she swallowed the $victim/;
    s/ «T» /to swallow a $victim!/;
    .say;
    last when /dead/;

    @history[0] ~~ s/^X/She swallowed the $victim/;
    .say for @history;
    @history.unshift($_) if @history < 5;
    @history.unshift("X to catch the $victim,");
}

```

And that's how I larned it!


[User]
Task

Write a program to perform a conversion of the old Russian measures of length to the metric system   (and vice versa).

It is an example of a linear transformation of several variables.

The program should accept a single value in a selected unit of measurement, and convert and return it to the other units:

*vershoks*, *arshins*, *sazhens*, *versts*, *meters*, *centimeters* and *kilometers*.

Also see
:   * Old Russian measure of length

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015.12

Fairly straightfoward. Define a hash of conversion factors then apply them. Makes no attempt to do correct pluralization because I have no idea what the correct plurals are and little interest in researching them. Conversion factors from Wikipedia: Obsolete Russian units of measurement.

```
convert(1, 'meter');

say '*' x 40, "\n";

convert(1, 'milia');

sub convert (Real $magnitude, $unit) {
     my %factor =
        tochka     => 0.000254,
        liniya     => 0.00254,
        diuym      => 0.0254,
        vershok    => 0.04445,
        piad       => 0.1778,
        fut        => 0.3048,
        arshin     => 0.7112,
        sazhen     => 2.1336,
        versta     => 1066.8,
        milia      => 7467.6,
        centimeter => 0.01,
        meter      => 1.0,
        kilometer  => 1000.0,
    ;

    my $meters = $magnitude * %factor{$unit.lc};

    say "$magnitude $unit to:\n", '_' x 40;

    printf "%10s: %s\n", $_,  $meters / %factor{$_} unless $_ eq $unit.lc
      for %factor.keys.sort:{ +%factor{$_} }
}

```

```
1 meter to:
________________________________________
    tochka: 3937.007874
    liniya: 393.700787
centimeter: 100
     diuym: 39.370079
   vershok: 22.497188
      piad: 5.624297
       fut: 3.280840
    arshin: 1.406074
    sazhen: 0.468691
 kilometer: 0.001
    versta: 0.000937
     milia: 0.000134
****************************************

1 milia to:
________________________________________
    tochka: 29400000
    liniya: 2940000
centimeter: 746760
     diuym: 294000
   vershok: 168000
      piad: 42000
       fut: 24500
    arshin: 10500
     meter: 7467.6
    sazhen: 3500
 kilometer: 7.4676
    versta: 7

```


[User]
A method of choosing a line randomly from a file:

:   :   * Without reading the file more than once
        * When substantial parts of the file cannot be held in memory
        * Without knowing how many lines are in the file

Is to:

:   :   * keep the first line of the file as a possible choice, then
        * Read the second line of the file if possible and make it the possible choice if a uniform random value between zero and one is less than 1/2.
        * Read the third line of the file if possible and make it the possible choice if a uniform random value between zero and one is less than 1/3.
        * ...
        * Read the Nth line of the file if possible and make it the possible choice if a uniform random value between zero and one is less than 1/N

:   :   * Return the computed possible choice when no further lines exist in the file.

Task

1. Create a function/method/routine called `one_of_n` that given `n`, the number of actual lines in a file, follows the algorithm above to return an integer - the line number of the line chosen from the file.
   The number returned can vary, randomly, in each run.
2. Use `one_of_n` in a *simulation* to find what would be the chosen line of a 10-line file simulated 1,000,000 times.
3. Print and show how many times each of the 10 lines is chosen as a rough measure of how well the algorithm works.

Note: You may choose a smaller number of repetitions if necessary, but mention this up-front.

Note: This is a specific version of a Reservoir Sampling algorithm: https://en.wikipedia.org/wiki/Reservoir\_sampling

[Assistant]
(formerly Perl 6)

**Translation of**: Python

```
sub one_of_n($n) {
    my $choice;
    $choice = $_ if .rand < 1 for 1 .. $n;
    $choice - 1;
}

sub one_of_n_test($n = 10, $trials = 1_000_000) {
    my @bins;
    @bins[one_of_n($n)]++ for ^$trials;
    @bins;
}

say one_of_n_test();

```

Output:

```
100288 100047 99660 99773 100256 99633 100161 100483 99789 99910
```


[User]
Assume an array of cells with an initial distribution of live and dead cells,
and imaginary cells off the end of the array having fixed values.

Cells in the next generation of the array are calculated based on the value of the cell and its left and right nearest neighbours in the current generation.

If, in the following table, a live cell is represented by 1 and a dead cell by 0 then to generate the value of the cell at a particular index in the array of cellular values you use the following table:

```
000 -> 0  #
001 -> 0  #
010 -> 0  # Dies without enough neighbours
011 -> 1  # Needs one neighbour to survive
100 -> 0  #
101 -> 1  # Two neighbours giving birth
110 -> 1  # Needs one neighbour to survive
111 -> 0  # Starved to death.

```

Related tasks

* Elementary cellular automaton

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2014-02-27

We'll make a general algorithm capable of computing any cellular automata
as defined by Stephen Wolfram's
famous book *A new kind of Science*.
We will take the liberty of wrapping the array of cells
as it does not affect the result much
and it makes the implementation a lot easier.

```
class Automaton {
    has $.rule;
    has @.cells;
    has @.code = $!rule.fmt('%08b').flip.comb».Int;

    method gist { "|{ @!cells.map({+$_ ?? '#' !! ' '}).join }|" }

    method succ {
        self.new: :$!rule, :@!code, :cells(
            @!code[
                    4 «*« @!cells.rotate(-1)
                »+« 2 «*« @!cells
                »+«       @!cells.rotate(1)
            ]
        )
    }
}

#  The rule proposed for this task is rule 0b01101000 = 104

my @padding = 0 xx 5;
my Automaton $a .= new:
    rule  => 104,
    cells => flat @padding, '111011010101'.comb, @padding
;
say $a++ for ^10;

# Rule 104 is not particularly interesting so here is [[wp:Rule 90|Rule 90]],
# which shows a [[wp:Sierpinski Triangle|Sierpinski Triangle]].

say '';
@padding = 0 xx 25;
$a = Automaton.new: :rule(90), :cells(flat @padding, 1, @padding);

say $a++ for ^20;

```

Output:

```
|     ### ## # # #     |
|     # ##### # #      |
|      ##   ## #       |
|      ##   ###        |
|      ##   # #        |
|      ##    #         |
|      ##              |
|      ##              |
|      ##              |
|      ##              |

|                         #                         |
|                        # #                        |
|                       #   #                       |
|                      # # # #                      |
|                     #       #                     |
|                    # #     # #                    |
|                   #   #   #   #                   |
|                  # # # # # # # #                  |
|                 #               #                 |
|                # #             # #                |
|               #   #           #   #               |
|              # # # #         # # # #              |
|             #       #       #       #             |
|            # #     # #     # #     # #            |
|           #   #   #   #   #   #   #   #           |
|          # # # # # # # # # # # # # # # #          |
|         #                               #         |
|        # #                             # #        |
|       #   #                           #   #       |
|      # # # #                         # # # #      |

```


[User]
Implement a One-time pad, for encrypting and decrypting messages.
To keep it simple, we will be using letters only.

Sub-Tasks

* **Generate** the data for a One-time pad (user needs to specify a filename and length)

:   The important part is to get "true random" numbers, e.g. from /dev/random

* **encryption / decryption** ( basically the same operation, much like Rot-13 )

:   For this step, much of Vigenère cipher could be reused,
    with the key to be read from the file containing the One-time pad.

* optional: **management** of One-time pads: list, mark as used, delete, etc.

:   Somehow, the users needs to keep track which pad to use for which partner.

To support the management of pad-files:

* Such files have a file-extension ".1tp"
* Lines starting with "#" may contain arbitary meta-data (i.e. comments)
* Lines starting with "-" count as "used"
* Whitespace within the otp-data is ignored

For example, here is the data from Wikipedia:

```
# Example data - Wikipedia - 2014-11-13
-ZDXWWW EJKAWO FECIFE WSNZIP PXPKIY URMZHI JZTLBC YLGDYJ
-HTSVTV RRYYEG EXNCGA GGQVRF FHZCIB EWLGGR BZXQDQ DGGIAK
 YHJYEQ TDLCQT HZBSIZ IRZDYS RBYJFZ AIRCWI UCVXTW YKPQMK
 CKHVEX VXYVCS WOGAAZ OUVVON GCNEVR LMBLYB SBDCDC PCGVJX
 QXAUIP PXZQIJ JIUWYH COVWMJ UZOJHL DWHPER UBSRUJ HGAAPR
 CRWVHI FRNTQW AJVWRT ACAKRD OZKIIB VIQGBK IJCWHF GTTSSE
 EXFIPJ KICASQ IOUQTP ZSGXGH YTYCTI BAZSTN JKMFXI RERYWE

```

See also

* one time pad encryption in Python
* snapfractalpop - One-Time-Pad Command-Line-Utility (C).
* Crypt-OTP-2.00 on CPAN (Perl)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.10

The task is somewhat under-specified, especially the third (optional) section so I'm skipping that for now. Each sub-task has it's own code.

**Sub-task one:** generate one-time-pad files.

This is a fairly basic otp file generator. Uses Crypt::Random for decently high quality random numbers. (Random bytes are drawn from /dev/urandom on Unix-like systems, and CryptGenRandom() on Windows.) It will ask for a file name to save to, and the number of lines you want. Each line can be used to encode up to 48 characters of data. Default is 1000 lines, Only generating 4 lines here for demonstration purposes. Saving the file to 'rosettacode.1tp'.

```
sub MAIN {
    put "Generate data for one time pad encryption.\n" ~
        "File will have .1tp extension.";
    my $fn;
    loop {
        $fn = prompt 'Filename for one time pad data: ';
        if $fn !~~ /'.1tp' $/ { $fn ~= '.1tp' }
        if $fn.IO.e {
            my $ow = prompt "$fn aready exists, over-write? y/[n] ";
            last if $ow ~~ m:i/'y'/;
            redo;
        }
        last;
    }

    put 'Each line will contain 48 characters of encyption data.';
    my $lines = prompt 'How many lines of data to generate? [1000] ';
    $lines ||= 1000;
    generate($fn, $lines);
    say "One-time-pad data saved to: ", $fn.IO.absolute;

    sub generate ( $fn, $lines) {
        use Crypt::Random;
        $fn.IO.spurt: "# one-time-pad encryption data\n" ~
          ((sprintf(" %s %s %s %s %s %s %s %s\n",
          ((('A'..'Z')[crypt_random_uniform(26)] xx 6).join) xx 8))
          xx $lines).join;
    }
}

```

Output:

```
Generate data for one time pad encryption.
File wile have .1tp extension.
Filename for one time pad data: rosettacode
Each line will contain 48 characters of encyption data.
How many lines of data to generate? [1000] 4
One-time-pad data saved to: /home/myhome/mydirectory/rosettacode.1tp

```

Sample file generated by above code:

```
# one-time-pad encryption data
 DSUJOU UUWDZD VHFWRR AJDMDC ERZDGD WWKLHJ YITCML FORXCV
 BXGFCL ANGCGY VTAEUG UYAIPK FXWMNI INDLOR JIDZQL BOFFQD
 JISNOS CMLRPW TFGELQ HPTMRN SHBBDP AIVDAC CEWIFH TRLQVK
 FRBUUC GDCQHQ CEEURS RGVWVT JZIQLP NQCABF BWUPUI UDTZAF
```

**Sub-task two:** encrypt/decrypt text using the otp files generated by part one.

One-time-pad encryption gets it's security from the fact that the pads are used **one time**. As a line is used in the otp file, it needs to be marked as used, or removed so it doesn't get reused. Theoretically, you would make a copy of rosettacode.1tp and send it by secure means to the receiver of your encrypted text so that they can use it to decrypt. Since we are encrypting and decrypting on the same computer, we'll make a copy of the otp file named rosettacopy.1tp and use that for decryption so the encrypt and decrypt functions don't conflict.

```
sub s2v ($s) { $s.uc.comb(/ <[ A..Z ]> /)».ord »-» 65 }
sub v2s (@v) { (@v »%» 26 »+» 65)».chr.join }

sub hide   ($secret, $otp) { v2s(s2v($secret) »+» s2v($otp)) }
sub reveal ($hidden, $otp) { v2s(s2v($hidden) »-» s2v($otp)) }

sub otp-data ($fn, $lines) {
    my $fh = $fn.IO.open :rw;
    my $data;
    my $count = 0;
    repeat {
        my $pos = $fh.tell;
        my $line = $fh.get;
        if $line.substr(0,1) ne '-'|'#' {
            $data ~= $line;
            $fh.seek($pos);
            $fh.put: '-' ~ $line.substr(1);
            $count++;
        }
    } until $count == $lines or $fh.eof;
    note "Insufficient lines of data remaining in $fn" if $count != $lines;
    $data;
}

sub otp-size (Str $string) { ceiling $string.uc.comb(/ <[ A..Z ]> /) / 48 }

sub otp-encrypt ( $secret, $fn ) {
    my $otp-size = otp-size $secret;
    my $otp-data = otp-data($fn, $otp-size);
    my $encrypted = hide $secret, $otp-data;
    # pad encryted text out to a full line with random text
    $encrypted ~= ('A'..'Z').roll while $encrypted.chars % 48;
    join "\n", $encrypted.comb(6).rotor(8, :partial).map:
      { sprintf "{ join ' ', "%s" xx $_ }", $_ };
}

sub otp-decrypt ( $secret, $fn ) {
    my $otp-size = otp-size $secret;
    my $otp-data = otp-data($fn, $otp-size);
    my $plain-text = reveal $secret, $otp-data;
    join "\n", $plain-text.comb(6).rotor(8, :partial).map:
      { sprintf "{ join ' ', "%s" xx $_ }", $_ };
}

my $otp-encrypt-fn = 'rosettacode.1tp';
my $otp-decrypt-fn = 'rosettacopy.1tp';

my $secret = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!";

say "Secret:\n$secret\n\nEncrypted:";
say my $encrypted =   otp-encrypt $secret,    $otp-encrypt-fn;
say "\nDecrypted:\n", otp-decrypt $encrypted, $otp-decrypt-fn;

```

Output:

```
Secret:
Beware the Jabberwock, my son! The jaws that bite, the claws that catch!

Encrypted:
EWQJFY NBAMZE WLWSFT KVBERP XYDMGZ OPRLAK GBXVTP HZRTUO
IXZHCE CUUORL THOFDI DCXRLG JQICPI ZEREHP RLOEAE PRMVJH

Decrypted:
BEWARE THEJAB BERWOC KMYSON THEJAW STHATB ITETHE CLAWST
HATCAT CHOMLN YOOBJC JEXJWW ETMQCA RROTTY IDLFKT ODHQTE
```

Contents of rosettacode.1tp after encryption / rosettacopy.1tp after decryption:

```
# one-time-pad encryption data
-DSUJOU UUWDZD VHFWRR AJDMDC ERZDGD WWKLHJ YITCML FORXCV
-BXGFCL ANGCGY VTAEUG UYAIPK FXWMNI INDLOR JIDZQL BOFFQD
 JISNOS CMLRPW TFGELQ HPTMRN SHBBDP AIVDAC CEWIFH TRLQVK
 FRBUUC GDCQHQ CEEURS RGVWVT JZIQLP NQCABF BWUPUI UDTZAF
```