rebol [
	Title: "First Class Functions"
	URL: http://rosettacode.org/wiki/First-class_functions
]

; Functions "foo" and "bar" are used to prove that composition
; actually took place by attaching their signatures to the result.

foo: func [x][reform ["foo:" x]]
bar: func [x][reform ["bar:" x]]

cube:  func [x][x * x * x]
croot: func [x][power  x  1 / 3]

; "compose" means something else in REBOL, so I "fashion" an alternative.

fashion: func [f1 f2][
	do compose/deep [func [x][(:f1) (:f2) x]]]

A: [foo sine    cosine    cube]
B: [bar arcsine arccosine croot]

while [not tail? A][
	fn: fashion get A/1 get B/1
	source fn ; Prove that functions actually got composed.
	print [fn 0.5  crlf]

	A: next A  B: next B  ; Advance to next pair.
]


GET "libhdr"

LET start() BE $(

    FOR i=1 TO 100 DO $(

        TEST (i REM 15) = 0 THEN
            writes("FizzBuzz")
        ELSE TEST (i REM 3) = 0 THEN
            writes("Fizz")
        ELSE TEST (i REM 5) = 0 THEN
            writes("Buzz")
        ELSE
            writen(i, 0)

        newline()
    $)
$)


set fiveWeekendMonths to {}
set noFiveWeekendYears to {}

set someDate to current date
set day of someDate to 1

repeat with someYear from 1900 to 2100
  set year of someDate to someYear
  set foundOne to false
  repeat with someMonth in {January, March, May, July, ¬
                            August, October, December}
    set month of someDate to someMonth
    if weekday of someDate is Friday then
        set foundOne to true
        set end of fiveWeekendMonths to ¬
             (someYear as text) & "-" & (someMonth as text)
    end
  end repeat
  if not foundOne then
    set end of noFiveWeekendYears to someYear
  end
end repeat

set text item delimiters to ", "
set monthList to ¬
  (items 1 thru 5 of fiveWeekendMonths as text) & ", ..." & linefeed & ¬
   " ..., " & (items -5 thru end of fiveWeekendMonths as text)

set monthCount to count fiveWeekendMonths
set yearCount to count noFiveWeekendYears

set resultText to ¬
  "Months with five weekends (" & monthCount & "): " & linefeed & ¬
  "      " & monthList & linefeed & linefeed & ¬
  "Years with no such months (" & yearCount & "): "

set y to 1
repeat while y < yearCount
  set final to y+11
  if final > yearCount then
    set final to yearCount
  end
  set resultText to ¬
    resultText & linefeed & ¬
    "      " & (items y through final of noFiveWeekendYears as text)
  set y to y + 12
end
resultText


package require Tcl 8.5

# Build a grid
proc makeGrid {w h {treeProbability 0.5}} {
    global grid gridW gridH
    set gridW $w
    set gridH $h
    set grid [lrepeat $h [lrepeat $w " "]]
    for {set x 0} {$x < $w} {incr x} {
	for {set y 0} {$y < $h} {incr y} {
	    if {rand() < $treeProbability} {
		lset grid $y $x "#"
	    }
	}
    }
}

# Evolve the grid (builds a copy, then overwrites)
proc evolveGrid {{fireProbability 0.01} {plantProbability 0.05}} {
    global grid gridW gridH
    set newGrid {}
    for {set y 0} {$y < $gridH} {incr y} {
	set row {}
	for {set x 0} {$x < $gridW} {incr x} {
	    switch -exact -- [set s [lindex $grid $y $x]] {
		" " {
		    if {rand() < $plantProbability} {
			set s "#"
		    }
		}
		"#" {
		    if {[burningNeighbour? $x $y] || rand() < $fireProbability} {
			set s "o"
		    }
		}
		"o" {
		    set s " "
		}
	    }
	    lappend row $s
	}
	lappend newGrid $row
    }
    set grid $newGrid
}

# We supply the neighbourhood model as an optional parameter (not used...)
proc burningNeighbour? {
    x y
    {neighbourhoodModel {-1 -1  -1 0  -1 1  0 -1  0 1  1 -1  1 0  1 1}}
} {
    global grid gridW gridH
    foreach {dx dy} $neighbourhoodModel {
	set i [expr {$x + $dx}]
	if {$i < 0 || $i >= $gridW} continue
	set j [expr {$y + $dy}]
	if {$j < 0 || $j >= $gridH} continue
	if {[lindex $grid $j $i] eq "o"} {
	    return 1
	}
    }
    return 0
}

proc printGrid {} {
    global grid
    foreach row $grid {
	puts [join $row ""]
    }
}

# Simple main loop; press Return for the next step or send an EOF to stop
makeGrid 70 8
while 1 {
    evolveGrid
    printGrid
    if {[gets stdin line] < 0} break
}


/*REXX program demonstrates first─class functions (as a list of the names of functions).*/
A = 'd2x   square   sin    cos'                  /*a list of  functions  to demonstrate.*/
B = 'x2d   sqrt     Asin   Acos'                 /*the inverse functions of above list. */
w=digits()                                       /*W:  width of numbers to be displayed.*/
                                                 /* [↓]  collection of  A & B  functions*/
     do j=1  for words(A);      say;       say   /*step through the list;  2 blank lines*/
     say center("number",w)     center('function', 3*w+1)     center("inverse", 4*w)
     say copies("─"     ,w)     copies("─",        3*w+1)     copies("─",       4*w)
     if j<2   then call test j, 20  60   500     /*functions  X2D, D2X:  integers only. */
              else call test j, 0  0.5  1  2     /*all other functions:  floating point.*/
     end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Acos:    procedure; parse arg x; if x<-1|x>1  then call AcosErr;    return .5*pi()-Asin(x)
r2r:     return arg(1) // (pi()*2)               /*normalize radians ──► 1 unit circle*/
square:  return arg(1) ** 2
pi:      pi=3.14159265358979323846264338327950288419716939937510582097494459230; return pi
tellErr: say;   say '*** error! ***';  say;  say arg(1);  say;  exit 13
tanErr:  call tellErr 'tan(' || x") causes division by zero, X="             ||  x
AsinErr: call tellErr 'Asin(x),  X  must be in the range of  -1 ──► +1,  X=' ||  x
AcosErr: call tellErr 'Acos(x),  X  must be in the range of  -1 ──► +1,  X=' ||  x
/*──────────────────────────────────────────────────────────────────────────────────────*/
Asin:    procedure; parse arg x;  if x<-1 | x>1  then call AsinErr;   s=x*x
             if abs(x)>=.7  then return sign(x)*Acos(sqrt(1-s));      z=x;  o=x;  p=z
                      do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end
             return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
cos:     procedure; parse arg x;   x=r2r(x);          a=abs(x);         Hpi=pi*.5
             numeric fuzz min(6,digits()-3);          if a=pi()    then return -1
             if a=Hpi | a=Hpi*3  then return  0 ;     if a=pi()/3  then return .5
             if a=pi()*2/3       then return -.5;                  return .sinCos(1,1,-1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
sin:     procedure; parse arg x;   x=r2r(x);          numeric fuzz min(5, digits()-3)
             if abs(x)=pi()  then return 0;                        return .sinCos(x,x,1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
.sinCos: parse arg z 1 p,_,i;  x=x*x
             do k=2  by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p  then leave; p=z; end; return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
invoke:  parse arg fn,v;  q='"';  if datatype(v,"N")  then q=
             _=fn || '('q || v || q")";          interpret 'func='_;           return func
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt:    procedure; parse arg x;  if x=0  then return 0;  d=digits();  m.=9;  numeric form
         numeric digits; parse value format(x,2,1,,0) 'E0'  with  g 'E' _ .;  g=g*.5'e'_%2
         h=d+6;     do j=0  while h>9;      m.j=h;               h=h%2+1;        end /*j*/
                    do k=j+5  to 0  by -1;  numeric digits m.k;  g=(g+x/g)*.5;   end /*k*/
         numeric digits d;                  return g/1
/*──────────────────────────────────────────────────────────────────────────────────────*/
test:    procedure expose A B w;  parse arg fu,xList;     d=digits() /*xList:  numbers. */
                 do k=1  for words(xList);          x=word(xList, k)
                 numeric digits d+5                                  /*higher precision.*/
                 fun=word(A, fu);  funV=invoke(fun, x)   ;  [email protected]=_
                 inv=word(B, fu);  invV=invoke(inv, funV);  [email protected]=_
                 numeric digits d                                    /*restore precision*/
                 if datatype(funV, 'N')  then funV=funV/1            /*round to digits()*/
                 if datatype(invV, 'N')  then invV=invV/1            /*round to digits()*/
                 say center(x, w)   right([email protected], 2*w)'='left(left('', funV>=0)funV, w),
                                    right([email protected], 3*w)'='left(left('', invV>=0)invV, w)
                 end   /*k*/
         return


               >     q
        >@F5~%"[email protected]{  >  @F     q
_1>F3~%'d`Fizz`@F5~%'d >`Buzz`@FNp
  ;[email protected][email protected]                P<


Year := 1900
End_Year := 2100
31_Day_Months = 01,03,05,07,08,10,12

While Year <= End_Year
  {
    Loop, Parse, 31_Day_Months, CSV
      {
        FormatTime, Day, %Year%%A_LoopField%01, dddd
        IfEqual, Day, Friday
          {
            All_Months_With_5_Weekends .=  A_LoopField . "/" . Year ",    "
            5_Weekend_Count++
            Year_Has_5_Weekend_Month := 1
          }
      }
   IfEqual, Year_Has_5_Weekend_Month, 0
      {
        All_Years_Without_5_Weekend .= Year ",   "
        No_5_Weekend_Count ++
      }
   Year ++
   Year_Has_5_Weekend_Month := 0
  }
; Trim the spaces and comma off the last item.
StringTrimRight, All_Months_With_5_Weekends, All_Months_With_5_Weekends, 5
StringTrimRight, All_Years_Without_5_Weekend, All_Years_Without_5_Weekend, 4
MsgBox,
(
Months with 5 day weekends between 1900 and 2100 : %5_Weekend_Count%
%All_Months_With_5_Weekends%
)
MsgBox,
(
Years with no 5 day weekends between 1900 and 2100 : %No_5_Weekend_Count%
%All_Years_Without_5_Weekend%
)


#include <Date.au3>
#include <Array.au3>
$array = Five_weekends(1)
_ArrayDisplay($array)
$array = Five_weekends(2)
_ArrayDisplay($array)
$array = Five_weekends(3)
_ArrayDisplay($array)

Func Five_weekends($ret = 1)
	If $ret < 1 Or $ret > 3 Then Return SetError(1, 0, 0)
	Local $avDateArray[1]
	Local $avYearArray[1]
	Local $avMonthArray[1]
	For $iYear = 1900 To 2100
		Local $checkyear = False
		For $iMonth = 1 To 12
			If _DateDaysInMonth($iYear, $iMonth) <> 31 Then ContinueLoop ; Month has less then 31 Days
			If _DateToDayOfWeek($iYear, $iMonth, "01") <> 6 Then ContinueLoop ;First Day is not a Friday
			_ArrayAdd($avMonthArray, $iYear & "-" & _DateToMonth($iMonth))
			$checkyear = True
			For $s = 1 To 31
				Local $Date = _DateToDayOfWeek($iYear, $iMonth, $s)
				If $Date = 6 Or $Date = 7 Or $Date = 1 Then ; if Date is Friday, Saturday or Sunday
					_ArrayAdd($avDateArray, $iYear & "\" & StringFormat("%02d", $iMonth) & "\" & StringFormat("%02d", $s))
				EndIf
			Next
		Next
		If Not $checkyear Then _ArrayAdd($avYearArray, $iYear)
	Next
	$avDateArray[0] = UBound($avDateArray) - 1
	$avYearArray[0] = UBound($avYearArray) - 1
	$avMonthArray[0] = UBound($avMonthArray) - 1
	If $ret = 1 Then
		Return $avDateArray
	ElseIf $ret = 2 Then
		Return $avYearArray
	ElseIf $ret = 3 Then
		Return $avMonthArray
	EndIf
EndFunc   ;==>Five_weekends


B = 1                                  ' A burning tree
E = 16                                 ' An empty space
T = 256                                ' A living tree

Input "%Chance a tree will burn: ";F   ' Enter chance of combustion
Input "%Chance a tree will grow: ";P   ' Enter chance of a new tree

Proc _CreateForest                     ' Now create a new forest

Do
  Proc _PrintForest                    ' Print the current forest
  Input "Press '1' to continue, '0' to quit: ";A
  Proc _BurnForest                     ' See what happens
  Proc _UpdateForest                   ' Update from buffer
  While A                              ' Until the user has enough
Loop                                   ' and answers with zero

End

_CreateForest                          ' Create an entire new forest
  Local(1)

  For [email protected] = 0 to 120                    ' For each main cell determine
    If RND(100) < P Then               ' if a tree will grow here
      @([email protected]) = T                        ' Ok, we got a tree
    Else                               ' Otherwise it remains empty
      @([email protected]) = E
    EndIf
  Next
Return

_BurnForest                            ' Now the forest starts to burn
  Local(2)

  For [email protected] = 0 To 10                     ' Loop vertical
    For [email protected] = 0 To 10                   ' Loop horizontal
      If @(([email protected] * 11) + [email protected]) = B Then @(([email protected] * 11) + [email protected] + 121) = E
                                       ' A tree has been burned flat
      If @(([email protected] * 11) + [email protected]) = E Then    ' For each open space determine
        If RND(100) < P Then           ' if a tree will grow here
          @(([email protected] * 11) + [email protected] + 121) = T
        Else                           ' Otherwise it remains an empty space
          @(([email protected] * 11) + [email protected] + 121) = E
        EndIf
      EndIf

      If @(([email protected] * 11) + [email protected]) = T Then    ' A tree grows here
        If RND(100) < F Then           ' See if it will spontaneously combust
          @(([email protected] * 11) + [email protected] + 121) = B
        Else                           ' No, then see if it got any burning
          @(([email protected] * 11) + [email protected] + 121) = FUNC(_BurningTrees([email protected], [email protected]))
        EndIf                          ' neighbors that will set it ablaze
      EndIf

    Next
  Next
Return

_UpdateForest                          ' Update the main buffer
  Local(1)

  For [email protected] = 0 To 120                    ' Move from temporary buffer to main
    @([email protected]) = @([email protected]+121)
  Next
Return

_PrintForest                           ' Print the forest on screen
  Local(2)
  Print                                ' Let's make a little space

  For [email protected] = 0 To 10                     ' Loop vertical
    For [email protected] = 0 To 10                   ' Loop horizontal
      If @(([email protected] * 11) + [email protected]) = B Then    ' This is a burning tree
        Print " *";
      Else                             ' Otherwise..
        If @(([email protected] * 11) + [email protected]) = E Then  ' It may be an empty space
          Print "  ";
        Else                           ' Otherwise
          Print " @";                  ' It has to be a tree
        EndIf
      EndIf
    Next
    Print                              ' Terminate row
  Next

  Print                                ' Terminate map
Return

_BurningTrees Param(2)                 ' Check the trees environment
  Local(2)

  For [email protected] = [email protected] To [email protected]+1                ' Loop vertical -1/+1
    If [email protected] < 0 Then Continue            ' Skip top edge
  Until [email protected] > 10                        ' End at bottom edge
    For [email protected] = [email protected] To [email protected]+1              ' Loop horizontal -1/+1
      If [email protected] < 0 Then Continue          ' Skip left edge
    Until [email protected] > 10                      ' End at right edge
      If @(([email protected] * 11) + [email protected]) = B Then Unloop : Unloop : Return (B)
    Next                               ' We found a burning tree, exit!
  Next                                 ' Try next row

Return (T)                             ' No burning trees found


#1 = 25         // height of the grid
#2 = 60         // width of the grid
#3 = 2          // probability of random fire, per 1000
#4 = 40         // probability of new tree, per 1000

#5 = #2+2+Newline_Chars                 // total length of a line
#90 = Time_Tick                         // seed for random number generator
#91 = 1000                              // get random numbers in range 0 to 999

// Fill the grid and draw border
Buf_Switch(Buf_Free)
Ins_Char('-', COUNT, #2+2)
Ins_Newline
for (#11=0; #11<#1; #11++) {
    Ins_Char('|')
    for (#12=0; #12<#2; #12++) {
        Call("RANDOM")
        if (Return_Value < 500) {               // 50% propability for a tree
            Ins_Char('♠')
        } else {
            Ins_Char(' ')
        }
    }
    Ins_Char('|')
    Ins_Newline
}
Ins_Char('-', COUNT, #2+2)

#8=1
Repeat(10) {
    BOF
    Update()
    // calculate one generation
    for (#11=1; #11<#1+2; #11++) {
        Goto_Line(#11)
        for (#12=1; #12<#2+2; #12++) {
            Goto_Col(#12)
            #14=Cur_Pos
            Call("RANDOM")
            #10 = Return_Value
            if (Cur_Char == '♠') {                      // tree?
                if (#10 < #3) {
                    Ins_Char('*', OVERWRITE)            // random combustion
                } else {
                    if (Search_Block("░", CP-#5-1, CP+#5+2, COLUMN+BEGIN+NOERR)) {
                        Goto_Pos(#14)
                        Ins_Char('*', OVERWRITE)        // combustion
                    }
                }
            } else {
                if (Cur_Char == ' ') {                  // empty space?
                    if (#10 < #4) {
                        Ins_Char('+', OVERWRITE)        // new tree
                    }
                }
            }
        }
    }
    // convert tmp symbols
    Replace("░"," ", BEGIN+ALL+NOERR)           // old fire goes out
    Replace("*","░", BEGIN+ALL+NOERR)           // new fire
    Replace("+","♠", BEGIN+ALL+NOERR)           // new tree
}
Return

//--------------------------------------------------------------
// Generate random numbers in range 0 <= Return_Value < #91
//  #90 = Seed    (0 to 0x7fffffff)
//  #91 = Scaling (0 to 0xffff)

:RANDOM:
#92 = 0x7fffffff / 48271
#93 = 0x7fffffff % 48271
#90 = (48271 * (#90 % #92) - #93 * (#90 / #92)) & 0x7fffffff
return ((#90 & 0xffff) * #91 / 0x10000)


cube = proc{|x| x ** 3}
croot = proc{|x| x ** (1.quo 3)}
compose = proc {|f,g| proc {|x| f[g[x]]}}
funclist = [Math.method(:sin), Math.method(:cos), cube]
invlist = [Math.method(:asin), Math.method(:acos), croot]

puts funclist.zip(invlist).map {|f, invf| compose[invf, f][0.5]}


#![feature(conservative_impl_trait)]
fn main() {
    let cube      = |x: f64| x.powi(3);
    let cube_root = |x: f64| x.powf(1.0 / 3.0);

    let flist  : [&Fn(f64) -> f64; 3] = [&cube     , &f64::sin , &f64::cos ];
    let invlist: [&Fn(f64) -> f64; 3] = [&cube_root, &f64::asin, &f64::acos];

    let result = flist.iter()
                      .zip(&invlist)
                      .map(|(f,i)| compose(f,i)(0.5))
                      .collect::<Vec<_>>();

    println!("{:?}", result);

}

fn compose<'a, F, G, T, U, V>(f: F, g: G) -> impl 'a + Fn(T) -> V
    where F: 'a + Fn(T) -> U,
          G: 'a + Fn(U) -> V,
{
    move |x| g(f(x))

}


import math._

// functions as values
val cube = (x: Double) => x * x * x
val cuberoot = (x: Double) => pow(x, 1 / 3d)

// higher order function, as a method
def compose[A,B,C](f: B => C, g: A => B) = (x: A) => f(g(x))

// partially applied functions in Lists
val fun = List(sin _, cos _, cube)
val inv = List(asin _, acos _, cuberoot)

// composing functions from the above Lists
val comp = (fun, inv).zipped map (_ compose _)

// output results of applying the functions
comp foreach {f => print(f(0.5) + "   ")}


for i = 0; i <= 100; i++
    out = ""
    if i % 3 == 0
        out = "Fizz"
    end
    if i % 5 == 0
        out = out + "Buzz"
    end
    if out == ""
        out = i
    end
    print(out)
end


# usage:  awk -f 5weekends.awk  cal.txt

# Filter a file of month-calendars, such as
# ...
##        January 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
# ...
##         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 file is generated by a script for the unix-shell,
# see http://rosettacode.org/wiki/Five_weekends#UNIX_Shell

BEGIN   { print("# Month with 5 weekends:")
          badYears = numW5 = 0;
          lastW5 = -1
        }

0+$2>33 { if( $2>currYear ) {       # calendar-header: month, year
            if( lastW5==numW5 ) {
              badYears++; sep="\n"
              if( badYears % 10 ) { sep=" " }
              bY=bY currYear sep;   # collect years in string
            ##print badYears,":", currYear
            }
            lastW5=numW5
          }
          WE=0; currYear=$2; currMY = $1 " " $2;
        ##print currMY;
          next
        }

/^Mo/   { next }                    # skip lines with weekday-names

        { $0 = substr($0,13) }      # cut inputline, leave  Fr,Sa,Su only

NF>2    { WE++;                     # 3 fields left => complete weekend found
          if( WE>4 ) {
            numW5++; printf("%4d : %s\n", numW5, currMY)
          }
        }

END     { print("# Found", numW5, "month with 5 weekends.")
          print("# Found", badYears, "years with no month having 5 weekends:")
          print(bY)
        }


      INSTALL @lib$+"DATELIB"
      DIM Month$(12)
      Month$() = "","January","February","March","April","May","June", \
      \   "July","August","September","October","November","December"

      num% = 0
      FOR year% = 1900 TO 2100
        PRINT ; year% ": " ;
        oldnum% = num%
        FOR month% = 1 TO 12
          IF FN_dim(month%,year%) = 31 IF FN_dow(FN_mjd(1,month%,year%)) = 5 THEN
            num% += 1
            PRINT Month$(month%), ;
          ENDIF
        NEXT
        IF num% = oldnum% PRINT "(none)" ELSE PRINT
      NEXT year%
      PRINT "Total = " ; num%


import rand
import strings
import os

const (
    rows = 20
    cols = 30
    p    = .01
    f    = .001
)

const rx = rows + 2
const cx = cols + 2

fn main() {
    mut odd := []string{len: rx*cx}
    mut even := []string{len: rx*cx}
    for r := 1; r <= rows; r++ {
        for c := 1; c <= cols; c++ {
            if rand.intn(2) or {1} == 1 {
                odd[r*cx+c] = 'T'
            }
        }
    }
    mut _ := ''
    for {
        print_row(odd)
        step(mut even, odd)
        _ = os.input('')

        print_row(even)
        step(mut odd, even)
        _ = os.input('')
    }
}

fn print_row(model []string) {
    println(strings.repeat_string("__", cols))
    println('')
    for r := 1; r <= rows; r++ {
        for c := 1; c <= cols; c++ {
            if model[r*cx+c] == '0' {
                print("  ")
            } else {
                print(" ${model[r*cx+c]}")
            }
        }
        println('')
    }
}

fn step(mut dst []string, src []string) {
    for r := 1; r <= rows; r++ {
        for c := 1; c <= cols; c++ {
            x := r*cx + c
            dst[x] = src[x]
            match dst[x] {
                '#' {
                    // rule 1. A burning cell turns into an empty cell
                    dst[x] = '0'
                }
                'T' {
                    // rule 2. A tree will burn if at least one neighbor is burning
                    if src[x-cx-1]=='#'  || src[x-cx]=='#' || src[x-cx+1]=='#' ||
                    src[x-1] == '#'  ||                   src[x+1] == '#'  ||
                    src[x+cx-1]=='#' || src[x+cx]=='#' || src[x+cx+1] == '#' {
                        dst[x] = '#'

                    // rule 3. A tree ignites with probability f
                    // even if no neighbor is burning
                    } else if rand.f64() < f {
                        dst[x] = '#'
                    }
                }
                else {
                    // rule 4. An empty space fills with a tree with probability p
                    if rand.f64() < p {
                        dst[x] = 'T'
                    }
                }
            }
        }
    }
}


import "random" for Random
import "io" for Stdin

var rand = Random.new()
var rows = 20
var cols = 30
var p    = 0.01
var f    = 0.001
var rx   = rows + 2
var cx   = cols + 2

var step = Fn.new { |dst, src|
    for (r in 1..rows) {
        for (c in 1..cols) {
            var x = r*cx + c
            dst[x] = src[x]
            if (dst[x] == "#") {
                // rule 1. A burning cell turns into an empty cell
                dst[x] = " "
            } else if(dst[x] == "T") {
                // rule 2. A tree will burn if at least one neighbor is burning
                if (src[x-cx-1] == "#"  || src[x-cx] == "#" || src[x-cx+1] == "#" ||
                    src[x-1] == "#"     || src[x+1] == "#"  ||
                    src[x+cx-1] == "#"  || src[x+cx] == "#" || src[x+cx+1] == "#") {
                    dst[x] = "#"
                    // rule 3. A tree ignites with probability f
                    // even if no neighbor is burning
                } else if (rand.float() < f) {
                    dst[x] = "#"
                }
            } else {
                // rule 4. An empty space fills with a tree with probability p
                if (rand.float() < p) dst[x] = "T"
            }
        }
    }
}

var print = Fn.new { |model|
    System.print("__" * cols)
    System.print()
    for (r in 1..rows) {
        for (c in 1..cols) System.write(" %(model[r*cx+c])")
        System.print()
    }
}

var odd  = List.filled(rx*cx, " ")
var even = List.filled(rx*cx, " ")
for (r in 1 ..rows) {
    for (c in 1..cols) {
        if (rand.int(2) == 1) odd[r*cx+c] = "T"
    }
}
while (true) {
    print.call(odd)
    step.call(even, odd)
    Stdin.readLine()

    print.call(even)
    step.call(odd, even)
    Stdin.readLine()
}


(define (compose f g) (lambda (x) (f (g x))))
(define (cube x) (expt x 3))
(define (cube-root x) (expt x (/ 1 3)))

(define function (list sin cos cube))
(define inverse (list asin acos cube-root))

(define x 0.5)
(define (go f g)
  (if (not (or (null? f)
               (null? g)))
      (begin (display ((compose (car f) (car g)) x))
             (newline)
             (go (cdr f) (cdr g)))))

(go function inverse)


func compose(f,g) {
    func (*args) {
        f(g(args...))
    }
}

var cube  = func(a) { a.pow(3) }
var croot = func(a) { a.root(3) }

var flist1 = [Num.method(:sin),  Num.method(:cos),  cube]
var flist2 = [Num.method(:asin), Num.method(:acos), croot]

for a,b (flist1 ~Z flist2) {
    say compose(a, b)(0.5)
}


#include <stdio.h>
#include <time.h>

static const char *months[] = {"January", "February", "March", "April", "May",
    "June", "July", "August", "September", "October", "November", "December"};
static int long_months[] = {0, 2, 4, 6, 7, 9, 11};

int main() {
    int n = 0, y, i, m;
    struct tm t = {0};
    printf("Months with five weekends:\n");
    for (y = 1900; y <= 2100; y++) {
        for (i = 0; i < 7; i++) {
            m = long_months[i];
            t.tm_year = y-1900;
	    t.tm_mon = m;
	    t.tm_mday = 1;
            if (mktime(&t) == -1) { /* date not supported */
                printf("Error: %d %s\n", y, months[m]);
                continue;
            }
            if (t.tm_wday == 5) { /* Friday */
                printf("  %d %s\n", y, months[m]);
                n++;
            }
        }
    }
    printf("%d total\n", n);
    return 0;
}


L(base) 2..16
   V n = Int64(Float(base) ^ ((base - 1) / 2))
   L
      V sq = n * n
      V sqstr = String(sq, radix' base)
      I sqstr.len >= base & Set(Array(sqstr)).len == base
         V nstr = String(n, radix' base)
         print(‘Base #2:  #8^2 = #.’.format(base, nstr, sqstr))
         L.break
      n++


[email protected](Method traits) ** [email protected](Method traits)
"Answers a new Method whose effect is that of calling the first method
on the results of the second method applied to whatever arguments are passed.
This composition is associative, i.e. (a ** b) ** c = a ** (b ** c).
When the second method, n, does not take a *rest option or the first takes
more than one input, then the output is chunked into groups for its
consumption. E.g.:
#; `er ** #; `er applyTo: {'a'. 'b'. 'c'. 'd'} => 'abcd'
#; `er ** #name `er applyTo: {#a. #/}. => 'a/'"
[
  n acceptsAdditionalArguments \/ [m arity = 1]
    ifTrue:
      [[| *args | m applyTo: {n applyTo: args}]]
    ifFalse:
      [[| *args |
        m applyTo:
          ([| :stream |
             args do: [| *each | stream nextPut: (n applyTo: each)]
                  inGroupsOf: n arity] writingAs: {})]]
].

#**`er asMethod: #compose: on: {Method traits. Method traits}.


|forward reverse composer compounds|
"commodities"
Number extend [
   cube [ ^self raisedTo: 3 ]
].
Number extend [
   cubeRoot [ ^self raisedTo: (1 / 3) ]
].

forward := #( #cos #sin #cube ).
reverse := #( #arcCos #arcSin #cubeRoot ).

composer := [ :f :g | [ :x | f value: (g value: x) ] ].

"let us create composed funcs"
compounds := OrderedCollection new.

1 to: 3 do: [ :i |
  compounds add: ([ :j | composer value: [ :x | x perform: (forward at: j) ]
                                  value: [ :x | x perform: (reverse at: j) ] ] value: i)
].

compounds do: [ :r | (r value: 0.5) displayNl ].


def fizzbuzz(size):
    for i in range(1, size):
        if i%15 == 0:
            print 'FizzBuzz'
        elif i%5 == 0:
            print 'Buzz'
        elif i%3 == 0:
            print 'Fizz'
        else:
            print i

fizzbuzz(101)


using System;

namespace _5_Weekends
{
    class Program
    {
        const int FIRST_YEAR = 1900;
        const int LAST_YEAR = 2100;
        static int[] _31_MONTHS = { 1, 3, 5, 7, 8, 10, 12 };

        static void Main(string[] args)
        {
            int totalNum = 0;
            int totalNo5Weekends = 0;

            for (int year = FIRST_YEAR; year <= LAST_YEAR; year++)
            {
                bool has5Weekends = false;

                foreach (int month in _31_MONTHS)
                {
                    DateTime firstDay = new DateTime(year, month, 1);
                    if (firstDay.DayOfWeek == DayOfWeek.Friday)
                    {
                        totalNum++;
                        has5Weekends = true;
                        Console.WriteLine(firstDay.ToString("yyyy - MMMM"));
                    }
                }

                if (!has5Weekends) totalNo5Weekends++;
            }
            Console.WriteLine("Total 5-weekend months between {0} and {1}: {2}", FIRST_YEAR, LAST_YEAR, totalNum);
            Console.WriteLine("Total number of years with no 5-weekend months {0}", totalNo5Weekends);
        }
    }
}


#include <vector>
#include <boost/date_time/gregorian/gregorian.hpp>
#include <algorithm>
#include <iostream>
#include <iterator>
using namespace boost::gregorian ;

void print( const date &d ) {
   std::cout << d.year( ) << "-" << d.month( ) << "\n" ;
}

int main( ) {
   greg_month longmonths[ ] = {Jan, Mar , May , Jul ,
      Aug , Oct , Dec } ;
   int monthssize = sizeof ( longmonths ) / sizeof (greg_month ) ;
   typedef std::vector<date> DateVector ;
   DateVector weekendmonster ;
   std::vector<unsigned short> years_without_5we_months ;
   for ( unsigned short i = 1900 ; i < 2101 ; i++ ) {
      bool months_found = false ; //does a given year have 5 weekend months ?
      for ( int j = 0 ; j < monthssize ; j++ ) {
	 date d ( i , longmonths[ j ] , 1 ) ;
	 if ( d.day_of_week( ) == Friday ) {  //for the month to have 5 weekends
	    weekendmonster.push_back( d ) ;
	    if ( months_found == false )
	       months_found = true ;
         }
      }
      if ( months_found == false ) {
	 years_without_5we_months.push_back( i ) ;
      }
   }
   std::cout << "Between 1900 and 2100 , there are " << weekendmonster.size( )
      << " months with 5 complete weekends!\n" ;
   std::cout << "Months with 5 complete weekends are:\n" ;
   std::for_each( weekendmonster.begin( ) , weekendmonster.end( ) , print ) ;
   std::cout <<  years_without_5we_months.size( ) << " years had no months with 5 complete weekends!\n" ;
   std::cout << "These are:\n" ;
   std::copy( years_without_5we_months.begin( ) , years_without_5we_months.end( ) ,
	 std::ostream_iterator<unsigned short>( std::cout , "\n" ) ) ;
   std::cout << std::endl ;
   return 0 ;
}


#include <stdio.h>
#include <string.h>

#define BUFF_SIZE 32

void toBaseN(char buffer[], long long num, int base) {
    char *ptr = buffer;
    char *tmp;

    // write it backwards
    while (num >= 1) {
        int rem = num % base;
        num /= base;

        *ptr++ = "0123456789ABCDEF"[rem];
    }
    *ptr-- = 0;

    // now reverse it to be written forwards
    for (tmp = buffer; tmp < ptr; tmp++, ptr--) {
        char c = *tmp;
        *tmp = *ptr;
        *ptr = c;
    }
}

int countUnique(char inBuf[]) {
    char buffer[BUFF_SIZE];
    int count = 0;
    int pos, nxt;

    strcpy_s(buffer, BUFF_SIZE, inBuf);

    for (pos = 0; buffer[pos] != 0; pos++) {
        if (buffer[pos] != 1) {
            count++;
            for (nxt = pos + 1; buffer[nxt] != 0; nxt++) {
                if (buffer[nxt] == buffer[pos]) {
                    buffer[nxt] = 1;
                }
            }
        }
    }

    return count;
}

void find(int base) {
    char nBuf[BUFF_SIZE];
    char sqBuf[BUFF_SIZE];
    long long n, s;

    for (n = 2; /*blank*/; n++) {
        s = n * n;
        toBaseN(sqBuf, s, base);
        if (strlen(sqBuf) >= base && countUnique(sqBuf) == base) {
            toBaseN(nBuf, n, base);
            toBaseN(sqBuf, s, base);
            //printf("Base %d : Num %lld Square %lld\n", base, n, s);
            printf("Base %d : Num %8s Square %16s\n", base, nBuf, sqBuf);
            break;
        }
    }
}

int main() {
    int i;

    for (i = 2; i <= 15; i++) {
        find(i);
    }

    return 0;
}


- fun cube x = Math.pow(x, 3.0);
val cube = fn : real -> real
- fun croot x = Math.pow(x, 1.0 / 3.0);
val croot = fn : real -> real
- fun compose (f, g) = fn x => f (g x); (* this is already implemented in Standard ML as the "o" operator
=                                          we could have written "fun compose (f, g) x = f (g x)" but we show this for clarity *)
val compose = fn : ('a -> 'b) * ('c -> 'a) -> 'c -> 'b
- val funclist = [Math.sin, Math.cos, cube];
val funclist = [fn,fn,fn] : (real -> real) list
- val funclisti = [Math.asin, Math.acos, croot];
val funclisti = [fn,fn,fn] : (real -> real) list
- ListPair.map (fn (f, inversef) => (compose (inversef, f)) 0.5) (funclist, funclisti);
val it = [0.5,0.5,0.500000000001] : real list


function _sin(x) {
	return(sin(x))
}

function _asin(x) {
	return(asin(x))
}

function _cos(x) {
	return(cos(x))
}

function _acos(x) {
	return(acos(x))
}

function cube(x) {
	return(x*x*x)
}

function cuberoot(x) {
	return(sign(x)*abs(x)^(1/3))
}

function compose(f,g,x) {
	return((*f)((*g)(x)))
}

a=&_sin(),&_cos(),&cube()
b=&_asin(),&_acos(),&cuberoot()

for(i=1;i<=length(a);i++) {
	printf("%10.5f\n",compose(a[i],b[i],0.5))
}


import Darwin
func compose<A,B,C>(f: (B) -> C, g: (A) -> B) -> (A) -> C {
  return { f(g($0)) }
}
let funclist = [ { (x: Double) in sin(x) }, { (x: Double) in cos(x) }, { (x: Double) in pow(x, 3) } ]
let funclisti = [ { (x: Double) in asin(x) }, { (x: Double) in acos(x) }, { (x: Double) in cbrt(x) } ]
println(map(zip(funclist, funclisti)) { f, inversef in compose(f, inversef)(0.5) })


% namespace path tcl::mathfunc ;# to import functions like abs() etc.
% proc cube x {expr {$x**3}}
% proc croot x {expr {$x**(1/3.)}}
% proc compose {f g} {list apply {{f g x} {{*}$f [{*}$g $x]}} $f $g}

% compose abs cube          ;# returns a partial command, without argument
apply {{f g x} {{*}$f [{*}$g $x]}} abs cube

% {*}[compose abs cube] -3  ;# applies the partial command to argument -3
27

% set forward [compose [compose sin cos] cube] ;# omitting to print result
% set backward [compose croot [compose acos asin]]
% {*}$forward 0.5
0.8372297964617733
% {*}$backward [{*}$forward 0.5]
0.5000000000000017


(∾´∾⟜"Fizz"‿"Buzz"/˜·(¬∨´)⊸∾0=3‿5|⊢)¨1+↕100


module rosetta.fiveweekends "1.0.0" {
    import ceylon.time "1.2.2";
}


(import java.util.GregorianCalendar
	java.text.DateFormatSymbols)

(->> (for [year (range 1900 2101)
	   month [0 2 4 6 7 9 11] ;; 31 day months
	   :let [cal (GregorianCalendar. year month 1)
		 day (.get cal GregorianCalendar/DAY_OF_WEEK)]
	   :when (= day GregorianCalendar/FRIDAY)]
       (println month "-" year))
     count
     (println "Total Months: " ,))


       program-id. five-we.
       data division.
       working-storage section.
       1 wk binary.
        2 int-date pic 9(8).
        2 dow pic 9(4).
        2 friday pic 9(4) value 5.
        2 mo-sub pic 9(4).
        2 months-with-5 pic 9(4) value 0.
        2 years-no-5 pic 9(4) value 0.
        2 5-we-flag pic 9(4) value 0.
         88 5-we-true value 1 when false 0.
       1 31-day-mos pic 9(14) value 01030507081012.
       1 31-day-table redefines 31-day-mos.
        2 mo-no occurs 7 pic 99.
       1 cal-date.
        2 yr pic 9(4).
        2 mo pic 9(2).
        2 da pic 9(2) value 1.
       procedure division.
           perform varying yr from 1900 by 1
           until yr > 2100
               set 5-we-true to false
               perform varying mo-sub from 1 by 1
               until mo-sub > 7
                   move mo-no (mo-sub) to mo
                   compute int-date = function
                       integer-of-date (function numval (cal-date))
                   compute dow = function mod
                       ((int-date - 1) 7) + 1
                   if dow = friday
                       perform output-date
                       add 1 to months-with-5
                       set 5-we-true to true
                   end-if
               end-perform
               if not 5-we-true
                   add 1 to years-no-5
               end-if
           end-perform
           perform output-counts
           stop run
           .

       output-counts.
           display "Months with 5 weekends: " months-with-5
           display "Years without 5 weekends: " years-no-5
           .

       output-date.
           display yr "-" mo
           .
       end program five-we.


using System;
using System.Collections.Generic;
using System.Numerics;

static class Program
{
    static byte Base, bmo, blim, ic; static DateTime st0; static BigInteger bllim, threshold;
    static HashSet<byte> hs = new HashSet<byte>(), o = new HashSet<byte>();
    static string chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|";
    static List<BigInteger> limits;
    static string ms;

    // convert BigInteger to string using current base
    static string toStr(BigInteger b) {
        string res = ""; BigInteger re; while (b > 0) {
            b = BigInteger.DivRem(b, Base, out re); res = chars[(byte)re] + res;
        } return res;
    }

    // check for a portion of digits, bailing if uneven
    static bool allInQS(BigInteger b) {
        BigInteger re; int c = ic; hs.Clear(); hs.UnionWith(o); while (b > bllim) {
            b = BigInteger.DivRem(b, Base, out re);
            hs.Add((byte)re); c += 1; if (c > hs.Count) return false;
        } return true;
    }

    // check for a portion of digits, all the way to the end
    static bool allInS(BigInteger b) {
        BigInteger re; hs.Clear(); hs.UnionWith(o); while (b > bllim) {
            b = BigInteger.DivRem(b, Base, out re); hs.Add((byte)re);
        } return hs.Count == Base;
    }

    // check for all digits, bailing if uneven
    static bool allInQ(BigInteger b) {
        BigInteger re; int c = 0; hs.Clear(); while (b > 0) {
            b = BigInteger.DivRem(b, Base, out re);
            hs.Add((byte)re); c += 1; if (c > hs.Count) return false;
        } return true;
    }

    // check for all digits, all the way to the end
    static bool allIn(BigInteger b) {
        BigInteger re; hs.Clear(); while (b > 0) {
            b = BigInteger.DivRem(b, Base, out re); hs.Add((byte)re);
        } return hs.Count == Base;
    }

    // parse a string into a BigInteger, using current base
    static BigInteger to10(string s) {
        BigInteger res = 0; foreach (char i in s) res = res * Base + chars.IndexOf(i);
        return res;
    }

    // returns the minimum value string, optionally inserting extra digit
    static string fixup(int n) {
        string res = chars.Substring(0, Base); if (n > 0) res = res.Insert(n, n.ToString());
        return "10" + res.Substring(2);
    }

    // checks the square against the threshold, advances various limits when needed
    static void check(BigInteger sq) {
        if (sq > threshold) {
            o.Remove((byte)chars.IndexOf(ms[blim])); blim -= 1; ic -= 1;
            threshold = limits[bmo - blim - 1]; bllim = to10(ms.Substring(0, blim + 1));
        }
    }

    // performs all the caclulations for the current base
    static void doOne() {
        limits = new List<BigInteger>();
        bmo = (byte)(Base - 1); byte dr = 0; if ((Base & 1) == 1) dr = (byte)(Base >> 1);
        o.Clear(); blim = 0;
        byte id = 0; int inc = 1; long i = 0; DateTime st = DateTime.Now; if (Base == 2) st0 = st;
        byte[] sdr = new byte[bmo]; byte rc = 0; for (i = 0; i < bmo; i++) {
            sdr[i] = (byte)((i * i) % bmo); rc += sdr[i] == dr ? (byte)1 : (byte)0;
            sdr[i] += sdr[i] == 0 ? bmo : (byte)0;
        } i = 0; if (dr > 0) {
            id = Base;
            for (i = 1; i <= dr; i++) if (sdr[i] >= dr) if (id > sdr[i]) id = sdr[i]; id -= dr;
            i = 0;
        } ms = fixup(id);
        BigInteger sq = to10(ms); BigInteger rt = new BigInteger(Math.Sqrt((double)sq) + 1);
        sq = rt * rt; if (Base > 9) {
            for (int j = 1; j < Base; j++)
                limits.Add(to10(ms.Substring(0, j) + new string(chars[bmo], Base - j + (rc > 0 ? 0 : 1))));
            limits.Reverse(); while (sq < limits[0]) { rt++; sq = rt * rt; }
        }
        BigInteger dn = (rt << 1) + 1; BigInteger d = 1; if (Base > 3 && rc > 0) {
            while (sq % bmo != dr) { rt += 1; sq += dn; dn += 2; } // alligns sq to dr
            inc = bmo / rc;
            if (inc > 1) { dn += rt * (inc - 2) - 1; d = inc * inc; }
            dn += dn + d;
        }
        d <<= 1; if (Base > 9) {
            blim = 0; while (sq < limits[bmo - blim - 1]) blim++; ic = (byte)(blim + 1);
            threshold = limits[bmo - blim - 1];
            if (blim > 0) for (byte j = 0; j <= blim; j++) o.Add((byte)chars.IndexOf(ms[j]));
            if (blim > 0) bllim = to10(ms.Substring(0, blim + 1)); else bllim = 0;
            if (Base > 5 && rc > 0)
                do { if (allInQS(sq)) break; sq += dn; dn += d; i += 1; check(sq); } while (true);
            else
                do { if (allInS(sq)) break; sq += dn; dn += d; i += 1; check(sq); } while (true);
        } else {
            if (Base > 5 && rc > 0)
                do { if (allInQ(sq)) break; sq += dn; dn += d; i += 1; } while (true);
            else
                do { if (allIn(sq)) break; sq += dn; dn += d; i += 1; } while (true);
        } rt += i * inc;
        Console.WriteLine("{0,3}  {1,2}  {2,2} {3,20} -> {4,-40} {5,10} {6,9:0.0000}s  {7,9:0.0000}s",
            Base, inc, (id > 0 ? chars.Substring(id, 1) : " "), toStr(rt), toStr(sq), i,
            (DateTime.Now - st).TotalSeconds, (DateTime.Now - st0).TotalSeconds);
    }

    static void Main(string[] args) {
        Console.WriteLine("base inc id                 root    square" +
            "                                   test count    time        total");
        for (Base = 2; Base <= 28; Base++) doOne();
        Console.WriteLine("Elasped time was {0,8:0.00} minutes", (DateTime.Now - st0).TotalMinutes);
    }
}


Prgm
  Local funs,invs,composed,x,i

  Define rc_cube(x) = x^3     © Cannot be local variables
  Define rc_curt(x) = x^(1/3)

  Define funs = {"sin","cos","rc_cube"}
  Define invs = {"sin","cos","rc_curt"}

  Define x = 0.5
  Disp "x = " & string(x)
  For i,1,3
    Disp "f=" & invs[i] & " g=" & funs[i] & " f(g(x))=" & string(#(invs[i])(#(funs[i])(x)))
  EndFor

  DelVar rc_cube,rc_curt  © Clean up our globals
EndPrgm


(defvar funlist [list sin
                      cos
                      (op expt @1 3)])

(defvar invlist [list asin
                      acos
                      (op expt @1 (/ 1 3))])

(each ((f funlist) (i invlist))
  (prinl [(chain f i) 0.5]))


#import std
#import flo

functions = <sin,cos,times^/~& sqr>
inverses  = <asin,acos,math..cbrt>

#cast %eL

main = (gang (+)*p\functions inverses) 0.5


var compose = Fn.new { |f, g| Fn.new { |x| f.call(g.call(x)) } }

var A = [
    Fn.new { |x| x.sin },
    Fn.new { |x| x.cos },
    Fn.new { |x| x * x * x }
]

var B = [
    Fn.new { |x| x.asin },
    Fn.new { |x| x.acos },
    Fn.new { |x| x.pow(1/3) }
]

var x = 0.5
for (i in 0..2) {
    System.print(compose.call(A[i], B[i]).call(x))
}


startsOnFriday = (month, year) ->
  # 0 is Sunday, 1 is Monday, ... 5 is Friday, 6 is Saturday
  new Date(year, month, 1).getDay() == 5

has31Days = (month, year) ->
  new Date(year, month, 31).getDate() == 31

checkMonths = (year) ->
  month = undefined
  count = 0
  month = 0
  while month < 12
    if startsOnFriday(month, year) and has31Days(month, year)
      count += 1
      console.log year + ' ' + month + ''
    month += 1
  count

fiveWeekends = ->
  startYear = 1900
  endYear = 2100
  year = undefined
  monthTotal = 0
  yearsWithoutFiveWeekends = []
  total = 0
  year = startYear
  while year <= endYear
    monthTotal = checkMonths(year)
    total += monthTotal
    # extra credit
    if monthTotal == 0
      yearsWithoutFiveWeekends.push year
    year += 1
  console.log 'Total number of months: ' + total + ''
  console.log ''
  console.log yearsWithoutFiveWeekends + ''
  console.log 'Years with no five-weekend months: ' + yearsWithoutFiveWeekends.length + ''
  return

fiveWeekends()


;; Given a date, get the day of the week.  Adapted from
;; http://lispcookbook.github.io/cl-cookbook/dates_and_times.html

(defun day-of-week (day month year)
  (nth-value
   6
   (decode-universal-time
	(encode-universal-time 0 0 0 day month year 0)
	0)))

(defparameter *long-months* '(1 3 5 7 8 10 12))

(defun sundayp (day month year)
  (= (day-of-week day month year) 6))

(defun ends-on-sunday-p (month year)
  (sundayp 31 month year))

;; We use the "long month that ends on Sunday" rule.
(defun has-five-weekends-p (month year)
  (and (member month *long-months*)
	   (ends-on-sunday-p month year)))

;; For the extra credit problem.
(defun has-at-least-one-five-weekend-month-p (year)
  (let ((flag nil))
	(loop for month in *long-months* do
		 (if (has-five-weekends-p month year)
			 (setf flag t)))
	flag))

(defun solve-it ()
  (let ((good-months '())
		(bad-years 0))
	(loop for year from 1900 to 2100 do
	   ;; First form in the PROGN is for the extra credit.
		 (progn (unless (has-at-least-one-five-weekend-month-p year)
				  (incf bad-years))
				(loop for month in *long-months* do
					 (when (has-five-weekends-p month year)
					   (push (list month year) good-months)))))
	(let ((len (length good-months)))
	  (format t "~A months have five weekends.~%" len)
	  (format t "First 5 months: ~A~%" (subseq good-months (- len 5) len))
	  (format t "Last 5 months: ~A~%" (subseq good-months 0 5))
	  (format t "Years without a five-weekend month: ~A~%" bad-years))))


#include <string>
#include <iostream>
#include <cstdlib>
#include <math.h>
#include <chrono>
#include <iomanip>

using namespace std;

const int maxBase = 16;  // maximum base tabulated
int base, bmo, tc; // globals: base, base minus one, test count
const string chars = "0123456789ABCDEF"; // characters to use for the different bases
unsigned long long full; // for allIn() testing

// converts base 10 to string representation of the current base
string toStr(const unsigned long long ull) {
	unsigned long long u = ull; string res = ""; while (u > 0) {
		lldiv_t result1 = lldiv(u, base); res = chars[(int)result1.rem] + res;
		u = (unsigned long long)result1.quot;
	} return res;
}

// converts string to base 10
unsigned long long to10(string s) {
	unsigned long long res = 0; for (char i : s) res = res * base + chars.find(i); return res;
}

// determines whether all characters are present
bool allIn(const unsigned long long ull) {
	unsigned long long u, found; u = ull; found = 0; while (u > 0) {
		lldiv_t result1 = lldiv(u, base); found |= (unsigned long long)1 << result1.rem;
		u = result1.quot;
	} return found == full;
}

// returns the minimum value string, optionally inserting extra digit
string fixup(int n) {
	string res = chars.substr(0, base); if (n > 0) res = res.insert(n, chars.substr(n, 1));
	return "10" + res.substr(2);
}

// perform the calculations for one base
void doOne() {
	bmo = base - 1; tc = 0; unsigned long long sq, rt, dn, d;
	int id = 0, dr = (base & 1) == 1 ? base >> 1 : 0, inc = 1, sdr[maxBase] = { 0 };
	full = ((unsigned long long)1 << base) - 1;
	int rc = 0; for (int i = 0; i < bmo; i++) {
		sdr[i] = (i * i) % bmo; if (sdr[i] == dr) rc++; if (sdr[i] == 0) sdr[i] += bmo;
	}
	if (dr > 0) {
		id = base; for (int i = 1; i <= dr; i++)
			if (sdr[i] >= dr) if (id > sdr[i]) id = sdr[i]; id -= dr;
	}
	sq = to10(fixup(id)); rt = (unsigned long long)sqrt(sq) + 1; sq = rt * rt;
	dn = (rt << 1) + 1; d = 1; if (base > 3 && rc > 0) {
		while (sq % bmo != dr) { rt += 1; sq += dn; dn += 2; } // alligns sq to dr
		inc = bmo / rc; if (inc > 1) { dn += rt * (inc - 2) - 1; d = inc * inc; }
		dn += dn + d;
	} d <<= 1;
	do { if (allIn(sq)) break; sq += dn; dn += d; tc++; } while (true);
	rt += tc * inc;
	cout << setw(4) << base << setw(3) << inc << "  " << setw(2)
		<< (id > 0 ? chars.substr(id, 1) : " ") << setw(10) << toStr(rt) << "  "
		<< setw(20) << left << toStr(sq) << right << setw(12) << tc << endl;
}

int main() {
	cout << "base inc id      root  sqr                   test count" << endl;
	auto st = chrono::system_clock::now();
	for (base = 2; base <= maxBase; base++) doOne();
	chrono::duration<double> et = chrono::system_clock::now() - st;
	cout << "\nComputation time was " << et.count() * 1000 << " milliseconds" << endl;
	return 0;
}


func cube(x:number):number{
	send x^3;
}
func cuberoot(x:number):number{
	send x^(1/3);
}

func compose(f:function,g:function):function{
	send func(n:number){
		send f(g(n));
	}
}

const a:[function]=[math.sin,math.cos,cube];
const b:[function]=[math.asin,math.acos,cuberoot];

each a as k,v{
	log(compose(v,b[k])(0.5))
}


var a=T(fcn(x){ x.toRad().sin() },  fcn(x){ x.toRad().cos() },  fcn(x){ x*x*x} );
var b=T(fcn(x){ x.asin().toDeg() }, fcn(x){ x.acos().toDeg() }, fcn(x){ x.pow(1.0/3) });

var H=Utils.Helpers;
var ab=b.zipWith(H.fcomp,a);  //-->list of deferred calculations
ab.run(True,5.0); //-->L(5.0,5.0,5.0)

a.run(True,5.0) //-->L(0.0871557,0.996195,125)


import std.stdio, std.datetime, std.algorithm, std.range;

Date[] m5w(in Date start, in Date end) pure /*nothrow*/ {
    typeof(return) res;
    // adjust to 1st day
    for (Date when = Date(start.year, start.month, 1);
         when < end;
         when.add!"months"(1))
        // Such month must have 3+4*7 days and start at friday
        // for 5 FULL weekends.
        if (when.daysInMonth == 31 &&
            when.dayOfWeek == DayOfWeek.fri)
            res ~= when;
    return res;
}

bool noM5wByYear(in int year) pure {
    return m5w(Date(year, 1, 1), Date(year, 12, 31)).empty;
}

void main() {
    immutable m = m5w(Date(1900, 1, 1), Date(2100, 12, 31));
    writeln("There are ", m.length,
            " months of which the first and last five are:");
    foreach (d; m[0 .. 5] ~ m[$ - 5 .. $])
        writeln(d.toSimpleString()[0 .. $ - 3]);

    immutable n = iota(1900, 2101).filter!noM5wByYear().walkLength();
    writefln("\nThere are %d years in the range that do not have " ~
             "months with five weekends.", n);
}


import std.algorithm;
import std.exception;
import std.math;
import std.stdio;
import std.string;

string toBaseN(const long num, const int base)
in (base > 1, "base cannot be less than 2")
body {
    immutable ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
    enforce(base < ALPHABET.length, "base cannot be represented");

    char[] result;
    long cnum = abs(num);
    while (cnum > 0) {
        auto rem = cast(uint) (cnum % base);
        result ~= ALPHABET[rem];
        cnum = (cnum - rem) / base;
    }

    if (num < 0) {
        result ~= '-';
    }
    return result.reverse.idup;
}

int countUnique(string buf) {
    bool[char] m;
    foreach (c; buf) {
        m[c] = true;
    }
    return m.keys.length;
}

void find(int base) {
    long nmin = cast(long) pow(cast(real) base, 0.5 * (base - 1));

    for (long n = nmin; /*blank*/; n++) {
        auto sq = n * n;
        enforce(n * n > 0, "Overflowed the square");
        string sqstr = toBaseN(sq, base);
        if (sqstr.length >= base && countUnique(sqstr) == base) {
            string nstr = toBaseN(n, base);
            writefln("Base %2d : Num %8s Square %16s", base, nstr, sqstr);
            return;
        }
    }
}

void main() {
    foreach (i; 2..17) {
        find(i);
    }
}


main() {
  var total = 0;
  var empty = <int>[];
  for (var year = 1900; year < 2101; year++) {
    var months =
        [1, 3, 5, 7, 8, 10, 12].where((m) => DateTime(year, m, 1).weekday == 5);
    print('$year\t$months');
    total += months.length;
    if (months.isEmpty) empty.add(year);
  }
  print('Total: $total');
  print('Year with none: $empty');
}


program FiveWeekends;

{$APPTYPE CONSOLE}

uses SysUtils, DateUtils;

var
  lMonth, lYear: Integer;
  lDate: TDateTime;
  lFiveWeekendCount: Integer;
  lYearsWithout: Integer;
  lFiveWeekendFound: Boolean;
begin
  for lYear := 1900 to 2100 do
  begin
    lFiveWeekendFound := False;
    for lMonth := 1 to 12 do
    begin
      lDate := EncodeDate(lYear, lMonth, 1);
      if (DaysInMonth(lDate) = 31) and (DayOfTheWeek(lDate) = DayFriday) then
      begin
        Writeln(FormatDateTime('mmm yyyy', lDate));
        Inc(lFiveWeekendCount);
        lFiveWeekendFound := True;
      end;
    end;
    if not lFiveWeekendFound then
      Inc(lYearsWithout);
  end;

  Writeln;
  Writeln(Format('Months with 5 weekends: %d', [lFiveWeekendCount]));
  Writeln(Format('Years with no 5 weekend months: %d', [lYearsWithout]));
end.


// Nigel Galloway: May 21st., 2019
let fN g=let g=int64(sqrt(float(pown g (int(g-1L)))))+1L in (Seq.unfold(fun(n,g)->Some(n,(n+g,g+2L))))(g*g,g*2L+1L)
let fG n g=Array.unfold(fun n->if n=0L then None else let n,g=System.Math.DivRem(n,g) in Some(g,n)) n
let fL g=let n=set[0L..g-1L] in Seq.find(fun x->set(fG x g)=n) (fN g)
let toS n g=let a=Array.concat [[|'0'..'9'|];[|'a'..'f'|]] in System.String(Array.rev(fG n g)|>Array.map(fun n->a.[(int n)]))
[2L..16L]|>List.iter(fun n->let g=fL n in printfn "Base %d: %s² -> %s" n (toS (int64(sqrt(float g))) n) (toS g n))


FOR i = 1 TO 100
	fz = i MOD 3 = 0
	bz = i MOD 5 = 0
	IF fz OR bz
		IF fz AND NOT bz: str = "Fizz"
		ELSEIF bz AND NOT fz: str = "Buzz"
		ELSE str = "FizzBuzz"
		END IF
	ELSE
		str = i.ToStr()
	END IF
	? str
END FOR


defmodule Date do
  @months { "January", "February", "March",     "April",   "May",      "June",
            "July",    "August",   "September", "October", "November", "December" }

  def five_weekends(year) do
    for m <-[1,3,5,7,8,10,12], :calendar.day_of_the_week(year, m, 31) == 7, do: elem(@months, m-1)
  end
end

months = Enum.map(1900..2100, fn year -> {year, Date.five_weekends(year)} end)
{none, months5} = Enum.partition(months, fn {_,m} -> Enum.empty?(m) end)
count = Enum.reduce(months5, 0, fn {year, months}, acc ->
  IO.puts "#{year} : #{Enum.join(months, ", ")}"
  acc + length(months)
end)
IO.puts "Found #{count} month with 5 weekends."
IO.puts "\nFound #{length(none)} years with no month having 5 weekends:"
IO.puts "#{inspect Enum.map(none, fn {y,_}-> y end)}"


#!/usr/bin/env escript
%%
%% Calculate number of months with five weekends between years 1900-2100
%%
main(_) ->
  Years = [ [{Y,M} || M <- lists:seq(1,12)] || Y <- lists:seq(1900,2100) ],
  {CountedYears, {Has5W, TotM5W}} = lists:mapfoldl(
    fun(Months, {Has5W, Tot}) ->
      WithFive = [M || M <- Months, has_five(M)],
      CountM5W = length(WithFive),
      {{Months,CountM5W}, {Has5W++WithFive, Tot+CountM5W}}
    end, {[], 0}, Years),
  io:format("There are ~p months with five full weekends.~n"
            "Showing top and bottom 5:~n",
    [TotM5W]),
  lists:map(fun({Y,M}) -> io:format("~p-~p~n", [Y,M]) end,
    lists:sublist(Has5W,1,5) ++ lists:nthtail(TotM5W-5, Has5W)),
  No5W = [Y || {[{Y,_M}|_], 0} <- CountedYears],
  io:format("The following ~p years do NOT have any five-weekend months:~n",
    [length(No5W)]),
  lists:map(fun(Y) -> io:format("~p~n", [Y]) end, No5W).

has_five({Year, Month}) ->
  has_five({Year, Month}, calendar:last_day_of_the_month(Year, Month)).

has_five({Year, Month}, Days) when Days =:= 31 ->
  calendar:day_of_the_week({Year, Month, 1}) =:= 5;
has_five({_Year, _Month}, _DaysNot31) ->
  false.


USING: assocs formatting fry kernel math math.functions
math.parser math.ranges math.statistics sequences ;
IN: rosetta-code.A260182

: pandigital? ( n base -- ? )
    [ >base histogram assoc-size ] keep >= ;

! Return the smallest decimal integer square root whose squared
! digit length in base n is at least n.
: search-start ( base -- n ) dup 1 - ^ sqrt ceiling >integer ;

: find-root ( base -- n )
    [ search-start ] [ ] bi
    '[ dup sq _ pandigital? ] [ 1 + ] until ;

: show-base ( base -- )
    dup find-root dup sq pick [ >base ] curry [email protected]
    "Base %2d: %8s squared = %s\n" printf ;

: main ( -- ) 2 16 [a,b] [ show-base ] each ;

MAIN: main


#! /usr/bin/gforth-fast

: 2^  1 swap lshift ;

: sq  s" dup *" evaluate ; immediate

: min-root  ( -- n )  \ minimum root that can be pandigitial
    base @ s>f fdup 1e f- 0.5e f* f** f>s ;

: pandigital? ( n -- f )
    0 swap  \ bitmask
    begin
        base @ /mod
        >r 2^ or r>
    dup 0= until drop
    base @ 2^ 1- = ;

: panroot ( -- n ) \ get the minimum square root using the variable BASE.
    min-root 1- begin
        1+
    dup sq pandigital? until ;

: .squares ( -- )
    base @ 17 2 do
        i base !
        i 2 dec.r 3 spaces panroot dup 8 .r ." ² = " sq . cr
    loop base ! ;

.squares
bye


PROGRAM FIVE_WEEKENDS

DIM M$[12]

PROCEDURE MODULO(X,Y->MD)
  IF Y=0 THEN
     MD=X
   ELSE
     MD=X-Y*INT(X/Y)
  END IF
END PROCEDURE

PROCEDURE WD(M,D,Y->RES%)
  IF M=1 OR M=2 THEN
     M+=12
     Y-=1
  END IF
  MODULO(365*Y+INT(Y/4)-INT(Y/100)+INT(Y/400)+D+INT((153*M+8)/5),7->RES)
  RES%=RES+1.0
END PROCEDURE

BEGIN
  M$[]=("","JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER")
  PRINT(CHR$(12);) ! CLS
  FOR YEAR=1900 TO 2100 DO
       FOREACH MONTH IN (1,3,5,7,8,10,12) DO   ! months with 31 days
           WD(MONTH,1,YEAR->RES%)
           IF RES%=6 THEN  ! day #6 is Friday
              PRINT(YEAR;": ";M$[MONTH])
              CNT%=CNT%+1
!             IF CNT% MOD 20=0 THEN GET(K$) END IF  ! press a key for next page
            END IF
       END FOR
  END FOR
  PRINT("Total =";CNT%)
END PROGRAM


--Five Weekend task from Rosetta Code wiki
--User:Lnettnay

include std/datetime.e

atom numbermonths = 0
sequence longmonths = {1, 3, 5, 7, 8, 10, 12}
sequence yearsmonths = {}
atom none = 0
datetime dt

for year = 1900 to 2100 do
	atom flag = 0
	for month = 1 to length(longmonths) do
		dt = new(year, longmonths[month], 1)
		if weeks_day(dt) = 6 then --Friday is day 6
			flag = 1
			numbermonths += 1
			yearsmonths = append(yearsmonths, {year, longmonths[month]})
		end if
	end for

	if flag = 0 then
		none += 1
	end if
end for

puts(1, "Number of months with five full weekends from 1900 to 2100 = ")
? numbermonths

puts(1, "First five and last five years, months\n")

for count = 1 to 5 do
	? yearsmonths[count]
end for

for count = length(yearsmonths) - 4 to length(yearsmonths) do
	? yearsmonths[count]
end for

puts(1, "Number of years that have no months with five full weekends = ")
? none


package main

import (
    "fmt"
    "math/big"
    "strconv"
    "time"
)

const maxBase = 27
const minSq36 = "1023456789abcdefghijklmnopqrstuvwxyz"
const minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"

var bigZero = new(big.Int)
var bigOne = new(big.Int).SetUint64(1)

func containsAll(sq string, base int) bool {
    var found [maxBase]byte
    le := len(sq)
    reps := 0
    for _, r := range sq {
        d := r - 48
        if d > 38 {
            d -= 39
        }
        found[d]++
        if found[d] > 1 {
            reps++
            if le-reps < base {
                return false
            }
        }
    }
    return true
}

func sumDigits(n, base *big.Int) *big.Int {
    q := new(big.Int).Set(n)
    r := new(big.Int)
    sum := new(big.Int).Set(bigZero)
    for q.Cmp(bigZero) == 1 {
        q.QuoRem(q, base, r)
        sum.Add(sum, r)
    }
    return sum
}

func digitalRoot(n *big.Int, base int) int {
    root := new(big.Int)
    b := big.NewInt(int64(base))
    for i := new(big.Int).Set(n); i.Cmp(b) >= 0; i.Set(root) {
        root.Set(sumDigits(i, b))
    }
    return int(root.Int64())
}

func minStart(base int) (string, uint64, int) {
    nn := new(big.Int)
    ms := minSq36[:base]
    nn.SetString(ms, base)
    bdr := digitalRoot(nn, base)
    var drs []int
    var ixs []uint64
    for n := uint64(1); n < uint64(2*base); n++ {
        nn.SetUint64(n * n)
        dr := digitalRoot(nn, base)
        if dr == 0 {
            dr = int(n * n)
        }
        if dr == bdr {
            ixs = append(ixs, n)
        }
        if n < uint64(base) && dr >= bdr {
            drs = append(drs, dr)
        }
    }
    inc := uint64(1)
    if len(ixs) >= 2 && base != 3 {
        inc = ixs[1] - ixs[0]
    }
    if len(drs) == 0 {
        return ms, inc, bdr
    }
    min := drs[0]
    for _, dr := range drs[1:] {
        if dr < min {
            min = dr
        }
    }
    rd := min - bdr
    if rd == 0 {
        return ms, inc, bdr
    }
    if rd == 1 {
        return minSq36x[:base+1], 1, bdr
    }
    ins := string(minSq36[rd])
    return (minSq36[:rd] + ins + minSq36[rd:])[:base+1], inc, bdr
}

func main() {
    start := time.Now()
    var nb, nn big.Int
    for n, k, base := uint64(2), uint64(1), 2; ; n += k {
        if base > 2 && n%uint64(base) == 0 {
            continue
        }
        nb.SetUint64(n)
        sq := nb.Mul(&nb, &nb).Text(base)
        if !containsAll(sq, base) {
            continue
        }
        ns := strconv.FormatUint(n, base)
        tt := time.Since(start).Seconds()
        fmt.Printf("Base %2d:%15s² = %-27s in %8.3fs\n", base, ns, sq, tt)
        if base == maxBase {
            break
        }
        base++
        ms, inc, bdr := minStart(base)
        k = inc
        nn.SetString(ms, base)
        nb.Sqrt(&nn)
        if nb.Uint64() < n+1 {
            nb.SetUint64(n + 1)
        }
        if k != 1 {
            for {
                nn.Mul(&nb, &nb)
                dr := digitalRoot(&nn, base)
                if dr == bdr {
                    n = nb.Uint64() - k
                    break
                }
                nb.Add(&nb, bigOne)
            }
        } else {
            n = nb.Uint64() - k
        }
    }
}


class Program
{
    public void FizzBuzzGo()
    {
        Boolean Fizz = false;
        Boolean Buzz = false;
        for (int count = 1; count <= 100; count ++)
        {
            Fizz = count % 3 == 0;
            Buzz = count % 5 == 0;
            if (Fizz && Buzz)
            {
                Console.WriteLine("Fizz Buzz");
                listBox1.Items.Add("Fizz Buzz");
            }
            else if (Fizz)
            {
                Console.WriteLine("Fizz");
                listBox1.Items.Add("Fizz");
            }
            else if (Buzz)
            {
                Console.WriteLine("Buzz");
                listBox1.Items.Add("Buzz");
            }
            else
            {
                Console.WriteLine(count);
                listBox1.Items.Add(count);
            }
        }
    }
}


open System

[<EntryPoint>]
let main argv =
    let (yearFrom, yearTo) = (1900, 2100)

    let monthsWith5We year =
        [1; 3; 5; 7; 8; 10; 12] |>
        List.filter (fun month -> DateTime(year, month, 1).DayOfWeek = DayOfWeek.Friday)

    let ym5we =
        [yearFrom .. yearTo]
        |> List.map (fun year -> year, (monthsWith5We year))

    let countMonthsWith5We =
        ym5we
        |> List.sumBy (snd >> List.length)

    let countYearsWithout5WeMonths =
        ym5we
        |> List.sumBy (snd >> List.isEmpty >> (function|true->1|_->0))

    let allMonthsWith5we =
        ym5we
        |> List.filter (snd >> List.isEmpty >> not)

    printfn "%d months in the range of years from %d to %d have 5 weekends."
        countMonthsWith5We yearFrom yearTo
    printfn "%d years in the range of years from %d to %d have no month with 5 weekends."
        countYearsWithout5WeMonths yearFrom yearTo
    printfn "Months with 5 weekends: %A ... %A"
        (List.take 5 allMonthsWith5we)
        (List.take 5 (List.skip ((List.length allMonthsWith5we) - 5) allMonthsWith5we))
    0


USING: calendar calendar.format formatting io kernel math
sequences ;

: timestamps>my ( months -- )
   [ { MONTH bl YYYY nl } formatted 2drop ] each ;

: month-range ( start-year #months -- seq )
    [ <year> ] [ <iota> ] bi* [ months time+ ] with map ;

: find-five-weekend-months ( months -- months' )
    [ [ friday? ] [ days-in-month ] bi 31 = and ] filter ;

1900 12 201 * month-range find-five-weekend-months
[ length "%d five-weekend months found.\n" printf ]
[ 5 head  timestamps>my "..." print ]
[ 5 tail* timestamps>my ] tri


import           Control.Monad (guard)
import           Data.List (find, unfoldr)
import           Data.Char (intToDigit)
import qualified Data.Set as Set
import           Text.Printf (printf)

digits :: Integral a => a -> a -> [a]
digits
  b = unfoldr
        (((>>) . guard . (0 /=)) <*> (pure . ((,) <$> (`mod` b) <*> (`div` b))))

sequenceForBaseN :: Integral a => a -> [a]
sequenceForBaseN
  b = unfoldr (\(v, n) -> Just (v, (v + n, n + 2))) (i ^ 2, i * 2 + 1)
  where
    i = succ (round $ sqrt (realToFrac (b ^ pred b)))

searchSequence :: Integral a => a -> Maybe a
searchSequence
  b = find ((digitsSet ==) . Set.fromList . digits b) (sequenceForBaseN b)
  where
    digitsSet = Set.fromList [0 .. pred b]

display :: Integer -> Integer -> String
display b n = map (intToDigit . fromIntegral) $ reverse $ digits b n

main :: IO ()
main = mapM_
  (\b -> case searchSequence b of
     Just n  -> printf
       "Base %2d: %8s² -> %16s\n"
       b
       (display b (squareRootValue n))
       (display b n)
     Nothing -> pure ())
  [2 .. 16]
  where
    squareRootValue = round . sqrt . realToFrac


#include <iostream>
#include <chrono>

int main()
{

	int fizz = 0, buzz = 0, fizzbuzz = 0;

	bool isFizz = false;

	auto startTime = std::chrono::high_resolution_clock::now();

	for (unsigned int i = 1; i <= 4000000000; i++) {
		isFizz = false;

		if (i % 3 == 0) {
			isFizz = true;
			fizz++;
		}

		if (i % 5 == 0) {
			if (isFizz) {
				fizz--;
				fizzbuzz++;
			}
			else {
				buzz++;
			}
		}

	}

	auto endTime = std::chrono::high_resolution_clock::now();
	auto totalTime = endTime - startTime;

	printf("\t fizz : %d, buzz: %d, fizzbuzz: %d, duration %lld milliseconds\n", fizz, buzz, fizzbuzz, (totalTime / std::chrono::milliseconds(1)));

	return 0;
}


program Five_weekends
  implicit none

  integer :: m, year, nfives = 0, not5 = 0
  logical :: no5weekend

  type month
    integer :: n
    character(3) :: name
  end type month

  type(month) :: month31(7)

  month31(1) = month(13, "Jan")
  month31(2) = month(3,  "Mar")
  month31(3) = month(5,  "May")
  month31(4) = month(7,  "Jul")
  month31(5) = month(8,  "Aug")
  month31(6) = month(10, "Oct")
  month31(7) = month(12, "Dec")

  do year = 1900, 2100
    no5weekend = .true.
    do m = 1, size(month31)
      if(month31(m)%n == 13) then
        if(Day_of_week(1, month31(m)%n, year-1) == 6) then
          write(*, "(a3, i5)") month31(m)%name, year
          nfives = nfives + 1
          no5weekend = .false.
        end if
      else
        if(Day_of_week(1, month31(m)%n, year) == 6) then
          write(*,"(a3, i5)") month31(m)%name, year
          nfives = nfives + 1
          no5weekend = .false.
        end if
      end if
    end do
    if(no5weekend) not5 = not5 + 1
  end do

  write(*, "(a, i0)") "Number of months with five weekends between 1900 and 2100 = ", nfives
  write(*, "(a, i0)") "Number of years between 1900 and 2100 with no five weekend months = ", not5

contains

function Day_of_week(d, m, y)
  integer :: Day_of_week
  integer, intent(in) :: d, m, y
  integer :: j, k

  j = y / 100
  k = mod(y, 100)
  Day_of_week = mod(d + (m+1)*26/10 + k + k/4 + j/4 + 5*j, 7)

end function Day_of_week
end program Five_weekends


pandigital=: [ = [: # [: ~. #.inv NB. BASE pandigital Y


import java.math.BigInteger;
import java.time.Duration;
import java.util.ArrayList;
import java.util.Collections;
import java.util.HashSet;
import java.util.List;
import java.util.Set;

public class Program {
    static final String ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|";
    static byte base, bmo, blim, ic;
    static long st0;
    static BigInteger bllim, threshold;
    static Set<Byte> hs = new HashSet<>();
    static Set<Byte> o = new HashSet<>();
    static final char[] chars = ALPHABET.toCharArray();
    static List<BigInteger> limits;
    static String ms;

    static int indexOf(char c) {
        for (int i = 0; i < chars.length; ++i) {
            if (chars[i] == c) {
                return i;
            }
        }
        return -1;
    }

    // convert BigInteger to string using current base
    static String toStr(BigInteger b) {
        BigInteger bigBase = BigInteger.valueOf(base);
        StringBuilder res = new StringBuilder();
        while (b.compareTo(BigInteger.ZERO) > 0) {
            BigInteger[] divRem = b.divideAndRemainder(bigBase);
            res.append(chars[divRem[1].intValue()]);
            b = divRem[0];
        }
        return res.toString();
    }

    // check for a portion of digits, bailing if uneven
    static boolean allInQS(BigInteger b) {
        BigInteger bigBase = BigInteger.valueOf(base);
        int c = ic;
        hs.clear();
        hs.addAll(o);
        while (b.compareTo(bllim) > 0) {
            BigInteger[] divRem = b.divideAndRemainder(bigBase);
            hs.add(divRem[1].byteValue());
            c++;

            if (c > hs.size()) {
                return false;
            }
            b = divRem[0];
        }
        return true;
    }

    // check for a portion of digits, all the way to the end
    static boolean allInS(BigInteger b) {
        BigInteger bigBase = BigInteger.valueOf(base);
        hs.clear();
        hs.addAll(o);
        while (b.compareTo(bllim) > 0) {
            BigInteger[] divRem = b.divideAndRemainder(bigBase);
            hs.add(divRem[1].byteValue());
            b = divRem[0];
        }
        return hs.size() == base;
    }

    // check for all digits, bailing if uneven
    static boolean allInQ(BigInteger b) {
        BigInteger bigBase = BigInteger.valueOf(base);
        int c = 0;
        hs.clear();
        while (b.compareTo(BigInteger.ZERO) > 0) {
            BigInteger[] divRem = b.divideAndRemainder(bigBase);
            hs.add(divRem[1].byteValue());
            c++;
            if (c > hs.size()) {
                return false;
            }
            b = divRem[0];
        }
        return true;
    }

    // check for all digits, all the way to the end
    static boolean allIn(BigInteger b) {
        BigInteger bigBase = BigInteger.valueOf(base);
        hs.clear();
        while (b.compareTo(BigInteger.ZERO) > 0) {
            BigInteger[] divRem = b.divideAndRemainder(bigBase);
            hs.add(divRem[1].byteValue());
            b = divRem[0];
        }
        return hs.size() == base;
    }

    // parse a string into a BigInteger, using current base
    static BigInteger to10(String s) {
        BigInteger bigBase = BigInteger.valueOf(base);
        BigInteger res = BigInteger.ZERO;
        for (int i = 0; i < s.length(); ++i) {
            char c = s.charAt(i);
            int idx = indexOf(c);
            BigInteger bigIdx = BigInteger.valueOf(idx);
            res = res.multiply(bigBase).add(bigIdx);
        }
        return res;
    }

    // returns the minimum value string, optionally inserting extra digit
    static String fixup(int n) {
        String res = ALPHABET.substring(0, base);
        if (n > 0) {
            StringBuilder sb = new StringBuilder(res);
            sb.insert(n, n);
            res = sb.toString();
        }
        return "10" + res.substring(2);
    }

    // checks the square against the threshold, advances various limits when needed
    static void check(BigInteger sq) {
        if (sq.compareTo(threshold) > 0) {
            o.remove((byte) indexOf(ms.charAt(blim)));
            blim--;
            ic--;
            threshold = limits.get(bmo - blim - 1);
            bllim = to10(ms.substring(0, blim + 1));
        }
    }

    // performs all the calculations for the current base
    static void doOne() {
        limits = new ArrayList<>();
        bmo = (byte) (base - 1);
        byte dr = 0;
        if ((base & 1) == 1) {
            dr = (byte) (base >> 1);
        }
        o.clear();
        blim = 0;
        byte id = 0;
        int inc = 1;
        long st = System.nanoTime();
        byte[] sdr = new byte[bmo];
        byte rc = 0;
        for (int i = 0; i < bmo; i++) {
            sdr[i] = (byte) ((i * i) % bmo);
            rc += sdr[i] == dr ? (byte) 1 : (byte) 0;
            sdr[i] += sdr[i] == 0 ? bmo : (byte) 0;
        }
        long i = 0;
        if (dr > 0) {
            id = base;
            for (i = 1; i <= dr; i++) {
                if (sdr[(int) i] >= dr) {
                    if (id > sdr[(int) i]) {
                        id = sdr[(int) i];
                    }
                }
            }
            id -= dr;
            i = 0;
        }
        ms = fixup(id);
        BigInteger sq = to10(ms);
        BigInteger rt = BigInteger.valueOf((long) (Math.sqrt(sq.doubleValue()) + 1));
        sq = rt.multiply(rt);
        if (base > 9) {
            for (int j = 1; j < base; j++) {
                limits.add(to10(ms.substring(0, j) + String.valueOf(chars[bmo]).repeat(base - j + (rc > 0 ? 0 : 1))));
            }
            Collections.reverse(limits);
            while (sq.compareTo(limits.get(0)) < 0) {
                rt = rt.add(BigInteger.ONE);
                sq = rt.multiply(rt);
            }
        }
        BigInteger dn = rt.shiftLeft(1).add(BigInteger.ONE);
        BigInteger d = BigInteger.ONE;
        if (base > 3 && rc > 0) {
            while (sq.remainder(BigInteger.valueOf(bmo)).compareTo(BigInteger.valueOf(dr)) != 0) {
                rt = rt.add(BigInteger.ONE);
                sq = sq.add(dn);
                dn = dn.add(BigInteger.TWO);
            } // aligns sq to dr
            inc = bmo / rc;
            if (inc > 1) {
                dn = dn.add(rt.multiply(BigInteger.valueOf(inc - 2)).subtract(BigInteger.ONE));
                d = BigInteger.valueOf(inc * inc);
            }
            dn = dn.add(dn).add(d);
        }
        d = d.shiftLeft(1);
        if (base > 9) {
            blim = 0;
            while (sq.compareTo(limits.get(bmo - blim - 1)) < 0) {
                blim++;
            }
            ic = (byte) (blim + 1);
            threshold = limits.get(bmo - blim - 1);
            if (blim > 0) {
                for (byte j = 0; j <= blim; j++) {
                    o.add((byte) indexOf(ms.charAt(j)));
                }
            }
            if (blim > 0) {
                bllim = to10(ms.substring(0, blim + 1));
            } else {
                bllim = BigInteger.ZERO;
            }
            if (base > 5 && rc > 0)
                while (!allInQS(sq)) {
                    sq = sq.add(dn);
                    dn = dn.add(d);
                    i += 1;
                    check(sq);
                }
            else {
                while (!allInS(sq)) {
                    sq = sq.add(dn);
                    dn = dn.add(d);
                    i += 1;
                    check(sq);
                }
            }
        } else {
            if (base > 5 && rc > 0) {
                while (!allInQ(sq)) {
                    sq = sq.add(dn);
                    dn = dn.add(d);
                    i += 1;
                }
            } else {
                while (!allIn(sq)) {
                    sq = sq.add(dn);
                    dn = dn.add(d);
                    i += 1;
                }
            }
        }

        rt = rt.add(BigInteger.valueOf(i * inc));
        long delta1 = System.nanoTime() - st;
        Duration dur1 = Duration.ofNanos(delta1);
        long delta2 = System.nanoTime() - st0;
        Duration dur2 = Duration.ofNanos(delta2);
        System.out.printf(
            "%3d  %2d  %2s %20s -> %-40s %10d %9s  %9s\n",
            base, inc, (id > 0 ? ALPHABET.substring(id, id + 1) : " "), toStr(rt), toStr(sq), i, format(dur1), format(dur2)
        );
    }

    private static String format(Duration d) {
        int minP = d.toMinutesPart();
        int secP = d.toSecondsPart();
        int milP = d.toMillisPart();
        return String.format("%02d:%02d.%03d", minP, secP, milP);
    }

    public static void main(String[] args) {
        System.out.println("base inc id                 root    square                                   test count    time        total");
        st0 = System.nanoTime();
        for (base = 2; base < 28; ++base) {
            doOne();
        }
    }
}


(* FizzBuzz in CDuce *)

let format (n : Int) : Latin1 =
    if (n mod 3 = 0) || (n mod 5 = 0) then "FizzBuzz"
    else if (n mod 5 = 0) then "Buzz"
    else if (n mod 3 = 0) then "Fizz"
    else string_of (n);;

let fizz (n : Int, size : Int) : _ =
    print (format (n) @ "\n");
    if (n = size) then
        n = 0 (* do nothing *)
    else
        fizz(n + 1, size);;

let fizbuzz (size : Int) : _ = fizz (1, size);;

let _ = fizbuzz(100);;


' version 23-06-2015
' compile with: fbc -s console

Function wd(m As Integer, d As Integer, y As Integer) As Integer
    ' Zellerish
    ' 0 = Sunday, 1 = Monday, 2 = Tuesday, 3 = Wednesday
    ' 4 = Thursday, 5 = Friday, 6 = Saturday

    If m < 3 Then        ' If m = 1 Or m = 2 Then
        m += 12
        y -= 1
    End If
    Return (y + (y \ 4) - (y \ 100) + (y \ 400) + d + ((153 * m + 8) \ 5)) Mod 7
End Function

' ------=< MAIN >=------
' only months with 31 day can have five weekends
' these months are: January, March, May, July, August, October, December
' in nr: 1, 3, 5, 7, 8, 10, 12
' the 1e day needs to be on a friday (= 5)

Dim As String month_names(1 To 12) => {"January","February","March",_
                               "April","May","June","July","August",_
                        "September","October","November","December"}
Dim As Integer m, yr, total, i, j, yr_without(200)
Dim As String answer

For yr = 1900 To 2100  ' Gregorian calendar
    answer = ""
    For m = 1 To 12 Step 2
        If m = 9 Then m = 8
        If wd(m , 1 , yr) = 5 Then
            answer = answer + month_names(m) + ", "
            total = total + 1
        End If
    Next
    If answer <> "" Then
        Print Using "#### | "; yr;
        Print Left(answer, Len(answer) -2) ' get rid of extra " ,"
    Else
        i = i + 1
        yr_without(i) = yr
    End If
Next

Print
Print "nr of month for 1900 to 2100 that has five weekends";total
Print
Print i;" years don't have months with five weekends"

For j = 1 To i
    Print yr_without(j); " ";
    If j Mod 8 = 0 Then Print
Next
Print

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


(() => {
    'use strict';

    // allDigitSquare :: Int -> Int
    const allDigitSquare = base => {
        const bools = replicate(base, false);
        return untilSucc(
            allDigitsUsedAtBase(base, bools),
            ceil(sqrt(parseInt(
                '10' + '0123456789abcdef'.slice(2, base),
                base
            )))
        );
    };

    // allDigitsUsedAtBase :: Int -> [Bool] -> Int -> Bool
    const allDigitsUsedAtBase = (base, bools) => n => {
        // Fusion of representing the square of integer N at a given base
        // with checking whether all digits of that base contribute to N^2.
        // Sets the bool at a digit position to True when used.
        // True if all digit positions have been used.
        const ds = bools.slice(0);
        let x = n * n;
        while (x) {
            ds[x % base] = true;
            x = floor(x / base);
        }
        return ds.every(x => x)
    };

    // showBaseSquare :: Int -> String
    const showBaseSquare = b => {
        const q = allDigitSquare(b);
        return justifyRight(2, ' ', str(b)) + ' -> ' +
            justifyRight(8, ' ', showIntAtBase(b, digit, q, '')) +
            ' -> ' + showIntAtBase(b, digit, q * q, '');
    };

    // TEST -----------------------------------------------
    const main = () => {
        // 1-12 only - by 15 the squares are truncated by
        // JS integer limits.

        // Returning values through console.log –
        // in separate events to avoid asynchronous disorder.
        print('Smallest perfect squares using all digits in bases 2-12:\n')
      (id > 0 ? chars.substr(id, 1) : " ")    print('Base      Root    Square')

        print(showBaseSquare(2));
        print(showBaseSquare(3));
        print(showBaseSquare(4));
        print(showBaseSquare(5));
        print(showBaseSquare(6));
        print(showBaseSquare(7));
        print(showBaseSquare(8));
        print(showBaseSquare(9));
        print(showBaseSquare(10));
        print(showBaseSquare(11));
        print(showBaseSquare(12));
    };

    // GENERIC FUNCTIONS ----------------------------------

    const
        ceil = Math.ceil,
        floor = Math.floor,
        sqrt = Math.sqrt;

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // digit :: Int -> Char
    const digit = n =>
        // Digit character for given integer.
        '0123456789abcdef' [n];

    // enumFromTo :: (Int, Int) -> [Int]
    const enumFromTo = (m, n) =>
        Array.from({
            length: 1 + n - m
        }, (_, i) => m + i);

    // justifyRight :: Int -> Char -> String -> String
    const justifyRight = (n, cFiller, s) =>
        n > s.length ? (
            s.padStart(n, cFiller)
        ) : s;

    // print :: a -> IO ()
    const print = x => console.log(x)

    // quotRem :: Int -> Int -> (Int, Int)
    const quotRem = (m, n) =>
        Tuple(Math.floor(m / n), m % n);

    // replicate :: Int -> a -> [a]
    const replicate = (n, x) =>
        Array.from({
            length: n
        }, () => x);

    // showIntAtBase :: Int -> (Int -> Char) -> Int -> String -> String
    const showIntAtBase = (base, toChr, n, rs) => {
        const go = ([n, d], r) => {
            const r_ = toChr(d) + r;
            return 0 !== n ? (
                go(Array.from(quotRem(n, base)), r_)
            ) : r_;
        };
        return 1 >= base ? (
            'error: showIntAtBase applied to unsupported base'
        ) : 0 > n ? (
            'error: showIntAtBase applied to negative number'
        ) : go(Array.from(quotRem(n, base)), rs);
    };

    // Abbreviation for quick testing - any 2nd arg interpreted as indent size

    // sj :: a -> String
    function sj() {
        const args = Array.from(arguments);
        return JSON.stringify.apply(
            null,
            1 < args.length && !isNaN(args[0]) ? [
                args[1], null, args[0]
            ] : [args[0], null, 2]
        );
    }

    // str :: a -> String
    const str = x => x.toString();

    // untilSucc :: (Int -> Bool) -> Int -> Int
    const untilSucc = (p, x) => {
        // The first in a chain of successive integers
        // for which p(x) returns true.
        let v = x;
        while (!p(v)) v = 1 + v;
        return v;
    };

    // MAIN ---
    return main();
})();


Public Sub Main()
Dim aMonth As Short[] = [1, 3, 5, 7, 8, 10, 12]                       'All 31 day months
Dim aMMStore As New String[]                                          'To store results
Dim siYear, siMonth, siCount As Short                                 'Various variables
Dim dDay As Date                                                      'To store the day to check
Dim sTemp As String                                                   'Temp string

For siYear = 1900 To 2100                                             'Loop through each year
  For siMonth = 0 To 6                                                'Loop through each 31 day month
    dDay = Date(siYear, aMonth[siMonth], 1)                           'Get the date of the 1st of the month
    If WeekDay(dDay) = 5 Then aMMStore.Add(Format(dDay, "mmmm yyyy")) 'If the 1st is a Friday then store the result
  Next
Next

For Each sTemp In aMMStore                                            'For each item in the stored array..
  Inc siCount                                                         'Increase siCount
  If siCount < 6 Then Print aMMStore[siCount]                         'If 1 of the 1st 5 dates then print it
  If siCount = 6 Then Print String$(14, "-")                          'Print a separator
  If siCount > aMMStore.Max - 4 Then Print aMMStore[siCount - 1]      'If 1 of the last 5 dates then print it
Next

Print gb.NewLine & "Total months = " & Str(siCount)                   'Print the number of months found

siCount = 0                                                           'Reset siCount
sTemp = aMMStore.Join(",")                                            'Put all the stored dates in one string joined by commas
aMMStore.Clear                                                        'Clear the store for reuse

For siYear = 1900 To 2100                                             'Loop through each year
   If Not InStr(sTemp, Str(siYear)) Then                              'If the year is not in the stored string then..
    Inc siCount                                                       'Increase siCount (Amount of years that don't have 5 weekend months)
    aMMStore.Add(Str(siYear))                                         'Add to the store
   End If
Next

Print gb.NewLine & "There are " & Str(siCount) &
  " years that do not have at least one five-weekend month"           'Print the amount of years with no 5 weekend months
Print aMMStore.Join(",")                                              'Print the years with no 5 weekend months
End


const num = "0123456789abcdef"
hasallin(n, nums, b) = (s = string(n, base=b); all(x -> occursin(x, s), nums))

function squaresearch(base)
    basenumerals = [c for c in num[1:base]]
    highest = parse(Int, "10" * num[3:base], base=base)
    for n in Int(trunc(sqrt(highest))):highest
        if hasallin(n * n, basenumerals, base)
            return n
        end
    end
end

println("Base     Root   N")
for b in 2:16
    n = squaresearch(b)
    println(lpad(b, 3), lpad(string(n, base=b), 10), "  ", string(n * n, base=b))
end


import java.math.BigInteger
import java.time.Duration
import java.util.ArrayList
import java.util.HashSet
import kotlin.math.sqrt

const val ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|"
var base: Byte = 0
var bmo: Byte = 0
var blim: Byte = 0
var ic: Byte = 0
var st0: Long = 0
var bllim: BigInteger? = null
var threshold: BigInteger? = null
var hs: MutableSet<Byte> = HashSet()
var o: MutableSet<Byte> = HashSet()
val chars = ALPHABET.toCharArray()
var limits: MutableList<BigInteger?>? = null
var ms: String? = null

fun indexOf(c: Char): Int {
    for (i in chars.indices) {
        if (chars[i] == c) {
            return i
        }
    }
    return -1
}

// convert BigInteger to string using current base
fun toStr(b: BigInteger): String {
    var b2 = b
    val bigBase = BigInteger.valueOf(base.toLong())
    val res = StringBuilder()
    while (b2 > BigInteger.ZERO) {
        val divRem = b2.divideAndRemainder(bigBase)
        res.append(chars[divRem[1].toInt()])
        b2 = divRem[0]
    }
    return res.toString()
}

// check for a portion of digits, bailing if uneven
fun allInQS(b: BigInteger): Boolean {
    var b2 = b
    val bigBase = BigInteger.valueOf(base.toLong())
    var c = ic.toInt()
    hs.clear()
    hs.addAll(o)
    while (b2 > bllim) {
        val divRem = b2.divideAndRemainder(bigBase)
        hs.add(divRem[1].toByte())
        c++
        if (c > hs.size) {
            return false
        }
        b2 = divRem[0]
    }
    return true
}

// check for a portion of digits, all the way to the end
fun allInS(b: BigInteger): Boolean {
    var b2 = b
    val bigBase = BigInteger.valueOf(base.toLong())
    hs.clear()
    hs.addAll(o)
    while (b2 > bllim) {
        val divRem = b2.divideAndRemainder(bigBase)
        hs.add(divRem[1].toByte())
        b2 = divRem[0]
    }
    return hs.size == base.toInt()
}

// check for all digits, bailing if uneven
fun allInQ(b: BigInteger): Boolean {
    var b2 = b
    val bigBase = BigInteger.valueOf(base.toLong())
    var c = 0
    hs.clear()
    while (b2 > BigInteger.ZERO) {
        val divRem = b2.divideAndRemainder(bigBase)
        hs.add(divRem[1].toByte())
        c++
        if (c > hs.size) {
            return false
        }
        b2 = divRem[0]
    }
    return true
}

// check for all digits, all the way to the end
fun allIn(b: BigInteger): Boolean {
    var b2 = b
    val bigBase = BigInteger.valueOf(base.toLong())
    hs.clear()
    while (b2 > BigInteger.ZERO) {
        val divRem = b2.divideAndRemainder(bigBase)
        hs.add(divRem[1].toByte())
        b2 = divRem[0]
    }
    return hs.size == base.toInt()
}

// parse a string into a BigInteger, using current base
fun to10(s: String?): BigInteger {
    val bigBase = BigInteger.valueOf(base.toLong())
    var res = BigInteger.ZERO
    for (element in s!!) {
        val idx = indexOf(element)
        val bigIdx = BigInteger.valueOf(idx.toLong())
        res = res.multiply(bigBase).add(bigIdx)
    }
    return res
}

// returns the minimum value string, optionally inserting extra digit
fun fixup(n: Int): String {
    var res = ALPHABET.substring(0, base.toInt())
    if (n > 0) {
        val sb = StringBuilder(res)
        sb.insert(n, n)
        res = sb.toString()
    }
    return "10" + res.substring(2)
}

// checks the square against the threshold, advances various limits when needed
fun check(sq: BigInteger) {
    if (sq > threshold) {
        o.remove(indexOf(ms!![blim.toInt()]).toByte())
        blim--
        ic--
        threshold = limits!![bmo - blim - 1]
        bllim = to10(ms!!.substring(0, blim + 1))
    }
}

// performs all the calculations for the current base
fun doOne() {
    limits = ArrayList()
    bmo = (base - 1).toByte()
    var dr: Byte = 0
    if ((base.toInt() and 1) == 1) {
        dr = (base.toInt() shr 1).toByte()
    }
    o.clear()
    blim = 0
    var id: Byte = 0
    var inc = 1
    val st = System.nanoTime()
    val sdr = ByteArray(bmo.toInt())
    var rc: Byte = 0
    for (i in 0 until bmo) {
        sdr[i] = (i * i % bmo).toByte()
        if (sdr[i] == dr) {
            rc = (rc + 1).toByte()
        }
        if (sdr[i] == 0.toByte()) {
            sdr[i] = (sdr[i] + bmo).toByte()
        }
    }
    var i: Long = 0
    if (dr > 0) {
        id = base
        i = 1
        while (i <= dr) {
            if (sdr[i.toInt()] >= dr) {
                if (id > sdr[i.toInt()]) {
                    id = sdr[i.toInt()]
                }
            }
            i++
        }
        id = (id - dr).toByte()
        i = 0
    }
    ms = fixup(id.toInt())
    var sq = to10(ms)
    var rt = BigInteger.valueOf((sqrt(sq.toDouble()) + 1).toLong())
    sq = rt.multiply(rt)
    if (base > 9) {
        for (j in 1 until base) {
            limits!!.add(to10(ms!!.substring(0, j) + chars[bmo.toInt()].toString().repeat(base - j + if (rc > 0) 0 else 1)))
        }
        limits!!.reverse()
        while (sq < limits!![0]) {
            rt = rt.add(BigInteger.ONE)
            sq = rt.multiply(rt)
        }
    }
    var dn = rt.shiftLeft(1).add(BigInteger.ONE)
    var d = BigInteger.ONE
    if (base > 3 && rc > 0) {
        while (sq.remainder(BigInteger.valueOf(bmo.toLong())).compareTo(BigInteger.valueOf(dr.toLong())) != 0) {
            rt = rt.add(BigInteger.ONE)
            sq = sq.add(dn)
            dn = dn.add(BigInteger.TWO)
        } // aligns sq to dr
        inc = bmo / rc
        if (inc > 1) {
            dn = dn.add(rt.multiply(BigInteger.valueOf(inc - 2.toLong())).subtract(BigInteger.ONE))
            d = BigInteger.valueOf(inc * inc.toLong())
        }
        dn = dn.add(dn).add(d)
    }
    d = d.shiftLeft(1)
    if (base > 9) {
        blim = 0
        while (sq < limits!![bmo - blim - 1]) {
            blim++
        }
        ic = (blim + 1).toByte()
        threshold = limits!![bmo - blim - 1]
        if (blim > 0) {
            for (j in 0..blim) {
                o.add(indexOf(ms!![j]).toByte())
            }
        }
        bllim = if (blim > 0) {
            to10(ms!!.substring(0, blim + 1))
        } else {
            BigInteger.ZERO
        }
        if (base > 5 && rc > 0) while (!allInQS(sq)) {
            sq = sq.add(dn)
            dn = dn.add(d)
            i += 1
            check(sq)
        } else {
            while (!allInS(sq)) {
                sq = sq.add(dn)
                dn = dn.add(d)
                i += 1
                check(sq)
            }
        }
    } else {
        if (base > 5 && rc > 0) {
            while (!allInQ(sq)) {
                sq = sq.add(dn)
                dn = dn.add(d)
                i += 1
            }
        } else {
            while (!allIn(sq)) {
                sq = sq.add(dn)
                dn = dn.add(d)
                i += 1
            }
        }
    }
    rt = rt.add(BigInteger.valueOf(i * inc))
    val delta1 = System.nanoTime() - st
    val dur1 = Duration.ofNanos(delta1)
    val delta2 = System.nanoTime() - st0
    val dur2 = Duration.ofNanos(delta2)
    System.out.printf(
        "%3d  %2d  %2s %20s -> %-40s %10d %9s  %9s\n",
        base, inc, if (id > 0) ALPHABET.substring(id.toInt(), id + 1) else " ", toStr(rt), toStr(sq), i, format(dur1), format(dur2)
    )
}

private fun format(d: Duration): String {
    val minP = d.toMinutesPart()
    val secP = d.toSecondsPart()
    val milP = d.toMillisPart()
    return String.format("%02d:%02d.%03d", minP, secP, milP)
}

fun main() {
    println("base inc id                 root    square                                   test count    time        total")
    st0 = System.nanoTime()
    base = 2
    while (base < 28) {
        doOne()
        ++base
    }
}


shared void run() => {for (i in 1..100) {for (j->k in [3->"Fizz", 5->"Buzz"]) if (j.divides(i)) k}.reduce(plus) else i}.each(print);


# return a list of two lists :
# first is the list of months with five weekends between years y1 and y2 (included)
# second is the list of years without such months, in the same interval
FiveWeekends := function(y1, y2)
  local L, yL, badL, d, m, y;
  L := [ ];
  badL := [ ];
  for y in [y1 .. y2] do
    yL := [ ];
    for m in [1, 3, 5, 7, 8, 10, 12] do
      if WeekDay([1, m, y]) = "Fri" then
        d := StringDate([1, m, y]);
        Add(yL, d{[4 .. 11]});
      fi;
    od;
    if Length(yL) = 0 then
      Add(badL, y);
    else
      Append(L, yL);
    fi;
  od;
  return [ L, badL ];
end;

r := FiveWeekends(1900, 2100);;
n := Length(r[1]);
# 201
Length(r[2]);
# 29
r[1]{[1 .. 5]};
# [ "Mar-1901", "Aug-1902", "May-1903", "Jan-1904", "Jul-1904" ]
r[1]{[n-4 .. n]};
# [ "Mar-2097", "Aug-2098", "May-2099", "Jan-2100", "Oct-2100" ]


package main

import (
    "fmt"
    "time"
)

func main() {
    var n int                                 // for task item 2
    var first, last time.Time                 // for task item 3
    haveNone := make([]int, 0, 29)            // for extra credit
    fmt.Println("Months with five weekends:") // for task item 1
    for year := 1900; year <= 2100; year++ {
        var hasOne bool // for extra credit
        for _, month := range []time.Month{1, 3, 5, 7, 8, 10, 12} {
            t := time.Date(year, month, 1, 0, 0, 0, 0, time.UTC)
            if t.Weekday() == time.Friday {
                // task item 1:  show month
                fmt.Println("  ", t.Format("2006 January"))
                n++
                hasOne = true
                last = t
                if first.IsZero() {
                    first = t
                }
            }
        }
        if !hasOne {
            haveNone = append(haveNone, year)
        }
    }
    fmt.Println(n, "total\n") // task item 2: number of months
    // task item 3
    fmt.Println("First five dates of weekends:")
    for i := 0; i < 5; i++ {
        fmt.Println("  ", first.Format("Monday, January 2, 2006"))
        first = first.Add(7 * 24 * time.Hour)
    }
    fmt.Println("Last five dates of weekends:")
    for i := 0; i < 5; i++ {
        fmt.Println("  ", last.Format("Monday, January 2, 2006"))
        last = last.Add(7 * 24 * time.Hour)
    }
    // extra credit
    fmt.Println("\nYears with no months with five weekends:")
    for _, y := range haveNone {
        fmt.Println("  ", y)
    }
    fmt.Println(len(haveNone), "total")
}


      DIM @environ$(12)
      @% = 4 : REM Column width

      REM Initialise:
      FOR E% = 1 TO 12
        PROCsetenvironment(@environ$(E%))
        seq% = E%
        cnt% = 0
        @environ$(E%) = FNgetenvironment
      NEXT

      REM Run hailstone sequences:
      REPEAT
        T% = 0
        FOR E% = 1 TO 12
          PROCsetenvironment(@environ$(E%))
          PRINT seq% ;
          IF seq% <> 1 THEN
            T% += 1
            cnt% += 1
            IF seq% AND 1 seq% = 3 * seq% + 1 ELSE seq% DIV= 2
          ENDIF
          @environ$(E%) = FNgetenvironment
        NEXT
        PRINT
      UNTIL T% = 0

      REM Print counts:
      PRINT "Counts:"
      FOR E% = 1 TO 12
        PROCsetenvironment(@environ$(E%))
        PRINT cnt% ;
        @environ$(E%) = FNgetenvironment
      NEXT
      PRINT
      END

      DEF FNgetenvironment
      LOCAL e$ : e$ = STRING$(216, CHR$0)
      SYS "RtlMoveMemory", !^e$, ^@%+108, 216
      = e$

      DEF PROCsetenvironment(e$)
      IF LEN(e$) < 216 e$ = STRING$(216, CHR$0)
      SYS "RtlMoveMemory", ^@%+108, !^e$, 216
      ENDPROC


ClearAll[FirstSquare]
FirstSquare[b_Integer] := Module[{n, alldigits, digs, start},
  digs = Range[0, b - 1];
  digs[[{2, 1}]] //= Reverse;
  start = Floor[Sqrt[FromDigits[digs, b]]];
  n = start;
  alldigits = Range[0, b - 1];
  While[! ContainsAll[IntegerDigits[n^2, b], alldigits], n++];
  {b, n, start, BaseForm[n, b]}
  ]
Scan[[email protected]*FirstSquare, Range[2, 16]]