Word Wrapped Weekends,
Perl 6 Edition

by Arne Sommer

Word Wrapped Weekends, Perl 6 Edition

Published 29. July 2019

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

Challenge #19.1

«Write a script to display months from the year 1900 to 2019 where you find 5 weekends i.e. 5 Friday, 5 Saturday and 5 Sunday.»

A first (working) version:

File: five-weekends-first
my @months;
    
for 1900 .. 2019 -> $year                # [1]
{
  for 1 .. 12 -> $month                  # [2]
  {
    my $date = Date.new($year, $month, 1);                    # [3]
    my @offset = [Nil,4,3,2,1,0,6,5];                         # [5]
    $date = $date.later(days => @offset[$date.day-of-week]);  # [4]

    my $new-date = $date.later(days => 30);                   # [6]

    @months.push( $date.year ~ "-" ~ $date.month.fmt('%02s') )
      if $new-date.month == $date.month;                      # [7]
   }
}

say "Months with five weekends: { @months.join(", ") }.";     # [8]

[1] Loop through the years,

[2] and the months.

[3] Start with the first day of the month,

[4] and add days so we get the first Friday in that month.

[5] The number of days to add is placed in an array, with the day number (on the form 1-7) as index.

[6] We add 30 days = 2 days (from Friday to Sunday) + 4 x 7 days (to a Sunday four weeks later).

[7] If the Sunday is in the same month, we have a match. I have used fmt('%02d') to get the month as two digits.

[8] Compact output.

Running it:

$ perl6 five-weekends-first
Months with five weekends: 1901-03, 1902-08, 1903-05, 1904-01, 1904-07, 1905-12,
1907-03, 1908-05, 1909-01, 1909-10, 1910-07, 1911-12, 1912-03, 1913-08, 1914-05,
1915-01, 1915-10, 1916-12, 1918-03, 1919-08, 1920-10, 1921-07, 1922-12, 1924-08,
1925-05, 1926-01, 1926-10, 1927-07, 1929-03, 1930-08, 1931-05, 1932-01, 1932-07,
1933-12, 1935-03, 1936-05, 1937-01, 1937-10, 1938-07, 1939-12, 1940-03, 1941-08,
1942-05, 1943-01, 1943-10, 1944-12, 1946-03, 1947-08, 1948-10, 1949-07, 1950-12,
1952-08, 1953-05, 1954-01, 1954-10, 1955-07, 1957-03, 1958-08, 1959-05, 1960-01,
1960-07, 1961-12, 1963-03, 1964-05, 1965-01, 1965-10, 1966-07, 1967-12, 1968-03,
1969-08, 1970-05, 1971-01, 1971-10, 1972-12, 1974-03, 1975-08, 1976-10, 1977-07,
1978-12, 1980-08, 1981-05, 1982-01, 1982-10, 1983-07, 1985-03, 1986-08, 1987-05,
1988-01, 1988-07, 1989-12, 1991-03, 1992-05, 1993-01, 1993-10, 1994-07, 1995-12,
1996-03, 1997-08, 1998-05, 1999-01, 1999-10, 2000-12, 2002-03, 2003-08, 2004-10,
2005-07, 2006-12, 2008-08, 2009-05, 2010-01, 2010-10, 2011-07, 2013-03, 2014-08,
2015-05, 2016-01, 2016-07, 2017-12, 2019-03.

But we can be smarter than this. The addition of 30 days is a clue. The two days can only be in the same month if the first one (a Friday) is the first day in the month. The last one is obviously the 31nd day, so the month must have 31 days.

Running a modified version of the Unix «cal» program on one of the matching months makes it (even more) obvious:

$ perl6 cal6 3 1901

    March 1901
Mo Tu We Th Fr Sa Su
             1  2  3
 4  5  6  7  8  9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31

This version of «cal» correctly (in my non-American view) regards Sunday as the seventh day of the week. I have written it in Perl6, and it is included in the zip file. (Specify a month and year, just a year, or nothing as arguments.)

File: five-weekends
my @months;

for 1900 .. 2019 -> $year
{
  for 1 .. 12 -> $month
  {
    my $date = Date.new($year, $month, 1);
    @months.push( $date.year ~ "-" ~ $date.month.fmt('%02s') )
      if $date.day-of-week == 5 && $date.days-in-month == 31;   # [1]
  }
}

say "Months with five weekends: { @months.join(", ") }.";

[1] We start with the first day of each month, and it is a match if that day is a Friday, and the month has 31 days.

The output is the same.

Challenge #19.2

«Write a script that can wrap the given paragraph at a specified column using the greedy algorithm

Here it is:

File: greedy-wrap
multi MAIN (*@strings, :$columns = 80)           # [1a]
{
  greedy-wrap(@strings, :$columns)
}

multi MAIN ($file where $file.IO.e && $file.IO.r, :$columns = 80) # [1b]
{
  greedy-wrap($file.IO.lines, :$columns)
}

sub greedy-wrap (*@strings, :$columns = 80)      # [1]
{
  my $out = "";                                  # [2]

  sub flush                                      # [3]
  {
    if $out
    {
      say $out;
      $out = "";  
    }
  }
  
  for @strings -> $string                         # [4]
  {
    if $string eq ""                              # [5]
    {
      flush;
      print "\n";
    }
    
    for $string.split(/\s+/) -> $word                    # [6]
    {
      flush if $out.chars + 1 + $word.chars >= $columns; # [7]
      
      $out = $out ?? "$out $word" !! $word;              # [8]
    }
  }
  flush;                                                 # [9]
}

[1] The «greedy-wrap» procedure takes one or more strings, and an optional value for the length. I have wrapped it in 2 «multi MAIN»s; one that takes one or more strings as arguments (on the command line) [1a], and the other that takes a file name to read the lines from [1b].

[2] This variable is used to build up the current line.

[3] This procedure flushes the current line variable (prints it, with a trailing newline), and does nothing if it is empty.

[4] Iterate over the strings.

[5] Flush if we have an empty line, and print a newline.

[6] Split on space characters (mainly: space, tab, newline) only.

[7] Flush if the addition of the next word (or rather «word») (and a space character) exceeds the column length.

[8] If we add a word, we prefix it with a space. If this is the first word on the line, skip that space.

[9] A final flush to get the last line.

Empty lines in the input is honoured, and result in empty lines in the output - at the same place.

$ perl6 greedy-wrap "qwe ksksk ksks" "slslsls kk ks"
qwe ksksk ksks slslsls kk ks
$ perl6 greedy-wrap "qwe ksksk ksks" "" "slslsls kk ks"
qwe ksksk ksks

slslsls kk ks
$ perl6 greedy-wrap --columns=10 "qwe ksksk ksks" "" "slslsls kk ks"
qwe ksksk
ksks

slslsls
kk ks

Words that are too long appear on a line of their own, and are not broken up:

$ perl6 greedy-wrap --columns=10 "123456 123 123 123 123456789012345 123 123"
123456
123 123
123
123456789012345
123 123

And that's it.