Surviving Dates with Raku

This is my response to the Perl Weekly Challenge #48.

Challenge #48.1: Survivor

An illustration can help:

1. Person 1 eliminates the next person (person 2), and passes the sword to the next remaining person (person 3)
2. Person 3 eliminates the next person (person 4), and passes the sword to the next remaining person (person 5)
3. Person 5 eliminates the next person (person 6), and passes the sword to the next remaining person (person 7)
4. Person 7 eliminates the next person (person 8), and passes the sword to the next remaining person (person 9)

The net result after the first round (which is an irrelevant conecpt as we conceptually have a circle) is the elimination of every second person (and actually all the even numbered ones).

We can simplify this elminiation process by replacing the concept of killer and killed with a simple eliminated (of the persons marked with red). The pattern should be easy to see. We remove the person at position 2, collapse the list, remove the person at position 3, and so on. The person marked with green is a distraction that we can ignore when we write the program.

unit sub MAIN (:$verbose);                   # [1]

my @people = 1 .. 50;                        # [2]

my $next = 1;                                # [3]

say "@people[] [Index: $next]" if $verbose;  # [1a]

while @people.elems > 1                      # [4]
{
  my $killed = @people.splice($next, 1);     # [5]

  $next++;                                   # [6]
  $next = 0 if $next > @people.end;          # [6a]

  say "@people[] [K:$killed] [Next:$next]" if $verbose;  # [1b]
}

say "Living: @people[]";                     # [7]

[1] Verbose mode to show what is going on, or rather show that the program does what it is supposed to do. [1a] shows the initial state, and [1b] shows the state after each elimination.

[2] Populate the array with people. The first person has the value «1» and so on (and index 0). I have chosen to simulate a circular buffer with an array and a corresponding index (see [3]).

[3] The next person to eliminate, as an index to be applied to the «@people» array.

[4] As long as there is more than one person left,

[5] • Eliminate the next one. («splice» removes one or more elements from an array. Here we remove one, at the position given by «$next»).

[6] • Advance the pointer one position, and rotate back to 0 if we have passed the end [6a]. («end» gives the index of the last item in the array, which is 1 less than what «elems» gives.)

[7] The single remaining person.

Running it:

$ raku survivor
Living: 31

The 31st person is the survivor.

Running it with verbose mode to show what is going on. I have abridged the output to make it fit the article width.

$ raku survivor --verbose
: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 50 [Index: 1]
: 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 50 [K:2] [Next:2]
: 1 3 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 50 [K:4] [Next:3]
: 1 3 5 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 50 [K:6] [Next:4]
: 1 3 5 7 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 49 50 [K:8] [Next:5]
: 1 3 5 7 9 11 12 13 14 15 16 17 18 19 20 21 22 ... 49 50 [K:10] [Next:6]
: 1 3 5 7 9 11 13 14 15 16 17 18 19 20 21 22 ... 48 49 50 [K:12] [Next:7]
: 1 3 5 7 9 11 13 15 16 17 18 19 20 21 22 .. 47 48 49 50 [K:14] [Next:8]
: 1 3 5 7 9 11 13 15 17 18 19 20 21 22 ... 47 48 49 50 [K:16] [Next:9]
: 1 3 5 7 9 11 13 15 17 19 20 21 22 ... 46 47 48 49 50 [K:18] [Next:10]
: 1 3 5 7 9 11 13 15 17 19 21 22 23 24 25 26 27 28 ... 50 [K:20] [Next:11]
: 1 3 5 7 9 11 13 15 17 19 21 23 24 25 26 27 28 ... 49 50 [K:22] [Next:12]
: 1 3 5 7 9 11 13 15 17 19 21 23 25 26 27 28 ... 48 49 50 [K:24] [Next:13]
: 1 ... 25 27 28 29 30 31 32 33 34 35 36 37 38 39 ... 49 50 [K:26] [Next:14]
: 1 ... 25 27 29 30 31 32 33 34 35 36 37 38 39 40 ... 49 50 [K:28] [Next:15]
: 1 ... 25 27 29 31 32 33 34 35 36 37 38 39 40 41 ... 49 50 [K:30] [Next:16]
: 1 ... 25 27 29 31 33 34 35 36 37 38 39 40 41 42 ... 49 50 [K:32] [Next:17]
: 1 ... 25 27 29 31 33 35 36 37 38 39 40 41 42 43 ... 49 50 [K:34] [Next:18]
: 1 ... 25 27 29 31 33 35 37 38 39 40 41 42 43 44 ... 49 50 [K:36] [Next:19]
: 1 ... 25 27 29 31 33 35 37 39 40 41 42 43 44 45 ... 49 50 [K:38] [Next:20]
: 1 ... 25 27 29 31 33 35 37 39 41 42 43 44 45 46 47 48 49 50 [K:40] [Next:21]
: 1 ... 25 27 29 31 33 35 37 39 41 43 44 45 46 47 48 49 50 [K:42] [Next:22]
: 1 3 ... 25 27 29 31 33 35 37 39 41 43 45 46 47 48 49 50 [K:44] [Next:23]
: 1 3 5 7 ... 25 27 29 31 33 35 37 39 41 43 45 47 48 49 50 [K:46] [Next:24]
: 1 3 5 7 9 11 ... 25 27 29 31 33 35 37 39 41 43 45 47 49 50 [K:48] [Next:25]
: 1 3 5 7 9 11 13 15 ... 27 29 31 33 35 37 39 41 43 45 47 49 [K:50] [Next:0]
: 3 5 7 9 11 13 15 17 19 ... 29 31 33 35 37 39 41 43 45 47 49 [K:1] [Next:1]
: 3 7 9 11 13 15 17 19 21 23 ... 31 33 35 37 39 41 43 45 47 49 [K:5] [Next:2]
: 3 7 11 13 15 17 19 21 23 25 27 ... 33 35 37 39 41 43 45 47 49 [K:9] [Next:3]
: 3 7 11 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 [K:13] [Next:4]
: 3 7 11 15 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 [K:17] [Next:5]
: 3 7 11 15 19 23 25 27 29 31 33 35 37 39 41 43 45 47 49 [K:21] [Next:6]
: 3 7 11 15 19 23 27 29 31 33 35 37 39 41 43 45 47 49 [K:25] [Next:7]
: 3 7 11 15 19 23 27 31 33 35 37 39 41 43 45 47 49 [K:29] [Next:8]
: 3 7 11 15 19 23 27 31 35 37 39 41 43 45 47 49 [K:33] [Next:9]
: 3 7 11 15 19 23 27 31 35 39 41 43 45 47 49 [K:37] [Next:10]
: 3 7 11 15 19 23 27 31 35 39 43 45 47 49 [K:41] [Next:11]
: 3 7 11 15 19 23 27 31 35 39 43 47 49 [K:45] [Next:12]
: 3 7 11 15 19 23 27 31 35 39 43 47 [K:49] [Next:0]
: 7 11 15 19 23 27 31 35 39 43 47 [K:3] [Next:1]
: 7 15 19 23 27 31 35 39 43 47 [K:11] [Next:2]
: 7 15 23 27 31 35 39 43 47 [K:19] [Next:3]
: 7 15 23 31 35 39 43 47 [K:27] [Next:4]
: 7 15 23 31 39 43 47 [K:35] [Next:5]
: 7 15 23 31 39 47 [K:43] [Next:0]
: 15 23 31 39 47 [K:7] [Next:1]
: 15 31 39 47 [K:23] [Next:2]
: 15 31 47 [K:39] [Next:0]
: 31 47 [K:15] [Next:1]
: 31 [K:47] [Next:0]

The first line shows the initial state, and the index ready for elimination. The second line shows the result after we have removed the person at index 1. The removed person is show as «[K:2]», and then the updated index («Next: 2») ready for the next elimintaion. And so on until we are left with a single person.

I Got It Wrong^TM

The survivor is 37, and not 31 as I got. See the Challenge Review for details.

Challenge #48.2: Palindrome Dates

Wikipedia: «A palindrome is a word, number, phrase, or other sequence of characters which reads the same backward as forward, such as madam, racecar».

Let't try with brute force:

my $date = Date.new('2000-01-01',                                  # [1]
   formatter => { sprintf "%02d%02d%04d", .month, .day, .year });  # [2]

while $date.year < 3000                       # [3]
{
  say $date if $date.Str eq $date.Str.flip;   # [4]

  $date = $date.succ;                         # [5]
}

[1] We start with a «Date» object set at the very first date.

[2] We specify a custom formatter (used when we stringify the object), that gives us the date with the format specified in the challenge.

[3] As long as we haven't reached the year 3000,

[4] • print the date if it is a palindrome.

[5] • increase the date by one day. This is the same as «$date = $date.succ». We could also have written it as «$date = $date.later(days => 1)». The result (and time usage, which we'll cover shortly) is the same.

See docs.raku.org/type/Date for information about the «Date» class. The cusom formatter was copied verbatim from the «(Dateish) method formatter» section.

Running it:

raku palindrome-date-object
10022001
01022010
11022011
02022020
12022021
03022030
04022040
05022050
06022060
07022070
08022080
09022090
10122101
01122110
11122111
02122120
12122121
03122130
04122140
05122150
06122160
07122170
08122180
09122190
10222201
01222210
11222211
02222220
12222221
03222230
04222240
05222250
06222260
07222270
08222280
09222290

That took about 2 minutes and 15 seconds on my pc, which is bad.

But we can optimize it:

my $date = Date.new('2000-01-01',
   formatter => { sprintf "%02d%02d%04d", .month, .day, .year });

while $date.year < 3000
{
  my $date-str = $date.Str;
  say $date-str if $date-str eq $date-str.flip;

  $date = $date.later(days => 1);
}

The change (doing the stringification of the date only once for each date, instead of twice (and thrice if we print it)) reduces the time usage by about 1 minute (to 1 minute and 10 seconds). That is pretty good, but it is still way too much time.

The Smart Solution

• Legal month values are 01 .. 12 (giving M1: 0 .. 1)
• Legal day values are 01 .. 31 (giving D1: 0 .. 3)
• Legal year values are 2000 .. 2999 (giving Y1: 2)

• Y4 can only be 0 or 1 (from M1)
• Y2 can only be 0 .. 3 (from D1)
• D2 can only be 2 (from Y1)

Observe that the second digit in the day can only be «2». That means that the first digit cannot be «3» (as «32» is not a valid day), and we remove that from the list of possible values (in D1 and Y2):

Note that this removes the problem of illegal days. The only days we get are 02, 12 and 22, so the issue of month length (28, 29, 30 or 31) doesn't apply. That means that we don't have to check if the day is legal, and we can avoid the «Date» objects.

Almost there... This does not remove the problem of illegal months. We have to check for 0 (or «00») and 13..19 manually, but that is easy.

for 0..2 -> $y2            # [1]
{
  for 0..9 -> $y3          # [1]
  {
    for 0..1 -> $y4        # [1]
    {
      for 0..1 -> $m1      # [1]
      {
        for 0..9 -> $m2    # [1]
	{
          for 0..2 -> $d1  # [1]
	  {
	    next unless $m1 == $y4 && $m2 == $y3 && $d1 == $y2;  # [2]
	    next if $m1 == 0 && $m2 == 0;                        # [3]
    	    next if $m1 == 1 && $m2 > 2;                         # [4]
	    
	    say $m1 ~ $m2 ~ $d1 ~ '22' ~ $y2 ~ $y3 ~ $y4;        # [5]
	  }
	}
      }
    }
  }
}

[1] One loop for each of the 6 fields that can have more than one value. Note the order, so that we get the dates sorted with the oldest one first.

[2] This ensures that the date string stays the same when we flip it.

[3] Prevent month «00». Note that we could have written this more compact as «next if $m1 == 0 == $m2;».

[4] Prevent months 13 and above (13..19).

[4] Print the date.

The output is the same as before.

6 for-loops inside each other is rather extreme, but the program is very efficient - and it works beautifully. The output is the same as for the object version, and the program ran in less than 0.2 seconds. That is a very good speed up compared to the previous two versions.

And that's it.