[User]
If one were to enter the words: 'softly affiliate activation' at the what3words.com site, the response would be a location in Walt Disney World. The latitude and longitude for that spot is 28.3852 -81.5638. Using that service enables anyone to specify any place on the Earth with three words.

Task: Provide a similar solution - Display a location on the Earth with three words derived from a latitude longitude pair.

For: latitude = 28.3852 longitude = -81.5638 Display: W18497 W11324 W01322

Implementation:

Build an array of 28126, 6 character words in the form W00000 thru W28125.

Convert latitude and longitude into positive integers.

Build a 43 bit integer containing latitude (21 bits) and longitude (22 bits).

Isolate most significant 15 bits for word 1 index.

Isolate next 14 bits for word 2 index.

Isolate next 14 bits for word 3 index.

Fetch each word from the word array.

Display the words.

Reverse the procedure and display the original latitude and longitude.

Extra credit: Find a way to populate the word array with actual words.

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

### The task

In large part due to the complete lack of specification, reference implementation, or guidance from the task creator, came up with my own bespoke synthetic word list.

Words always consist of a series of consonant/vowel pairs. Uses a cut down alphabet to reduce possible confusion from overlapping pronunciation.

Some letters with overlapping pronunciation are removed: c: confusable with k or s, g: overlaps with j, x: overlaps with z, q: just because, v: similar to w and we have way more than enough characters anyway.

As it is, with this alphabet we can form 512000 different 6 character "words"; 28126 is a drop in the bucket. To spread out the the words a bit, add a bit of randomness. 28126 fits into 512000 18 and a bit times. Add a random multiple of 28126 to the encoder then modulus it back out on decode. Will get different results on different runs.

We don't bother to pre-calculate and store the words, just generate them on the fly.

Official pronunciation guide:

* a - long a (say may day)
* e - long e (he me see)
* i - long i (hi sigh die)
* o - long o (go so low)
* u - long u (due boo moo)

```
# SYNTHETICS HANDLING
my @synth = flat < b d f h j k l m n p r s t w y z > X~ < a e i o u >;
my %htnys = @synth.antipairs;
my $exp   = @synth.elems;

sub synth (Int $v) { @synth[($v + (^18).pick * 28126).polymod($exp xx *).reverse || 0].join }

sub thnys (Str $v) { (sum %htnys{$v.comb(2).reverse} Z* 1, $exp, $exp**2) % 28126 }

# ENCODE / DECODE
sub w-encode ( Rat(Real) $lat, Rat(Real) $lon, :&f = &synth ) {
    $_ = (($lat +  90) * 10000).round.fmt('%021b') ~ (($lon + 180) * 10000).round.fmt('%022b');
    (:2(.substr(0,15)), :2(.substr(15,14)),:2(.substr(29)))».&f
}

sub w-decode ( *@words, :&f = &thnys ) {
    my $bin = (@words».&f Z, <0 1 1>).map({.[0].fmt('%015b').substr(.[1])}).join;
    (:2($bin.substr(0,21))/10000) - 90, (:2($bin.substr(21))/10000) - 180
}

# TESTING
for 51.4337,  -0.2141, # Wimbledon
    21.2596,-157.8117, # Diamond Head crater
   -55.9652, -67.2256, # Monumento Cabo De Hornos
    59.3586,  24.7447, # Lake Raku
    29.2021,  81.5324, # Village Raku
    -7.1662,  53.9470, # The Indian ocean, south west of Seychelles
    28.3852, -81.5638  # Walt Disney World
  -> $lat, $lon {
    my @words = w-encode $lat, $lon;
    my @index = w-encode $lat, $lon, :f( { $_ } );
    printf "Coordinates: %s, %s\n   To Index: %s\n  To 3-word: %s\nFrom 3-word: %s, %s\n From Index: %s, %s\n\n",
      $lat, $lon, @index.Str, @words.Str, w-decode(@words), w-decode @index, :f( { $_ } );
}

```

Output:

```
Coordinates: 51.4337, -0.2141
   To Index: 22099 365 12003
  To 3-word: zofobe fohujo habute
From 3-word: 51.4337, -0.2141
 From Index: 51.4337, -0.2141

Coordinates: 21.2596, -157.8117
   To Index: 17384 5133 8891
  To 3-word: nijemo zanaza fupawu
From 3-word: 21.2596, -157.8117
 From Index: 21.2596, -157.8117

Coordinates: -55.9652, -67.2256
   To Index: 5317 15428 13632
  To 3-word: zanohu julaso husese
From 3-word: -55.9652, -67.2256
 From Index: -55.9652, -67.2256

Coordinates: 59.3586, 24.7447
   To Index: 23337 4732 15831
  To 3-word: kapupi hokame supoku
From 3-word: 59.3586, 24.7447
 From Index: 59.3586, 24.7447

Coordinates: 29.2021, 81.5324
   To Index: 18625 5535 10268
  To 3-word: dijule nutuza nefini
From 3-word: 29.2021, 81.5324
 From Index: 29.2021, 81.5324

Coordinates: -7.1662, 53.947
   To Index: 12942 12942 12942
  To 3-word: rakudo rakudo rakudo
From 3-word: -7.1662, 53.947
 From Index: -7.1662, 53.947

Coordinates: 28.3852, -81.5638
   To Index: 18497 11324 1322
  To 3-word: tabesa nekaso bupodo
From 3-word: 28.3852, -81.5638
 From Index: 28.3852, -81.5638
```

(Ok, I admit I manipulated that second to last one, but it **is** a correct and valid 3-word location in this implementation. There is less than 1 chance in 5000 that it will produce that specific word group though.)

### A thought experiment

A little thought experiment... Latitude, longitude to four decimal places is accurate to about 11.1 meters at the equator, smaller the further from the equator you get.
What would it take to support five decimal places? (Accurate to 1.11 meters.)

`360 * 100000 == 36000000;
ceiling 36000000.log(2) == 26;`

So we need 26 bits to cover 360.00000; half of that for 180.00000, or `26 bits + 25 bits == 51 bits`. `51 / 3 == 17`. `2**17 == 131072` indices. The previous synthetics routine provides much more than enough.

How many sylabics will we need to minimally cover it?

`∛131072 == 50.7968...`

So at least 51. The synthetics routine provide sylabics in blocks of 5, so we would need
at least 11 consonants.

Capriciously and somewhat randomly cutting down the list we arrive at this.

10 times better accuracy in the same three, 6-letter word space.

```
# SYNTHETICS HANDLING
my @synth = flat < b d f j k n p r s t w > X~ < a e i o u >;
my %htnys = @synth.antipairs;
my $exp   = @synth.elems;
my $prec  = 100_000;

sub synth (Int $v) { @synth[$v.polymod($exp xx *).reverse || 0].join }

sub thnys (Str $v) { sum %htnys{$v.comb(2).reverse} Z× 1, $exp, $exp² }

# ENCODE / DECODE
sub w-encode ( Rat(Real) $lat, Rat(Real) $lon, :&f = &synth ) {
    $_ = (($lat +  90) × $prec).round.fmt('%025b') ~ (($lon + 180) × $prec).round.fmt('%026b');
    (:2(.substr(0,17)), :2(.substr(17,17)), :2(.substr(34)))».&f
}

sub w-decode ( *@words, :&f = &thnys ) {
    my $bin = @words».&f.map({.fmt('%017b')}).join;
    (:2($bin.substr(0,25))/$prec) - 90, (:2($bin.substr(25))/$prec) - 180
}

# TESTING
for 51.43372,  -0.21412, # Wimbledon center court
    21.25976,-157.81173, # Diamond Head summit
   -55.96525, -67.22557, # Monumento Cabo De Hornos
    28.3852,  -81.5638,  # Walt Disney World
    89.99999, 179.99999, # test some
   -89.99999,-179.99999  # extremes
  -> $lat, $lon {
    my @words = w-encode $lat, $lon;
    printf "Coordinates: %s, %s\n   To Index: %s\n  To 3-word: %s\nFrom 3-word: %s, %s\n\n",
      $lat, $lon, w-encode($lat, $lon, :f({$_})).Str, @words.Str, w-decode(@words);
}

```

Output:

```
Coordinates: 51.43372, -0.21412
   To Index: 55247 71817 21724
  To 3-word: jofuni kosasi diduwu
From 3-word: 51.43372, -0.21412

Coordinates: 21.25976, -157.81173
   To Index: 43460 110608 121675
  To 3-word: fukafa repebo safija
From 3-word: 21.25976, -157.81173

Coordinates: -55.96525, -67.22557
   To Index: 13294 108118 5251
  To 3-word: bukeru rasaso besane
From 3-word: -55.96525, -67.22557

Coordinates: 28.3852, -81.5638
   To Index: 46244 28747 13220
  To 3-word: jajasu duniri bukaka
From 3-word: 28.3852, -81.5638

Coordinates: 89.99999, 179.99999
   To Index: 70312 65298 86271
  To 3-word: kofoki kepifo nonope
From 3-word: 89.99999, 179.99999

Coordinates: -89.99999, -179.99999
   To Index: 0 512 1
  To 3-word: ba duji be
From 3-word: -89.99999, -179.99999
```


[User]
Task

Create a Thue-Morse sequence.

See also

* YouTube entry: The Fairest Sharing Sequence Ever
* YouTube entry: Math and OCD - My story with the Thue-Morse sequence
* Task: Fairshare between two and more

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

First 8 of an infinite sequence

```
.say for (0, { '0' ~ @_.join.trans( "01" => "10", :g) } ... *)[^8];

```

Output:

```
0
01
0110
01101001
0110100110010110
01101001100101101001011001101001
0110100110010110100101100110100110010110011010010110100110010110
01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001
^C
```


[User]
Task

Play a game of tic-tac-toe.

Ensure that legal moves are played and that a winning position is notified.

*Tic-tac-toe*   is also known as:

:   :   * *noughts and crosses*
        * *tic tac toe*
        * *tick tack toe*
        * *three in a row*
        * *tres en rayo*       and
        * *Xs  and  Os*

See also

* MathWorld™, Tic-Tac-Toe game.
* Wikipedia tic-tac-toe.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

The computer plays a random game.

```
my @board = 1..9;
my @winning-positions = [0..2], [3..5], [6..8], [0,3,6], [1,4,7], [2,5,8],
	[0,4,8], [6,4,2];

sub get-winner() {
	for @winning-positions {
        return (@board[|$_][0], $_) if [eq] @board[|$_];
	}
}

sub free-indexes() {
	@board.keys.grep: { @board[$_] eq any(1..9) }
}

sub ai-move() {
	given free-indexes.pick {
		@board[$_] = 'o';
		say "I go at: { $_ + 1 }\n";
	}
}

sub print-board() {
    print "\e[2J";
    say @board.map({ "$^a | $^b | $^c" }).join("\n--+---+--\n"), "\n";
}

sub human-move() {
	my $pos = prompt "Choose one of { (free-indexes() »+» 1).join(",") }: ";
	if $pos eq any(free-indexes() »+» 1) {
		@board[$pos - 1] = 'x';
	} else {
		say "Sorry, you want to put your 'x' where?";
		human-move();
	}
}

for flat (&ai-move, &human-move) xx * {
	print-board;
    last if get-winner() or not free-indexes;
    .();
}

if get-winner() -> ($player, $across) {
	say "$player wins across [", ($across »+» 1).join(", "), "].";
} else {
	say "How boring, a draw!";
}

```


[User]
Task

Write a program which uses a timer (with the least granularity available
on your system) to time how long a function takes to execute.

Whenever possible, use methods which measure only the processing time used
by the current process; instead of the difference in system time
between start and finish, which could include time used by
other processes on the computer.

This task is intended as a subtask for Measure relative performance of sorting algorithms implementations.

[Assistant]
(formerly Perl 6)
Follows modern trend toward measuring wall-clock time, since CPU time is becoming rather ill-defined in the age of multicore, and doesn't reflect IO overhead in any case.

```
my $start = now;
(^100000).pick(1000);
say now - $start;

```

Output:

```
0.02301709
```


[User]
## Time Conventions and Conversions

### Background

The accurate timing of events is an important measure in many areas of computing.

Computer benchmarking or network timeouts may use the computer clock only to compute the difference in time between events. For other tasks, such as measuring the time of events in a way that is independent of individual computers or when logging an event as having occurred at a particular time for later evaluation, an external time system is necessary to allow software to "tag" an event in time with a **timestamp** that can establish its position within an event history in that time system.

There are many such **timestamp** standards in use, and sometimes data with one system's timestamp may need to be used with a system that contains other data using a different system's timestamp. To properly correlate such mixed data, conversion of dates and times between timestamps in different systems is required.

The current task is to create a function or functions to perform timestamp conversions between **time conventions**, systems established as social conventions for tracking events in time.

### Time system epochs

When converting between time conventions, the origin (time 0) of each convention needs to be considered, along with the historical times of past adjustment of the system if any. The time 0 (sometimes, time 1) of a system can be referred to as its **epoch**.

#### UTC Time

The **ISO 8601 standard** created the time convention of **Coordinated Universal Time**, or **UTC**.

The ISO 8601 standard expresses dates and times in the format "yyyy-mm-ddTHH:MM:SS.xxx", where yyyy is 4-digit year, mm is 2-digit month, dd is 2-digit day of month, HH is 2-digit, 24-hour hour, MM is 2-digit minutes past the hour, SS is seconds past the minute, T is the letter T used to separate days from hours, and xxx is an optional decimal fraction of a second. In addition, the timestamp may have a timezone such as GMT appended to the UTC string (note however that time zones will not be covered in this task).

UTC defines Day 1 of the year 1 Common Era (AD) as 0001-1-1T00:00:00. Exceptionally for a mostly continuous variable, there is no 0 year in the conventional AD/BC, CE/BCE calendar. Instead, the previous year is defined to start at 0000:1:1T00:00:00Z, so the years going backwards in the CE/BCE system are are ...3 CE, 2 CE, 1 CE, 1 BCE, 2 BCE... whereas in UTC these are ...3, 2, 1, 0, -1...

The actual day 0, the UTC epoch start, is then 1 BCE, and the Day 0 epoch is defined as at the last day of year 1 BCE, or December 31, 1 BCE (BC), which is 0000-12-31T00:00:00 in the ISO 8601 standard for UTC time stamps.

#### UNIX Time

The Unix operating system time() function was the basis for the convention of **Unix system time**.

The Unix epoch (or Unix time or POSIX time or Unix timestamp) is the number of non-leap seconds that have elapsed since January 1, 1970 (midnight Coordinated Universal Time, or UTC, also GMT), not counting leap seconds. The time() function in Unix actually returns the number of (non-leap) milliseconds since the Unix epoch as a floating point number, which would be the Unix timestamp.

The Unix "epoch" is thus expressed in UTC 8601 terms as 1970-01-01T00:00:00.

#### NTP Time

The Network Time Protocol (or **NTP**) defines the prime epoch as beginning at UTC 1900-01-01T00:00:00. NTP timestamps are defined as the number of non-leap seconds since the NTP epoch.

### Leap seconds

The moon's tidal drag on Earth makes the Earth's rotation slow very slightly over the years, at a rate that is usually less than a second a year but varies from year to year. Because of a desire to keep the time of day in synchrony with the Earth's rotation, the exact duration of a year varies because of **leap seconds**. On certain years there have been **leap seconds** added at midnight mostly between 31 December and 1 January and occasionally at midnight between June 30 and July 1. These changes have been used to keep the **UTC** time of day in sync with the astronomical day. The **Unix**, **NTP**, and **UTC** time conventions essentially ignore leap seconds in their timekeeping. On the other hand, there other time conventions, including the **TAI** and **GPS** conventions, which advance their second clock even during leap seconds. This has caused **TAI time** and **GPS time** to progressively run ahead of **UTC time** by a slowly increasing number of seconds, even though the second measure itself is constant between conventions.

#### The leap second table

A file is kept current at the **NIST** ftp site, filed as **ftp.boulder.nist.gov/pub/time/leap-seconds.list**, which contains a history of each timestamp (in **NTP** time) in which the leap seconds were added and ignored in the counting of seconds in **NTP**, **Unix**, and **UTC** conventions.

The leap-seconds.list file currently contains data including the following:

```
Timestamp of last update of this file in NTP seconds:
3929093563

Planned expiration date of the file in NTP timestamp seconds:
3960057600

2272060800      10      # 1 Jan 1972
2287785600      11      # 1 Jul 1972
2303683200      12      # 1 Jan 1973
2335219200      13      # 1 Jan 1974
2366755200      14      # 1 Jan 1975
2398291200      15      # 1 Jan 1976
2429913600      16      # 1 Jan 1977
2461449600      17      # 1 Jan 1978
2492985600      18      # 1 Jan 1979
2524521600      19      # 1 Jan 1980
2571782400      20      # 1 Jul 1981
2603318400      21      # 1 Jul 1982
2634854400      22      # 1 Jul 1983
2698012800      23      # 1 Jul 1985
2776982400      24      # 1 Jan 1988
2840140800      25      # 1 Jan 1990
2871676800      26      # 1 Jan 1991
2918937600      27      # 1 Jul 1992
2950473600      28      # 1 Jul 1993
2982009600      29      # 1 Jul 1994
3029443200      30      # 1 Jan 1996
3076704000      31      # 1 Jul 1997
3124137600      32      # 1 Jan 1999
3345062400      33      # 1 Jan 2006
3439756800      34      # 1 Jan 2009
3550089600      35      # 1 Jul 2012
3644697600      36      # 1 Jul 2015
3692217600      37      # 1 Jan 2017

```

According to the **leap-seconds.list** file, then, an offset of 37 seconds started in 2017 and should be current through 2024. Lesser whole-second adjustments would be correct for dates from 1972 through 2016. So, for example, for the date of "October 5, 1998", or UTC "1998-10-05", falls after 1997, when the leap seconds last went up to 31, and before 1999, when the total leap seconds then went up to 32. So, the leap seconds value correction for that date is 31 seconds. This is the number of seconds a **UTC** timestamp would lag behind a **TAI** time timestamp (see below).

The leap-seconds.list file provided by NIST includes a series of NTP timestamps to indicate the date and time of each update to the leap seconds, as given in the table above.

#### TAI Time

The above mentioned **TAI time**, or international atomic clock time, is defined as the number of seconds since **UTC** 1958-01-01T00:00:00, but with counting the leap seconds not counted by UTC.

#### GPS Time

Similarly to **TAI** time, the **GPS** time, or **Global Positioning System** convention time, is defined as the number of seconds since **UTC** 1980-01-06T00:00:00. Since the **UTC** time in 1980 had already fallen behind **TAI** time by 19 seconds, **GPS** time's offset is always 19 less than the (positive) **TAI** offset used in conversion to **TAI** from any given **UTC** standard timestamp.

## Task:

In your chosen programming language, write a function or functions to convert between timestamps in **UTC**, **Unix**, **NTP**, **TAI**, and **GPS** time conventions. Timestamps should be capable of 1 millisecond precision as a minimum, with microsecond or nanosecond precision optional. Negative values for a timestamp before its epoch can be used when necessary. Add or subtract the proper number of leap seconds as appropriate when converting between leap-second-ignoring (UTC, Unix, NTP) and leap-second-counting (TAI, GPS) timestamp standards.

Demonstrate the use of the function or functions to output values to fill in blanks in the following table:

```
      UTC                      Unix           NTP            TAI              GPS
__________________________________________________________________________________________
0000-12-31T00:00:00
1900-01-01T00:00:00
1958-01-01T00:00:00
1970-01-01T00:00:00
1980-01-06T00:00:00
1989-12-31T00:00:00
1990-01-01T00:00:00
2025-06-01T00:00:00
2050-01-01T00:00:00
                          1810753809.806
                           154956295.688
                           780673454.121
                                          2871676795
                                          2335219189
                                          3029443171
                                                          996796823
                                                          996796824
                                                          996796825
                                                          996796826
                                                                          996796804.250
                                                                          996796805.500
                                                                          996796806.750
                                                                          996796807.9999

```

References

[1] Wikipedia reference

[2] Non-paywalled version of the ISO 8601 standard for UTC

[3] Discussion of the leap-seconds.list file

[4] Comparisons of different time conventions and timestamps

[5] Online time stamp converter

[Assistant]
When using the Instant class for leap second operations in Raku, the results may be version-dependent as it is preloaded with leap seconds adjustments at the then current point in time. Users should be aware of this and take it into consideration, as the knowledge of future leap seconds can vary between different Raku compiler versions.

**Translation of**: Wren

```
# 20241023 Raku programming solution

my (\UNIX_EPOCH, \NTP_EPOCH, \TAI_EPOCH, \GPS_EPOCH) = map { DateTime.new: $_ },
   < 1970-01-01  1900-01-01  1958-01-01  1980-01-06 >;

my %NTP_TO_LS = ( my @CHANGE_TIMES = <
   2272060800 2287785600 2303683200 2335219200 2366755200 2398291200 2429913600
   2461449600 2492985600 2524521600 2571782400 2603318400 2634854400 2698012800
   2776982400 2840140800 2871676800 2918937600 2950473600 2982009600 3029443200
   3076704000 3124137600 3345062400 3439756800 3550089600 3644697600 3692217600
> ) Z=> 10 .. * ;

# The conversions without leap second adjustments

my &utc2unix = -> $utcStr {
   do given DateTime.new($utcStr).posix { * < 0 ?? $_ !! $_ - UNIX_EPOCH }
}

my &utc2ntp  = -> $utcStr   { utc2unix($utcStr) + UNIX_EPOCH - NTP_EPOCH }

my &ntp2unix = -> $ntpSecs  { $ntpSecs + NTP_EPOCH - UNIX_EPOCH }

my &unix2ntp = -> $unixSecs { $unixSecs + UNIX_EPOCH - NTP_EPOCH }

my &unix2utc = -> $unixSecs { Instant.from-posix($unixSecs).DateTime }

my &ntp2utc  = -> $ntpSecs  { unix2utc(ntp2unix($ntpSecs)) }

my &tai2gps  = -> $taiSecs  { $taiSecs + TAI_EPOCH - GPS_EPOCH - 10 }

my &gps2tai  = -> $gpsSecs  { $gpsSecs + GPS_EPOCH - TAI_EPOCH + 10 }

# Conversions requiring leap-second adjustments

my &ntp2tai = sub ($ntpSecs) {
   my $tai =  $ntpSecs + NTP_EPOCH - TAI_EPOCH;

   return $tai if $ntpSecs < @CHANGE_TIMES[0];

   return $tai+%NTP_TO_LS{@CHANGE_TIMES[*-1]} if $ntpSecs >= @CHANGE_TIMES[*-1];

   for 1 .. @CHANGE_TIMES.elems - 1 {
      if $ntpSecs < @CHANGE_TIMES[$_] {
         return $tai + %NTP_TO_LS{@CHANGE_TIMES[$_-1]}
      }
   }
}

my &tai2ntp = sub ($taiSecs) {
   my $ntp = $taiSecs + TAI_EPOCH - NTP_EPOCH;

   return $ntp if $ntp < @CHANGE_TIMES[0];

   my ($idx, $delta) = (0, 0);

   if $ntp >= @CHANGE_TIMES[*-1] {
      $delta = %NTP_TO_LS{@CHANGE_TIMES[*-1]}
   } else {
      for 1 .. @CHANGE_TIMES.elems - 1 {
         if $ntp < @CHANGE_TIMES[$_] {
            $delta = %NTP_TO_LS{@CHANGE_TIMES[$_-1]};
            $idx = $_;
            last;
         }
      }
   }

   return do given $ntp - $delta {
      when * < @CHANGE_TIMES[0]      { @CHANGE_TIMES[0] - 1 + $ntp.fraction }
      when * < @CHANGE_TIMES[$idx-1] { $_ + 1 }
      default                        { $_ }
   }
}

my &ntp2gps  = -> $ntpSecs  { tai2gps(ntp2tai($ntpSecs)) }

my &gps2ntp  = -> $gpsSecs  { tai2ntp(gps2tai($gpsSecs)) }

my &tai2unix = -> $taiSecs  { ntp2unix(tai2ntp($taiSecs)) }

my &unix2tai = -> $unixSecs { ntp2tai(unix2ntp($unixSecs)) }

my &tai2utc  = -> $taiSecs  { ntp2utc(tai2ntp($taiSecs)) }

my &utc2tai  = -> $utcStr   { ntp2tai(utc2ntp($utcStr)) }

my &gps2unix = -> $gpsSecs  { tai2unix(gps2tai($gpsSecs)) }

my &unix2gps = -> $unixSecs { tai2gps(unix2tai($unixSecs)) }

my &utc2gps  = -> $utcStr   { tai2gps(utc2tai($utcStr)) }

my &gps2utc  = -> $gpsSecs  { tai2utc(gps2tai($gpsSecs)) }

# Output formatting
say "      UTC                            Unix               NTP               TAI               GPS";
say '_' x 100;

my $fmt = "%-28s%18.4f%18.4f%18.4f%18.4f\n";

for < 0001-01-01T00:00:00 1900-01-01T00:00:00 1958-01-01T00:00:00
      1970-01-01T00:00:00 1980-01-06T00:00:00 1989-12-31T00:00:00
      1990-01-06T00:00:00 2025-06-01T00:00:00 2050-01-01T00:00:00 > {
   printf $fmt, $_, .&utc2unix, .&utc2ntp, .&utc2tai, .&utc2gps
}

for < 1810753809.806 154956295.688 780673454.121 > {
   printf $fmt, .&unix2utc, $_, .&unix2ntp, .&unix2tai, .&unix2gps
}

for < 2871676795 2335219189 3029443171 3124137599 3124137600 > {
   printf $fmt, .&ntp2utc, .&ntp2unix, $_, .&ntp2tai, .&ntp2gps
}

for <  996796823  996796824  996796825  996796826
      1293840030 1293840031 1293840032 1293840033 > {
   printf $fmt, .&tai2utc, .&tai2unix, .&tai2ntp, $_, .&tai2gps
}

for < 996796804.250 996796805.5 996796806.750 996796807.9999 > {
   printf $fmt, .&gps2utc, .&gps2unix, .&gps2ntp, .&gps2tai, $_
}

```

You may Attempt This Online!

Output:

```
      UTC                            Unix               NTP               TAI               GPS
____________________________________________________________________________________________________
0001-01-01T00:00:00          -62135596800.0000 -59926608000.0000 -61756905600.0000 -62451561619.0000
1900-01-01T00:00:00           -2208988800.0000            0.0000  -1830297600.0000  -2524953619.0000
1958-01-01T00:00:00            -378691200.0000   1830297600.0000            0.0000   -694656019.0000
1970-01-01T00:00:00                     0.0000   2208988800.0000    378691200.0000   -315964819.0000
1980-01-06T00:00:00             315964800.0000   2524953600.0000    694656019.0000            0.0000
1989-12-31T00:00:00             631065600.0000   2840054400.0000   1009756824.0000    315100805.0000
1990-01-06T00:00:00             631584000.0000   2840572800.0000   1010275225.0000    315619206.0000
2025-06-01T00:00:00            1748736000.0000   3957724800.0000   2127427237.0000   1432771218.0000
2050-01-01T00:00:00            2524608000.0000   4733596800.0000   2903299237.0000   2208643218.0000
2027-05-19T19:10:09.806000Z    1810753809.8060   4019742609.8060   2189445046.8060   1494789027.8060
1974-11-29T11:24:55.688000Z     154956295.6880   2363945095.6880    533647508.6880   -161008510.3120
1994-09-27T13:44:14.121000Z     780673454.1210   2989662254.1210   1159364683.1210    464708664.1210
1990-12-31T23:59:55Z            662687995.0000   2871676795.0000   1041379220.0000    346723201.0000
1973-12-31T23:59:49Z            126230389.0000   2335219189.0000    504921601.0000   -189734418.0000
1995-12-31T23:59:31Z            820454371.0000   3029443171.0000   1199145600.0000    504489581.0000
1998-12-31T23:59:59Z            915148799.0000   3124137599.0000   1293840030.0000    599184011.0000
1999-01-01T00:00:00Z            915148800.0000   3124137600.0000   1293840032.0000    599184013.0000
1989-08-02T23:59:59Z            618105599.0000   2827094399.0000    996796823.0000    302140804.0000
1989-08-03T00:00:00Z            618105600.0000   2827094400.0000    996796824.0000    302140805.0000
1989-08-03T00:00:01Z            618105601.0000   2827094401.0000    996796825.0000    302140806.0000
1989-08-03T00:00:02Z            618105602.0000   2827094402.0000    996796826.0000    302140807.0000
1998-12-31T23:59:59Z            915148799.0000   3124137599.0000   1293840030.0000    599184011.0000
1999-01-01T00:00:00Z            915148800.0000   3124137600.0000   1293840031.0000    599184012.0000
1999-01-01T00:00:00Z            915148800.0000   3124137600.0000   1293840032.0000    599184013.0000
1999-01-01T00:00:01Z            915148801.0000   3124137601.0000   1293840033.0000    599184014.0000
2011-08-07T23:59:49.250000Z    1312761589.2500   3521750389.2500   1691452823.2500    996796804.2500
2011-08-07T23:59:50.500000Z    1312761590.5000   3521750390.5000   1691452824.5000    996796805.5000
2011-08-07T23:59:51.750000Z    1312761591.7500   3521750391.7500   1691452825.7500    996796806.7500
2011-08-07T23:59:52.999900Z    1312761592.9999   3521750392.9999   1691452826.9999    996796807.9999
```


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

A Time-based One-time Password Algorithm (TOTP) is an algorithm that computes a one-time password from a shared secret key and the current time. It is the cornerstone of Initiative For Open Authentication (OATH) and is used in a number of two factor authentication systems.

Essentially, both the server and the client compute the time-limited token, then the server checks if the token supplied by the client matches the locally generated token.

Task

Implement this algorithm using **HMAC-SHA1** and an optional step is to generate the random Base-32 string used as the secret key, but this is not a requirement.

A reference implementation, based on JavaScript, can be found at the following location:

:   :   :   http://blog.tinisles.com/2011/10/google-authenticator-one-time-password-algorithm-in-javascript

According to RFC 6238, the reference implementation is as follows:

* Generate a key, **K**, which is an arbitrary bytestring, and share it securely with the client.
* Agree upon an epoch, T0, and an interval, TI, which will be used to calculate the value of the counter C (defaults are the Unix epoch as T0 and 30 seconds as TI)
* Agree upon a cryptographic hash method (default is SHA-1)
* Agree upon a token length, **N** (default is 6)

Although RFC 6238 allows different parameters to be used, the Google implementation of the authenticator app does not support T0, TI values, hash methods and token lengths different from the default.   It also expects the **K** secret key to be entered (or supplied in a QR code) in base-32 encoding according to RFC 3548.

* Google Authenticator App (Apple iOS)
* Google Authenticator App (Google Android)
* Microsoft Authenticator App (Windows Phone)

[Assistant]
(formerly Perl 6)
This is a minimal attempt that covers only the "Time-based" part of the requirement.

```
# Reference:
# https://github.com/retupmoca/P6-Digest-HMAC

use v6.d;
use Digest::HMAC;
use Digest::SHA;

sub totp (Str \secret, DateTime \counter, Int \T0=0, Int \T1=30 --> Str) {
   my \key = ( counter - DateTime.new(T0) ).Int div T1;
   return hmac-hex(key.Str, secret, &sha1).substr(0,6) # first 6 chars of sha1
}

my $message = "show me the monKey";

say "Deterministic output at ", DateTime.new(2177452800), " with fixed checks,";
loop (my $t = 2177452800 ; $t < 2177452900 ; $t+= 17 ) { # Y2038 safe
   say totp $message, DateTime.new($t);
}

say "Current time output at ", DateTime.new(now), " with random checks,";
loop (my $n = 0 ; $n < 6 ; $n++, sleep (13..23).roll ) {
   say totp $message, DateTime.new(now);
}

```

Output:

```
Deterministic output at 2039-01-01T00:00:00Z with fixed checks,
34ca2a
acfa3f
950fc3
950fc3
a2d4ea
a2d4ea
Current time output at 2019-03-31T15:00:01.765312Z with random checks,
4e36de
d4e9f8
d4e9f8
077e2c
63bbb5
63bbb5
```


[User]
Separate the string "Hello,How,Are,You,Today" by commas into an array (or list) so that each element of it stores a different word.

Display the words to the 'user', in the simplest manner possible, separated by a period.

To simplify, you may display a trailing period.

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 #22 "Thousand Oaks"

```
'Hello,How,Are,You,Today'.split(',').join('.').say;
```

Or with function calls:

```
say join '.', split ',', 'Hello,How,Are,You,Today';
```


[User]
Task[edit]

Write a function or program that can split a string at each non-escaped occurrence of a separator character.

It should accept three input parameters:

:   :   :   * The **string**
            * The **separator character**
            * The **escape character**

It should output a list of strings.

Details

Rules for splitting:

* The fields that were separated by the separators, become the elements of the output list.
* Empty fields should be preserved, even at the start and end.

Rules for escaping:

* "Escaped" means preceded by an occurrence of the escape character that is not already escaped itself.
* When the escape character precedes a character that has no special meaning, it still counts as an escape (but does not do anything special).
* Each occurrence of the escape character that was used to escape something, should **not** become part of the output.

Test case

Demonstrate that your function satisfies the following test-case:

| Input | Output |
| --- | --- |
| |  |  | | --- | --- | | string: | ``` one^|uno||three^^^^|four^^^|^cuatro| ``` | | separator character: | ``` | ``` | | escape character: | ``` ^ ``` | | |  | | --- | | ``` one|uno ``` | |  | | ``` three^^ ``` | | ``` four^|cuatro ``` | |  | |

(Print the output list in any format you like, as long as it is it easy to see what the fields are.)

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)

```
sub tokenize ($string, :$sep!, :$esc!) {
    return $string.match(/([ <!before $sep | $esc> . | $esc . ]*)+ % $sep/)\
                  .[0].map(*.subst: /$esc )> ./, '', :g);
}

say "'$_'" for tokenize 'one^|uno||three^^^^|four^^^|^cuatro|', sep => '|', esc => '^';

```

Output:

```
'one|uno'
''
'three^^'
'four^|cuatro'
''

```

Notable Raku innovations that make this different from the equivalent #Perl solution:

* string variables can be safely interpolated into regexes without having to 'quotemeta' them
* regexes matches return a nested `Match` object which allows retrieving *all* results for a given capture group *(rather than just the last thing that it matched)*, thus getting rid of the need for repeated global matching
* the `<field>+ % <delimiter>` regex construct allows handling the delimiters in a more idiomatic way
* the `)>` regex construct can be used to exclude anything that follows it from the returned match result


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

In computational number theory, the Tonelli–Shanks algorithm is a technique for solving for **x** in a congruence of the form:

:   :   x2 ≡ n (mod p)

where **n** is an integer which is a quadratic residue (mod p), **p** is an odd prime, and **x,n ∈ Fp** where Fp = {0, 1, ..., p - 1}.

It is used in cryptography techniques.

To apply the algorithm, we need the Legendre symbol:

The Legendre symbol **(a | p)** denotes the value of a(p-1)/2 (mod p).

* **(a | p) ≡ 1**    if **a** is a square (mod p)
* **(a | p) ≡ -1**    if **a** is not a square (mod p)
* **(a | p) ≡ 0**    if **a** ≡ 0 (mod p)

Algorithm pseudo-code

All ≡ are taken to mean (mod p) unless stated otherwise.

* Input: **p** an odd prime, and an integer **n** .
* Step 0: Check that **n** is indeed a square: (n | p) must be ≡ 1 .
* Step 1: By factoring out powers of 2 from p - 1, find **q** and **s** such that p - 1 = q2s with **q** odd .
  + If p ≡ 3 (mod 4) (i.e. s = 1), output the two solutions r ≡ ± n(p+1)/4 .
* Step 2: Select a non-square **z** such that (z | p) ≡ -1 and set c ≡ zq .
* Step 3: Set r ≡ n(q+1)/2, t ≡ nq, m = s .
* Step 4: Loop the following:
  + If t ≡ 1, output **r** and **p - r** .
  + Otherwise find, by repeated squaring, the lowest **i**, 0 < i < m , such that t2i ≡ 1 .
  + Let b ≡ c2(m - i - 1), and set r ≡ rb, t ≡ tb2, c ≡ b2 and m = i .

Task

Implement the above algorithm.

Find solutions (if any) for

* n = 10 p = 13
* n = 56 p = 101
* n = 1030 p = 10009
* n = 1032 p = 10009
* n = 44402 p = 100049

Extra credit

* n = 665820697 p = 1000000009
* n = 881398088036 p = 1000000000039
* n = 41660815127637347468140745042827704103445750172002 p = 10^50 + 577

See also

* Modular exponentiation
* Cipolla's algorithm

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.04

Translation of the Wikipedia pseudocode, heavily influenced by Sidef and Python.

```
#  Legendre operator (𝑛│𝑝)
sub infix:<│> (Int \𝑛, Int \𝑝 where 𝑝.is-prime && (𝑝 != 2)) {
    given 𝑛.expmod( (𝑝-1) div 2, 𝑝 ) {
        when 0  {  0 }
        when 1  {  1 }
        default { -1 }
    }
}

sub tonelli-shanks ( \𝑛, \𝑝 where (𝑛│𝑝) > 0 ) {
    my $𝑄 = 𝑝 - 1;
    my $𝑆 = 0;
    $𝑄 +>= 1 and $𝑆++ while $𝑄 %% 2;
    return 𝑛.expmod((𝑝+1) div 4, 𝑝) if $𝑆 == 1;
    my $𝑐 = ((2..𝑝).first: (*│𝑝) < 0).expmod($𝑄, 𝑝);
    my $𝑅 = 𝑛.expmod( ($𝑄+1) +> 1, 𝑝 );
    my $𝑡 = 𝑛.expmod( $𝑄, 𝑝 );
    while ($𝑡-1) % 𝑝 {
        my $b;
        my $𝑡2 = $𝑡² % 𝑝;
        for 1 .. $𝑆 {
            if ($𝑡2-1) %% 𝑝 {
                $b = $𝑐.expmod(1 +< ($𝑆-1-$_), 𝑝);
                $𝑆 = $_;
                last;
            }
            $𝑡2 = $𝑡2² % 𝑝;
        }
        $𝑅 = ($𝑅 * $b) % 𝑝;
        $𝑐 = $b² % 𝑝;
        $𝑡 = ($𝑡 * $𝑐) % 𝑝;
    }
    $𝑅;
}

my @tests = (
    (10, 13),
    (56, 101),
    (1030, 10009),
    (1032, 10009),
    (44402, 100049),
    (665820697, 1000000009),
    (881398088036, 1000000000039),
    (41660815127637347468140745042827704103445750172002,
      100000000000000000000000000000000000000000000000577)
);

 for @tests -> ($n, $p) {
    try my $t = tonelli-shanks($n, $p);
    say "No solution for ({$n}, {$p})." and next if !$t or ($t² - $n) % $p;
    say "Roots of $n are ($t, {$p-$t}) mod $p";
}

```

Output:

```
Roots of 10 are (7, 6) mod 13
Roots of 56 are (37, 64) mod 101
Roots of 1030 are (1632, 8377) mod 10009
No solution for (1032, 10009).
Roots of 44402 are (30468, 69581) mod 100049
Roots of 665820697 are (378633312, 621366697) mod 1000000009
Roots of 881398088036 are (791399408049, 208600591990) mod 1000000000039
Roots of 41660815127637347468140745042827704103445750172002 are (32102985369940620849741983987300038903725266634508, 67897014630059379150258016012699961096274733366069) mod 100000000000000000000000000000000000000000000000577
```


[User]
Task

Find the top   *N*   salaries in each department,   where   *N*   is provided as a parameter.

Use this data as a formatted internal data structure (adapt it to your language-native idioms, rather than parse at runtime), or identify your external data source:

```
Employee Name,Employee ID,Salary,Department
Tyler Bennett,E10297,32000,D101
John Rappl,E21437,47000,D050
George Woltman,E00127,53500,D101
Adam Smith,E63535,18000,D202
Claire Buckman,E39876,27800,D202
David McClellan,E04242,41500,D101
Rich Holcomb,E01234,49500,D202
Nathan Adams,E41298,21900,D050
Richard Potter,E43128,15900,D101
David Motsinger,E27002,19250,D202
Tim Sampair,E03033,27000,D101
Kim Arlich,E10001,57000,D190
Timothy Grove,E16398,29900,D190

```

[Assistant]
(formerly Perl 6)
We use whitespace-separated fields here from a heredoc; q:to/---/ begins the heredoc. The Z=> operator zips two lists into a list of pairs.
In MAIN, the classify method generates pairs where each key is a different department, and each value all the entries in that department. We then sort the pairs and process each department separately. Within each department, we sort on salary (negated to reverse the order). The last statement is essentially a list comprehension that uses a slice subscript with the ^ "up to" operator to take the first N elements of the sorted employee list. The :v modifier returns only valid values. The .<Name> form is a slice hash subscript with literals strings. That in turn is just the subscript form of the <...> ("quote words") form, which is more familar to Perl 5 programmers as
qw/.../. We used that form earlier to label the initial data set.

This program also makes heavy use of method calls that start with dot. In Raku this means a method call on the current topic, $\_, which is automatically set by any for or map construct that doesn't declare an explicit formal parameter on its closure.

```
my @data = do for q:to/---/.lines -> $line {
        E10297  32000   D101    Tyler Bennett
        E21437  47000   D050    John Rappl
        E00127  53500   D101    George Woltman
        E63535  18000   D202    Adam Smith
        E39876  27800   D202    Claire Buckman
        E04242  41500   D101    David McClellan
        E01234  49500   D202    Rich Holcomb
        E41298  21900   D050    Nathan Adams
        E43128  15900   D101    Richard Potter
        E27002  19250   D202    David Motsinger
        E03033  27000   D101    Tim Sampair
        E10001  57000   D190    Kim Arlich
        E16398  29900   D190    Timothy Grove
        ---

  $%( < Id      Salary  Dept    Name >
      Z=>
      $line.split(/ \s\s+ /)
    )
}

sub MAIN(Int $N = 3) {
    for @data.classify({ .<Dept> }).sort».value {
        my @es = .sort: { -.<Salary> }
        say '' if (state $bline)++;
        say .< Dept Id Salary Name > for @es[^$N]:v;
    }
}

```

Output:

```
D050 E21437 47000 John Rappl
D050 E41298 21900 Nathan Adams

D101 E00127 53500 George Woltman
D101 E04242 41500 David McClellan
D101 E10297 32000 Tyler Bennett

D190 E10001 57000 Kim Arlich
D190 E16398 29900 Timothy Grove

D202 E01234 49500 Rich Holcomb
D202 E39876 27800 Claire Buckman
D202 E27002 19250 David Motsinger
```


[User]
Several programming languages offer syntax shortcuts to deal with the notion of "current" or "topic" variable.

A topic variable is a special variable with a very short name which can also often be omitted.

Demonstrate the utilization and behaviour of the topic variable within the language and explain or demonstrate how the topic variable behaves under different levels of nesting or scope, if this applies, within the language.

For instance you can (but you don't have to) show how the topic variable can be used by assigning the number

3
{\displaystyle {\displaystyle 3}}
 to it and then computing its square and square root.

[Assistant]
(formerly Perl 6)

As in Perl, in Raku the topic variable is $\_. In addition to a direct assigment, it can be set with the 'given' or 'with' keywords, or by some iteration operator ('for', 'map' etc). A method can be called from it with an implicit call:

```
$_ = 'Outside';
for <3 5 7 10> {
    print $_;
    .³.map: { say join "\t", '', $_, .², .sqrt, .log(2), OUTER::<$_>, UNIT::<$_>  }
}

```

Output:

```
3	27	729	5.196152422706632	4.754887502163469	3	Outside
5	125	15625	11.180339887498949	6.965784284662088	5	Outside
7	343	117649	18.520259177452136	8.422064766172811	7	Outside
10	1000	1000000	31.622776601683793	9.965784284662087	10	Outside
```

Note: that the $\_ inside the 'map' block is different than the $\_ set in the 'for' block. The scope of the $\_ variable is always lexical in Raku, though a function can access topics in other scopes by specifying the scope: `CALLER::<$_>` from within a subroutine, `OUTER::<$_>` for the next enclosing block, `UNIT::<$_>` for the outermost block in a compilation unit, etc. The scope modifiers may be stacked: `CALLER::OUTER::<$_>` would be the topic variable of the next outer block of the current subroutines caller block.

The scope modifiers can only flow outward. There is no way to access the topic of a block enclosed within the current scope or in a separate scope 'branch'.

Also note: **Any** variable in other scopes can be accessed this way. This is just pointing out that the default (topic) variable also has this property.


[User]
Given a mapping between items, and items they depend on, a topological sort orders items so that no item precedes an item it depends upon.

The compiling of a library in the VHDL language has the constraint that a library must be compiled after any library it depends on.

A tool exists that extracts library dependencies.

Task

Write a function that will return a valid compile order of VHDL libraries from their dependencies.

* Assume library names are single words.
* Items mentioned as only dependents, (sic), have no dependents of their own, but their order of compiling must be given.
* Any self dependencies should be ignored.
* Any un-orderable dependencies should be flagged.

Use the following data as an example:

```
LIBRARY          LIBRARY DEPENDENCIES
=======          ====================
des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
dw01             ieee dw01 dware gtech
dw02             ieee dw02 dware
dw03             std synopsys dware dw03 dw02 dw01 ieee gtech
dw04             dw04 ieee dw01 dware gtech
dw05             dw05 ieee dware
dw06             dw06 ieee dware
dw07             ieee dware
dware            ieee dware
gtech            ieee gtech
ramlib           std ieee
std_cell_lib     ieee std_cell_lib
synopsys

```

Note: the above data would be un-orderable if, for example, `dw04` is added to the list of dependencies of `dw01`.

C.f.
:   * Topological sort/Extracted top item.

There are two popular algorithms for topological sorting:

:   * Kahn's 1962 topological sort [1]
    * depth-first search [2] [3]

[Assistant]
(formerly Perl 6)

**Translation of**: Perl

**Works with**: rakudo version 2016.01

```
sub print_topo_sort ( %deps ) {
    my %ba;
    for %deps.kv -> $before, @afters {
        for @afters -> $after {
            %ba{$before}{$after} = 1 if $before ne $after;
            %ba{$after} //= {};
        }
    }

    while %ba.grep( not *.value )».key -> @afters {
        say ~@afters.sort;
        %ba{@afters}:delete;
        for %ba.values { .{@afters}:delete }
    }

    say %ba ?? "Cycle found! {%ba.keys.sort}" !! '---';
}

my %deps =
    des_system_lib => < std synopsys std_cell_lib des_system_lib dw02
                                                     dw01 ramlib ieee >,
    dw01           => < ieee dw01 dware gtech                         >,
    dw02           => < ieee dw02 dware                               >,
    dw03           => < std synopsys dware dw03 dw02 dw01 ieee gtech  >,
    dw04           => < dw04 ieee dw01 dware gtech                    >,
    dw05           => < dw05 ieee dware                               >,
    dw06           => < dw06 ieee dware                               >,
    dw07           => < ieee dware                                    >,
    dware          => < ieee dware                                    >,
    gtech          => < ieee gtech                                    >,
    ramlib         => < std ieee                                      >,
    std_cell_lib   => < ieee std_cell_lib                             >,
    synopsys       => <                                               >;

print_topo_sort(%deps);
%deps<dw01> = <ieee dw01 dware gtech dw04>; # Add unresolvable dependency
print_topo_sort(%deps);

```

Output:

```
ieee std synopsys
dware gtech ramlib std_cell_lib
dw01 dw02 dw05 dw06 dw07
des_system_lib dw03 dw04
---
ieee std synopsys
dware gtech ramlib std_cell_lib
dw02 dw05 dw06 dw07
Cycle found! des_system_lib dw01 dw03 dw04
```

Some differences from the Perl 5 version include use of
formal parameters; use of » as a "hyper" operator, that is, a parallelizable implicit loop; and use of normal lambda-like notation to bind loop parameters, so we can have multiple loop parameters bound on each iteration. Also,
since => is now a real pair composer rather than a synonym for comma, the data can be represented with real pair notation that points to quoted word lists delimited by angle brackets rather than [qw(...)].


[User]
Given a mapping between items, and items they depend on, a topological sort orders items so that no item precedes an item it depends upon.

The compiling of a design in the VHDL language has the constraint that a file must be compiled after any file containing definitions it depends on. A tool exists that extracts file dependencies.

* Assume the file names are single words, given without their file extensions.
* Files mentioned as only dependants, have no dependants of their own, but their order of compiling must be given.
* Any self dependencies should be ignored.

A top level file is defined as a file that:

1. Has dependents.
2. Is not itself the dependent of another file

**Task Description**

Given the following file dependencies as an example:

```
FILE    FILE DEPENDENCIES
====    =================
top1    des1 ip1 ip2
top2    des1 ip2 ip3
ip1     extra1 ip1a ipcommon
ip2     ip2a ip2b ip2c ipcommon
des1    des1a des1b des1c
des1a   des1a1 des1a2
des1c   des1c1 extra1
```

The task is to create a program that given a graph of the dependency:

1. Determines the top levels from the dependencies and show them.
2. Extracts a compile order of files to compile any given (usually top level) file.
3. Give a compile order for file top1.
4. Give a compile order for file top2.

You may show how to compile multiple top levels as a stretch goal

Note: this task differs from task Topological sort in that the order for compiling any file might not include all files; and that checks for dependency cycles are not mandated.

Related task

* Topological sort

[Assistant]
(formerly Perl 6)

```
sub top_topos ( %deps, *@top ) {
    my %ba;
    for %deps.kv -> $after, @befores {
        for @befores -> $before {
            %ba{$after}{$before} = 0 if $before ne $after;
            %ba{$before} //= {};
        }
    }

    if @top {
	my @want = @top;
	my %care;
	%care{@want} = 1 xx *;
	repeat while @want {
	    my @newwant;
	    for @want -> $before {
		if %ba{$before} {
		    for %ba{$before}.keys -> $after {
			if not %ba{$before}{$after} {
			    %ba{$before}{$after}++;
			    push @newwant, $after;
			}
		    }
		}
	    }
	    @want = @newwant;
	    %care{@want} = 1 xx *;
	}

	for %ba.keys -> $before {
	    %ba{$before}:delete unless %care{$before};
	}
    }

    my @levels;
    while %ba.grep( not *.value )».key -> @befores {
	push @levels, ~@befores.sort;
        %ba{@befores}:delete;
        for %ba.values { .{@befores}:delete }
    }
    if @top {
	say "For top-level-modules: ", @top;
	say "  $_" for @levels;
    }
    else {
	say "Top levels are: @levels[*-1]";
    }

    say "Cycle found! {%ba.keys.sort}" if %ba;
    say '';
}

my %deps =
    top1  =>  <des1 ip1 ip2>,
    top2  =>  <des1 ip2 ip3>,
    ip1   =>  <extra1 ip1a ipcommon>,
    ip2   =>  <ip2a ip2b ip2c ipcommon>,
    des1  =>  <des1a des1b des1c>,
    des1a =>  <des1a1 des1a2>,
    des1c =>  <des1c1 extra1>;

top_topos(%deps);
top_topos(%deps, 'top1');
top_topos(%deps, 'top2');
top_topos(%deps, 'ip1');
top_topos(%deps, 'top1', 'top2');

```

Output:

```
Top levels are: top1 top2

For top-level-modules: top1
  des1a1 des1a2 des1b des1c1 extra1 ip1a ip2a ip2b ip2c ipcommon
  des1a des1c ip1 ip2
  des1
  top1

For top-level-modules: top2
  des1a1 des1a2 des1b des1c1 extra1 ip2a ip2b ip2c ip3 ipcommon
  des1a des1c ip2
  des1
  top2

For top-level-modules: ip1
  extra1 ip1a ipcommon
  ip1

For top-level-modules: top1 top2
  des1a1 des1a2 des1b des1c1 extra1 ip1a ip2a ip2b ip2c ip3 ipcommon
  des1a des1c ip1 ip2
  des1
  top1 top2

```


[User]
Topswops is a card game created by John Conway in the 1970's.

Assume you have a particular permutation of a set of   n   cards numbered   1..n   on both of their faces, for example the arrangement of four cards given by   [2, 4, 1, 3]   where the leftmost card is on top.

A round is composed of reversing the first   m   cards where   m   is the value of the topmost card.

Rounds are repeated until the topmost card is the number   1   and the number of swaps is recorded.

For our example the swaps produce:

```

    [2, 4, 1, 3]    # Initial shuffle
    [4, 2, 1, 3]
    [3, 1, 2, 4]
    [2, 1, 3, 4]
    [1, 2, 3, 4]

```

For a total of four swaps from the initial ordering to produce the terminating case where   1   is on top.

For a particular number    `n`    of cards,    `topswops(n)`    is the maximum swaps needed for any starting permutation of the   `n`   cards.

Task

The task is to generate and show here a table of    `n`    vs    `topswops(n)`    for    `n`    in the range   1..10   inclusive.

Note

Topswops   is also known as   Fannkuch   from the German word   *Pfannkuchen*   meaning   pancake.

Related tasks

* Number reversal game
* Sorting algorithms/Pancake sort

[Assistant]
(formerly Perl 6)

```
sub swops(@a is copy) {
    my int $count = 0;
    until @a[0] == 1 {
        @a[ ^@a[0] ] .= reverse;
        ++$count;
    }
    $count
}

sub topswops($n) { max (1..$n).permutations.race.map: &swops }

say "$_ {topswops $_}" for 1 .. 10;

```

Output:

```
1 0
2 1
3 2
4 4
5 7
6 10
7 16
8 22
9 30
10 38
```

Alternately, using string manipulation instead. Much faster, though honestly, still not very fast.

```
sub swops($a is copy) {
    my int $count = 0;
    while (my \l = $a.ord) > 1 {
        $a = $a.substr(0, l).flip ~ $a.substr(l);
        ++$count;
    }
    $count
}

sub topswops($n) { max (1..$n).permutations.map: { .chrs.join.&swops } }

say "$_ {topswops $_}" for 1 .. 10;

```

Same output


[User]
Example circles

Example circles filtered

Given some partially overlapping circles on the plane, compute and show the total area covered by them, with four or six (or a little more) decimal digits of precision. The area covered by two or more disks needs to be counted only once.

One point of this Task is also to compare and discuss the relative merits of various solution strategies, their performance, precision and simplicity. This means keeping both slower and faster solutions for a language (like C) is welcome.

To allow a better comparison of the different implementations, solve the problem with this standard dataset, each line contains the **x** and **y** coordinates of the centers of the disks and their radii   (11 disks are fully contained inside other disks):

```
         xc              yc          radius
     1.6417233788   1.6121789534   0.0848270516
    -1.4944608174   1.2077959613   1.1039549836
     0.6110294452  -0.6907087527   0.9089162485
     0.3844862411   0.2923344616   0.2375743054
    -0.2495892950  -0.3832854473   1.0845181219
     1.7813504266   1.6178237031   0.8162655711
    -0.1985249206  -0.8343333301   0.0538864941
    -1.7011985145  -0.1263820964   0.4776976918
    -0.4319462812   1.4104420482   0.7886291537
     0.2178372997  -0.9499557344   0.0357871187
    -0.6294854565  -1.3078893852   0.7653357688
     1.7952608455   0.6281269104   0.2727652452
     1.4168575317   1.0683357171   1.1016025378
     1.4637371396   0.9463877418   1.1846214562
    -0.5263668798   1.7315156631   1.4428514068
    -1.2197352481   0.9144146579   1.0727263474
    -0.1389358881   0.1092805780   0.7350208828
     1.5293954595   0.0030278255   1.2472867347
    -0.5258728625   1.3782633069   1.3495508831
    -0.1403562064   0.2437382535   1.3804956588
     0.8055826339  -0.0482092025   0.3327165165
    -0.6311979224   0.7184578971   0.2491045282
     1.4685857879  -0.8347049536   1.3670667538
    -0.6855727502   1.6465021616   1.0593087096
     0.0152957411   0.0638919221   0.9771215985

```

The result is   21.56503660... .

Related task

* Circles of given radius through two points.

See also

* http://www.reddit.com/r/dailyprogrammer/comments/zff9o/9062012\_challenge\_96\_difficult\_water\_droplets/
* http://stackoverflow.com/a/1667789/10562

[Assistant]
(formerly Perl 6)
This subdivides the outer rectangle repeatedly into subrectangles, and classifies them into wet, dry, or unknown. The knowns are summed to provide an inner bound and an outer bound, while the unknowns are further subdivided. The estimate is the average of the outer bound and the inner bound. Not the simplest algorithm, but converges fairly rapidly because it can treat large areas sparsely, saving the fine subdivisions for the circle boundaries. The number of unknown rectangles roughly doubles each pass, but the area of those unknowns is about half.

```
class Point {
    has Real $.x;
    has Real $.y;
    has Int $!cbits;	# bitmap of circle membership

    method cbits { $!cbits //= set_cbits(self) }
    method gist { $!x ~ "\t" ~ $!y }
}

multi infix:<to>(Point $p1, Point $p2) {
    sqrt ($p1.x - $p2.x) ** 2 + ($p1.y - $p2.y) ** 2;
}

multi infix:<mid>(Point $p1, Point $p2) {
    Point.new(x => ($p1.x + $p2.x) / 2, y => ($p1.y + $p2.y) / 2);
}

class Circle {
    has Point $.center;
    has Real $.radius;

    has Point $.north = Point.new(x => $!center.x, y => $!center.y + $!radius);
    has Point $.west  = Point.new(x => $!center.x - $!radius, y => $!center.y);
    has Point $.south = Point.new(x => $!center.x, y => $!center.y - $!radius);
    has Point $.east  = Point.new(x => $!center.x + $!radius, y => $!center.y);

    multi method contains(Circle $c) { $!center to $c.center <= $!radius - $c.radius }
    multi method contains(Point $p) { $!center to $p <= $!radius }
    method gist { $!center.gist ~ "\t" ~ $.radius }
}

class Rect {
    has Point $.nw;
    has Point $.ne;
    has Point $.sw;
    has Point $.se;

    method diag { $!ne to $!se }
    method area { ($!ne.x - $!nw.x) * ($!nw.y - $!sw.y) }
    method contains(Point $p) {
	$!nw.x < $p.x < $!ne.x and
	$!sw.y < $p.y < $!nw.y;
    }
}

my @rawcircles = sort -*.radius,
    map -> $x, $y, $radius { Circle.new(:center(Point.new(:$x, :$y)), :$radius) },
    <
	 1.6417233788  1.6121789534 0.0848270516
	-1.4944608174  1.2077959613 1.1039549836
	 0.6110294452 -0.6907087527 0.9089162485
	 0.3844862411  0.2923344616 0.2375743054
	-0.2495892950 -0.3832854473 1.0845181219
	 1.7813504266  1.6178237031 0.8162655711
	-0.1985249206 -0.8343333301 0.0538864941
	-1.7011985145 -0.1263820964 0.4776976918
	-0.4319462812  1.4104420482 0.7886291537
	 0.2178372997 -0.9499557344 0.0357871187
	-0.6294854565 -1.3078893852 0.7653357688
	 1.7952608455  0.6281269104 0.2727652452
	 1.4168575317  1.0683357171 1.1016025378
	 1.4637371396  0.9463877418 1.1846214562
	-0.5263668798  1.7315156631 1.4428514068
	-1.2197352481  0.9144146579 1.0727263474
	-0.1389358881  0.1092805780 0.7350208828
	 1.5293954595  0.0030278255 1.2472867347
	-0.5258728625  1.3782633069 1.3495508831
	-0.1403562064  0.2437382535 1.3804956588
	 0.8055826339 -0.0482092025 0.3327165165
	-0.6311979224  0.7184578971 0.2491045282
	 1.4685857879 -0.8347049536 1.3670667538
	-0.6855727502  1.6465021616 1.0593087096
	 0.0152957411  0.0638919221 0.9771215985
    >».Num;

# remove redundant circles
my @circles;
while @rawcircles {
    my $c = @rawcircles.shift;
    next if @circles.any.contains($c);
    push @circles, $c;
}

sub set_cbits(Point $p) {
    my $cbits = 0;
    for @circles Z (1,2,4...*) -> ($c, $b) {
	$cbits += $b if $c.contains($p);
    }
    $cbits;
}

my $xmin = min @circles.map: { .center.x - .radius }
my $xmax = max @circles.map: { .center.x + .radius }
my $ymin = min @circles.map: { .center.y - .radius }
my $ymax = max @circles.map: { .center.y + .radius }

my $min-radius = @circles[*-1].radius;

my $outer-rect = Rect.new:
    nw => Point.new(x => $xmin, y => $ymax),
    ne => Point.new(x => $xmax, y => $ymax),
    sw => Point.new(x => $xmin, y => $ymin),
    se => Point.new(x => $xmax, y => $ymin);

my $outer-area = $outer-rect.area;

my @unknowns = $outer-rect;
my $known-dry = 0e0;
my $known-wet = 0e0;
my $div = 1;

# divide current rects each into four rects, analyze each
sub divide(@old) {

    $div *= 2;

    # rects too small to hold circle?
    my $smallish = @old[0].diag < $min-radius;

    my @unk;
    for @old {
	my $center = .nw mid .se;
	my $north = .nw mid .ne;
	my $south = .sw mid .se;
	my $west = .nw mid .sw;
	my $east = .ne mid .se;

	for Rect.new(nw => .nw, ne => $north, sw => $west, se => $center),
	    Rect.new(nw => $north, ne => .ne, sw => $center, se => $east),
	    Rect.new(nw => $west, ne => $center, sw => .sw, se => $south),
	    Rect.new(nw => $center, ne => $east, sw => $south, se => .se)
	{
	    my @bits = .nw.cbits, .ne.cbits, .sw.cbits, .se.cbits;

	    # if all 4 points wet by same circle, guaranteed wet
	    if [+&] @bits {
		$known-wet += .area;
		next;
	    }

	    # if all 4 corners are dry, must check further
	    if not [+|] @bits and $smallish {

		# check that no circle bulges into this rect
		my $ok = True;
		for @circles -> $c {
		    if .contains($c.east) or .contains($c.west) or
			.contains($c.north) or .contains($c.south)
		    {
			$ok = False;
			last;
		    }
		}
		if $ok {
		    $known-dry += .area;
		    next;
		}
	    }
	    push @unk, $_;	# dunno yet
	}
    }
    @unk;
}

my $delta = 0.001;
repeat until my $diff < $delta {
    @unknowns = divide(@unknowns);

    $diff = $outer-area - $known-dry - $known-wet;
    say 'div: ', $div.fmt('%-5d'),
	' unk: ', (+@unknowns).fmt('%-6d'),
	' est: ', ($known-wet + $diff/2).fmt('%9.6f'),
	' wet: ', $known-wet.fmt('%9.6f'),
	' dry: ', ($outer-area - $known-dry).fmt('%9.6f'),
	' diff: ', $diff.fmt('%9.6f'),
	' error: ', ($diff - @unknowns * @unknowns[0].area).fmt('%e');
}

```

Output:

```
div: 2     unk: 4      est: 14.607153 wet:  0.000000 dry: 29.214306 diff: 29.214306 error: 0.000000e+000
div: 4     unk: 15     est: 15.520100 wet:  1.825894 dry: 29.214306 diff: 27.388411 error: 0.000000e+000
div: 8     unk: 39     est: 20.313072 wet: 11.411838 dry: 29.214306 diff: 17.802467 error: 7.105427e-015
div: 16    unk: 107    est: 23.108972 wet: 17.003639 dry: 29.214306 diff: 12.210667 error: -1.065814e-014
div: 32    unk: 142    est: 21.368667 wet: 19.343066 dry: 23.394268 diff:  4.051203 error: 8.881784e-014
div: 64    unk: 290    est: 21.504182 wet: 20.469985 dry: 22.538380 diff:  2.068396 error: 1.771916e-013
div: 128   unk: 582    est: 21.534495 wet: 21.015613 dry: 22.053377 diff:  1.037764 error: -3.175238e-013
div: 256   unk: 1169   est: 21.557898 wet: 21.297343 dry: 21.818454 diff:  0.521111 error: -2.501332e-013
div: 512   unk: 2347   est: 21.563415 wet: 21.432636 dry: 21.694194 diff:  0.261558 error: -1.046996e-012
div: 1024  unk: 4700   est: 21.564111 wet: 21.498638 dry: 21.629584 diff:  0.130946 error: 1.481315e-013
div: 2048  unk: 9407   est: 21.564804 wet: 21.532043 dry: 21.597565 diff:  0.065522 error: 1.781700e-012
div: 4096  unk: 18818  est: 21.564876 wet: 21.548492 dry: 21.581260 diff:  0.032768 error: 1.098372e-011
div: 8192  unk: 37648  est: 21.564992 wet: 21.556797 dry: 21.573187 diff:  0.016389 error: -1.413968e-011
div: 16384 unk: 75301  est: 21.565017 wet: 21.560920 dry: 21.569115 diff:  0.008195 error: -7.683898e-011
div: 32768 unk: 150599 est: 21.565031 wet: 21.562982 dry: 21.567080 diff:  0.004097 error: -1.247991e-010
div: 65536 unk: 301203 est: 21.565035 wet: 21.564010 dry: 21.566059 diff:  0.002049 error: -2.830591e-010
div: 131072 unk: 602411 est: 21.565036 wet: 21.564524 dry: 21.565548 diff:  0.001024 error: -1.607121e-010
```

Here the "diff" is calculated by subtracting the known wet and dry areas from the total area, and the "error" is the difference between that and the sum of the areas of the unknown blocks, to give a rough idea of how much floating point roundoff error we've accumulated.


[User]
The   **totient**   function is also known as:

:   :   * Euler's totient function
        * Euler's phi totient function
        * phi totient function
        * Φ    function   (uppercase Greek phi)
        * φ     function   (lowercase Greek phi)

Definitions   (as per number theory)

The totient function:

:   :   * counts the integers up to a given positive integer   **n**   that are relatively prime to   **n**
        * counts the integers   **k**   in the range   **1 ≤ k ≤ n**   for which the greatest common divisor   **gcd(n,k)**   is equal to   **1**
        * counts numbers   **≤ n**   and   prime to   **n**

If the totient number   (for **N**)   is one less than   **N**,   then   **N**   is prime.

Task

Create a   **totient**   function and:

:   :   * Find and display   (1 per line)   for the 1st   **25**   integers:

        :   :   * the integer   (the index)
                * the totient number for that integer
                * indicate if that integer is prime

        * Find and display the   *count*   of the primes up to          100
        * Find and display the   *count*   of the primes up to       1,000
        * Find and display the   *count*   of the primes up to     10,000
        * Find and display the   *count*   of the primes up to   100,000     (optional)

Show all output here.

Related task
:   :   * Perfect totient numbers

Also see
:   :   * Wikipedia: Euler's totient function.
        * MathWorld: totient function.
        * OEIS: Euler totient function phi(n).

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.11

This is an *incredibly* inefficient way of finding prime numbers.

```
use Prime::Factor;

my \𝜑 = 0, |(1..*).hyper.map: -> \t { t * [*] t.&prime-factors.squish.map: { 1 - 1/$_ } }

printf "𝜑(%2d) = %3d %s\n", $_, 𝜑[$_], $_ - 𝜑[$_] - 1 ?? '' !! 'Prime' for 1 .. 25;

(1e2, 1e3, 1e4, 1e5).map: -> $limit {
    say "\nCount of primes <= $limit: " ~ +(^$limit).grep: {$_ == 𝜑[$_] + 1}
}

```

Output:

```
𝜑( 1) =   1
𝜑( 2) =   1 Prime
𝜑( 3) =   2 Prime
𝜑( 4) =   2
𝜑( 5) =   4 Prime
𝜑( 6) =   2
𝜑( 7) =   6 Prime
𝜑( 8) =   4
𝜑( 9) =   6
𝜑(10) =   4
𝜑(11) =  10 Prime
𝜑(12) =   4
𝜑(13) =  12 Prime
𝜑(14) =   6
𝜑(15) =   8
𝜑(16) =   8
𝜑(17) =  16 Prime
𝜑(18) =   6
𝜑(19) =  18 Prime
𝜑(20) =   8
𝜑(21) =  12
𝜑(22) =  10
𝜑(23) =  22 Prime
𝜑(24) =   8
𝜑(25) =  20

Count of primes <= 100: 25

Count of primes <= 1000: 168

Count of primes <= 10000: 1229

Count of primes <= 100000: 9592
```


[User]
Task

Solve the   Towers of Hanoi   problem with recursion.

[Assistant]
(formerly Perl 6)

```
subset Peg of Int where 1|2|3;

multi hanoi (0,      Peg $a,     Peg $b,     Peg $c)     { }
multi hanoi (Int $n, Peg $a = 1, Peg $b = 2, Peg $c = 3) {
    hanoi $n - 1, $a, $c, $b;
    say "Move $a to $b.";
    hanoi $n - 1, $c, $b, $a;
}
```


[User]
The TPK algorithm is an early example of a programming chrestomathy.
It was used in Donald Knuth and Luis Trabb Pardo's Stanford tech report The Early Development of Programming Languages.
The report traces the early history of work in developing computer languages in the 1940s and 1950s, giving several translations of the algorithm.

From the wikipedia entry:

```
ask for 11 numbers to be read into a sequence S
reverse sequence S
for each item in sequence S
    result := call a function to do an operation
    if result overflows
        alert user
    else
        print result

```

The task is to implement the algorithm:

1. Use the function:

   f
   (
   x
   )
   =

   |
   x

   |

   0.5
   +
   5

   x

   3
   {\displaystyle {\displaystyle f(x)=|x|^{0.5}+5x^{3}}}
2. The overflow condition is an answer of greater than 400.
3. The 'user alert' should not stop processing of other items of the sequence.
4. Print a prompt before accepting **eleven**, textual, numeric inputs.
5. You may optionally print the item as well as its associated result, but the results must be in reverse order of input.
6. The sequence    ***S***    may be 'implied' and so not shown explicitly.
7. *Print and show the program in action from a typical run here*. (If the output is graphical rather than text then either add a screendump or describe textually what is displayed).

[Assistant]
(formerly Perl 6)

```
my @nums = prompt("Please type 11 space-separated numbers: ").words
    until @nums == 11;
for @nums.reverse -> $n {
    my $r = $n.abs.sqrt + 5 * $n ** 3;
    say "$n\t{ $r > 400 ?? 'Urk!' !! $r }";
}

```

Output:

```
Please type 11 space-separated numbers: 10 -1 1 2 3 4 4.3 4.305 4.303 4.302 4.301
4.301	399.88629974772681
4.302	Urk!
4.303	Urk!
4.305	Urk!
4.3	399.60864413533278
4	322
3	136.73205080756887
2	41.414213562373092
1	6
-1	-4
10	Urk!
```


[User]
Rules

A rather silly little task intended as a bit of fun as well as a simple exercise in text substitution. So, if you're a Greek speaker or an expert in ancient Greek, please don't take it too seriously!

As there isn't a one-to-one correspondence between the English and Greek alphabets, we need some rules:

| Greek letter | Corresponding English letter(s) |
| --- | --- |
| alpha | a |
| beta | b or v |
| gamma | g |
| delta | d |
| epsilon | e (but not ee) |
| zeta | z |
| eta | h or ee (but not ch, kh, ph, rh or th) |
| theta | th |
| iota | i or j |
| kappa | c, k, q or ck (but not ch and kh) |
| lambda | l |
| mu | m |
| nu | n |
| xi | x |
| omicron | o (but not oo) |
| pi | p (but not ph or ps) |
| rho | r or rh |
| sigma | s (but not ps) |
| tau | t (but not th) |
| upsilon | u or y |
| phi | f or ph |
| chi | ch or kh |
| psi | ps |
| omega | w or oo |

In the case of lower-case sigma, use **ς** when **s** is the final letter of an English word or **σ** otherwise.

Ignore Greek diacritics (accents and breathings) but use the same capitalization, spacing and punctuation as in the English text.

Example

English: The quick brown fox jumped over the lazy dog.

Greek: Θε κυικ βροων φοξ ιυμπεδ οβερ θε λαζυ δογ.

Task

Transliterate the following English text into Greek using the above rules:

```
I was looking at some rhododendrons in my back garden,
dressed in my khaki shorts, when the telephone rang.

As I answered it, I cheerfully glimpsed that the July sun
caused a fragment of black pine wax to ooze on the velvet quilt
laying in my patio.

```

If your language does not support the printing of non-ascii characters, then you can instead transliterate the following lower-case pangram:

```
sphinx of black quartz, judge my vow.

```

Just represent the Greek letters by their names in angle brackets. For example:

```
the dog => <theta><epsilon> <delta><omicron><gamma>
```

Reference

* Wikipedia: Greek alphabet

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]
```
sub to-Greek (Str $string is copy) {
    my %pre =  :Ph<F>, :ck<k>, :ee<h>, :J<I>, :rh<r>,:oo<w>, :ph<f>, :ch<χ>,
               :th<θ>, :ps<ψ>, :Ch<Χ>, :Th<Θ>, :Ps<Ψ>, :kh<χ>, 's ' => 'ς ';
    my %post = :a<α>, :b<β>, :d<δ>, :e<ε>, :f<φ>, :g<γ>, :h<η>, :i<ι>, :j<ι>,
               :k<κ>, :l<λ>, :m<μ>, :n<ν>, :o<ο>, :p<π>, :q<κ>, :r<ρ>, :s<σ>,
               :t<τ>, :u<υ>, :v<β>, :w<ω>, :x<ξ>, :y<υ>, :z<ζ>, :A<Α>, :B<Β>,
               :D<Δ>, :E<Ε>, :F<Φ>, :G<Γ>, :H<Η>, :I<Ι>, :L<Λ>, :M<Μ>, :N<Ν>,
               :O<Ο>, :P<Π>, :Q<Κ>, :R<Ρ>, :S<Σ>, :T<Τ>, :U<Υ>, :W<Ω>, :X<Ξ>,
               :Z<Ζ>;

    $string.=subst(:g, .key, .value ) for flat %pre, %post;
    $string
}

my $text = chomp q:to/ENGLISH/;
    The quick brown fox jumped over the lazy dog.

    I was looking at some rhododendrons in my back garden,
    dressed in my khaki shorts, when the telephone rang.

    As I answered it, I cheerfully glimpsed that the July sun
    caused a fragment of black pine wax to ooze on the velvet quilt
    laying in my patio.

    sphinx of black quartz, judge my vow.
    ENGLISH

say "English:\n\n" ~ $text ~ "\n" ~ '=' x 80;

say "\"Greek\":\n\n" ~ $text.&to-Greek ~ "\n" ~ '=' x 80;

say "Or, to named characters:\n\n$_\n" ~
  .&to-Greek.comb.map({ .match(/\W/) ?? $_ !!
      '<' ~ .uniname.subst( /.+<?after LETTER\s>/).lc ~ '>'
  }).join
  given 'sphinx of black quartz, judge my vow.';

```

Output:

```
English:

The quick brown fox jumped over the lazy dog.

I was looking at some rhododendrons in my back garden,
dressed in my khaki shorts, when the telephone rang.

As I answered it, I cheerfully glimpsed that the July sun
caused a fragment of black pine wax to ooze on the velvet quilt
laying in my patio.

sphinx of black quartz, judge my vow.
================================================================================
"Greek":

Θε κυικ βροων φοξ ιυμπεδ οβερ θε λαζυ δογ.

Ι ωας λωκινγ ατ σομε ροδοδενδρονς ιν μυ βακ γαρδεν,
δρεσσεδ ιν μυ χακι σηορτσ, ωηεν θε τελεφονε ρανγ.

Ας Ι ανσωερεδ ιτ, Ι χηρφυλλυ γλιμψεδ θατ θε Ιυλυ συν
cαυσεδ α φραγμεντ οφ βλακ πινε ωαξ το ωζε ον θε βελβετ κυιλτ
λαυινγ ιν μυ πατιο.

σφινξ οφ βλακ κυαρτζ, ιυδγε μυ βοω.
================================================================================
Or, to named characters:

sphinx of black quartz, judge my vow.
<sigma><phi><iota><nu><xi> <omicron><phi> <beta><lamda><alpha><kappa> <kappa><upsilon><alpha><rho><tau><zeta>, <iota><upsilon><delta><gamma><epsilon> <mu><upsilon> <beta><omicron><omega>.
```


[User]
The **transportation problem** in linear programming is to find the optimal transportation plan for certain volumes of resources from suppliers to consumers, taking into account the cost of transportation. The plan is a table (matrix), whose rows and columns correspond to the suppliers and consumers, the cells are placed in cargo volume.

Example of the transportation problem:

:   :   :   :   :   :   |  | *Consumer 1*,  need 20 kg | *Consumer 2*,  need 30 kg | *Consumer 3*,  need 10 kg |
                        | --- | --- | --- | --- |
                        | *Supplier 1*,  supply 25 kg | $3 per kg | $5 per kg | $7 per kg |
                        | *Supplier 2*,  supply 35 kg | $3 per kg | $2 per kg | $5 per kg |

The object is to solve the classical transport problem using the method of potentials (with redistributive cycle) with the preparation of the initial transportation plan by the north-west corner of the features to be implemented in this task. The input is the number of suppliers and customers, inventory levels, needs and cost matrix transport cargo. The output of the program is the optimal plan. If necessary, enter a fictitious vendor or customer.

The solution for the above example would be the plan:

:   :   :   :   :   :   |  | *Consumer 1* | *Consumer 2* | *Consumer 3* |
                        | --- | --- | --- | --- |
                        | *Supplier 1* | 20 kg | - | 5 kg |
                        | *Supplier 2* | - | 30 kg | 5 kg |

See also

* The Transportation Problem
* Transportation model - Concepts (youtube)

Related tasks

* Vogel's approximation method

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.03.1

Using Vogel's approximation method:

```
my  %costs = :S1{:3C1, :5C2, :7C3}, :S2{:3C1, :2C2, :5C3};
my %demand = :20C1, :30C2, :10C3;
my %supply = :25S1, :35S2;

my @cols = %demand.keys.sort;

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

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

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

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

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

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

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

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

    %supply{$s} -= $v;

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

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

```

Output:

```
	C1	C2	C3
S1	20	-	5
S2	-	30	5
```


[User]
The following shows a tree of data with nesting denoted by visual levels of indentation:

```
RosettaCode
    rocks
        code
        comparison
        wiki
    mocks
        trolling
```

A common datastructure for trees is to define node structures having a name and a, (possibly empty), list of child nodes. The nesting of nodes captures the indentation of the tree. Lets call this **the nest form**.

```
# E.g. if child nodes are surrounded by brackets
#      and separated by commas then:
RosettaCode(rocks(code, ...), ...)
# But only an _example_
```

Another datastructure for trees is to construct from the root an ordered list of the nodes level of indentation and the name of that node. The indentation for the root node is zero; node 'rocks is indented by one level from the left, and so on. Lets call this **the indent form**.

```
0 RosettaCode
1 rocks
2 code
...
```

Task

1. Create/use a nest datastructure format and textual representation for arbitrary trees.
2. Create/use an indent datastructure format and textual representation for arbitrary trees.
3. Create methods/classes/proceedures/routines etc to:
   1. Change from a nest tree datastructure to an indent one.
   2. Change from an indent tree datastructure to a nest one
4. Use the above to encode the example at the start into the nest format, and show it.
5. transform the initial nest format to indent format and show it.
6. transform the indent format to final nest format and show it.
7. Compare initial and final nest formats which should be the same.

Note

* It's all about showing aspects of the contrasting datastructures as they hold the tree.
* Comparing nested datastructures is secondary - saving formatted output as a string then a string compare would suffice for this task, if its easier.

Show all output on this page.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

Code golf is a entertaining passtime, even if it isn't appropriate for this site. To a large extent, I agree with Hout, I am not really on board with mocking anybody, especially espousing it as an official RosettaCode position. So, feel free to mark this incorrect.

```
#`(
Sort of vague as to what we are trying to accomplish here. If we are just
trying to transform from one format to another, probably easiest to just
perform string manipulations.
)

my $level = '  ';

my $trees = q:to/END/;
    RosettaCode
      encourages
        code
          diversity
          comparison
      discourages
        golfing
        trolling
        emphasising execution speed
    code-golf.io
      encourages
        golfing
      discourages
        comparison
    END

sub nested-to-indent { $^str.subst: / ^^ ($($level))* /, -> $/ { "{+$0} " }, :g }
sub indent-to-nested { $^str.subst: / ^^ (\d+) \s* /, -> $/ { "{$level x +$0}" }, :g }

say $trees;
say my $indent = $trees.&nested-to-indent;
say my $nest = $indent.&indent-to-nested;

use Test;
is($trees, $nest, 'Round-trip equals original');

#`(
If, on the other hand, we want perform more complex transformations; better to
load it into a native data structure which will then allow us to manipulate it
however we like.
)

# Import outline paragraph into native data structure
sub import (Str $trees, $level = '  ') {
    my $forest;
    my $last = -Inf;

    for $trees.lines -> $branch {
        $branch ~~ / ($($level))* /;
        my $this = +$0;
        $forest ~= do {
            given $this cmp $last {
                when More { "\['{esc $branch.trim}', " }
                when Same { "'{esc $branch.trim}', " }
                when Less { "{']' x $last - $this}, '{esc $branch.trim}', " }
            }
        }
        $last = $this;
    }

    sub esc { $^s.subst( /(<['\\]>)/, -> $/ { "\\$0" }, :g) }

    $forest ~= ']' x 1 + $last;
    $forest.EVAL;
}

my $forest = import $trees;

say "\nNative data structure:\n", $forest.raku;

{
    use JSON::Fast;
    say "\nJSON:\n", $forest.&to-json;
}

{
    use YAML;
    say "\nYAML:\n", $forest.&dump;
}

```

Output:

```
RosettaCode
  encourages
    code
      diversity
      comparison
  discourages
    golfing
    trolling
    emphasising execution speed
code-golf.io
  encourages
    golfing
  discourages
    comparison

0 RosettaCode
1 encourages
2 code
3 diversity
3 comparison
1 discourages
2 golfing
2 trolling
2 emphasising execution speed
0 code-golf.io
1 encourages
2 golfing
1 discourages
2 comparison

RosettaCode
  encourages
    code
      diversity
      comparison
  discourages
    golfing
    trolling
    emphasising execution speed
code-golf.io
  encourages
    golfing
  discourages
    comparison

ok 1 - Round-trip equals original

Native data structure:
$["RosettaCode", ["encourages", ["code", ["diversity", "comparison"]], "discourages", ["golfing", "trolling", "emphasising execution speed"]], "code-golf.io", ["encourages", ["golfing"], "discourages", ["comparison"]]]

JSON:
[
  "RosettaCode",
  [
    "encourages",
    [
      "code",
      [
        "diversity",
        "comparison"
      ]
    ],
    "discourages",
    [
      "golfing",
      "trolling",
      "emphasising execution speed"
    ]
  ],
  "code-golf.io",
  [
    "encourages",
    [
      "golfing"
    ],
    "discourages",
    [
      "comparison"
    ]
  ]
]

YAML:
---
- RosettaCode
- - encourages
  - - code
    - - diversity
      - comparison
  - discourages
  - - golfing
    - trolling
    - emphasising execution speed
- code-golf.io
- - encourages
  - - golfing
  - discourages
  - - comparison
...
```


[User]
Given a flat list of integers greater than zero, representing object nesting
levels, e.g. `[1, 2, 4]`,
generate a tree formed from nested lists of those nesting level integers where:

* Every int appears, in order, at its depth of nesting.
* If the next level int is greater than the previous then it appears in a sub-list of the list containing the previous item

The generated tree data structure should ideally be in a languages nested list format that can
be used for further calculations rather than something just calculated for printing.

An input of `[1, 2, 4]` should produce the equivalent of: `[1, [2, [[4]]]]`
where 1 is at depth1, 2 is two deep and 4 is nested 4 deep.

`[1, 2, 4, 2, 2, 1]` should produce `[1, [2, [[4]], 2, 2], 1]`.
All the nesting integers are in the same order but at the correct nesting
levels.

Similarly `[3, 1, 3, 1]` should generate `[[[3]], 1, [[3]], 1]`

Task

Generate and show here the results for the following inputs:

:   * `[]`
    * `[1, 2, 4]`
    * `[3, 1, 3, 1]`
    * `[1, 2, 3, 1]`
    * `[3, 2, 1, 3]`
    * `[3, 3, 3, 1, 1, 3, 3, 3]`

[Assistant]
### Iterative

**Translation of**: Python

```
sub new_level ( @stack --> Nil ) {
    my $e = [];
    push @stack.tail, $e;
    push @stack,      $e;
}
sub to_tree_iterative ( @xs --> List ) {
    my $nested = [];
    my @stack  = $nested;

    for @xs -> Int $x {
        new_level(@stack) while $x > @stack;
        pop       @stack  while $x < @stack;
        push @stack.tail, $x;
    }

    return $nested;
}
my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3);
say .Str.fmt( '%15s => ' ), .&to_tree_iterative for @tests;

```

Output:

```
                => []
          1 2 4 => [1 [2 [[4]]]]
        3 1 3 1 => [[[3]] 1 [[3]] 1]
        1 2 3 1 => [1 [2 [3]] 1]
        3 2 1 3 => [[[3] 2] 1 [[3]]]
3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]

```

### Recursive

**Translation of**: Python

```
sub to_tree_recursive ( @list, $index is copy, $depth ) {
    my @so_far = gather while $index <= @list.end {
        my $t = @list[$index];

        given $t <=> $depth {
            when Order::Same {
                take $t;
            }
            when Order::More {
                ( $index, my $n1 ) = to_tree_recursive( @list, $index, $depth+1 );
                take $n1;
            }
            when Order::Less {
                $index--;
                last;
            }
        }
        $index++;
    }

    my $i = ($depth > 1) ?? $index !! -1;
    return $i, @so_far;
}
my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3);
say .Str.fmt( '%15s => ' ), to_tree_recursive( $_, 0, 1 ).[1] for @tests;

```

Output:

```
                => []
          1 2 4 => [1 [2 [[4]]]]
        3 1 3 1 => [[[3]] 1 [[3]] 1]
        1 2 3 1 => [1 [2 [3]] 1]
        3 2 1 3 => [[[3] 2] 1 [[3]]]
3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]

```

### String Eval

**Translation of**: Perl

```
use MONKEY-SEE-NO-EVAL;
sub to_tree_string_eval ( @xs --> Array ) {
    my @gap = [ |@xs, 0 ]  Z-  [ 0, |@xs ];

    my @open  = @gap.map( '[' x  * );
    my @close = @gap.map( ']' x -* );

    my @wrapped = [Z~] @open, @xs, @close.skip;

    return EVAL @wrapped.join(',').subst(:g, ']]', '],]') || '[]';
}
my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3);
say .Str.fmt( '%15s => ' ), .&to_tree_string_eval for @tests;

```

Output:

```
                => []
          1 2 4 => [1 [2 [[4]]]]
        3 1 3 1 => [[[3]] 1 [[3]] 1]
        1 2 3 1 => [1 [2 [3]] 1]
        3 2 1 3 => [[[3] 2] 1 [[3]]]
3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]

```


[User]
Task

Implement a binary tree where each node carries an integer,   and implement:

:   :   :   * pre-order,
            * in-order,
            * post-order,     and
            * level-order   traversal.

Use those traversals to output the following tree:

```
         1
        / \
       /   \
      /     \
     2       3
    / \     /
   4   5   6
  /       / \
 7       8   9

```

The correct output should look like this:

```
preorder:    1 2 4 7 5 3 6 8 9
inorder:     7 4 2 5 1 8 6 9 3
postorder:   7 4 5 2 8 9 6 3 1
level-order: 1 2 3 4 5 6 7 8 9

```

See also

* Wikipedia article:   Tree traversal.

[Assistant]
(formerly Perl 6)

```
class TreeNode {
    has TreeNode $.parent;
    has TreeNode $.left;
    has TreeNode $.right;
    has $.value;

    method pre-order {
        flat gather {
            take $.value;
            take $.left.pre-order if $.left;
            take $.right.pre-order if $.right
        }
    }

    method in-order {
        flat gather {
            take $.left.in-order if $.left;
            take $.value;
            take $.right.in-order if $.right;
        }
    }

    method post-order {
        flat gather {
            take $.left.post-order if $.left;
            take $.right.post-order if $.right;
            take $.value;
        }
    }

    method level-order {
        my TreeNode @queue = (self);
        flat gather while @queue.elems {
            my $n = @queue.shift;
            take $n.value;
            @queue.push($n.left) if $n.left;
            @queue.push($n.right) if $n.right;
        }
    }
}

my TreeNode $root .= new( value => 1,
                    left => TreeNode.new( value => 2,
                            left => TreeNode.new( value => 4, left => TreeNode.new(value => 7)),
                            right => TreeNode.new( value => 5)
                    ),
                    right => TreeNode.new( value => 3,
                             left => TreeNode.new( value => 6,
                                     left => TreeNode.new(value => 8),
                                     right => TreeNode.new(value => 9)
                                     )
                             )
                    );

say "preorder:  ",$root.pre-order.join(" ");
say "inorder:   ",$root.in-order.join(" ");
say "postorder: ",$root.post-order.join(" ");
say "levelorder:",$root.level-order.join(" ");

```

Output:

```
preorder:  1 2 4 7 5 3 6 8 9
inorder:   7 4 2 5 1 8 6 9 3
postorder: 7 4 5 2 8 9 6 3 1
levelorder:1 2 3 4 5 6 7 8 9
```