This article has been moved from «perl6.eu» and updated to reflect the language rename in 2019.
This is my response to the Perl Weekly Challenge #19.
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 (as a Date
object),
[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.
See
docs.raku.org/type/Date for more information about the Date
class
and available methods.
See my Raku P(i)ermutations article for more information about «fmt».
Running it:
$ raku 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:
$ raku 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 Raku, 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.
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], using IO.e
to ensure that the file exist and
IO.r
to ensure that it is readable by the user.
[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.
See
docs.raku.org/routine/e
for more information about IO.e
.
See
docs.raku.org/routine/r
for more information about IO.e
.
Empty lines in the input is honoured, and result in empty lines in the output - at the same place.
$ raku greedy-wrap "qwe ksksk ksks" "slslsls kk ks"
qwe ksksk ksks slslsls kk ks
$ raku greedy-wrap "qwe ksksk ksks" "" "slslsls kk ks"
qwe ksksk ksks
slslsls kk ks
$ raku 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:
$ raku greedy-wrap --columns=10 "123456 123 123 123 123456789012345 123 123"
123456
123 123
123
123456789012345
123 123
And that's it.