[User]
There are 100 doors in a row that are all initially closed.

You make 100 passes by the doors.

The first time through, visit every door and *toggle* the door (if the door is closed, open it; if it is open, close it).

The second time, only visit every 2nd door (door #2, #4, #6, ...), and toggle it.

The third time, visit every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door.

Task

Answer the question: what state are the doors in after the last pass? Which are open, which are closed?

**Alternate:**
As noted in this page's discussion page, the only doors that remain open are those whose numbers are perfect squares.

Opening only those doors is an optimization that may also be expressed;
however, as should be obvious, this defeats the intent of comparing implementations across programming languages.

Why doesn't syntax highlighting work on this page ?

Currently, there is a limit on how many <syntaxhighlight> tags can appear on a page, so only the first few languages get highlighting, the rest are shown in monochrome.
You could try "manual highlighting", possibly using one of the highlighters on Syntax highlighting using Mediawiki formatting or something similar.

[Assistant]
(formerly Perl 6)

### unoptimized

**Works with**: Rakudo version 2015.09"

```
my @doors = False xx 101;

(.=not for @doors[0, $_ ... 100]) for 1..100;

say "Door $_ is ", <closed open>[ @doors[$_] ] for 1..100;
```

### optimized

```
say "Door $_ is open" for map {$^n ** 2}, 1..10;
```

### probably the most compact idiom

```
say 'Door $_ is open' for (1..10)»²;
```

### Here's a version using the cross meta-operator instead of a map:

```
 say "Door $_ is open" for 1..10 X** 2;
```

This one prints both opened and closed doors:

```
say "Door $_ is ", <closed open>[.sqrt == .sqrt.floor] for 1..100;
```

### verbose version, but uses ordinary components

**Works with**: Rakudo version 2016.07 Tom Legrady

```
sub  output( @arr, $max ) {
    my $output = 1;
    for 1..^$max -> $index {
	if @arr[$index] {
	    printf "%4d", $index;
	    say '' if $output++ %%  10;
	}
    }
    say '';
}

sub MAIN ( Int :$doors = 100 ) {
    my $doorcount = $doors + 1;
    my @door[$doorcount] = 0 xx ($doorcount);

    INDEX:
    for 1...^$doorcount -> $index {
        # flip door $index & its multiples, up to last door.
        #
	for ($index, * + $index ... *)[^$doors] -> $multiple {
	    next INDEX if $multiple > $doors;
	    @door[$multiple] =  @door[$multiple] ?? 0 !! 1;
	}
    }
    output @door, $doors+1;
}
```

Output:

```
$ ./100_doors.pl6 -doors=100
   1   4   9  16  25  36  49  64  81

```


[User]
The Problem

* 100 prisoners are individually numbered 1 to 100
* A room having a cupboard of 100 opaque drawers numbered 1 to 100, that cannot be seen from outside.
* Cards numbered 1 to 100 are placed randomly, one to a drawer, and the drawers all closed; at the start.
* Prisoners start outside the room

:   * They can decide some strategy before any enter the room.
    * Prisoners enter the room one by one, can open a drawer, inspect the card number in the drawer, then close the drawer.
    * A prisoner can open no more than 50 drawers.
    * A prisoner tries to find his own number.
    * A prisoner finding his own number is then held apart from the others.

* If **all** 100 prisoners find their own numbers then they will all be pardoned. If *any* don't then *all* sentences stand.

The task

1. Simulate several thousand instances of the game where the prisoners randomly open drawers
2. Simulate several thousand instances of the game where the prisoners use the optimal strategy mentioned in the Wikipedia article, of:

:   * First opening the drawer whose outside number is his prisoner number.
    * If the card within has his number then he succeeds otherwise he opens the drawer with the same number as that of the revealed card. (until he opens his maximum).

Show and compare the computed probabilities of success for the two strategies, here, on this page.

References

1. The unbelievable solution to the 100 prisoner puzzle standupmaths (Video).
2. wp:100 prisoners problem
3. 100 Prisoners Escape Puzzle DataGenetics.
4. Random permutation statistics#One hundred prisoners on Wikipedia.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

Accepts command line parameters to modify the number of prisoners and the number of simulations to run.

Also test with 10 prisoners to verify that the logic is correct for random selection. Random selection should succeed with 10 prisoners at a probability of (1/2)\*\*10, so in 100\_000 simulations, should get pardons about .0977 percent of the time.

```
unit sub MAIN (:$prisoners = 100, :$simulations = 10000);
my @prisoners = ^$prisoners;
my $half = floor +@prisoners / 2;

sub random ($n) {
    ^$n .race.map( {
        my @drawers = @prisoners.pick: *;
        @prisoners.map( -> $prisoner {
            my $found = 0;
            for @drawers.pick($half) -> $card {
                $found = 1 and last if $card == $prisoner
            }
            last unless $found;
            $found
        }
        ).sum == @prisoners
    }
    ).grep( *.so ).elems / $n * 100
}

sub optimal ($n) {
    ^$n .race.map( {
        my @drawers = @prisoners.pick: *;
        @prisoners.map( -> $prisoner {
            my $found = 0;
            my $card = @drawers[$prisoner];
            if $card == $prisoner {
                $found = 1
            } else {
                for ^($half - 1) {
                    $card = @drawers[$card];
                    $found = 1 and last if $card == $prisoner
                }
            }
            last unless $found;
            $found
        }
        ).sum == @prisoners
    }
    ).grep( *.so ).elems / $n * 100
}

say "Testing $simulations simulations with $prisoners prisoners.";
printf " Random play wins: %.3f%% of simulations\n", random $simulations;
printf "Optimal play wins: %.3f%% of simulations\n", optimal $simulations;

```

Output:

**With defaults**

```
Testing 10000 simulations with 100 prisoners.
 Random play wins: 0.000% of simulations
Optimal play wins: 30.510% of simulations
```

**With passed parameters: --prisoners=10, --simulations=100000**

```
Testing 100000 simulations with 10 prisoners.
 Random play wins: 0.099% of simulations
Optimal play wins: 35.461% of simulations

```


[User]
Task

Find and show on this page the 10001st prime number.

[Assistant]
```
say (^∞).grep( &is-prime )[10000]

```

Output:

```
104743
```


[User]
Task

Implement the Fifteen Puzzle Game.

The   **15-puzzle**   is also known as:

:   :   :   * **Fifteen Puzzle**
            * **Gem Puzzle**
            * **Boss Puzzle**
            * **Game of Fifteen**
            * **Mystic Square**
            * **14-15 Puzzle**
            * and some others.

Related Tasks
:   * 15 Puzzle Solver
    * 16 Puzzle Game

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.06

Most of this is interface code. Reused substantial portions from the 2048 task. Use the arrow keys to slide tiles, press 'q' to quit or 'n' for a new puzzle. Requires a POSIX termios aware terminal. Ensures that the puzzle is solvable by shuffling the board with an even number of swaps, then checking for even taxicab parity for the empty space.

```
use Term::termios;

constant $saved   = Term::termios.new(fd => 1).getattr;
constant $termios = Term::termios.new(fd => 1).getattr;
# raw mode interferes with carriage returns, so
# set flags needed to emulate it manually
$termios.unset_iflags(<BRKINT ICRNL ISTRIP IXON>);
$termios.unset_lflags(< ECHO ICANON IEXTEN ISIG>);
$termios.setattr(:DRAIN);

# reset terminal to original setting on exit
END { $saved.setattr(:NOW) }

constant n    = 4; # board size
constant cell = 6; # cell width

constant $top = join '─' x cell, '┌', '┬' xx n-1, '┐';
constant $mid = join '─' x cell, '├', '┼' xx n-1, '┤';
constant $bot = join '─' x cell, '└', '┴' xx n-1, '┘';

my %dir = (
   "\e[A" => 'up',
   "\e[B" => 'down',
   "\e[C" => 'right',
   "\e[D" => 'left',
);

my @solved = [1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14,15,' '];
my @board;
new();

sub new () {
    loop {
       @board = shuffle();
       last if parity-ok(@board);
   }
}

sub parity-ok (@b) {
    my $row = @b.first(/' '/,:k);
    my $col = @b[$row].first(/' '/,:k);
    so ([3,3] <<->> [$row,$col]).sum %% 2;
}

sub shuffle () {
    my @c = [1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14,15,' '];
    for (^16).pick(*) -> $y, $x {
        my ($yd, $ym, $xd, $xm) = ($y div n, $y mod n, $x div n, $x mod n);
        @(@c[$ym;$yd],@c[$xm;$xd]) = @(@c[$xm;$xd],@c[$ym;$yd]);
    }
    @c;
}

sub row (@row) { '│' ~ (join '│', @row».&center) ~ '│' }

sub center ($s){
    my $c   = cell - $s.chars;
    my $pad = ' ' x ceiling($c/2);
    sprintf "%{cell}s", "$s$pad";
}

sub draw-board {
    run('clear');
    print qq:to/END/;

	Press direction arrows to move.

	Press q to quit. Press n for a new puzzle.

	$top
	{ join "\n\t$mid\n\t", map { .&row }, @board }
	$bot

	{ (so @board ~~ @solved) ?? 'Solved!!' !! '' }
END
}

sub slide (@c is copy) {
    my $t = (grep { /' '/ }, :k, @c)[0];
    return @c unless $t and $t > 0;
    @c[$t,$t-1] = @c[$t-1,$t];
    @c;
}

proto sub move (|) {*};

multi move('up') {
    map { @board[*;$_] = reverse slide reverse @board[*;$_] }, ^n;
}

multi move('down') {
    map { @board[*;$_] = slide @board[*;$_] }, ^n;
}

multi move('left') {
    map { @board[$_] = reverse slide reverse @board[$_] }, ^n;
}

multi move('right') {
    map { @board[$_] = slide @board[$_] }, ^n;
}

loop {
    draw-board;

    # Read up to 4 bytes from keyboard buffer.
    # Page navigation keys are 3-4 bytes each.
    # Specifically, arrow keys are 3.
    my $key = $*IN.read(4).decode;

    move %dir{$key} if so %dir{$key};
    last if $key eq 'q'; # (q)uit
    new() if $key eq 'n';
}

```

Sample screen shot:

```
	Press direction arrows to move.

	Press q to quit. Press n for a new puzzle.

	┌──────┬──────┬──────┬──────┐
	│  2   │  1   │  10  │  14  │
	├──────┼──────┼──────┼──────┤
	│  15  │  11  │  12  │      │
	├──────┼──────┼──────┼──────┤
	│  13  │  3   │  6   │  7   │
	├──────┼──────┼──────┼──────┤
	│  9   │  4   │  5   │  8   │
	└──────┴──────┴──────┴──────┘

```


[User]
Your task is to write a program that finds a solution in the fewest moves possible single moves to a random Fifteen Puzzle Game.
For this task you will be using the following puzzle:

```
15 14  1  6
 9 11  4 12
 0 10  7  3
13  8  5  2
```

Solution:

```
 1  2  3  4
 5  6  7  8
 9 10 11 12
13 14 15  0

```

The output must show the moves' directions, like so: left, left, left, down, right... and so on.
There are two solutions, of fifty-two moves:
rrrulddluuuldrurdddrullulurrrddldluurddlulurruldrdrd
rrruldluuldrurdddluulurrrdlddruldluurddlulurruldrrdd
see: Pretty Print of Optimal Solution

Finding either one, or both is an acceptable result.

Extra credit.

Solve the following problem:

```
  0 12  9 13
 15 11 10 14
  3  7  2  5
  4  8  6  1

```

Related Task

* 15 puzzle game
* A\* search algorithm

[Assistant]
**Translation of**: C++

```
# 20210623 Raku programming solution vCSMt9hkak0

constant \Nr = <3 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3>;
constant \Nc = <3 0 1 2 3 0 1 2 3 0 1 2 3 0 1 2>;

my ($n,$m) = 0,0 ;
my @N0 is default(0);
my @N3 is default(0);
my @N4 is default(0);
my @N2 is default(0);

sub fY() {
   if @N2[$n] == 0x123456789abcdef0 {
      say "Solution found in ", $n, " moves: ", [~] @N3[1..$n] and exit();
   }
   return @N4[$n] ≤ $m ?? fN() !! False ;
}

sub fN() {
   sub common { ++$n; return True if fY(); --$n }
   if (@N3[$n] ne 'u' && @N0[$n] div 4 < 3) { fI() and common }
   if (@N3[$n] ne 'd' && @N0[$n] div 4 > 0) { fG() and common }
   if (@N3[$n] ne 'l' && @N0[$n]  %  4 < 3) { fE() and common }
   if (@N3[$n] ne 'r' && @N0[$n]  %  4 > 0) { fL() and common }
   return False;
}

sub fI() {
   my \g = (11-@N0[$n])*4;
   my \a = @N2[$n] +& (15 +< g);
   @N0[$n+1]=@N0[$n]+4;
   @N2[$n+1]=@N2[$n]-a+(a+<16);
   @N3[$n+1]='d';
   @N4[$n+1]=@N4[$n]+(Nr[a+>g] ≤ @N0[$n] div 4 ?? 0 !! 1);
}

sub fG() {
   my \g = (19-@N0[$n])*4;
   my \a = @N2[$n] +& (15 +< g);
   @N0[$n+1]=@N0[$n]-4;
   @N2[$n+1]=@N2[$n]-a+(a+>16);
   @N3[$n+1]='u';
   @N4[$n+1]=@N4[$n]+(Nr[a+>g] ≥ @N0[$n] div 4 ?? 0 !! 1);
}

sub fE() {
   my \g = (14-@N0[$n])*4;
   my \a = @N2[$n] +& (15 +< g);
   @N0[$n+1]=@N0[$n]+1;
   @N2[$n+1]=@N2[$n]-a+(a+<4);
   @N3[$n+1]='r';
   @N4[$n+1]=@N4[$n]+(Nc[a+>g] ≤ @N0[$n]%4 ?? 0 !! 1);
}

sub fL(){
   my \g = (16-@N0[$n])*4;
   my \a = @N2[$n] +& (15 +< g);
   @N0[$n+1]=@N0[$n]-1;
   @N2[$n+1]=@N2[$n]-a+(a+>4);
   @N3[$n+1]='l';
   @N4[$n+1]=@N4[$n]+(Nc[a+>g] ≥ @N0[$n]%4 ?? 0 !! 1);
}

sub fifteenSolver(\n, \g){@N0[0]=n; @N2[0]=g}

fifteenSolver(8,0xfe169b4c0a73d852);
loop { fY() or ++$m }

```

Output:

```
Solution found in 52 moves: rrrulddluuuldrurdddrullulurrrddldluurddlulurruldrdrd

```


[User]
16 numbered pieces of the puzzle are placed out of order on a 4 X 4 grid. The correct order to win is to order the pieces
as 1 through 16, read left to right, top to bottom:

```
  1  2  3  4
  5  6  7  8
  9 10 11 12
 13 14 15 16

```

How to Play: The aim is to get the pieces back in order by clicking on the yellow arrows (choosing a location to rotate a row or column) to slide the pieces left or right, up or down.

```
  1 14  3  4          1  2  3  4
  5  2  7  8   -->    5  6  7  8
  9  6 11 12          9 10 11 12
 13 10 15 16         13 14 15 16
     ^

```

The Easy puzzle target is 3 moves, for the Hard puzzle it is 12 moves (or less!). Can it be that simple?

Task

Create 16 Puzzle Game.

See details: [1]

Video: 16 Puzzle Game

Related task
:   * 15 Puzzle Game

[Assistant]
For brevity, changed to zero-based and skipped some error handling.

**Translation of**: Go

```
# 20210914 Raku programming solution

my (\easy,\hard) = 1,4 ; my @n = ^16; my \level = $ = easy ; my \moves = $ = 0;

sub hasWon { @n eq ^16 }

sub setDiff($level) {
   say "\nTarget is ", ( moves = $level == hard ?? 12 !! 3 ).Str, " moves.";
   for ^moves {
      my \s = (^4).roll;
      @n[ ( [ s, s+4 ... s+12 ] , [ s*4 .. s*4+3 ] ).roll ] .= rotate ;
      redo if hasWon
   }
}

sub drawGrid {
   say "\n     U1   U2   U3   U4";
   say "   ╔════╦════╦════╦════╗";
   printf  "L1 ║ %2d ║ %2d ║ %2d ║ %2d ║ R1\n", @n[0..3];
   say "   ╠════╬════╬════╬════╣";
   printf  "L2 ║ %2d ║ %2d ║ %2d ║ %2d ║ R2\n", @n[4..7];
   say "   ╠════╬════╬════╬════╣";
   printf  "L3 ║ %2d ║ %2d ║ %2d ║ %2d ║ R3\n", @n[8..11];
   say "   ╠════╬════╬════╬════╣";
   printf  "L4 ║ %2d ║ %2d ║ %2d ║ %2d ║ R4\n", @n[12..15];
   say "   ╚════╩════╩════╩════╝";
   say "     D1   D2   D3   D4\n"
}

sub init {
   loop {
      print "Enter difficulty level easy or hard E/H : ";
      given $*IN.get.uc {
         when 'E'|'H' { level = $_ eq 'H' ?? hard !! easy ;  last  }
         default      { say "Invalid response, try again." }
      }
   }
   setDiff(level);
   moves = 0;
}

init;

loop {
   drawGrid;
   if hasWon() {
      say "Congratulations, you have won the game in {moves} moves.\n" and exit
   }
   say "When entering moves, you can also enter Q to quit or S to start again.";
   say "\nMoves so far = {moves}\n";
   print "Enter move : " ;
   given $*IN.get.uc {
      my \c = .substr(*-1).ord - 49 ; moves++ ;
      when 'D1'|'D2'|'D3'|'D4' { @n[ (12,8,4,0) >>+>> c   ] .= rotate }
      when 'L1'|'L2'|'L3'|'L4' { @n[ (0,1,2,3)  >>+>> 4*c ] .= rotate }
      when 'U1'|'U2'|'U3'|'U4' { @n[ (0,4,8,12) >>+>> c   ] .= rotate }
      when 'R1'|'R2'|'R3'|'R4' { @n[ (3,2,1,0)  >>+>> 4*c ] .= rotate }
      when 'Q'                 { exit }
      when 'S'                 { init }
      default                  { say "\nInvalid move, try again." and moves-- }
   }
}

```


[User]
Task

Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their values.

Rules of the game
:   * The rules are that on each turn the player must choose a direction   (up, down, left or right).
    * All tiles move as far as possible in that direction, some move more than others.
    * Two adjacent tiles (in that direction only) with matching numbers combine into one bearing the sum of those numbers.
    * A move is valid when at least one tile can be moved, including by combination.
    * A new tile is spawned at the end of each turn at a randomly chosen empty square   (if there is one).
    * Most of the time, a new **2** is to be added, but occasionally (**10%** of the time), a **4**.
    * To win, the player must create a tile with the number **2048**.
    * The player loses if no valid moves are possible.

The name comes from the popular open-source implementation of this game mechanic, 2048.

Requirements

* "Non-greedy" movement.
    The tiles that were created by combining other tiles should not be combined again during the same turn (move).
    That is to say, that moving the tile row of:

```
               [2][2][2][2]

```

:   :   to the right should result in:

```
               ......[4][4]

```

:   :   and not:

```
               .........[8]

```

* "Move direction priority".
    If more than one variant of combining is possible, move direction shall indicate which combination will take effect.
    For example, moving the tile row of:

```
               ...[2][2][2]

```

:   :   to the right should result in:

```
               ......[2][4]

```

:   :   and not:

```
               ......[4][2]

```

* Check for valid moves. The player shouldn't be able to gain new tile by trying a move that doesn't change the board.
* Check for a win condition.
* Check for a lose condition.

[Assistant]
(formerly Perl 6)
Uses termios to set the terminal options, so only compatible with POSIX terminals. This version does not include a specific "win" or "lose" condition. (though it would be trivial to add them.) You can continue to play this even after getting a 2048 tile; and if there is no valid move you can make, you can't do anything but quit.

**Works with**: Rakudo version 2018.05

```
use Term::termios;

constant $saved   = Term::termios.new(fd => 1).getattr;
constant $termios = Term::termios.new(fd => 1).getattr;
# raw mode interferes with carriage returns, so
# set flags needed to emulate it manually
$termios.unset_iflags(<BRKINT ICRNL ISTRIP IXON>);
$termios.unset_lflags(< ECHO ICANON IEXTEN ISIG>);
$termios.setattr(:DRAIN);

# reset terminal to original setting on exit
END { $saved.setattr(:NOW) }

constant n    = 4; # board size
constant cell = 6; # cell width
constant ansi = True; # color!

my @board = ( ['' xx n] xx n );
my $save  = '';
my $score = 0;

constant $top = join '─' x cell, '┌', '┬' xx n-1, '┐';
constant $mid = join '─' x cell, '├', '┼' xx n-1, '┤';
constant $bot = join '─' x cell, '└', '┴' xx n-1, '┘';

my %dir = (
   "\e[A" => 'up',
   "\e[B" => 'down',
   "\e[C" => 'right',
   "\e[D" => 'left',
);

my @ANSI = <0 1;97 1;93 1;92 1;96 1;91 1;95 1;94 1;30;47 1;43
    1;42 1;46 1;41 1;45 1;44 1;33;43 1;33;42 1;33;41 1;33;44>;

sub row (@row) { '│' ~ (join '│', @row».&center) ~ '│' }

sub center ($s){
    my $c   = cell - $s.chars;
    my $pad = ' ' x ceiling($c/2);
    my $tile = sprintf "%{cell}s", "$s$pad";
    my $idx = $s ?? $s.log(2) !! 0;
    ansi ?? "\e[{@ANSI[$idx]}m$tile\e[0m" !! $tile;
}

sub draw-board {
    run('clear');
    print qq:to/END/;

	Press direction arrows to move.

	Press q to quit.

	$top
	{ join "\n\t$mid\n\t", map { .&row }, @board }
	$bot

	Score: $score

END
}

sub squash (@c) {
    my @t = grep { .chars }, @c;
    map { combine(@t[$_], @t[$_+1]) if @t[$_] && @t[$_+1] == @t[$_] }, ^@t-1;
    @t = grep { .chars }, @t;
    @t.push: '' while @t < n;
    @t;
}

sub combine ($v is rw, $w is rw) { $v += $w; $w = ''; $score += $v; }

proto sub move (|) {*};

multi move('up') {
    map { @board[*;$_] = squash @board[*;$_] }, ^n;
}

multi move('down') {
    map { @board[*;$_] = reverse squash reverse @board[*;$_] }, ^n;
}

multi move('left') {
    map { @board[$_] = squash @board[$_] }, ^n;
}

multi move('right') {
    map { @board[$_;*] = reverse squash reverse @board[$_] }, ^n;
}

sub another {
    my @empties;
    for @board.kv -> $r, @row {
        @empties.push(($r, $_)) for @row.grep(:k, '');
    }
    my ( $x, $y ) = @empties.roll;
    @board[$x; $y] = (flat 2 xx 9, 4).roll;
}

sub save () { join '|', flat @board».list }

loop {
    another if $save ne save();
    draw-board;
    $save = save();

    # Read up to 4 bytes from keyboard buffer.
    # Page navigation keys are 3-4 bytes each.
    # Specifically, arrow keys are 3.
    my $key = $*IN.read(4).decode;

    move %dir{$key} if so %dir{$key};
    last if $key eq 'q'; # (q)uit
}

```

Sample output:

```

	Press direction arrows to move.

	Press q to quit.

	┌──────┬──────┬──────┬──────┐
	│  4   │  2   │      │      │
	├──────┼──────┼──────┼──────┤
	│  16  │  8   │      │      │
	├──────┼──────┼──────┼──────┤
	│  64  │  32  │  16  │      │
	├──────┼──────┼──────┼──────┤
	│ 128  │ 512  │ 128  │  64  │
	└──────┴──────┴──────┴──────┘

	Score: 6392

```


[User]
**21** is a two player game, the game is played by choosing
a number (**1**, **2**, or **3**) to be added to the *running total*.

The game is won by the player whose chosen number causes the *running total*
to reach *exactly* **21**.

The *running total* starts at zero.
One player will be the computer.

Players alternate supplying a number to be added to the *running total*.

Task

Write a computer program that will:

:   :   * do the prompting (or provide a button menu),
        * check for errors and display appropriate error messages,
        * do the additions (add a chosen number to the *running total*),
        * display the *running total*,
        * provide a mechanism for the player to quit/exit/halt/stop/close the program,
        * issue a notification when there is a winner, and
        * determine who goes first (maybe a random or user choice, or can be specified when the game begins).

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.09

Since there is no requirement that the computer play sensibly, it always plays a random guess so the player has some chance to win.

```
say qq :to 'HERE';
    The 21 game. Each player chooses to add 1, 2, or 3 to a running total.
    The player whose turn it is when the total reaches 21 wins. Enter q to quit.
    HERE

my $total = 0;
loop {
    say "Running total is: $total";
    my ($me,$comp);
    loop {
        $me = prompt 'What number do you play> ';
        last if $me ~~ /^<[123]>$/;
        insult $me;
    }
    $total += $me;
    win('Human') if $total >= 21;
    say "Computer plays: { $comp = (1,2,3).roll }\n";
    $total += $comp;
    win('Computer') if $total >= 21;
}

sub win ($player) {
    say "$player wins.";
    exit;
}

sub insult ($g) {
    exit if $g eq 'q';
    print ('Yo mama,', 'Jeez,', 'Ummmm,', 'Grow up,', 'Did you even READ the instructions?').roll;
    say " $g is not an integer between 1 & 3..."
}

```

Sample game:

```
The 21 game. Each player chooses to add 1, 2, or 3 to a running total.
The player whose turn it is when the total reaches 21 wins. Enter q to quit.

Running total is: 0
What number do you play> 5
Did you even READ the instructions? 5 is not an integer between 1 & 3...
What number do you play> g
Yo mama, g is not an integer between 1 & 3...
What number do you play> 12
Jeez, 12 is not an integer between 1 & 3...
What number do you play> 3
Computer plays: 2

Running total is: 5
What number do you play> 3
Computer plays: 3

Running total is: 11
What number do you play> 1
Computer plays: 1

Running total is: 13
What number do you play> 3
Computer plays: 2

Running total is: 18
What number do you play> 3
Human wins.
```


[User]
The 24 Game tests one's mental arithmetic.

Task

Write a program that randomly chooses and displays four digits, each from 1 ──► 9 (inclusive) with repetitions allowed.

The program should prompt for the player to enter an arithmetic expression using *just* those, and *all* of those four digits, used exactly *once* each. The program should *check* then evaluate the expression.

The goal is for the player to enter an expression that (numerically) evaluates to **24**.

* Only the following operators/functions are allowed: multiplication, division, addition, subtraction
* Division should use floating point or rational arithmetic, etc, to preserve remainders.
* Brackets are allowed, if using an infix expression evaluator.
* Forming multiple digit numbers from the supplied digits is *disallowed*. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
* The order of the digits when given does not have to be preserved.

Notes

* The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
* The task is not for the program to generate the expression, or test whether an expression is even possible.

Related tasks

* 24 game/Solve

Reference

* The 24 Game on h2g2.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015.12

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

say "Here are your digits: ",
constant @digits = (1..9).roll(4)».Str;

grammar Exp24 {
    token TOP { ^ <exp> $ { fail unless EVAL($/) == 24 } }
    rule exp { <term>+ % <op> }
    rule term { '(' <exp> ')' | <@digits> }
    token op { < + - * / > }
}

while my $exp = prompt "\n24? " {
    if try Exp24.parse: $exp {
        say "You win :)";
        last;
    } else {
        say (
            'Sorry.  Try again.' xx 20,
            'Try harder.' xx 5,
            'Nope.  Not even close.' xx 2,
            'Are you five or something?',
            'Come on, you can do better than that.'
        ).flat.pick
    }
}

```

The `MONKEY-SEE-NO-EVAL` pragma enables the dangerous `EVAL` function, which will compile and execute even user input. In this example, the grammar used to parse the input should ensure that only safe expressions are evaluated.


[User]
task

Write a program that takes four digits, either from user input or by random generation, and computes arithmetic expressions following the rules of the 24 game.

Show examples of solutions generated by the program.

Related task

* Arithmetic Evaluator

[Assistant]
(formerly Perl 6)

### With EVAL

A loose translation of the Perl entry. Does not return every possible permutation of the possible solutions. Filters out duplicates (from repeated digits) and only reports the solution for a particular order of digits and operators with the fewest parenthesis (avoids reporting duplicate solutions only differing by unnecessary parenthesis). Does not guarantee the order in which results are returned.

Since Raku uses Rational numbers for division (whenever possible) there is no loss of precision as is common with floating point division. So a comparison like (1 + 7) / (1 / 3) == 24 "Just Works"™

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

my @digits;
my $amount = 4;

# Get $amount digits from the user,
# ask for more if they don't supply enough
while @digits.elems < $amount {
    @digits.append: (prompt "Enter {$amount - @digits} digits from 1 to 9, "
    ~ '(repeats allowed): ').comb(/<[1..9]>/);
}
# Throw away any extras
@digits = @digits[^$amount];

# Generate combinations of operators
my @ops = [X,] <+ - * /> xx 3;

# Enough sprintf formats to cover most precedence orderings
my @formats = (
    '%d %s %d %s %d %s %d',
    '(%d %s %d) %s %d %s %d',
    '(%d %s %d %s %d) %s %d',
    '((%d %s %d) %s %d) %s %d',
    '(%d %s %d) %s (%d %s %d)',
    '%d %s (%d %s %d %s %d)',
    '%d %s (%d %s (%d %s %d))',
);

# Brute force test the different permutations
@digits.permutations».join.unique».comb.race.map: -> @p {
    for @ops -> @o {
        for @formats -> $format {
            my $result = .EVAL given my $string = sprintf $format, roundrobin(@p, @o, :slip);
            say "$string = 24" and last if $result and $result == 24;
        }
    }
}

```

Output:

```
Enter 4 digits from 1 to 9, (repeats allowed): 3711
(1 + 7) * 3 * 1 = 24
(1 + 7) * 3 / 1 = 24
(1 * 3) * (1 + 7) = 24
3 * (1 + 1 * 7) = 24
(3 * 1) * (1 + 7) = 24
3 * (1 / 1 + 7) = 24
(3 / 1) * (1 + 7) = 24
3 / (1 / (1 + 7)) = 24
(1 + 7) * 1 * 3 = 24
(1 + 7) / 1 * 3 = 24
(1 + 7) / (1 / 3) = 24
(1 * 7 + 1) * 3 = 24
(7 + 1) * 3 * 1 = 24
(7 + 1) * 3 / 1 = 24
(7 - 1) * (3 + 1) = 24
(1 + 1 * 7) * 3 = 24
(1 * 1 + 7) * 3 = 24
(1 / 1 + 7) * 3 = 24
(3 + 1) * (7 - 1) = 24
3 * (1 + 7 * 1) = 24
3 * (1 + 7 / 1) = 24
(3 * 1) * (7 + 1) = 24
(3 / 1) * (7 + 1) = 24
3 / (1 / (7 + 1)) = 24
(1 + 3) * (7 - 1) = 24
(1 * 3) * (7 + 1) = 24
(7 + 1) * 1 * 3 = 24
(7 + 1) / 1 * 3 = 24
(7 + 1) / (1 / 3) = 24
(7 - 1) * (1 + 3) = 24
(7 * 1 + 1) * 3 = 24
(7 / 1 + 1) * 3 = 24
3 * (7 + 1 * 1) = 24
3 * (7 + 1 / 1) = 24
3 * (7 * 1 + 1) = 24
3 * (7 / 1 + 1) = 24

Enter 4 digits from 1 to 9, (repeats allowed):  5 5 5 5
5 * 5 - 5 / 5 = 24

Enter 4 digits from 1 to 9, (repeats allowed): 8833
8 / (3 - 8 / 3) = 24

```

### No EVAL

Alternately, a version that doesn't use EVAL. More general case. Able to handle 3 or 4 integers, able to select the goal value.

```
my %*SUB-MAIN-OPTS = :named-anywhere;

sub MAIN (*@parameters, Int :$goal = 24) {
    my @numbers;
    if +@parameters == 1 {
        @numbers = @parameters[0].comb(/\d/);
        USAGE() and exit unless 2 < @numbers < 5;
    } elsif +@parameters > 4 {
        USAGE() and exit;
    } elsif +@parameters == 3|4 {
        @numbers = @parameters;
        USAGE() and exit if @numbers.any ~~ /<-[-\d]>/;
    } else {
        USAGE();
        exit if +@parameters == 2;
        @numbers = 3,3,8,8;
        say 'Running demonstration with: ', |@numbers, "\n";
    }
    solve @numbers, $goal
}

sub solve (@numbers, $goal = 24) {
    my @operators = < + - * / >;
    my @ops   = [X] @operators xx (@numbers - 1);
    my @perms = @numbers.permutations.unique( :with(&[eqv]) );
    my @order = (^(@numbers - 1)).permutations;
    my @sol;
    @sol[250]; # preallocate some stack space

    my $batch = ceiling +@perms/4;

    my atomicint $i;
    @perms.race(:batch($batch)).map: -> @p {
        for @ops -> @o {
            for @order -> @r {
                my $result = evaluate(@p, @o, @r);
                @sol[$i⚛++] = $result[1] if $result[0] and $result[0] == $goal;
            }
        }
    }
    @sol.=unique;
    say @sol.join: "\n";
    my $pl = +@sol == 1 ?? '' !! 's';
    my $sg = $pl ?? '' !! 's';
    say +@sol, " equation{$pl} evaluate{$sg} to $goal using: {@numbers}";
}

sub evaluate ( @digit, @ops, @orders ) {
    my @result = @digit.map: { [ $_, $_ ] };
    my @offset = 0 xx +@orders;

    for ^@orders {
        my $this  = @orders[$_];
        my $order = $this - @offset[$this];
        my $op    = @ops[$this];
        my $result = op( $op, @result[$order;0], @result[$order+1;0] );
        return [ NaN, Str ] unless defined $result;
        my $string = "({@result[$order;1]} $op {@result[$order+1;1]})";
        @result.splice: $order, 2, [ $[ $result, $string ] ];
        @offset[$_]++ if $order < $_ for ^@offset;
    }
    @result[0];
}

multi op ( '+', $m, $n ) { $m + $n }
multi op ( '-', $m, $n ) { $m - $n }
multi op ( '/', $m, $n ) { $n == 0 ?? fail() !! $m / $n }
multi op ( '*', $m, $n ) { $m * $n }

my $txt = "\e[0;96m";
my $cmd = "\e[0;92m> {$*EXECUTABLE-NAME} {$*PROGRAM-NAME}";
sub USAGE {
    say qq:to
    '========================================================================'
    {$txt}Supply 3 or 4 integers on the command line, and optionally a value
    to equate to.

    Integers may be all one group: {$cmd} 2233{$txt}
          Or, separated by spaces: {$cmd} 2 4 6 7{$txt}

    If you wish to supply multi-digit or negative numbers, you must
        separate them with spaces: {$cmd} -2 6 12{$txt}

    If you wish to use a different equate value,
    supply a new --goal parameter: {$cmd} --goal=17 2 -3 1 9{$txt}

    If you don't supply any parameters, will use 24 as the goal, will run a
    demo and will show this message.\e[0m
    ========================================================================
}

```

Output:

When supplied 1399 on the command line:

```
(((9 - 1) / 3) * 9)
((9 - 1) / (3 / 9))
((9 / 3) * (9 - 1))
(9 / (3 / (9 - 1)))
((9 * (9 - 1)) / 3)
(9 * ((9 - 1) / 3))
(((9 - 1) * 9) / 3)
((9 - 1) * (9 / 3))
8 equations evaluate to 24 using: 1 3 9 9
```


[User]
Task

Replace       **a, b, c, d, e, f,**   and
  **g**        with the decimal
digits   LOW   ───►   HIGH

such that the sum of the letters inside of each of the four large squares add up to
the same sum.

```
            ╔══════════════╗      ╔══════════════╗
            ║              ║      ║              ║
            ║      a       ║      ║      e       ║
            ║              ║      ║              ║
            ║          ┌───╫──────╫───┐      ┌───╫─────────┐
            ║          │   ║      ║   │      │   ║         │
            ║          │ b ║      ║ d │      │ f ║         │
            ║          │   ║      ║   │      │   ║         │
            ║          │   ║      ║   │      │   ║         │
            ╚══════════╪═══╝      ╚═══╪══════╪═══╝         │
                       │       c      │      │      g      │
                       │              │      │             │
                       │              │      │             │
                       └──────────────┘      └─────────────┘

```

Show all output here.

:   * Show all solutions for each letter being unique with

```
        LOW=1     HIGH=7

```

:   * Show all solutions for each letter being unique with

```
        LOW=3     HIGH=9

```

:   * Show only the   *number*   of solutions when each letter can be non-unique

```
        LOW=0     HIGH=9

```

Related task

* Solve the no connection puzzle

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2016.12

```
sub four-squares ( @list, :$unique=1, :$show=1 ) {

    my @solutions;

    for $unique.&combos -> @c {
        @solutions.push: @c if [==]
          @c[0] + @c[1],
          @c[1] + @c[2] + @c[3],
          @c[3] + @c[4] + @c[5],
          @c[5] + @c[6];
    }

    say +@solutions, ($unique ?? ' ' !! ' non-'), "unique solutions found using {join(', ', @list)}.\n";

    my $f = "%{@list.max.chars}s";

    say join "\n", (('a'..'g').fmt: $f), @solutions».fmt($f), "\n" if $show;

    multi combos ( $ where so * ) { @list.combinations(7).map: |*.permutations }

    multi combos ( $ where not * ) { [X] @list xx 7 }
}

# TASK
four-squares( [1..7] );
four-squares( [3..9] );
four-squares( [8, 9, 11, 12, 17, 18, 20, 21] );
four-squares( [0..9], :unique(0), :show(0) );

```

Output:

```
8 unique solutions found using 1, 2, 3, 4, 5, 6, 7.

a b c d e f g
3 7 2 1 5 4 6
4 5 3 1 6 2 7
4 7 1 3 2 6 5
5 6 2 3 1 7 4
6 4 1 5 2 3 7
6 4 5 1 2 7 3
7 2 6 1 3 5 4
7 3 2 5 1 4 6

4 unique solutions found using 3, 4, 5, 6, 7, 8, 9.

a b c d e f g
7 8 3 4 5 6 9
8 7 3 5 4 6 9
9 6 4 5 3 7 8
9 6 5 4 3 8 7

8 unique solutions found using 8, 9, 11, 12, 17, 18, 20, 21.

 a  b  c  d  e  f  g
17 21  8  9 11 18 20
20 18 11  9  8 21 17
17 21  9  8 12 18 20
20 18  8 12  9 17 21
20 18 12  8  9 21 17
21 17  9 12  8 18 20
20 18 11  9 12 17 21
21 17 12  9 11 18 20

2860 non-unique solutions found using 0, 1, 2, 3, 4, 5, 6, 7, 8, 9.

```


[User]
This task is a variation of the short story by Arthur C. Clarke.

(Solvers should be aware of the consequences of completing this task.)

In detail, to specify what is meant by a   “name”:

:   The integer 1 has 1 name     “1”.
:   The integer 2 has 2 names   “1+1”,   and   “2”.
:   The integer 3 has 3 names   “1+1+1”,   “2+1”,   and   “3”.
:   The integer 4 has 5 names   “1+1+1+1”,   “2+1+1”,   “2+2”,   “3+1”,   “4”.
:   The integer 5 has 7 names   “1+1+1+1+1”,   “2+1+1+1”,   “2+2+1”,   “3+1+1”,   “3+2”,   “4+1”,   “5”.

Task

Display the first 25 rows of a number triangle which begins:

```
                                      1
                                    1   1
                                  1   1   1
                                1   2   1   1
                              1   2   2   1   1
                            1   3   3   2   1   1

```

Where row

n
{\displaystyle {\displaystyle n}}
   corresponds to integer

n
{\displaystyle {\displaystyle n}}
,   and each column

C
{\displaystyle {\displaystyle C}}
   in row

m
{\displaystyle {\displaystyle m}}
   from left to right corresponds to the number of names beginning with

C
{\displaystyle {\displaystyle C}}
.

A function

G
(
n
)
{\displaystyle {\displaystyle G(n)}}
   should return the sum of the

n
{\displaystyle {\displaystyle n}}
-th   row.

Demonstrate this function by displaying:

G
(
23
)
{\displaystyle {\displaystyle G(23)}}
,

G
(
123
)
{\displaystyle {\displaystyle G(123)}}
,

G
(
1234
)
{\displaystyle {\displaystyle G(1234)}}
,   and

G
(
12345
)
{\displaystyle {\displaystyle G(12345)}}
.

Optionally note that the sum of the

n
{\displaystyle {\displaystyle n}}
-th   row

P
(
n
)
{\displaystyle {\displaystyle P(n)}}
   is the     integer partition function.

Demonstrate this is equivalent to

G
(
n
)
{\displaystyle {\displaystyle G(n)}}
   by displaying:

P
(
23
)
{\displaystyle {\displaystyle P(23)}}
,

P
(
123
)
{\displaystyle {\displaystyle P(123)}}
,

P
(
1234
)
{\displaystyle {\displaystyle P(1234)}}
,   and

P
(
12345
)
{\displaystyle {\displaystyle P(12345)}}
.

Extra credit

If your environment is able, plot

P
(
n
)
{\displaystyle {\displaystyle P(n)}}
   against

n
{\displaystyle {\displaystyle n}}
   for

n
=
1
…
999
{\displaystyle {\displaystyle n=1\ldots 999}}
.

Related tasks

* Partition function P

[Assistant]
(formerly Perl 6)
To save a bunch of memory, this algorithm throws away all the numbers that it knows it's not going to use again, on the assumption that the function will only be called with increasing values of $n. (It could easily be made to recalculate if it notices a regression.)

```
my @todo = $[1];
my @sums = 0;
sub nextrow($n) {
    for +@todo .. $n -> $l {
        my $r = [];
        for reverse ^$l -> $x {
            my @x := @todo[$x];
            if @x {
                $r.push: @sums[$x] += @x.shift;
            }
            else {
                $r.push: @sums[$x];
            }
        }
        @todo.push($r);
    }
    @todo[$n];
}

say "rows:";
say .fmt('%2d'), ": ", nextrow($_)[] for 1..25;

my @names-of-God = 1, { partition-sum ++$ } … *;
my @names-of-God-adder = lazy [\+] flat 1, ( (1 .. *) Z (1 .. *).map: * × 2 + 1 );
sub partition-sum ($n) {
    sum @names-of-God[$n X- @names-of-God-adder[^(@names-of-God-adder.first: * > $n, :k)]]
        Z× (flat (1, 1, -1, -1) xx *)
}

say "\nsums:";
for 23, 123, 1234, 12345 {
    put $_, "\t",  @names-of-God[$_];
}

```

Output:

```
rows:
 1: [1]
 2: [1 1]
 3: [1 1 1]
 4: [1 2 1 1]
 5: [1 2 2 1 1]
 6: [1 3 3 2 1 1]
 7: [1 3 4 3 2 1 1]
 8: [1 4 5 5 3 2 1 1]
 9: [1 4 7 6 5 3 2 1 1]
10: [1 5 8 9 7 5 3 2 1 1]
11: [1 5 10 11 10 7 5 3 2 1 1]
12: [1 6 12 15 13 11 7 5 3 2 1 1]
13: [1 6 14 18 18 14 11 7 5 3 2 1 1]
14: [1 7 16 23 23 20 15 11 7 5 3 2 1 1]
15: [1 7 19 27 30 26 21 15 11 7 5 3 2 1 1]
16: [1 8 21 34 37 35 28 22 15 11 7 5 3 2 1 1]
17: [1 8 24 39 47 44 38 29 22 15 11 7 5 3 2 1 1]
18: [1 9 27 47 57 58 49 40 30 22 15 11 7 5 3 2 1 1]
19: [1 9 30 54 70 71 65 52 41 30 22 15 11 7 5 3 2 1 1]
20: [1 10 33 64 84 90 82 70 54 42 30 22 15 11 7 5 3 2 1 1]
21: [1 10 37 72 101 110 105 89 73 55 42 30 22 15 11 7 5 3 2 1 1]
22: [1 11 40 84 119 136 131 116 94 75 56 42 30 22 15 11 7 5 3 2 1 1]
23: [1 11 44 94 141 163 164 146 123 97 76 56 42 30 22 15 11 7 5 3 2 1 1]
24: [1 12 48 108 164 199 201 186 157 128 99 77 56 42 30 22 15 11 7 5 3 2 1 1]
25: [1 12 52 120 192 235 248 230 201 164 131 100 77 56 42 30 22 15 11 7 5 3 2 1 1]

sums:
23	1255
123	2552338241
1234	156978797223733228787865722354959930
12345	69420357953926116819562977205209384460667673094671463620270321700806074195845953959951425306140971942519870679768681736
```


[User]
Task

Display the complete lyrics for the song:     **99 Bottles of Beer on the Wall**.

The beer song

The lyrics follow this form:

> :   :   :   99 bottles of beer on the wall
>         :   99 bottles of beer
>         :   Take one down, pass it around
>         :   98 bottles of beer on the wall
>
> :   :   :   98 bottles of beer on the wall
>         :   98 bottles of beer
>         :   Take one down, pass it around
>         :   97 bottles of beer on the wall

... and so on, until reaching   **0**     (zero).

Grammatical support for   *1 bottle of beer*   is optional.

As with any puzzle, try to do it in as creative/concise/comical a way
as possible (simple, obvious solutions allowed, too).

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

See also

* http://99-bottles-of-beer.net/
* Category:99\_Bottles\_of\_Beer
* Category:Programming language families
* Wikipedia 99 bottles of beer

[Assistant]
(formerly Perl 6)

### A Simple Way

```
my $b = 99;

repeat while --$b {
    say "{b $b} on the wall";
    say "{b $b}";
    say "Take one down, pass it around";
    say "{b $b-1} on the wall";
    say "";
}

sub b($b) {
    "$b bottle{'s' if $b != 1} of beer";
}
```

### A Clearer Way

Similar to "A Simple Way", but with proper variable and subroutine naming, declarator documentation, strongly-typed function definition, better code reuse, and external ternary logic.

```
for 99...1 -> $bottles {
    sing $bottles, :wall;
    sing $bottles;
    say  "Take one down, pass it around";
    sing $bottles - 1, :wall;
    say  "";
}

#| Prints a verse about a certain number of beers, possibly on a wall.
sub sing(
    Int $number, #= Number of bottles of beer.
    Bool :$wall, #= Mention that the beers are on a wall?
) {
    my $quantity = $number == 0 ?? "No more"      !! $number;
    my $plural   = $number == 1 ?? ""             !! "s";
    my $location = $wall        ?? " on the wall" !! "";
    say "$quantity bottle$plural of beer$location"
}
```

### A More Extravagant Way

**Works with**: Rakudo version 2015.09

```
my @quantities = flat (99 ... 1), 'No more', 99;
my @bottles = flat 'bottles' xx 98, 'bottle', 'bottles' xx 2;
my @actions = flat 'Take one down, pass it around' xx 99,
              'Go to the store, buy some more';

for @quantities Z @bottles Z @actions Z
    @quantities[1 .. *] Z @bottles[1 .. *]
    -> ($a, $b, $c, $d, $e) {
    say "$a $b of beer on the wall";
    say "$a $b of beer";
    say $c;
    say "$d $e of beer on the wall\n";
}
```


[User]
The A\* search algorithm is an extension of Dijkstra's algorithm useful for finding the lowest cost path between two nodes (aka vertices) of a graph. The path may traverse any number of nodes connected by edges (aka arcs) with each edge having an associated cost. The algorithm uses a heuristic which associates an estimate of the lowest cost path from this node to the goal node, such that this estimate is never greater than the actual cost.

The algorithm should not assume that all edge costs are the same. It should be possible to start and finish on any node, including ones identified as a barrier in the task.

Task

Consider the problem of finding a route across the diagonal of a chess board-like 8x8 grid. The rows are numbered from 0 to 7. The columns are also numbered 0 to 7. The start position is (0, 0) and the end position is (7, 7). Movement is allow by one square in any direction including diagonals, similar to a king in chess. The standard movement cost is 1. To make things slightly harder, there is a barrier that occupy certain positions of the grid. Moving into any of the barrier positions has a cost of 100.

The barrier occupies the positions (2,4), (2,5), (2,6), (3,6), (4,6), (5,6), (5,5), (5,4), (5,3), (5,2), (4,2) and (3,2).

A route with the lowest cost should be found using the A\* search algorithm (there are multiple optimal solutions with the same total cost).

Print the optimal route in text format, as well as the total cost of the route.

Optionally, draw the optimal route and the barrier positions.

Note: using a heuristic score of zero is equivalent to Dijkstra's algorithm and that's kind of cheating/not really A\*!

*Extra Credit*

Use this algorithm to solve an 8 puzzle. Each node of the input graph will represent an arrangement of the tiles. The nodes will be connected by 4 edges representing swapping the blank tile up, down, left, or right. The cost of each edge is 1. The heuristic will be the sum of the manhatten distance of each numbered tile from its goal position. An 8 puzzle graph will have 9!/2 (181,440) nodes. The 15 puzzle has over 10 trillion nodes. This algorithm may solve simple 15 puzzles (but there are not many of those).

See also

* Wikipedia webpage:   A\* search algorithm.
* An introduction to: Breadth First Search |> Dijkstra’s Algorithm |> A\*

Related tasks

* 15 puzzle solver
* Dijkstra's algorithm
* Knapsack problem/0-1

[Assistant]
**Translation of**: Sidef

```
# 20200427 Raku programming solution

class AStarGraph {

   has @.barriers =
      <2 4>,<2 5>,<2 6>,<3 6>,<4 6>,<5 6>,<5 5>,<5 4>,<5 3>,<5 2>,<4 2>,<3 2>;

   method heuristic(\start, \goal) {
      my (\D1,\D2) = 1, 1;
      my (\dx,\dy) = ( start.list »-« goal.list )».abs;
      return  (D1 * (dx + dy)) + (D2 - 2*D1) * min dx, dy
   }

   method get_vertex_neighbours(\pos) {
      gather {
         for <1 0>,<-1 0>,<0 1>,<0 -1>,<1 1>,<-1 1>,<1 -1>,<-1 -1> -> \d {
            my (\x2,\y2) = pos.list »+« d.list;
            (x2 < 0 || x2 > 7 || y2 < 0 || y2 > 7) && next;
            take x2, y2;
         }
      }
   }

   method move_cost(\a,\b) { (b ~~ any self.barriers) ?? 100 !! 1 }
}

sub AStarSearch(\start, \end, \graph) {

   my (%G,%F);

   %G{start.Str} = 0;
   %F{start.Str} = graph.heuristic(start, end);

   my @closedVertices = [];
   my @openVertices = [].push(start);
   my %cameFrom;

   while (@openVertices.Bool) {
      my $current = Nil; my $currentFscore = Inf;

      for @openVertices -> \pos {
         if (%F{pos.Str} < $currentFscore) {
            $currentFscore = %F{pos.Str};
            $current = pos
         }
      }

      if $current ~~ end {
         my @path = [].push($current);
         while %cameFrom{$current.Str}:exists {
            $current = %cameFrom{$current.Str};
            @path.push($current)
         }
         return @path.reverse, %F{end.Str}
      }

      @openVertices .=  grep: * !eqv $current;
      @closedVertices.push($current);

      for (graph.get_vertex_neighbours($current)) -> \neighbour {
         next if neighbour ~~ any @closedVertices;
         my \candidateG = %G{$current.Str}+graph.move_cost($current,neighbour);

         if !(neighbour ~~ any @openVertices) {
            @openVertices.push(neighbour)
         } elsif (candidateG ≥ %G{neighbour.Str}) {
            next
         }

         %cameFrom{neighbour.Str} = $current;
         %G{neighbour.Str} = candidateG;
         my \H = graph.heuristic(neighbour, end);
         %F{neighbour.Str} = %G{neighbour.Str} + H;
      }
   }
   die "A* failed to find a solution"
}

my \graph = AStarGraph.new;
my (\route, \cost) = AStarSearch(<0 0>, <7 7>, graph);

my \w = my \h = 10;

my @grid = [ ['.' xx w ] xx h ];
for ^h -> \y { @grid[y;0] = "█"; @grid[y;*-1] = "█" }
for ^w -> \x { @grid[0;x] = "█"; @grid[*-1;x] = "█" }

for (graph.barriers) -> \d { @grid[d[0]+1][d[1]+1] = "█" }
for @(route)         -> \d { @grid[d[0]+1][d[1]+1] = "x" }

.join.say for @grid ;

say "Path cost : ", cost, " and route : ", route;

```

Output:

```
██████████

█x.......█
█.x......█
█..x.███.█
█.x█...█.█
█.x█...█.█
█.x█████.█
█..xxxxx.█
█.......x█
██████████

Path cost : 11 and route : ((0 0) (1 1) (2 2) (3 1) (4 1) (5 1) (6 2) (6 3) (6 4) (6 5) (6 6) (7 7))
```


[User]
**A+B**   ─── a classic problem in programming contests,   it's given so contestants can gain familiarity with the online judging system being used.

Task

Given two integers,   **A** and **B**.

Their sum needs to be calculated.

Input data

Two integers are written in the input stream, separated by space(s):

:   (
    −
    1000
    ≤
    A
    ,
    B
    ≤
    +
    1000
    )
    {\displaystyle {\displaystyle (-1000\leq A,B\leq +1000)}}

Output data

The required output is one integer:   the sum of **A** and **B**.

Example

:   :   | input | output |
        | --- | --- |
        | 2 2 | 4 |
        | 3 2 | 5 |

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015.12

Short version with very little "line noise":

```
get.words.sum.say;
```

Reduction operator `[+]`, and `say` as a function:

```
say [+] get.words;
```

Long version:

```
my ($a, $b) = $*IN.get.split(" ");
say $a + $b;
```


[User]
The use of   abbreviations   (also sometimes called synonyms, nicknames, AKAs, or aliases)   can be an

easy way to add flexibility when specifying or using commands, sub─commands, options, etc.

It would make a list of words easier to maintain   (as words are added, changed, and/or deleted)   if
the minimum abbreviation length of that list could be automatically (programmatically) determined.

For this task, use the list (below) of the days-of-the-week names that are expressed in about a hundred languages   (note that there is a blank line in the list).

```
Sunday Monday Tuesday Wednesday Thursday Friday Saturday
Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag
E_djelë E_hënë E_martë E_mërkurë E_enjte E_premte E_shtunë
Ehud Segno Maksegno Erob Hamus Arbe Kedame
Al_Ahad Al_Ithinin Al_Tholatha'a Al_Arbia'a Al_Kamis Al_Gomia'a Al_Sabit
Guiragui Yergou_shapti Yerek_shapti Tchorek_shapti Hink_shapti Ourpat Shapat
domingu llunes martes miércoles xueves vienres sábadu
Bazar_gÜnÜ Birinci_gÜn Çkinci_gÜn ÜçÜncÜ_gÜn DÖrdÜncÜ_gÜn Bes,inci_gÜn Altòncò_gÜn
Igande Astelehen Astearte Asteazken Ostegun Ostiral Larunbat
Robi_bar Shom_bar Mongal_bar Budhh_bar BRihashpati_bar Shukro_bar Shoni_bar
Nedjelja Ponedeljak Utorak Srijeda Cxetvrtak Petak Subota
Disul Dilun Dimeurzh Dimerc'her Diriaou Digwener Disadorn
nedelia ponedelnik vtornik sriada chetvartak petak sabota
sing_kei_yaht sing_kei_yat sing_kei_yee sing_kei_saam sing_kei_sie sing_kei_ng sing_kei_luk
Diumenge Dilluns Dimarts Dimecres Dijous Divendres Dissabte
Dzeenkk-eh Dzeehn_kk-ehreh Dzeehn_kk-ehreh_nah_kay_dzeeneh Tah_neesee_dzeehn_neh Deehn_ghee_dzee-neh Tl-oowey_tts-el_dehlee Dzeentt-ahzee
dy_Sul dy_Lun dy_Meurth dy_Mergher dy_You dy_Gwener dy_Sadorn
Dimanch Lendi Madi Mèkredi Jedi Vandredi Samdi
nedjelja ponedjeljak utorak srijeda cxetvrtak petak subota
nede^le ponde^lí úterÿ str^eda c^tvrtek pátek sobota
Sondee Mondee Tiisiday Walansedee TOOsedee Feraadee Satadee
s0ndag mandag tirsdag onsdag torsdag fredag l0rdag
zondag maandag dinsdag woensdag donderdag vrijdag zaterdag
Diman^co Lundo Mardo Merkredo ^Jaùdo Vendredo Sabato
pÜhapäev esmaspäev teisipäev kolmapäev neljapäev reede laupäev

Diu_prima Diu_sequima Diu_tritima Diu_quartima Diu_quintima Diu_sextima Diu_sabbata
sunnudagur mánadagur tÿsdaguy mikudagur hósdagur friggjadagur leygardagur
Yek_Sham'beh Do_Sham'beh Seh_Sham'beh Cha'har_Sham'beh Panj_Sham'beh Jom'eh Sham'beh
sunnuntai maanantai tiistai keskiviiko torsktai perjantai lauantai
dimanche lundi mardi mercredi jeudi vendredi samedi
Snein Moandei Tiisdei Woansdei Tonersdei Freed Sneon
Domingo Segunda_feira Martes Mércores Joves Venres Sábado
k'vira orshabati samshabati otkhshabati khutshabati p'arask'evi shabati
Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag
Kiriaki' Defte'ra Tri'ti Teta'rti Pe'mpti Paraskebi' Sa'bato
ravivaar somvaar mangalvaar budhvaar guruvaar shukravaar shanivaar
pópule pó`akahi pó`alua pó`akolu pó`ahá pó`alima pó`aono
Yom_rishon Yom_sheni Yom_shlishi Yom_revi'i Yom_chamishi Yom_shishi Shabat
ravivara somavar mangalavar budhavara brahaspativar shukravara shanivar
vasárnap hétfö kedd szerda csütörtök péntek szombat
Sunnudagur Mánudagur ╞riδjudagur Miδvikudagar Fimmtudagur FÖstudagur Laugardagur
sundio lundio mardio merkurdio jovdio venerdio saturdio
Minggu Senin Selasa Rabu Kamis Jumat Sabtu
Dominica Lunedi Martedi Mercuridi Jovedi Venerdi Sabbato
Dé_Domhnaigh Dé_Luain Dé_Máirt Dé_Ceadaoin Dé_ardaoin Dé_hAoine Dé_Sathairn
domenica lunedí martedí mercoledí giovedí venerdí sabato
Nichiyou_bi Getzuyou_bi Kayou_bi Suiyou_bi Mokuyou_bi Kin'you_bi Doyou_bi
Il-yo-il Wol-yo-il Hwa-yo-il Su-yo-il Mok-yo-il Kum-yo-il To-yo-il
Dies_Dominica Dies_Lunæ Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Saturni
sve-tdien pirmdien otrdien tresvdien ceturtdien piektdien sestdien
Sekmadienis Pirmadienis Antradienis Trec^iadienis Ketvirtadienis Penktadienis S^es^tadienis
Wangu Kazooba Walumbe Mukasa Kiwanuka Nnagawonye Wamunyi
xing-_qi-_rì xing-_qi-_yi-. xing-_qi-_èr xing-_qi-_san-. xing-_qi-_sì xing-_qi-_wuv. xing-_qi-_liù
Jedoonee Jelune Jemayrt Jecrean Jardaim Jeheiney Jesam
Jabot Manre Juje Wonje Taije Balaire Jarere
geminrongo minòmishi mártes mièrkoles misheushi bèrnashi mishábaro
Ahad Isnin Selasa Rabu Khamis Jumaat Sabtu
sφndag mandag tirsdag onsdag torsdag fredag lφrdag
lo_dimenge lo_diluns lo_dimarç lo_dimèrcres lo_dijòus lo_divendres lo_dissabte
djadomingo djaluna djamars djarason djaweps djabièrna djasabra
Niedziela Poniedzial/ek Wtorek S,roda Czwartek Pia,tek Sobota
Domingo segunda-feire terça-feire quarta-feire quinta-feire sexta-feira såbado
Domingo Lunes martes Miercoles Jueves Viernes Sabado
Duminicª Luni Mart'i Miercuri Joi Vineri Sâmbªtª
voskresenie ponedelnik vtornik sreda chetverg pyatnitsa subbota
Sunday Di-luain Di-màirt Di-ciadain Di-ardaoin Di-haoine Di-sathurne
nedjelja ponedjeljak utorak sreda cxetvrtak petak subota
Sontaha Mmantaha Labobedi Laboraro Labone Labohlano Moqebelo
Iridha- Sandhudha- Anga.haruwa-dha- Badha-dha- Brahaspa.thindha- Sikura-dha- Sena.sura-dha-
nedel^a pondelok utorok streda s^tvrtok piatok sobota
Nedelja Ponedeljek Torek Sreda Cxetrtek Petek Sobota
domingo lunes martes miércoles jueves viernes sábado
sonde mundey tude-wroko dride-wroko fode-wroko freyda Saturday
Jumapili Jumatatu Jumanne Jumatano Alhamisi Ijumaa Jumamosi
söndag måndag tisdag onsdag torsdag fredag lordag
Linggo Lunes Martes Miyerkoles Huwebes Biyernes Sabado
Lé-pài-jít Pài-it Pài-jï Pài-sañ Pài-sì Pài-gÖ. Pài-lák
wan-ar-tit wan-tjan wan-ang-kaan wan-phoet wan-pha-ru-hat-sa-boh-die wan-sook wan-sao
Tshipi Mosupologo Labobedi Laboraro Labone Labotlhano Matlhatso
Pazar Pazartesi Sali Çar,samba Per,sembe Cuma Cumartesi
nedilya ponedilok vivtorok sereda chetver pyatnytsya subota
Chu?_Nhâ.t Thú*_Hai Thú*_Ba Thú*_Tu* Thú*_Na'm Thú*_Sáu Thú*_Ba?y
dydd_Sul dyds_Llun dydd_Mawrth dyds_Mercher dydd_Iau dydd_Gwener dyds_Sadwrn
Dibeer Altine Talaata Allarba Al_xebes Aljuma Gaaw
iCawa uMvulo uLwesibini uLwesithathu uLuwesine uLwesihlanu uMgqibelo
zuntik montik dinstik mitvokh donershtik fraytik shabes
iSonto uMsombuluko uLwesibili uLwesithathu uLwesine uLwesihlanu uMgqibelo
Dies_Dominica Dies_Lunæ Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Saturni
Bazar_gÜnÜ Bazar_ærtæsi Çærs,ænbæ_axs,amò Çærs,ænbæ_gÜnÜ CÜmæ_axs,amò CÜmæ_gÜnÜ CÜmæ_Senbæ
Sun Moon Mars Mercury Jove Venus Saturn
zondag maandag dinsdag woensdag donderdag vrijdag zaterdag
KoseEraa GyoOraa BenEraa Kuoraa YOwaaraa FeEraa Memenaa
Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Sonnabend
Domingo Luns Terza_feira Corta_feira Xoves Venres Sábado
Dies_Solis Dies_Lunae Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Sabbatum
xing-_qi-_tiàn xing-_qi-_yi-. xing-_qi-_èr xing-_qi-_san-. xing-_qi-_sì xing-_qi-_wuv. xing-_qi-_liù
djadomingu djaluna djamars djarason djaweps djabièrnè djasabra
Killachau Atichau Quoyllurchau Illapachau Chaskachau Kuychichau Intichau

```

*Caveat:   The list (above) most surely contains errors (or, at the least, differences) of what the actual (or true) names for the days-of-the-week.*

To make this Rosetta Code task page as small as possible, if processing the complete list, read the days-of-the-week from a file (that is created from the above list).

Notes concerning the above list of words

:   :   * each line has a list of days-of-the-week for a language, separated by at least one blank
        * the words on each line happen to be in order, from Sunday ──► Saturday
        * most lines have words in mixed case and some have all manner of accented words and other characters
        * some words were translated to the nearest character that was available to *code page*   **437**
        * the characters in the words are not restricted except that they may not have imbedded blanks
        * for this example, the use of an underscore (**\_**) was used to indicate a blank in a word

Task
:   :   * The list of words   (days of the week)   needn't be verified/validated.
        * Write a function to find the (numeric) minimum length abbreviation for each line that would make abbreviations unique.
        * A blank line   (or a null line)   should return a null string.
        * Process and show the output for at least the first **five** lines of the file.
        * Show all output here.

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 2017.08

Saving the "Days of Week, Also Known As" table to a local file DoWAKA.txt. Lines that have duplicate day names will get ∞ as the minimum number of characters, as there is no amount of characters that can be entered to distinguish the days uniquely. It is somewhat unclear as to what is meant by "return a null string". I have chosen to return Nil.

Note that this is using a previous version of the date file that has erroneous duplicate day names (see line 90). Since the effort was already expended to catch such problems, it may as well be demonstrated.

```
sub auto-abbreviate ( Str $string ) {
    return Nil unless my @words = $string.words;
    return $_ if @words».substr(0, $_).Set == @words for 1 .. @words».chars.max;
    return '∞';
}

# Testing
 say ++$, ') ', .&auto-abbreviate, '  ', $_ for './DoWAKA.txt'.IO.lines;

```

Output:

```
1) 2  Sunday Monday Tuesday Wednesday Thursday Friday Saturday
2) 2  Sondag Maandag Dinsdag Woensdag Donderdag Vrydag Saterdag
3) 4  E_djelë E_hënë E_martë E_mërkurë E_enjte E_premte E_shtunë
4) 2  Ehud Segno Maksegno Erob Hamus Arbe Kedame
5) 5  Al_Ahad Al_Ithinin Al_Tholatha'a Al_Arbia'a Al_Kamis Al_Gomia'a Al_Sabit
6) 4  Guiragui Yergou_shapti Yerek_shapti Tchorek_shapti Hink_shapti Ourpat Shapat
7) 2  domingu llunes martes miércoles xueves vienres sábadu
8) 2  Bazar_gÜnÜ Birinci_gÜn Çkinci_gÜn ÜçÜncÜ_gÜn DÖrdÜncÜ_gÜn Bes,inci_gÜn Altòncò_gÜn
9) 6  Igande Astelehen Astearte Asteazken Ostegun Ostiral Larunbat
10) 4  Robi_bar Shom_bar Mongal_bar Budhh_bar BRihashpati_bar Shukro_bar Shoni_bar
11) 2  Nedjelja Ponedeljak Utorak Srijeda Cxetvrtak Petak Subota
12) 5  Disul Dilun Dimeurzh Dimerc'her Diriaou Digwener Disadorn
13) 2  nedelia ponedelnik vtornik sriada chetvartak petak sabota
14) 13  sing_kei_yath sing_kei_yat sing_kei_yee sing_kei_saam sing_kei_sie sing_kei_ng sing_kei_luk
15) 4  Diumenge Dilluns Dimarts Dimecres Dijous Divendres Dissabte
16) 16  Dzeenkk-eh Dzeehn_kk-ehreh Dzeehn_kk-ehreh_nah_kay_dzeeneh Tah_neesee_dzeehn_neh Deehn_ghee_dzee-neh Tl-oowey_tts-el_dehlee Dzeentt-ahzee
17) 6  dy_Sul dy_Lun dy_Meurth dy_Mergher dy_You dy_Gwener dy_Sadorn
18) 2  Dimanch Lendi Madi Mèkredi Jedi Vandredi Samdi
19) 2  nedjelja ponedjeljak utorak srijeda cxetvrtak petak subota
20) 2  nede^le ponde^lí úterÿ str^eda c^tvrtek pátek sobota
21) 2  Sondee Mondee Tiisiday Walansedee TOOsedee Feraadee Satadee
22) 2  s0ndag mandag tirsdag onsdag torsdag fredag l0rdag
23) 2  zondag maandag dinsdag woensdag donderdag vrijdag zaterdag
24) 2  Diman^co Lundo Mardo Merkredo ^Jaùdo Vendredo Sabato
25) 1  pÜhapäev esmaspäev teisipäev kolmapäev neljapäev reede laupäev
26) Nil
27) 7  Diu_prima Diu_sequima Diu_tritima Diu_quartima Diu_quintima Diu_sextima Diu_sabbata
28) 2  sunnudagur mánadagur tÿsdaguy mikudagur hósdagur friggjadagur leygardagur
29) 2  Yek_Sham'beh Do_Sham'beh Seh_Sham'beh Cha'har_Sham'beh Panj_Sham'beh Jom'eh Sham'beh
30) 2  sunnuntai maanantai tiistai keskiviiko torsktai perjantai lauantai
31) 2  dimanche lundi mardi mercredi jeudi vendredi samedi
32) 4  Snein Moandei Tiisdei Woansdei Tonersdei Freed Sneon
33) 2  Domingo Segunda_feira Martes Mércores Joves Venres Sábado
34) 2  k'vira orshabati samshabati otkhshabati khutshabati p'arask'evi shabati
35) 2  Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag
36) 2  Kiriaki' Defte'ra Tri'ti Teta'rti Pe'mpti Paraskebi' Sa'bato
37) 3  ravivaar somvaar mangalvaar budhvaar guruvaar shukravaar shanivaar
38) 6  pópule pó`akahi pó`alua pó`akolu pó`ahá pó`alima pó`aono
39) 7  Yom_rishon Yom_sheni Yom_shlishi Yom_revi'i Yom_chamishi Yom_shishi Shabat
40) 3  ravivara somavar mangalavar budhavara brahaspativar shukravara shanivar
41) 3  vasárnap hétfö kedd szerda csütörtök péntek szombat
42) 2  Sunnudagur Mánudagur ╞riδjudagur Miδvikudagar Fimmtudagur FÖstudagur Laugardagur
43) 2  sundio lundio mardio merkurdio jovdio venerdio saturdio
44) 3  Minggu Senin Selasa Rabu Kamis Jumat Sabtu
45) 2  Dominica Lunedi Martedi Mercuridi Jovedi Venerdi Sabbato
46) 4  Dé_Domhnaigh Dé_Luain Dé_Máirt Dé_Ceadaoin Dé_ardaoin Dé_hAoine Dé_Sathairn
47) 2  domenica lunedí martedí mercoledí giovedí venerdí sabato
48) 2  Nichiyou_bi Getzuyou_bi Kayou_bi Suiyou_bi Mokuyou_bi Kin'you_bi Doyou_bi
49) 1  Il-yo-il Wol-yo-il Hwa-yo-il Su-yo-il Mok-yo-il Kum-yo-il To-yo-il
50) 7  Dies_Dominica Dies_Lunæ Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Saturni
51) 3  sve-tdien pirmdien otrdien tresvdien ceturtdien piektdien sestdien
52) 2  Sekmadienis Pirmadienis Antradienis Trec^iadienis Ketvirtadienis Penktadienis S^es^tadienis
53) 3  Wangu Kazooba Walumbe Mukasa Kiwanuka Nnagawonye Wamunyi
54) 12  xing-_qi-_rì xing-_qi-_yi-. xing-_qi-_èr xing-_qi-_san-. xing-_qi-_sì xing-_qi-_wuv. xing-_qi-_liù
55) 3  Jedoonee Jelune Jemayrt Jecrean Jardaim Jeheiney Jesam
56) 3  Jabot Manre Juje Wonje Taije Balaire Jarere
57) 5  geminrongo minòmishi mártes mièrkoles misheushi bèrnashi mishábaro
58) 2  Ahad Isnin Selasa Rabu Khamis Jumaat Sabtu
59) 2  sφndag mandag tirsdag onsdag torsdag fredag lφrdag
60) 7  lo_dimenge lo_diluns lo_dimarç lo_dimèrcres lo_dijòus lo_divendres lo_dissabte
61) 4  djadomingo djaluna djamars djarason djaweps djabièrna djasabra
62) 2  Niedziela Poniedzial/ek Wtorek S,roda Czwartek Pia,tek Sobota
63) 3  Domingo segunda-feire terça-feire quarta-feire quinta-feire sexta-feira såbado
64) 1  Domingo Lunes martes Miercoles Jueves Viernes Sabado
65) 2  Duminicª Luni Mart'i Miercuri Joi Vineri Sâmbªtª
66) 2  voskresenie ponedelnik vtornik sreda chetverg pyatnitsa subbota
67) 4  Sunday Di-luain Di-màirt Di-ciadain Di-ardaoin Di-haoine Di-sathurne
68) 2  nedjelja ponedjeljak utorak sreda cxetvrtak petak subota
69) 5  Sontaha Mmantaha Labobedi Laboraro Labone Labohlano Moqebelo
70) 2  Iridha- Sandhudha- Anga.haruwa-dha- Badha-dha- Brahaspa.thindha- Sikura-dha- Sena.sura-dha-
71) 2  nedel^a pondelok utorok streda s^tvrtok piatok sobota
72) 2  Nedelja Ponedeljek Torek Sreda Cxetrtek Petek Sobota
73) 2  domingo lunes martes miércoles jueves viernes sábado
74) 2  sonde mundey tude-wroko dride-wroko fode-wroko freyda Saturday
75) 7  Jumapili Jumatatu Jumanne Jumatano Alhamisi Ijumaa Jumamosi
76) 2  söndag måndag tisdag onsdag torsdag fredag lordag
77) 2  Linggo Lunes Martes Miyerkoles Huwebes Biyernes Sabado
78) 6  Lé-pài-jít Pài-it Pài-jï Pài-sañ Pài-sì Pài-gÖ. Pài-lák
79) 7  wan-ar-tit wan-tjan wan-ang-kaan wan-phoet wan-pha-ru-hat-sa-boh-die wan-sook wan-sao
80) 5  Tshipi Mosupologo Labobedi Laboraro Labone Labotlhano Matlhatso
81) 6  Pazar Pazartesi Sali Çar,samba Per,sembe Cuma Cumartesi
82) 2  nedilya ponedilok vivtorok sereda chetver pyatnytsya subota
83) 8  Chu?_Nhâ.t Thú*_Hai Thú*_Ba Thú*_Tu* Thú*_Na'm Thú*_Sáu Thú*_Ba?y
84) 6  dydd_Sul dyds_Llun dydd_Mawrth dyds_Mercher dydd_Iau dydd_Gwener dyds_Sadwrn
85) 3  Dibeer Altine Talaata Allarba Al_xebes Aljuma Gaaw
86) 7  iCawa uMvulo uLwesibini uLwesithathu uLuwesine uLwesihlanu uMgqibelo
87) 2  zuntik montik dinstik mitvokh donershtik fraytik shabes
88) 7  iSonto uMsombuluko uLwesibili uLwesithathu uLwesine uLwesihlanu uMgqibelo
89) 7  Dies_Dominica Dies_Lunæ Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Saturni
90) ∞  Bazar_gÜnÜ Bazar_ærtæsi Çærs,ænbæ_axs,amò Çærs,ænbæ_gÜnÜ CÜmæ_axs,amò CÜmæ_gÜnÜ CÜmæ_gÜnÜ
91) 2  Sun Moon Mars Mercury Jove Venus Saturn
92) 2  zondag maandag dinsdag woensdag donderdag vrijdag zaterdag
93) 2  KoseEraa GyoOraa BenEraa Kuoraa YOwaaraa FeEraa Memenaa
94) 5  Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Sonnabend
95) 1  Domingo Luns Terza_feira Corta_feira Xoves Venres Sábado
96) 7  Dies_Solis Dies_Lunae Dies_Martis Dies_Mercurii Dies_Iovis Dies_Veneris Dies_Sabbatum
97) 12  xing-_qi-_tiàn xing-_qi-_yi-. xing-_qi-_èr xing-_qi-_san-. xing-_qi-_sì xing-_qi-_wuv. xing-_qi-_liù
98) 4  djadomingu djaluna djamars djarason djaweps djabièrnè djasabra
99) 2  Killachau Atichau Quoyllurchau Illapachau Chaskachau Kuychichau Intichau

```


[User]
This task is an easier (to code) variant of the Rosetta Code task:    Abbreviations, simple.

For this task, the following   *command table*   will be used:

```
   Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
   COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
   NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
   Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
   MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
   READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
   RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up

```

Notes concerning the above   *command table*:

:   :   * it can be thought of as one long literal string   (with blanks at end-of-lines)
        * it may have superfluous blanks
        * it may be in any case (lower/upper/mixed)
        * the order of the words in the   *command table*   must be preserved as shown
        * the user input(s) may be in any case (upper/lower/mixed)
        * commands will be restricted to the Latin alphabet   (A ──► Z,   a ──► z)
        * A valid abbreviation is a word that has:

        :   * at least the minimum length of the number of capital letters of the word in the *command table*
            * compares equal (regardless of case) to the leading characters of the word in the *command table*
            * a length not longer than the word in the *command table*

            :   * **ALT**,   **aLt**,   **ALTE**,   and   **ALTER**   are all abbreviations of   **ALTer**
                * **AL**,   **ALF**,   **ALTERS**,   **TER**,   and   **A**   aren't valid abbreviations of   **ALTer**
                * The number of capital letters in   **ALTer**   indicates that any abbreviation for   **ALTer**   must be at least three letters
                * Any word longer than five characters can't be an abbreviation for   **ALTer**
                * **o**,   **ov**,   **oVe**,   **over**,   **overL**,   **overla**   are all acceptable abbreviations for   **Overlay**

        * if there isn't any lowercase letters in the word in the *command table*,   then there isn't an abbreviation permitted

Task
:   :   * The command table needn't be verified/validated.
        * Write a function to validate if the user "words"   (given as input)   are valid   (in the *command table*).
        * If the word   is   valid,   then return the full uppercase version of that "word".
        * If the word isn't valid,   then return the lowercase string:    **\*error\***        (7 characters).
        * A blank input   (or a null input)   should return a null string.
        * Show all output here.

An example test case to be used for this task

For a user string of:

```
 riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin

```

the computer program should return the string:

```
 RIGHT REPEAT *error* PUT MOVE RESTORE *error* *error* *error* POWERINPUT

```

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 2017.08

Demonstrate that inputting an empty string returns an empty string in addition to the required test input.

```
<
Add ALTer  BAckup Bottom  CAppend Change SCHANGE  CInsert CLAst COMPress COpy
COUnt COVerlay CURsor DELete CDelete Down DUPlicate Xedit EXPand EXTract Find
NFind NFINDUp NFUp CFind FINdup FUp FOrward GET Help HEXType Input POWerinput
Join SPlit SPLTJOIN  LOAD  Locate CLocate  LOWercase UPPercase  LPrefix MACRO
MErge MODify MOve MSG Next Overlay PARSE PREServe PURge PUT PUTD  Query  QUIT
READ  RECover REFRESH RENum REPeat  Replace CReplace  RESet  RESTore  RGTLEFT
RIght LEft  SAVE  SET SHift SI  SORT  SOS  STAck STATus  TOP TRAnsfer Type Up
> ~~ m:g/ ((<.:Lu>+) <.:Ll>*) /;

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

sub abbr-easy ( $str ) { %abr{$str.trim.fc} // '*error*' }

# Testing
for 'riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin', '' -> $str {
    put ' Input: ', $str;
    put 'Output: ', join ' ', $str.words.map: &abbr-easy;
}

```

Output:

```
 Input: riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin
Output: RIGHT REPEAT *error* PUT MOVE RESTORE *error* *error* *error* POWERINPUT
 Input:
Output:
```


[User]
The use of   abbreviations   (also sometimes called synonyms, nicknames, AKAs, or aliases)   can be an

easy way to add flexibility when specifying or using commands, sub─commands, options, etc.

For this task, the following   *command table*   will be used:

```
   add 1  alter 3  backup 2  bottom 1  Cappend 2  change 1  Schange  Cinsert 2  Clast 3
   compress 4 copy 2 count 3 Coverlay 3 cursor 3  delete 3 Cdelete 2  down 1  duplicate
   3 xEdit 1 expand 3 extract 3  find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2
   forward 2  get  help 1 hexType 4  input 1 powerInput 3  join 1 split 2 spltJOIN load
   locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2  macro  merge 2 modify 3 move 2
   msg  next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit  read recover 3
   refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left
   2  save  set  shift 2  si  sort  sos  stack 3 status 4 top  transfer 3  type 1  up 1

```

Notes concerning the above   *command table*:

:   :   * it can be thought of as one long literal string   (with blanks at end-of-lines)
        * it may have superfluous blanks
        * it may be in any case (lower/upper/mixed)
        * the order of the words in the   *command table*   must be preserved as shown
        * the user input(s) may be in any case (upper/lower/mixed)
        * commands will be restricted to the Latin alphabet   (A ──► Z,   a ──► z)
        * a command is followed by an optional number, which indicates the minimum abbreviation
        * A valid abbreviation is a word that has:

        :   * at least the minimum length of the word's minimum number in the *command table*
            * compares equal (regardless of case) to the leading characters of the word in the *command table*
            * a length not longer than the word in the *command table*

            :   * **ALT**,   **aLt**,   **ALTE**,   and   **ALTER**   are all abbreviations of   **ALTER 3**
                * **AL**,   **ALF**,   **ALTERS**,   **TER**,   and   **A**   aren't valid abbreviations of   **ALTER 3**
                * The   **3**   indicates that any abbreviation for   **ALTER**   must be at least three characters
                * Any word longer than five characters can't be an abbreviation for   **ALTER**
                * **o**,   **ov**,   **oVe**,   **over**,   **overL**,   **overla**   are all acceptable abbreviations for   **overlay 1**

        * if there isn't a number after the command,   then there isn't an abbreviation permitted

Task
:   :   * The command table needn't be verified/validated.
        * Write a function to validate if the user "words"   (given as input)   are valid   (in the *command table*).
        * If the word   is   valid,   then return the full uppercase version of that "word".
        * If the word isn't valid,   then return the lowercase string:    **\*error\***        (7 characters).
        * A blank input   (or a null input)   should return a null string.
        * Show all output here.

An example test case to be used for this task

For a user string of:

```
 riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin

```

the computer program should return the string:

```
 RIGHT REPEAT *error* PUT MOVE RESTORE *error* *error* *error* POWERINPUT

```

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 2017.08

Demonstrate that inputting an empty string returns an empty string in addition to the required test input.

```
<
add 1  alter 3  backup 2  bottom 1  Cappend 2  change 1  Schange  Cinsert 2  Clast 3
compress 4 copy 2 count 3 Coverlay 3 cursor 3  delete 3 Cdelete 2  down 1  duplicate
3 xEdit 1 expand 3 extract 3  find 1 Nfind 2 Nfindup 6 NfUP 3 Cfind 2 findUP 3 fUP 2
forward 2  get  help 1 hexType 4  input 1 powerInput 3  join 1 split 2 spltJOIN load
locate 1 Clocate 2 lowerCase 3 upperCase 3 Lprefix 2  macro  merge 2 modify 3 move 2
msg  next 1 overlay 1 parse preserve 4 purge 3 put putD query 1 quit  read recover 3
refresh renum 3 repeat 3 replace 1 Creplace 2 reset 3 restore 4 rgtLEFT right 2 left
2  save  set  shift 2  si  sort  sos  stack 3 status 4 top  transfer 3  type 1  up 1
> ~~ m:g/ (<.alpha>+) \s* (\d*) /;

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

sub abbr-simple ( $str ) { %abr{$str.trim.fc} // '*error*' }

# Testing
for 'riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin', '' -> $str {
    put ' Input: ', $str;
    put 'Output: ', join ' ', $str.words.map: &abbr-simple;
}

```

Output:

```
 Input: riG   rePEAT copies  put mo   rest    types   fup.    6       poweRin
Output: RIGHT REPEAT *error* PUT MOVE RESTORE *error* *error* *error* POWERINPUT
 Input:
Output:
```


[User]
Taken from this video at the time stamp of 9:02

**Task:**

Get a string input and store it into a variable or something and compare the number of occurrences of the letters "a", "b" and "c".
All other characters MUST be ignored. If the "a"'s, "b"'s and "c"'s occur with exactly equal frequency, return true; otherwise return false.

[Assistant]
I've elected to do 'or something' as specified in the task instructions. Rather than just feeding a few words in to check if there are equal counts of 'a', 'b', and 'c'; instead, reads in the words\_alpha.txt word list and returns the words that have equal counts of 'a', 'b', and 'c', and, (to make things a little less verbose,) **have more than one of each**.

```
.say for 'words_alpha.txt'.IO.lines.race.grep({+(my \b = .comb.Bag)<a> > 1 and [==] b<a b c>}) X~ " True";

```

Output:

```
abboccato True
bambocciade True
beccabunga True
blackback True
bombacaceous True
brachiocubital True
buccolabial True
cabbalistic True
subbrachycephaly True
subcarbonaceous True

```


[User]
Write a routine (function, subroutine, procedure, whatever it may be called in your language,) that when given a set of three letters, (a, b, c) for instance, will identify words that contain each of those letters, in differing amounts, and where each count differs from another by exactly 1. Ignore any characters that are not in the given search group.

For example: using the letters (a, b, c) the "word" 'abbccc' would be valid (1(a), 2(b) & 3(c)), as would 'acodablaccab' (2(b), 3(c) & 4(a)).

Do not hard code the letters to search for. Do not create three different single purpose search routines. Instead, create a generic routine that uses a given set of letters as its search criteria. Include some mechanism to limit the minimum count for the least common letter.

You may assume that the words are all lower case, or may choose to regularize the case of the words. In either case assume upper and lower case are the same. (The test files contain all and only lower case.)

Task

Write a general purpose routine to identify incremental letter count words following the above description.

Using the unixdict.txt from http://wiki.puzzlers.org, find and display the words that are identified as incremental count words, or <none> if no words are found that match.

:   * Search for words containing (a b c) with a minimum count of 1
    * Search for words containing (t h e) with a minimum count of 1
    * Search for words containing (c i o) with a minimum count of 2

Show the output here, on this page.

Stretch

Use the same routine to search the words\_alpha.txt file from https://github.com/dwyl/english-words using the same letter groups, but with a minimum 1 higher.

:   * Search for words containing (a b c) with a minimum count of 2
    * Search for words containing (t h e) with a minimum count of 2
    * Search for words containing (c i o) with a minimum count of 3

Related

ABC correlation

[Assistant]
```
say "\nUsing ", my $dict = 'unixdict.txt';
my @tests = <a b c>, 1, <t h e>, 1, <c i o>, 2;
filter $dict.IO.words;

say "\n\nUsing ", $dict = 'words_alpha.txt';
@tests[1,3,5]».++;
filter $dict.IO.words;

sub filter (@words) {
    for @tests -> ($a, $b, $c), $min {
        say "\nLetters: ($a $b $c) -- Minimum count $min\n",
          @words.race.grep(&incremental).sort.join("\n") || '<none>';

        sub incremental ($word) {
            my @v = $word.comb.Bag{$a,$b,$c}.values.sort;
            (@v[0] >= $min) && (@v[0]+1 == @v[1]) && (@v[0]+2 == @v[2])
        }
    }
}

```

Output:

```
Using unixdict.txt

Letters: (a b c) -- Minimum count 1
baccarat
canvasback
sabbatical

Letters: (t h e) -- Minimum count 1
aesthete
afterthought
authenticate
bethlehem
cheesecloth
diethylstilbestrol
eratosthenes
heathenish
letterhead
liechtenstein
mephistopheles
nineteenth
orthophosphate
seventieth
sweetheart
teethe
teethed
thereafter
theretofore
thirtieth
triphenylphosphine
twentieth
westchester
wholehearted

Letters: (c i o) -- Minimum count 2
socioeconomic

Using words_alpha.txt

Letters: (a b c) -- Minimum count 2
<none>

Letters: (t h e) -- Minimum count 2
demethylchlortetracycline
dichlorodiphenyltrichloroethane
hyperthermesthesia
tetrachloroethylene
thermohyperesthesia
trinitrophenylmethylnitramine

Letters: (c i o) -- Minimum count 3
scleroticochorioiditis

```


[User]
You are given a collection of ABC blocks   (maybe like the ones you had when you were a kid).

There are twenty blocks with two letters on each block.

A complete alphabet is guaranteed amongst all sides of the blocks.

The sample collection of blocks:

```
 (B O)
 (X K)
 (D Q)
 (C P)
 (N A)
 (G T)
 (R E)
 (T G)
 (Q D)
 (F S)
 (J W)
 (H U)
 (V I)
 (A N)
 (O B)
 (E R)
 (F S)
 (L Y)
 (P C)
 (Z M)

```

Task

Write a function that takes a string (word) and determines whether the word can be spelled with the given collection of blocks.

The rules are simple:

:   :   1. Once a letter on a block is used that block cannot be used again
        2. The function should be case-insensitive
        3. Show the output on this page for the following 7 words in the following example

Example

```
    >>> can_make_word("A")
    True
    >>> can_make_word("BARK")
    True
    >>> can_make_word("BOOK")
    False
    >>> can_make_word("TREAT")
    True
    >>> can_make_word("COMMON")
    False
    >>> can_make_word("SQUAD")
    True
    >>> can_make_word("CONFUSE")
    True

```

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 6.0.c

Blocks are stored as precompiled regexes. We do an initial pass on the blockset to include in the list only those regexes that match somewhere in the current word. Conveniently, regexes scan the word for us.

```
multi can-spell-word(Str $word, @blocks) {
    my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
    can-spell-word $word.uc.comb.list, @regex;
}

multi can-spell-word([$head,*@tail], @regex) {
    for @regex -> $re {
        if $head ~~ $re {
            return True unless @tail;
            return False if @regex == 1;
            return True if can-spell-word @tail, list @regex.grep: * !=== $re;
        }
    }
    False;
}

my @b = <BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM>;

for <A BaRK BOoK tREaT COmMOn SqUAD CoNfuSE> {
    say "$_     &can-spell-word($_, @b)";
}
```

Output:

```
A	True
BaRK	True
BOoK	False
tREaT	True
COmMOn	False
SqUAD	True
CoNfuSE	True
```