langs a-z

Task/Five-weekends/NetRexx/five-weekends.netrexx

@@ -0,0 +1,46 @@
+/* NetRexx ************************************************************
+* 30.08.2012 Walter Pachl derived from Rexx version 3
+*                         omitting dead code left there
+**********************************************************************/
+options replace format comments java crossref savelog symbols
+Numeric digits 20
+nr5fwe=0
+years_without_5fwe=0
+mnl='Jan Mar May Jul Aug Oct Dec'
+ml='1 3 5 7 8 10 12'
+Loop j=1900 To 2100
+  year_has_5fwe=0
+  Loop mi=1 To ml.words()
+    m=ml.word(mi)
+    jd=greg2jul(j,m,1)
+    IF jd//7=4 Then Do                 /* 1st m j is a Friday */
+      nr5fwe=nr5fwe+1
+      year_has_5fwe=1
+      If j<=1905 | 2095<=j Then
+        Say mnl.word(mi) j 'has 5 full weekends'
+      End
+    End
+    If j=1905 Then Say '...'
+    if year_has_5fwe=0 Then years_without_5fwe=years_without_5fwe+1
+  End
+Say ' '
+Say nr5fwe 'occurrences of 5 full weekends in a month'
+Say years_without_5fwe 'years without 5 full weekends'
+exit
+
+method greg2jul(yy,mm,d) public static returns Rexx
+/***********************************************************************
+* Converts a Gregorian date to the corresponding Julian day number
+* 19891101 Walter Pachl REXXified algorithm published in CACM
+*                (Fliegel & vanFlandern, CACM Vol.11 No.10 October 1968)
+***********************************************************************/
+  numeric digits 12
+/***********************************************************************
+* The published formula:
+* res=d-32075+1461*(yy+4800+(mm-14)%12)%4+,
+*     367*(mm-2-((mm-14)%12)*12)%12-3*((yy+4900+(mm-14)%12)%100)%4
+***********************************************************************/
+  mma=(mm-14)%12
+  yya=yy+4800+mma
+  result=d-32075+1461*yya%4+367*(mm-2-mma*12)%12-3*((yya+100)%100)%4
+    Return result                   /* return the result              */

Task/Five-weekends/OCaml/five-weekends.ocaml

@@ -0,0 +1,27 @@
+open CalendarLib
+
+let list_first_five = function
+  | x1 :: x2 :: x3 :: x4 :: x5 :: _ -> [x1; x2; x3; x4; x5]
+  | _ -> invalid_arg "list_first_five"
+
+let () =
+  let months = ref [] in
+  for year = 1900 to 2100 do
+    for month = 1 to 12 do
+      let we = ref 0 in
+      let num_days = Date.days_in_month (Date.make_year_month year month) in
+      for day = 1 to num_days - 2 do
+        let d0 = Date.day_of_week (Date.make year month day)
+        and d1 = Date.day_of_week (Date.make year month (day + 1))
+        and d2 = Date.day_of_week (Date.make year month (day + 2)) in
+        if (d0, d1, d2) = (Date.Fri, Date.Sat, Date.Sun) then incr we
+      done;
+      if !we = 5 then months := (year, month) :: !months
+    done;
+  done;
+  Printf.printf "Number of months with 5 weekends: %d\n" (List.length !months);
+  print_endline "First and last months between 1900 and 2100:";
+  let print_month (year, month) = Printf.printf "%d-%02d\n" year month in
+  List.iter print_month (list_first_five (List.rev !months));
+  List.iter print_month (List.rev (list_first_five !months));
+;;

Task/Five-weekends/PARI-GP/five-weekends.pari

@@ -0,0 +1,20 @@
+fiveWeekends()={
+	my(day=6);	\\ 0 = Friday; this represents Thursday for March 1, 1900.
+	my(ny=[31,30,31,30,31,31,30,31,30,31,31,28],ly=ny,v,s);
+	ly[12]=29;
+	for(year=1900,2100,
+		v=if((year+1)%4,ny,ly);	\\ Works for 1600 to 2398
+		for(month=1,12,
+			if(v[month] == 31 && !day,
+				if(month<11,
+					print(year" "month+2)
+				,
+					print(year+1" 1")
+				);
+				s++
+			);
+			day = (day + v[month])%7
+		)
+	);
+	s
+};

Task/Five-weekends/PL-I/five-weekends.pli

@@ -0,0 +1,25 @@
+weekends: procedure options (main); /* 28/11/2011 */
+   declare tally fixed initial (0);
+   declare (d, dend, dn) fixed (10);
+   declare (date_start, date_end) picture '99999999';
+   declare Leap fixed (1);
+
+   date_start = '01011900';
+   do date_start = date_start to '01012100';
+      d        = days(date_start, 'DDMMYYYY');
+      date_end = date_start + 30110000;
+      dend     = days(date_end,   'DDMMYYYY');
+      Leap     = dend-d-364;
+      do dn = d, d+59+Leap, d+120+Leap, d+181+Leap, d+212+Leap,
+                 d+273+Leap, d+334+Leap;
+         if weekday(dn) = 6 then
+            do;
+               put skip list (daystodate(dn, 'MmmYYYY') || ' has 5 weekends' );
+               tally = tally + 1;
+            end;
+      end;
+   end;
+
+   put skip list ('Total number of months having 3-day weekends =', tally);
+
+end weekends;

Task/Five-weekends/Perl-6/five-weekends.pl6

@@ -0,0 +1,11 @@
+# A month has 5 weekends iff it has 31 days and starts on Friday.
+
+my @years = 1900 .. 2100;
+my @ym = @years X 1, 3, 5, 7, 8, 10, 12; # Months with 31 days
+
+my @happy = @ym.map({ Date.new: $^a, $^b, 1 }).grep: { .day-of-week == 5 };
+
+say 'Happy month count:  ',  +@happy;
+say 'First happy months: ' ~ @happy[^5];
+say 'Last  happy months: ' ~ @happy[*-5 .. *];
+say 'Dreary years count: ',  @years - @happy».year.uniq;

Task/Five-weekends/Pike/five-weekends.pike

@@ -0,0 +1,18 @@
+int(0..1) weekends(object day)
+{
+    return (<5,6,7>)[day->week_day()];
+}
+
+int(0..1) has5(object month)
+{
+    return sizeof(filter(month->days(), weekends))==15;
+}
+
+object range = Calendar.Year(1900)->distance(Calendar.Year(2101));
+array have5 = filter(range->months(), has5);
+
+write("found %d months:\n%{%s\n%}...\n%{%s\n%}",
+       sizeof(have5), have5[..4]->format_nice(), have5[<4..]->format_nice());
+
+array rest = range->years() - have5->year();
+write("%d years without any 5 weekend month:\n %{%d,%}\n", sizeof(rest), rest->year_no());

Task/Five-weekends/PureBasic/five-weekends.purebasic

@@ -0,0 +1,66 @@
+Procedure DateG(year.w, month.b, day)
+  ;Returns the number of days before or after the earliest reference date
+  ;in PureBasic's Date Library (1 Jan 1970) based on an assumed Gregorian calendar calculation
+  Protected days
+  days = (year) * 365 + (month - 1) * 31 + day - 1 - 719527 ;DAYS_UNTIL_1970_01_01 = 719527
+  If month >= 3
+    days - Int(0.4 * month + 2.3)
+  Else
+    year - 1
+  EndIf
+  days + Int(year/4) - Int(year/100) + Int(year/400)
+
+  ProcedureReturn days
+EndProcedure
+
+Procedure startsOnFriday(year, month)
+  ;0 is Sunday, 1 is Monday, ... 5 is Friday, 6 is Saturday
+  Protected referenceDay = DayOfWeek(Date(1970, 1, 1, 0, 0, 0)) ;link to the first day in the PureBasic's date library
+  Protected resultDay = (((DateG(year, month, 1) + referenceDay) % 7) + 7) % 7
+   If resultDay = 5
+    ProcedureReturn #True
+  EndIf
+EndProcedure
+
+Procedure has31Days(month)
+  Select month
+    Case 1, 3, 5, 7 To 8, 10, 12
+      ProcedureReturn #True
+  EndSelect
+EndProcedure
+
+Procedure checkMonths(year)
+  Protected month, count
+  For month = 1 To 12
+    If startsOnFriday(year, month) And has31Days(month)
+      count + 1
+      PrintN(Str(year) + " " + Str(month))
+    EndIf
+  Next
+  ProcedureReturn count
+EndProcedure
+
+Procedure fiveWeekends()
+  Protected startYear = 1900, endYear = 2100, year, monthTotal, total
+  NewList yearsWithoutFiveWeekends()
+
+  For year = startYear To endYear
+    monthTotal = checkMonths(year)
+    total + monthTotal
+    ;extra credit
+    If monthTotal = 0
+      AddElement(yearsWithoutFiveWeekends())
+      yearsWithoutFiveWeekends() = year
+    EndIf
+  Next
+
+   PrintN("Total number of months: " + Str(total) + #CRLF$)
+   PrintN("Years with no five-weekend months: " + Str(ListSize(yearsWithoutFiveWeekends())) )
+EndProcedure
+
+If OpenConsole()
+  fiveWeekends()
+
+  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf

Task/Five-weekends/Run-BASIC/five-weekends.run

@@ -0,0 +1,26 @@
+preYear = 1900
+for yyyy      = 1900 to 2100
+   for mm     = 1 to 12                ' go thru all 12 months
+      dayOne$ = mm;"-01-";yyyy         ' First day of month
+      n       = date$(dayOne$)         ' Days since 1700
+      dow     = 1 + (n mod 7)          ' Day of Week month begins
+      m1      = mm                     '
+      n1      = n + 27                 ' find end of month starting with 27th day
+      while   m1 = mm                  ' if month changes we have the end of the month
+         n1   = n1 + 1
+         n$   = date$(n1)
+         m1   = val(left$(n$,2))
+      wend
+      mmDays  = n1 - n                 ' Days in the Month
+      if dow  = 4 and mmDays = 31 then ' test for 5 weeks
+         count = count + 1
+         print using("###",count);" ";yyyy;"-";left$("0";mm,2)
+      end if
+
+   next mm
+   if preCount = count then
+     noCount = noCount + 1             ' count years that have none
+     print yyyy;" has none ";noCount
+   end if
+   preCount = count
+next yyyy

Task/Five-weekends/Seed7/five-weekends.seed7

@@ -0,0 +1,18 @@
+$ include "seed7_05.s7i";
+  include "time.s7i";
+
+const proc: main is func
+  local
+    var integer: months is 0;
+    var time: firstDayInMonth is time.value;
+  begin
+    for firstDayInMonth.year range 1900 to 2100 do
+      for firstDayInMonth.month range 1 to 12 do
+        if daysInMonth(firstDayInMonth) = 31 and dayOfWeek(firstDayInMonth) = 5 then
+          writeln(firstDayInMonth.year <& "-" <& firstDayInMonth.month lpad0 2);
+          incr(months);
+        end if;
+      end for;
+    end for;
+    writeln("Number of months:" <& months);
+  end func;

Task/Five-weekends/TUSCRIPT/five-weekends.tuscript

@@ -0,0 +1,7 @@
+$$ MODE TUSCRIPT
+LOOP year=1900,2100
+ LOOP month="1'3'5'7'8'10'12"
+ SET dayofweek=DATE (number,1,month,year,nummer)
+ IF (dayofweek==5) PRINT year,"-",month
+ ENDLOOP
+ENDLOOP

Task/Five-weekends/XPL0/five-weekends.xpl0

@@ -0,0 +1,38 @@
+include c:\cxpl\codes;                  \intrinsic 'code' declarations
+
+
+proc    WeekDay(Year, Month, Day);      \Return day of week (0=Sat 1=Sun..6=Fri)
+int     Year, Month, Day;
+[if Month<=2 then [Month:= Month+12;  Year:= Year-1];
+return rem((Day + (Month+1)*26/10 + Year + Year/4 + Year/100*6 + Year/400) / 7);
+];      \WeekDay
+
+
+int     MonthTbl, Year, I, C;
+[MonthTbl:= [1, 3, 5, 7, 8, 10, 12];            \months with 31 days
+C:= 0;
+for Year:= 1900 to 2100 do
+  for I:= 0 to 6 do                             \for all the 31-day months...
+    if WeekDay(Year, MonthTbl(I), 1) = 6 then   \first of month is a Friday
+        [C:= C+1;                               \count this year
+        if C<=5 or C>201-5 then                 \show first 5 and last 5 years
+                [IntOut(0, Year);  ChOut(0, ^ );
+                 IntOut(0, MonthTbl(I));  CrLf(0);
+                ];
+        ];
+IntOut(0, C);  CrLf(0);                         \show number of years
+
+\Count and show all years that don't have any 5-weekend months
+C:= 0;
+for Year:= 1900 to 2100 do
+        [for I:= 0 to 6 do                      \for all the 31-day months...
+            if WeekDay(Year, MonthTbl(I), 1) = 6 \Friday\ then
+                I:= 10;                         \bail out of 'for' loop
+        if I<10 then                            \'for' loop completed
+                [if (C&$F) = 0 then CrLf(0);    \(format 16 years per line)
+                C:= C+1;                        \ without finding a 5-weekend
+                IntOut(0, Year);  ChOut(0, ^ ); \ so show the year
+                ];
+        ];
+CrLf(0);  IntOut(0, C);  CrLf(0);               \show number of years
+]