import algorithm, math, strformat

const Alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

func toBaseN(num, base: Natural): string =
  doAssert(base in 2..Alphabet.len, &"base must be in 2..{Alphabet.len}")
  var num = num
  while true:
    result.add(Alphabet[num mod base])
    num = num div base
    if num == 0: break
  result.reverse()

func countUnique(str: string): int =
  var charset: set['0'..'Z']
  for ch in str: charset.incl(ch)
  result = charset.card

proc find(base: Natural) =
  var n = pow(base.toFloat, (base - 1) / 2).int
  while true:
    let sq = n * n
    let sqstr = sq.toBaseN(base)
    if sqstr.len >= base and countUnique(sqstr) == base:
      let nstr = n.toBaseN(base)
      echo &"Base {base:2d}:  {nstr:>8s}² = {sqstr:<16s}"
      break
    inc n

when isMainModule:
  for base in 2..16:
    base.find()


program project1;
//Find the smallest number n to base b, so that n*n includes all
//digits of base b
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
uses
  sysutils;
const
 charSet : array[0..36] of char ='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
type
  tNumtoBase = record
                 ntb_dgt : array[0..31-4] of byte;
                 ntb_cnt,
                 ntb_bas  : Word;
               end;
var
  Num,
  sqr2B,
  deltaNum  : tNumtoBase;

function Minimal_n(base:NativeUint):Uint64;
//' 1023456789ABCDEFGHIJ...'
var
  i : NativeUint;
Begin
  result := base;  // aka '10'
  IF base > 2 then
    For i := 2 to base-1 do
      result := result*base+i;
  result := trunc(sqrt(result)+0.99999);
end;

procedure Conv2num(var num:tNumtoBase;n:Uint64;base:NativeUint);
var
  quot :UInt64;
  i :NativeUint;
Begin
  i := 0;
  repeat
    quot := n div base;
    Num.ntb_dgt[i] := n-quot*base;
    n := quot;
    inc(i);
  until n = 0;
  Num.ntb_cnt := i;
  Num.ntb_bas := base;
  //clear upper digits
  For i := i to high(tNumtoBase.ntb_dgt) do
     Num.ntb_dgt[i] := 0;
end;

procedure OutNum(const num:tNumtoBase);
var
  i : NativeInt;
Begin
  with num do
  Begin
    For i := 17-ntb_cnt-1 downto 0 do
      write(' ');
    For i := ntb_cnt-1 downto 0 do
      write(charSet[ntb_dgt[i]]);
  end;
end;

procedure IncNumBig(var add1:tNumtoBase;n:NativeUInt);
//prerequisites
//bases are the same,delta : NativeUint
var
  i,s,b,carry : NativeInt;
Begin
  b := add1.ntb_bas;
  i := 0;
  carry := 0;
  while n > 0 do
  Begin
    s := add1.ntb_dgt[i]+carry+ n MOD b;
    carry := Ord(s>=b);
    s := s- (-carry AND b);
    add1.ntb_dgt[i] := s;
    n := n div b;
    inc(i);
  end;

  while carry <> 0 do
  Begin
    s := add1.ntb_dgt[i]+carry;
    carry := Ord(s>=b);
    s := s- (-carry AND b);
    add1.ntb_dgt[i] := s;
    inc(i);
  end;

  IF add1.ntb_cnt < i then
    add1.ntb_cnt := i;
end;

procedure IncNum(var add1:tNumtoBase;carry:NativeInt);
//prerequisites: bases are the same, carry==delta < base
var
  i,s,b : NativeInt;
Begin
  b := add1.ntb_bas;
  i := 0;
  while carry <> 0 do
  Begin
    s := add1.ntb_dgt[i]+carry;
    carry := Ord(s>=b);
    s := s- (-carry AND b);
    add1.ntb_dgt[i] := s;
    inc(i);
  end;
  IF add1.ntb_cnt < i then
    add1.ntb_cnt := i;
end;

procedure AddNum(var add1,add2:tNumtoBase);
//prerequisites
//bases are the same,add1>add2, add1 <= add1+add2;
var
  i,carry,s,b : NativeInt;
Begin
  b := add1.ntb_bas;
  carry := 0;
  For i := 0 to add2.ntb_cnt-1 do
  begin
    s := add1.ntb_dgt[i]+add2.ntb_dgt[i]+carry;
    carry := Ord(s>=b);
    s := s- (-carry AND b);
    add1.ntb_dgt[i] := s;
  end;

  i := add2.ntb_cnt;
  while carry = 1 do
  Begin
    s := add1.ntb_dgt[i]+carry;
    carry := Ord(s>=b);
    // remove of if s>b then by bit-twiddling
    s := s- (-carry AND b);
    add1.ntb_dgt[i] := s;
    inc(i);
  end;

  IF add1.ntb_cnt < i then
    add1.ntb_cnt := i;
end;

procedure Test(base:NativeInt);
var
  n : Uint64;
  i,j,TestSet : NativeInt;
Begin
  write(base:5);
  n := Minimal_n(base);
  Conv2num(sqr2B,n*n,base);
  Conv2num(Num,n,base);
  deltaNum := num;
  AddNum(deltaNum,deltaNum);
  IncNum(deltaNum,1);

  i := 0;
  repeat
    //count used digits
    TestSet := 0;
    For j := sqr2B.ntb_cnt-1 downto 0 do
      TestSet := TestSet OR (1 shl sqr2B.ntb_dgt[j]);
    inc(TestSet);
    IF (1 shl base)=TestSet  then
       BREAK;
    //next square number
    AddNum(sqr2B,deltaNum);
    IncNum(deltaNum,2);
    inc(i);
  until false;
  IncNumBig(num,i);
  OutNum(Num);
  OutNum(sqr2B);
  Writeln(i:14);
end;

var
  T0: TDateTime;
  base :nativeInt;
begin
  T0 := now;
  writeln('base                 n        square(n)       Testcnt');
  For base := 2 to 16 do
    Test(base);
  writeln((now-T0)*86400:10:3);
  {$IFDEF WINDOWS}readln;{$ENDIF}
end.


proc fizzbuzz(n) {
	for i in 1..n do
		if i % 15 == 0 then
			writeln("FizzBuzz");
		else if i % 5 == 0 then
			writeln("Buzz");
		else if i % 3 == 0 then
			writeln("Fizz");
		else
			writeln(i);
}

fizzbuzz(100);


enum Day {
    Sun, Mon, Tue, Wed, Thu, Fri, Sat
    static Day valueOf(Date d) { Day.valueOf(d.format('EEE')) }
}

def date = Date.&parse.curry('yyyy-M-dd')
def isLongMonth = { firstDay -> (firstDay + 31).format('dd') == '01'}

def fiveWeekends = { years ->
    years.collect { year ->
        (1..12).collect { month ->
            date("${year}-${month}-01")
        }.findAll { firstDay ->
            isLongMonth(firstDay) && Day.valueOf(firstDay) == Day.Fri
        }
    }.flatten()
}


PROCEDURE Main()
   LOCAL y, m, d, nFound, cNames, nTot := 0, nNotFives := 0
   LOCAL aFounds := {}

   SET DATE ANSI

   FOR y := 1900 TO 2100
      nFound := 0 ; cNames := ""
      FOR m := 1 TO 12
      d := CtoD( hb_NtoS( y ) +"/" + hb_NtoS( m ) + "/1" )
         IF CDoW( d ) == "Friday"
	    IF DaysInMonth( m ) == 31
	       nFound++
	       cNames += CMonth( d ) + " "
	    ENDIF
         ENDIF
      NEXT
      IF nFound > 0
         AAdd( aFounds, hb_NtoS( y ) + " : " + hb_NtoS( nFound ) + " ( " + Rtrim( cNames ) + " )" )
         nTot += nFound
      ELSE
         nNotFives++
      ENDIF
   NEXT
   ? "Total months with five weekends: " + hb_NtoS( nTot )
   ? "(see bellow the first and last five years/months with five weekends)"
   ?
   AEval( aFounds, { | e, n | Iif( n < 6, Qout( e ), NIL ) } )
   Qout("...")
   AEval( aFounds, { | e, n | Iif( n > Len(aFounds)-5, Qout( e ), NIL ) } )
   ?
   ? "Years with no five weekends months: " + hb_NtoS( nNotFives )

   RETURN


(  (environment=(cnt=0) (seq=))
& :?environments
& 13:?seq
&   whl
  ' ( !seq+-1:>0:?seq
    & new$environment:?env
    & !seq:?(env..seq)
    & !env !environments:?environments
    )
& out$(Before !environments)
&   whl
  ' ( !environments:? (=? (seq=>1) ?) ?
    & !environments:?envs
    &   whl
      ' ( !envs:(=?env) ?envs
        &   (
              ' ( $env
                  (
                  =
                    .     put$(!(its.seq) \t)
                        & !(its.seq):1
                      |   1+!(its.cnt):?(its.cnt)
                        & 1/2*!(its.seq):~/?(its.seq)
                      | 3*!(its.seq)+1:?(its.seq)
                  )
                )
            .
            )
          $
        )
    & out$
    )
& out$(After !environments)
)


#include <stdio.h>

#define JOBS 12
#define jobs(a) for (switch_to(a = 0); a < JOBS || !printf("\n"); switch_to(++a))
typedef struct { int seq, cnt; } env_t;

env_t env[JOBS] = {{0, 0}};
int *seq, *cnt;

void hail()
{
	printf("% 4d", *seq);
	if (*seq == 1) return;
	++*cnt;
	*seq = (*seq & 1) ? 3 * *seq + 1 : *seq / 2;
}

void switch_to(int id)
{
	seq = &env[id].seq;
	cnt = &env[id].cnt;
}

int main()
{
	int i;
	jobs(i) { env[i].seq = i + 1; }

again:	jobs(i) { hail(); }
	jobs(i) { if (1 != *seq) goto again; }

	printf("COUNTS:\n");
	jobs(i) { printf("% 4d", *cnt); }

	return 0;
}


(def hailstone-src
  "(defn hailstone-step [env]
     (let [{:keys[n cnt]} env]
       (cond
         (= n 1)   {:n 1 :cnt cnt}
         (even? n) {:n (/ n 2) :cnt (inc cnt)}
         :else     {:n (inc (* n 3)) :cnt (inc cnt)})))")

(defn create-hailstone-table [f-src]
  (let [done?        (fn [e] (= (:n e) 1))
        print-step   (fn [envs] (println (map #(format "%4d" (:n %)) envs)))
        print-counts (fn [envs] (println "Counts:\n"
                                         (map #(format "%4d" (:cnt %)) envs)))]
    (loop [f    (eval (read-string f-src))
           envs (for [n (range 12)]
                  {:n (inc n) :cnt 0})]
      (if (every? done? envs)
        (print-counts envs)
        (do
          (print-step envs)
          (recur f (map f envs)))))))


use strict;
use warnings;
use feature 'say';
use ntheory qw/fromdigits todigitstring/;
use utf8;
binmode('STDOUT', 'utf8');

sub first_square  {
    my $n = shift;
    my $sr = substr('1023456789abcdef',0,$n);
    my $r  = int fromdigits($sr, $n) ** .5;
    my @digits = reverse split '', $sr;
    TRY: while (1) {
        my $sq = $r * $r;
        my $cnt = 0;
        my $s = todigitstring($sq, $n);
        my $i = scalar @digits;
        for (@digits) {
            $r++ and redo TRY if (-1 == index($s, $_)) || ($i-- + $cnt < $n);
            last if $cnt++ == $n;
        }
        return sprintf "Base %2d: %10s² == %s", $n, todigitstring($r, $n),
               todigitstring($sq, $n);
    }
}

say "First perfect square with N unique digits in base N: ";
say first_square($_) for 2..16;


main() {
    for(i in range(1,100)) {
        if(i % 3 == 0 and i % 5 == 0) println("fizzbuzz");
        else if(i % 3 == 0) println("fizz");
        else if(i % 5 == 0) println("buzz");
        else print(i);
    }
}


import Data.List (intercalate)

data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday |
    Saturday | Sunday
    deriving (Eq, Show)

-- the whole thing bases upon an infinite list of weeks

daysFrom1_1_1900 :: [DayOfWeek]
daysFrom1_1_1900 = concat $ repeat [Monday, Tuesday, Wednesday,
    Thursday, Friday, Saturday, Sunday]

data Month = January | February | March | April | May | June | July |
    August | September | October | November | December
    deriving (Show)

type Year = Int
type YearCalendar = (Year, [DayOfWeek])
type MonthlyCalendar = (Year, [(Month, [DayOfWeek])])

-- makes groups of 365 or 366 days for each year (infinite list)

yearsFrom :: [DayOfWeek] -> Year -> [YearCalendar]
yearsFrom s i = (i, yeardays) : yearsFrom rest (i + 1)
    where
        yeardays = take (leapOrNot i) s
        yearlen  = length yeardays
        rest    = drop yearlen s
        leapOrNot n = if isLeapYear n then 366 else 365

yearsFrom1900 :: [YearCalendar]
yearsFrom1900 = yearsFrom daysFrom1_1_1900 1900

-- makes groups of days for each month of the year

months :: YearCalendar -> MonthlyCalendar
months (y, d) = (y, [(January, january), (February, february),
    (March, march), (April, april), (May, may), (June, june),
    (July, july), (August, august), (September, september),
    (October, october), (November, november), (December, december)])
    where
        leapOrNot = if isLeapYear y then 29 else 28
        january = take 31 d
        february = take leapOrNot $ drop 31 d
        march = take 31 $ drop (31 + leapOrNot) d
        april = take 30 $ drop (62 + leapOrNot) d
        may = take 31 $ drop (92 + leapOrNot) d
        june = take 30 $ drop (123 + leapOrNot) d
        july = take 31 $ drop (153 + leapOrNot) d
        august = take 31 $ drop (184 + leapOrNot) d
        september = take 30 $ drop (215 + leapOrNot) d
        october = take 31 $ drop (245 + leapOrNot) d
        november = take 30 $ drop (276 + leapOrNot) d
        december = take 31 $ drop (306 + leapOrNot) d

-- see if a year is a leap year

isLeapYear n
    | n `mod` 100 == 0 = n `mod` 400 == 0
    | otherwise = n `mod` 4 == 0

-- make a list of the months of a year that have 5 weekends
-- (they must have 31 days and the first day must be Friday)
-- if the year doesn't contain any 5-weekended months, then
-- return the year and an empty list

whichFiveWeekends :: MonthlyCalendar -> (Year, [Month])
whichFiveWeekends (y, ms) = (y, map (\(m, _) -> m) found) -- extract the months & leave out their days
    where   found = filter (\(m, a@(d:ds)) -> and [length a == 31,
                d == Friday]) ms

-- take all days from 1900 until 2100, grouping them by years, then by
-- months, and calculating whether they have any 5-weekended months
-- or not

calendar :: [MonthlyCalendar]
calendar = map months $ yearsFrom1900

fiveWeekends1900To2100 :: [(Year, [Month])]
fiveWeekends1900To2100 = takeWhile (\(y, _) -> y <= 2100) $
    map whichFiveWeekends calendar

main = do
    -- count the number of years with 5 weekends
    let answer1 = foldl (\c (_, m) -> c + length m) 0 fiveWeekends1900To2100
    -- take only the years with 5-weekended months
        answer2 = filter (\(_, m) -> not $ null m) fiveWeekends1900To2100
    -- take only the years without 5-weekended months
        answer30 = filter (\(_, m) -> null m) fiveWeekends1900To2100
    -- count how many years without 5-weekended months there are
        answer31 = length answer30
    -- show the years without 5-weekended months
        answer32 = intercalate ", " $ map (\(y, m) -> show y) answer30
    putStrLn $ "There are " ++ show answer1 ++ " months with 5 weekends between 1900 and 2100."
    putStrLn "\nThe first ones are:"
    mapM_ (putStrLn . formatMonth) $ take 5 $ answer2
    putStrLn "\nThe last ones are:"
    mapM_ (putStrLn . formatMonth) $ reverse $ take 5 $ reverse answer2
    putStrLn $ "\n" ++ show answer31 ++ " years don't have at least one five-weekened month"
    putStrLn "\nThose are:"
    putStrLn answer32

formatMonth :: (Year, [Month]) -> String
formatMonth (y, m) = show y ++ ": " ++ intercalate ", " [ show x | x <- m ]


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

struct Prop {
    int[string] data;
    ref opDispatch(string s)() pure nothrow {
        return data[s];
    }
}

immutable code = `
writef("% 4d", e.seq);
if (e.seq != 1) {
    e.cnt++;
    e.seq = (e.seq & 1) ? 3 * e.seq + 1 : e.seq / 2;
}`;

void main() {
    auto envs = 12.iota.map!(i => Prop(["cnt": 0, "seq": i+1])).array;

    while (envs.any!(env => env.seq > 1)) {
        foreach (e; envs) {
            mixin(code);
        }
        writeln;
    }

    writefln("Counts:\n%(% 4d%)", envs.map!(env => env.cnt));
}


(define (bump-value)
	(when (> value 1)
	(set! count (1+ count))
	(set! value (if (even? value) (/ value 2) (1+ (* 3 value))))))

(define (env-show name envs )
(write name)
(for ((env envs)) (write (format "%4a" (eval name env))))
(writeln))

(define (task (envnum 12))
(define envs (for/list ((i envnum)) (environment-new `((value ,(1+ i)) (count 0)))))
(env-show 'value envs)
(while
	(any  (curry  (lambda ( n env) (!= 1 (eval n env))) 'value) envs)
	(for/list ((env envs)) (eval '(bump-value) env))
	(env-show 'value envs))
(env-show 'count envs))


-- demo\rosetta\PandigitalSquares.exw
without javascript_semantics    -- (mpz_set_str() currently only supports bases 2, 8, 10, and 16 under pwa/p2js)
include mpfr.e
atom t0 = time()
constant chars = "0123456789abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz|",
         use_hll_code = true

function str_conv(sequence s, integer mode=+1)
-- mode of +1: eg {1,2,3} -> "123", mode of -1 the reverse.
-- note this doesn't really care what base s/res are in.
    {sequence res,integer dcheck} = iff(mode=+1?{"",9}:{{},'9'})
    for i=1 to length(s) do
        integer d = s[i]
        d += mode*iff(d>dcheck?'a'-10:'0')
        res &= d
    end for
    return res
end function

procedure do_one(integer base)
-- tabulates one base
    integer bm1 = base-1,
            dr = iff(and_bits(base,1) ? floor(base/2) : 0),
            id = 0,
            rc = 0,
            sdri
    atom st = time()
    sequence sdr = repeat(0,bm1)
    for i=0 to bm1-1 do
        sdri = mod(i*i,bm1)
        rc += (sdri==dr)
        sdr[i+1] = iff(sdri=0 ? bm1 : sdri)
    end for
    if dr>0 then
        id = base
        for i=1 to dr do
            sdri = sdr[i+1]
            if sdri>=dr
            and id>sdri then
                id = sdri
            end if
        end for
        id -= dr
    end if
    string sq = chars[1..base]
    if id>0 then sq = sq[1..id]&chars[id+1]&sq[id+1..$] end if
    sq[1..2] = "10"
    mpz sqz = mpz_init(),
        rtz = mpz_init(),
        dnz = mpz_init(),
        tmp = mpz_init()
    mpz_set_str(sqz,sq,base)
    mpz_sqrt(rtz,sqz)
    mpz_add_ui(rtz,rtz,1)       -- rtz = sqrt(sqz)+1
    mpz_mul_si(dnz,rtz,2)
    mpz_add_si(dnz,dnz,1)       -- dnz = rtz*2+1
    mpz_mul(sqz,rtz,rtz)        -- sqz = rtz * rtz
    integer d = 1,
            inc = 1
    if base>3 and rc>0 then
        while mpz_fdiv_ui(sqz,bm1)!=dr do
            -- align sqz to dr
            mpz_add_ui(rtz,rtz,1)   -- rtz += 1
            mpz_add(sqz,sqz,dnz)    -- sqz += dnz
            mpz_add_ui(dnz,dnz,2)   -- dnz += 2
        end while
        inc = floor(bm1/rc)
        if inc>1 then
            mpz_mul_si(tmp,rtz,inc-2)
            mpz_sub_ui(tmp,tmp,1)
            mpz_add(dnz,dnz,tmp)    -- dnz += rtz*(inc-2)-1
        end if
        d = inc * inc
        mpz_add(dnz,dnz,dnz)
        mpz_add_ui(dnz,dnz,d)       -- dnz += dnz + d
    end if
    d *= 2
    atom mask, fullmask = power(2,base)-1 -- ie 0b111..
    integer icount = 0
    mpz_set_si(tmp,d)
    sequence sqi = str_conv(mpz_get_str(sqz,base), mode:=-1),
             dni = str_conv(mpz_get_str(dnz,base), mode:=-1),
             dti = str_conv(mpz_get_str(tmp,base), mode:=-1)
    while true do
        if use_hll_code then
            mask = 0
            for i=1 to length(sqi) do
                mask = or_bits(mask,power(2,sqi[i]))
            end for
        else
            ?9/0 -- see below, inline part 1
        end if
        if mask=fullmask then exit end if
        integer carry = 0, sidx, si
        if use_hll_code then
            for sidx=-1 to -length(dni) by -1 do
                si = sqi[sidx]+dni[sidx]+carry
                carry = si>=base
                sqi[sidx] = si-carry*base
            end for
            sidx += length(sqi)+1
            while carry and sidx do
                si = sqi[sidx]+carry
                carry = si>=base
                sqi[sidx] = si-carry*base
                sidx -= 1
            end while
        else
            ?9/0 --see below, inline part 2
        end if
        if carry then
            sqi = carry&sqi
        end if
        carry = 0
        for sidx=-1 to -length(dti) by -1 do
            si = dni[sidx]+dti[sidx]+carry
            carry = floor(si/base)
            dni[sidx] = remainder(si,base)
        end for
        sidx += length(dni)+1
        while carry and sidx do
            si = dni[sidx]+carry
            carry = si>=base
            dni[sidx] = si-carry*base
            sidx -= 1
        end while
        if carry then
            dni = carry&dni
        end if
        icount += 1
    end while
    mpz_set_si(tmp,icount)
    mpz_mul_si(tmp,tmp,inc)
    mpz_add(rtz,rtz,tmp)            -- rtz += icount * inc
    sq = str_conv(sqi, mode:=+1)
    string rt = mpz_get_str(rtz,base),
           idstr = iff(id?sprintf("%d",id):" "),
           ethis = elapsed_short(time()-st),
           etotal = elapsed_short(time()-t0)
    printf(1,"%3d %3d %s %18s -> %-28s %10d %8s     %8s\n",
             {base, inc, idstr, rt, sq, icount, ethis, etotal})
    {sqz,rtz,dnz,tmp} = mpz_free({sqz,rtz,dnz,tmp})
end procedure

puts(1,"base inc id             root -> square" &
        "                       test count    time        total\n")
for base=2 to 19 do
--for base=2 to 25 do
--for base=2 to 28 do
    do_one(base)
end for
printf(1,"completed in %s\n", {elapsed(time()-t0)})


link datetime,printf

procedure main(A)  # five weekends
   printf(  "There are %d months from %d to %d with five full weekends.\n",
            *(L := fiveweekends(s := 1900, f := 2100)), s,f)
   printf("The first and last five such months are:\n")
   every printf("%s\n",L[1 to 5]|"..."|L[-4 to 0])
   printf(  "There are %d years without such months as follows:\n",
            *(M := Bonus(s,f,L)))
   every printf("%s\n",!M)
end

procedure fiveweekends(start,finish)
   L := []        # months years with five weekends FRI-SUN
   every year := start to finish & month := 1 to 12 do
      if month = (2|4|6|9|11) then next
      else if julian(month,1,year) % 7 = 4 then
         put(L,sprintf("%d-%d-1",year,month))
   return L
end

procedure Bonus(start,finish,fwe)
every insert(Y := set(), start to finish)
every insert(F := set(), integer(!fwe ? tab(find("-"))))
return sort(Y--F)
end


Note that using the Process Dictionary:
Destroys referencial transparency
Makes debugging difficult
Survives Catch/Throw


USING: assocs continuations formatting io kernel math
math.ranges sequences ;

: (next-hailstone) ( count value -- count' value' )
    [ 1 + ] [ dup even? [ 2/ ] [ 3 * 1 + ] if ] bi* ;

: next-hailstone ( count value -- count' value' )
    dup 1 = [ (next-hailstone) ] unless ;

: make-environments ( -- seq ) 12 [ 0 ] replicate 12 [1,b] zip ;

: step ( seq -- new-seq )
    [ [ dup "%4d " printf next-hailstone ] with-datastack ] map
    nl ;

: done? ( seq -- ? ) [ second 1 = ] all? ;

make-environments
[ dup done? ] [ step ] until nl
"Counts:" print
[ [ drop "%4d " printf ] with-datastack drop ] each nl


package main

import "fmt"

const jobs = 12

type environment struct{ seq, cnt int }

var (
    env      [jobs]environment
    seq, cnt *int
)

func hail() {
    fmt.Printf("% 4d", *seq)
    if *seq == 1 {
        return
    }
    (*cnt)++
    if *seq&1 != 0 {
        *seq = 3*(*seq) + 1
    } else {
        *seq /= 2
    }
}

func switchTo(id int) {
    seq = &env[id].seq
    cnt = &env[id].cnt
}

func main() {
    for i := 0; i < jobs; i++ {
        switchTo(i)
        env[i].seq = i + 1
    }

again:
    for i := 0; i < jobs; i++ {
        switchTo(i)
        hail()
    }
    fmt.Println()

    for j := 0; j < jobs; j++ {
        switchTo(j)
        if *seq != 1 {
            goto again
        }
    }
    fmt.Println()

    fmt.Println("COUNTS:")
    for i := 0; i < jobs; i++ {
        switchTo(i)
        fmt.Printf("% 4d", *cnt)
    }
    fmt.Println()
}


'''Perfect squares using every digit in a given base.'''

from itertools import count, dropwhile, repeat
from math import ceil, sqrt
from time import time

# allDigitSquare :: Int -> Int -> Int
def allDigitSquare(base, above):
    '''The lowest perfect square which
       requires all digits in the given base.
    '''
    bools = list(repeat(True, base))
    return next(
        dropwhile(
            missingDigitsAtBase(base, bools),
            count(
                max(
                    above,
                    ceil(sqrt(int(
                        '10' + '0123456789abcdef'[2:base],
                        base
                    )))
                )
            )
        )
    )

# missingDigitsAtBase :: Int -> [Bool] -> Int -> Bool
def missingDigitsAtBase(base, bools):
    '''Fusion of representing the square of integer N at a
       given base with checking whether all digits of
       that base contribute to N^2.
       Clears the bool at a digit position to False when used.
       True if any positions remain uncleared (unused).
    '''
    def go(x):
        xs = bools.copy()
        while x:
            xs[x % base] = False
            x //= base
        return any(xs)
    return lambda n: go(n * n)

# digit :: Int -> Char
def digit(n):
    '''Digit character for given integer.'''
    return '0123456789abcdef'[n]

# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''Smallest perfect squares using all digits in bases 2-16'''

    start = time()

    print(main.__doc__ + ':\n\nBase      Root    Square')
    q = 0
    for b in enumFromTo(2)(16):
        q = allDigitSquare(b, q)
        print(
            str(b).rjust(2, ' ') + ' -> ' +
            showIntAtBase(b)(digit)(q)('').rjust(8, ' ') +
            ' -> ' +
            showIntAtBase(b)(digit)(q * q)('')
        )

    print(
        '\nc. ' + str(ceil(time() - start)) + ' seconds.'
    )

# ----------------------- GENERIC ------------------------

# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
    '''Integer enumeration from m to n.'''
    return lambda n: list(range(m, 1 + n))

# showIntAtBase :: Int -> (Int -> String) -> Int ->
# String -> String
def showIntAtBase(base):
    '''String representation of an integer in a given base,
       using a supplied function for the string representation
       of digits.
    '''
    def wrap(toChr, n, rs):
        def go(nd, r):
            n, d = nd
            r_ = toChr(d) + r
            return go(divmod(n, base), r_) if 0 != n else r_
        return 'unsupported base' if 1 >= base else (
            'negative number' if 0 > n else (
                go(divmod(n, base), rs))
        )
    return lambda toChr: lambda n: lambda rs: (
        wrap(toChr, n, rs)
    )

# MAIN ---
if __name__ == '__main__':
    main()


PROCEDURE Main()

   LOCAL n
   LOCAL cFB

   FOR n := 1 TO 100
      cFB := ""
      AEval( { { 3, "Fizz" }, { 5, "Buzz" } }, {|x| cFB += iif( ( n % x[ 1 ] ) == 0, x[ 2 ], "" ) } )
      ?? iif( cFB == "", LTrim( Str( n ) ), cFB ) + iif( n == 100, ".", ", " )
   NEXT

   RETURN


Calendar is a room.

When play begins:
	let happy month count be 0;
	let sad year count be 0;
	repeat with Y running from Y1900 to Y2100:
		if Y is a sad year, increment the sad year count;
		repeat with M running through months:
			if M of Y is a happy month:
				say "[M] [year number of Y].";
				increment the happy month count;
	say "Found [happy month count] month[s] with five weekends and [sad year count] year[s] with no such months.";
	end the story.

Section - Years

A year is a kind of value. Y1 specifies a year.

To decide which number is year number of (Y - year):
	decide on Y / Y1.

To decide if (N - number) is divisible by (M - number):
	decide on whether or not the remainder after dividing N by M is zero.

Definition: a year (called Y) is a leap year:
	let YN be the year number of Y;
	if YN is divisible by 400, yes;
	if YN is divisible by 100, no;
	if YN is divisible by 4, yes;
	no.

Section - Months

A month is a kind of value. The months are defined by the Table of Months.

Table of Months
month		month number
January		1
February	2
March		3
April		4
May		5
June		6
July		7
August		8
September	9
October		10
November	11
December	12

A month has a number called length. The length of a month is usually 31.
September, April, June, and November have length 30. February has length 28.

To decide which number is number of days in (M - month) of (Y - year):
	let L be the length of M;
	if M is February and Y is a leap year, decide on L + 1;
	otherwise decide on L.

Section - Weekdays

A weekday is a kind of value. The weekdays are defined by the Table of Weekdays.

Table of Weekdays
weekday		weekday number
Saturday	0
Sunday		1
Monday		2
Tuesday		3
Wednesday	4
Thursday	5
Friday		6

To decide which weekday is weekday of the/-- (N - number) of (M - month) of (Y - year):
	let MN be the month number of M;
	let YN be the year number of Y;
	if MN is less than 3:
		increase MN by 12;
		decrease YN by 1;
	let h be given by Zeller's Congruence;
	let WDN be the remainder after dividing h by 7;
	decide on the weekday corresponding to a weekday number of WDN in the Table of Weekdays.

Equation - Zeller's Congruence
	h = N + ((MN + 1)*26)/10 + YN + YN/4 + 6*(YN/100) + YN/400
where h is a number, N is a number, MN is a number, and YN is a number.

To decide which number is number of (W - weekday) days in (M - month) of (Y - year):
	let count be 0;
	repeat with N running from 1 to the number of days in M of Y:
		if W is the weekday of the N of M of Y, increment count;
	decide on count.

Section - Happy Months and Sad Years

To decide if (M - month) of (Y - year) is a happy month:
	if the number of days in M of Y is 31 and the weekday of the 1st of M of Y is Friday, decide yes;
	decide no.

To decide if (Y - year) is a sad year:
	repeat with M running through months:
		if M of Y is a happy month, decide no;
	decide yes.


require 'types/datetime numeric'
find5wkdMonths=: verb define
  years=. range 2{. y
  months=. 1 3 5 7 8 10 12
  m5w=. (#~ 0 = weekday) >,{years;months;31   NB. 5 full weekends iff 31st is Sunday(0)
  >'MMM YYYY' fmtDate toDayNo m5w
)


import java.util.Calendar;
import java.util.GregorianCalendar;

public class FiveFSS {
    private static boolean[] years = new boolean[201];
    private static int[] month31 = {Calendar.JANUARY, Calendar.MARCH, Calendar.MAY,
        Calendar.JULY, Calendar.AUGUST, Calendar.OCTOBER, Calendar.DECEMBER};

    public static void main(String[] args) {
        StringBuilder months = new StringBuilder();
        int numMonths = 0;
        for (int year = 1900; year <= 2100; year++) {
            for (int month : month31) {
                Calendar date = new GregorianCalendar(year, month, 1);
                if (date.get(Calendar.DAY_OF_WEEK) == Calendar.FRIDAY) {
                    years[year - 1900] = true;
                    numMonths++;
                    //months are 0-indexed in Calendar
                    months.append((date.get(Calendar.MONTH) + 1) + "-" + year +"\n");
                }
            }
        }
        System.out.println("There are "+numMonths+" months with five weekends from 1900 through 2100:");
        System.out.println(months);
        System.out.println("Years with no five-weekend months:");
        for (int year = 1900; year <= 2100; year++) {
            if(!years[year - 1900]){
                System.out.println(year);
            }
        }
    }
}


hailstone n
  | n == 1 = 1
  | even n = n `div` 2
  | odd n  = 3*n + 1


link printf

procedure main()
   every put(environment := [], hailenv(1 to 12,0))  # setup environments
   printf("Sequences:\n")
   while (e := !environment).sequence > 1 do {
      every hailstep(!environment)
      printf("\n")
      }
   printf("\nCounts:\n")
   every printf("%4d ",(!environment).count)
   printf("\n")
end

record hailenv(sequence,count)

procedure hailstep(env)
   printf("%4d ",env.sequence)
    if env.sequence ~= 1 then {
        env.count +:= 1
        if env.sequence % 2 = 0 then env.sequence /:= 2
        else env.sequence := 3 * env.sequence + 1
        }
end


coclass 'hailstone'

step=:3 :0
  NB. and determine next element in hailstone sequence
  if.1=N do. N return.end.
    NB. count how many times this has run when N was not 1
    STEP=:STEP+1
  if.0=2|N do.
    N=: N%2
  else.
    N=: 1 + 3*N
  end.
)

create=:3 :0
  STEP=: 0
  N=: y
)

current=:3 :0
  N__y
)

run1=:3 :0
  step__y''
  STEP__y
)

run=:3 :0
  old=: ''
  while. -. old -: state=: run1"0 y do.
    smoutput 4j0 ": current"0 y
    old=: state
  end.
)


F intersection_point(ray_direction, ray_point, plane_normal, plane_point)
   R ray_point - ray_direction * dot(ray_point - plane_point, plane_normal) / dot(ray_direction, plane_normal)

print(‘The ray intersects the plane at ’intersection_point((0.0, -1.0, -1.0), (0.0, 0.0, 10.0), (0.0, 0.0, 1.0), (0.0, 0.0, 5.0)))


#`[

Only search square numbers that have at least N digits;
smaller could not possibly match.

Only bother to use analytics for large N. Finesse takes longer than brute force for small N.

]

unit sub MAIN ($timer = False);

sub first-square (Int $n) {
    my @start = flat '1', '0', (2 ..^ $n)».base: $n;

    if $n > 10 { # analytics
        my $root  = digital-root( @start.join, :base($n) );
        my @roots = (2..$n).map(*²).map: { digital-root($_.base($n), :base($n) ) };
        if $root ∉ @roots {
            my $offset = min(@roots.grep: * > $root ) - $root;
            @start[1+$offset] = $offset ~ @start[1+$offset];
        }
    }

    my $start = @start.join.parse-base($n).sqrt.ceiling;
    my @digits = reverse (^$n)».base: $n;
    my $sq;
    my $now  = now;
    my $time = 0;
    my $sr;
    for $start .. * {
        $sq = .²;
        my $s = $sq.base($n);
        my $f;
        $f = 1 and last unless $s.contains: $_ for @digits;
        if $timer && $n > 19 && $_ %% 1_000_000 {
            $time += now - $now;
            say "N $n:  {$_}² = $sq <$s> : {(now - $now).round(.001)}s" ~
                " : {$time.round(.001)} elapsed";
            $now = now;
        }
        next if $f;
        $sr = $_;
        last
    }
    sprintf( "Base %2d: %13s² == %-30s", $n, $sr.base($n), $sq.base($n) ) ~
        ($timer ?? ($time + now - $now).round(.001) !! '');
}

sub digital-root ($root is copy, :$base = 10) {
    $root = $root.comb.map({:36($_)}).sum.base($base) while $root.chars > 1;
    $root.parse-base($base);
}

say  "First perfect square with N unique digits in base N: ";
say .&first-square for flat
   2 .. 12, # required
  13 .. 16, # optional
  17 .. 19, # stretch
  20, # slow
  21, # pretty fast
  22, # very slow
  23, # don't hold your breath
  24, # slow but not too terrible
  25, # very slow
  26, #   "
;


(deffacts count
  (count-to 100)
)

(defrule print-numbers
  (count-to ?max)
  =>
  (loop-for-count (?num ?max) do
    (if
      (= (mod ?num 3) 0)
      then
      (printout t "Fizz")
    )
    (if
      (= (mod ?num 5) 0)
      then
      (printout t "Buzz")
    )
    (if
      (and (> (mod ?num 3) 0) (> (mod ?num 5) 0))
      then
      (printout t ?num)
    )
    (priint depth, unsigned int i> struct NUM_DIGITS_CORE : NUM_DIGITS_COREntout t crlf)
  )
)


function startsOnFriday(month, year)
{
 // 0 is Sunday, 1 is Monday, ... 5 is Friday, 6 is Saturday
 return new Date(year, month, 1).getDay() === 5;
}
function has31Days(month, year)
{
 return new Date(year, month, 31).getDate() === 31;
}
function checkMonths(year)
{
 var month, count = 0;
 for (month = 0; month < 12; month += 1)
 {
  if (startsOnFriday(month, year) && has31Days(month, year))
  {
   count += 1;
   document.write(year + ' ' + month + '
');
  }
 }
 return count;
}
function fiveWeekends()
{
 var
  startYear = 1900,
  endYear = 2100,
  year,
  monthTotal = 0,
  yearsWithoutFiveWeekends = [],
  total = 0;
 for (year = startYear; year <= endYear; year += 1)
 {
  monthTotal = checkMonths(year);
  total += monthTotal;
  // extra credit
  if (monthTotal === 0)
   yearsWithoutFiveWeekends.push(year);
 }
 document.write('Total number of months: ' + total + '
');
 document.write('
');
 document.write(yearsWithoutFiveWeekends + '
');
 document.write('Years with no five-weekend months: ' + yearsWithoutFiveWeekends.length + '
');
}
fiveWeekends();


{ "value": <HAILSTONE>, "count": <COUNT> }


const jobs = 12

mutable struct Environment
    seq::Int
    cnt::Int
    Environment() = new(0, 0)
end

const env = [Environment() for i in 1:jobs]
const currentjob = [1]

seq() = env[currentjob[1]].seq
cnt() = env[currentjob[1]].cnt
seq(n) = (env[currentjob[1]].seq = n)
cnt(n) = (env[currentjob[1]].cnt = n)

function hail()
    print(lpad(seq(), 4))
    if seq() == 1
        return
    end
    cnt(cnt() + 1)
    seq(isodd(seq()) ? 3 * seq() + 1 : div(seq(), 2))
end

function runtest()
    for i in 1:jobs
        currentjob[1] = i
        env[i].seq = i
    end
    computing = true
    while computing
        for i in 1:jobs
            currentjob[1] = i
            hail()
        end
        println()
        for j in 1:jobs
            currentjob[1] = j
            if seq() != 1
                break
            elseif j == jobs
                computing = false
            end
        end
    end
    println("\nCOUNTS:")
    for i in 1:jobs
        currentjob[1] = i
        print(lpad(cnt(), 4))
    end
    println()
end

runtest()


// version 1.1.3

class Environment(var seq: Int, var count: Int)

const val JOBS = 12
val envs = List(JOBS) { Environment(it + 1, 0) }
var seq = 0     // 'seq' for current environment
var count = 0   // 'count' for current environment
var currId = 0  // index of current environment

fun switchTo(id: Int) {
    if (id != currId) {
        envs[currId].seq = seq
        envs[currId].count = count
        currId = id
    }
    seq = envs[id].seq
    count = envs[id].count
}

fun hailstone() {
    print("%4d".format(seq))
    if (seq == 1) return
    count++
    seq = if (seq % 2 == 1) 3 * seq + 1 else seq / 2
}

val allDone get(): Boolean {
    for (a in 0 until JOBS) {
        switchTo(a)
        if (seq != 1) return false
    }
    return true
}

fun code() {
    do {
        for (a in 0 until JOBS) {
            switchTo(a)
            hailstone()
        }
        println()
    }
    while (!allDone)

    println("\nCOUNTS:")
    for (a in 0 until JOBS) {
        switchTo(a)
        print("%4d".format(count))
    }
    println()
}

fun main(args: Array<String>) {
    code()
}


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

DEFINE REALPTR="CARD"
TYPE VectorR=[REALPTR x,y,z]

PROC PrintVector(VectorR POINTER v)
  Print("(") PrintR(v.x)
  Print(",") PrintR(v.y)
  Print(",") PrintR(v.z)
  Print(")")
RETURN

PROC Vector(REAL POINTER vx,vy,vz VectorR POINTER v)
  v.x=vx v.y=vy v.z=vz
RETURN

PROC VectorSub(VectorR POINTER a,b,res)
  RealSub(a.x,b.x,res.x)
  RealSub(a.y,b.y,res.y)
  RealSub(a.z,b.z,res.z)
RETURN

PROC VectorDot(VectorR POINTER a,b REAL POINTER res)
  REAL tmp1,tmp2

  RealMult(a.x,b.x,res)
  RealMult(a.y,b.y,tmp1)
  RealAdd(res,tmp1,tmp2)
  RealMult(a.z,b.z,tmp1)
  RealAdd(tmp1,tmp2,res)
RETURN

PROC VectorMul(VectorR POINTER a REAL POINTER b VectorR POINTER res)
  RealMult(a.x,b,res.x)
  RealMult(a.y,b,res.y)
  RealMult(a.z,b,res.z)
RETURN

BYTE FUNC IsZero(REAL POINTER a)
  CHAR ARRAY s(10)

  StrR(a,s)
  IF s(0)=1 AND s(1)='0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC Intersection(VectorR POINTER
  rayVector,rayPoint,planeNormal,planePoint,result)

  REAL tmpx,tmpy,tmpz,prod1,prod2,prod3
  VectorR tmp

  Vector(tmpx,tmpy,tmpz,tmp)

  VectorSub(rayPoint,planePoint,tmp)
  VectorDot(tmp,planeNormal,prod1)
  VectorDot(rayVector,planeNormal,prod2)

  IF IsZero(prod2) THEN
    RETURN (1)
  FI

  RealDiv(prod1,prod2,prod3)
  VectorMul(rayVector,prod3,tmp)
  VectorSub(rayPoint,tmp,result)
RETURN (0)

PROC Test(VectorR POINTER rayVector,rayPoint,planeNormal,planePoint)
  BYTE res
  REAL px,py,pz
  VectorR p

  Vector(px,py,pz,p)
  res=Intersection(rayVector,rayPoint,planeNormal,planePoint,p)

  Print("Ray vector: ")
  PrintVector(rayVector) PutE()
  Print("Ray point: ")
  PrintVector(rayPoint) PutE()
  Print("Plane normal: ")
  PrintVector(planeNormal) PutE()
  Print("Plane point: ")
  PrintVector(planePoint) PutE()

  IF res=0 THEN
    Print("Intersection point: ")
    PrintVector(p) PutE()
  ELSEIF res=1 THEN
    PrintE("There is no intersection")
  FI
  PutE()
RETURN

PROC Main()
  REAL r0,r1,r5,r10,rm1
  VectorR rayVector,rayPoint,planeNormal,planePoint

  Put(125) PutE() ;clear screen

  ValR("0",r0) ValR("1",r1) ValR("5",r5)
  ValR("10",r10) ValR("-1",rm1)

  Vector(r0,rm1,rm1,rayVector)
  Vector(r0,r0,r10,rayPoint)
  Vector(r0,r0,r1,planeNormal)
  Vector(r0,r0,r5,planePoint)
  Test(rayVector,rayPoint,planeNormal,planePoint)

  Vector(r1,r1,r0,rayVector)
  Vector(r1,r1,r0,rayPoint)
  Vector(r0,r0,r1,planeNormal)
  Vector(r5,r1,r0,planePoint)
  Test(rayVector,rayPoint,planeNormal,planePoint)
RETURN


with Ada.Numerics.Generic_Real_Arrays;
with Ada.Text_IO;

procedure Intersection is

   type Real is new Long_Float;

   package Real_Arrays is
      new Ada.Numerics.Generic_Real_Arrays (Real => Real);
   use Real_Arrays;

   package Real_IO is
      new Ada.Text_IO.Float_IO (Num => Real);

   subtype Vector_3D is Real_Vector (1 .. 3);

   function Line_Plane_Intersection (Line_Vector  : in Vector_3D;
                                     Line_Point   : in Vector_3D;
                                     Plane_Normal : in Vector_3D;
                                     Plane_Point  : in Vector_3D)
                                    return Vector_3D
   is
      Diff  : constant Vector_3D := Line_Point - Plane_Point;
      Denom : constant Real      := Line_Vector * Plane_Normal;
   begin
      if Denom = 0.0 then
         raise Constraint_Error with "Line does not intersect plane";
      end if;
      declare
         Scale : constant Real :=
           -Real'(Diff * Plane_Normal) / Denom;
         Point : constant Vector_3D :=
           Diff + Plane_Point + Scale * Line_Vector;
      begin
         return Point;
      end;
   end Line_Plane_Intersection;

   procedure Put (V : in Vector_3D) is
      use Ada.Text_IO, Real_IO;
   begin
      Put ("(");
      Put (V (1));  Put (",");
      Put (V (2));  Put (",");
      Put (V (3));  Put (")");
   end Put;

begin
   Real_IO.Default_Exp := 0;
   Real_IO.Default_Aft := 3;

   Put (Line_Plane_Intersection (Line_Vector  => (0.0, -1.0, -1.0),
                                 Line_Point   => (0.0,  0.0, 10.0),
                                 Plane_Normal => (0.0,  0.0,  1.0),
                                 Plane_Point  => (0.0,  0.0,  5.0)));
end Intersection;


⍝ Find the intersection of a line with a plane
⍝ The intersection I belongs to a line defined by point L and vector V, translates to:
⍝ A real parameter t exists, that satisfies I = L + tV
⍝ I belongs to the plan defined by point P and normal vector N. This means that any two points of the plane make a vector
⍝ normal to vector N. As I and P belong to the plane, the vector IP is normal to N.
⍝ This translates to: The scalar product IP.N = 0.
⍝ (P - I).N = 0 <=> (P - L - tV).N = 0
⍝ Using distributivity, then associativity, the following equations are established:
⍝ (P - L - tV).N = (P - L).N - (tV).N = (P - L).N - t(V.N) = 0
⍝ Which allows to resolve t: t = ((P - L).N) ÷ (V.N)
⍝ In APL, A.B is coded +/A x B
  V ← 0 ¯1 ¯1
  L ← 0 0 10
  N ← 0 0 1
  P ← 0 0 5
  dot ← { +/ ⍺ × ⍵ }
  t ← ((P - L) dot N) ÷ V dot N
  I ← L + t × V


/*REXX program finds/displays the first perfect square with  N  unique digits in base N.*/
numeric digits 40                                /*ensure enough decimal digits for a #.*/
parse arg LO HI .                                /*obtain optional argument from the CL.*/
if LO==''            then do;  LO=2;  HI=16; end /*not specified?  Then use the default.*/
if LO==','           then      LO=2              /*not specified?  Then use the default.*/
if HI=='' | HI==","  then             HI=LO      /*not specified?  Then use the default.*/
@start= 1023456789abcdefghijklmnopqrstuvwxyz     /*contains the start # (up to base 36).*/
                                                 /* [↓]  find the smallest square with  */
    do j=LO  to HI;        beg= left(@start, j)  /*      N  unique digits in base  N.   */
       do k=iSqrt( base(beg,10,j) )  until #==0  /*start each search from smallest sqrt.*/
       $= base(k*k, j, 10)                       /*calculate square, convert to base J. */
       $u= $;              upper $u              /*get an uppercase version fast count. */
       #= verify(beg, $u)                        /*count differences between 2 numbers. */
       end   /*k*/
    say 'base'            right(j, length(HI) )                   "   root="   ,
                   lower( right( base(k, j, 10), max(5, HI) ) )   '   square='    lower($)
    end      /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
base: procedure;  arg x 1 #,toB,inB              /*obtain:  three arguments.            */
      @l= '0123456789abcdefghijklmnopqrstuvwxyz' /*lowercase (Latin or English) alphabet*/
      @u= @l;     upper @u                       /*uppercase    "    "    "         "   */
      if inb\==10  then                          /*only convert if  not  base 10.       */
         do 1;  #= 0                             /*result of converted  X  (in base 10).*/
         if inb==2   then do; #= b2d(x); leave; end  /*convert   binary    to decimal.  */
         if inb==16  then do; #= x2d(x); leave; end  /*   "    hexadecimal  "    "      */
           do j=1  for length(x)                 /*convert  X:   base inB  ──► base 10. */
           #= # * inB + pos(substr(x,j,1), @u)-1 /*build a new number,  digit by digit. */
           end    /*j*/                          /* [↑]  this also verifies digits.     */
         end
      y=                                         /*the value of  X  in base  B (so far).*/
      if tob==10  then return #                  /*if TOB is ten,  then simply return #.*/
      if tob==2   then return d2b(#)             /*convert base 10 number to binary.    */
      if tob==16  then return lower( d2x(#) )    /*   "      "   "    "    " hexadecimal*/
         do  while  # >= toB                     /*convert #:    decimal  ──►  base toB.*/
         y= substr(@l, (# // toB) + 1, 1)y       /*construct the output number.         */
         #= # % toB                              /*      ··· and whittle  #  down also. */
         end    /*while*/                        /* [↑]  algorithm may leave a residual.*/
      return substr(@l, # + 1, 1)y               /*prepend the residual, if any.        */
/*──────────────────────────────────────────────────────────────────────────────────────*/
iSqrt: procedure; parse arg x;  r=0;  q=1;             do while q<=x;  q=q*4;  end
        do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end; end; return r
/*──────────────────────────────────────────────────────────────────────────────────────*/
b2d:   return x2d( b2x( arg(1) ) )               /*convert binary      number to decimal*/
d2b:   return x2b( d2x( arg(1) ) )  +  0         /*   "    hexadecimal    "    "    "   */
lower: @abc= 'abcdefghijklmnopqrstuvwxyz'; return translate(arg(1), @abc, translate(@abc))


(doseq [x (range 1 101)] (println x (str (when (zero? (mod x 3)) "fizz") (when (zero? (mod x 5)) "buzz"))))


 Use Zeller's Congruence to determine the day of the week, given
# year, month and day as integers in the conventional way.
# Emit 0 for Saturday, 1 for Sunday, etc.
#
def day_of_week(year; month; day):
  if month == 1 or month == 2 then
    [month + 12, year - 1]
  else
    [month, year]
  end
  | day + (13*(.[0] + 1)/5|floor)
    +  (.[1]%100)       + ((.[1]%100)/4|floor)
    +  (.[1]/400|floor) - 2*(.[1]/100|floor)
  | . % 7
;


isweekend(dt::Date) = Dates.dayofweek(dt) ∈ (Dates.Friday, Dates.Saturday, Dates.Sunday)

function hasfiveweekend(month::Integer, year::Integer)
    dmin = Date(year, month, 1)
    dmax = dmin + Dates.Day(Dates.daysinmonth(dmin) - 1)
    return count(isweekend, dmin:dmax) ≥ 15
end

months = collect((y, m) for y in 1900:2100, m in 1:12 if hasfiveweekend(m, y))

println("Number of months with 5 full-weekends: $(length(months))")
println("First five such months:")
for (y, m) in months[1:5] println(" - $y-$m") end
println("Last five such months:")
for (y, m) in months[end-4:end] println(" - $y-$m") end

# extra credit
yrs = getindex.(months, 1)
nyrs = 2100 - 1899 - length(unique(yrs))

println("Number of year with not one 5-full-weekend month: $nyrs")


cal_j:(_jd[19000101]+!(-/_jd 21010101 19000101)) / enumerate the calendar
is_we:(cal_j!7) _lin 4 5 6                       / identify friday saturdays and sundays
m:__dj[cal_j]%100                                / label the months
mi:&15=+/'is_we[=m]                              / group by month and sum the weekend days
`0:,"There are ",($#mi)," months with five weekends"
m5:(?m)[mi]
`0:$5#m5
`0:,"..."
`0:$-5#m5
y:1900+!201                                     / enumerate the years in the range
y5:?_ m5%100                                    / label the years of the months
yn5:[email protected]&~y _lin y5                               / find any years not in the 5 weekend month list
`0:,"There are ",($#yn5)," years without any five-weekend months"
`0:,1_,/",",/:$yn5


local envs = { }
for i = 1, 12 do
    -- fallback to the global environment for io and math
    envs[i] = setmetatable({ count = 0, n = i }, { __index = _G })
end

local code = [[
io.write(("% 4d"):format(n))
if n ~= 1 then
    count = count + 1
    n = (n % 2 == 1) and 3 * n + 1 or math.floor(n / 2)
end
]]

while true do
    local finished = 0
    for _, env in ipairs(envs) do
        if env.n == 1 then finished = finished + 1 end
    end

    if finished == #envs then break end

    for _, env in ipairs(envs) do
        -- 5.1; in 5.2, use load(code, nil, nil, env)() instead
        setfenv(loadstring(code), env)()
    end
    io.write "\n"
end

print "counts:"
for _, env in ipairs(envs) do
    io.write(("% 4d"):format(env.count))
end


import strformat

const Jobs = 12

type Environment = object
  sequence: int
  count: int

var
  env: array[Jobs, Environment]
  sequence, count: ptr int

#---------------------------------------------------------------------------------------------------

proc hail() =
  stdout.write fmt"{sequence[]: 4d}"
  if sequence[] == 1: return
  inc count[]
  sequence[] = if (sequence[] and 1) != 0: 3 * sequence[] + 1
               else: sequence[] div 2

#---------------------------------------------------------------------------------------------------

proc switchTo(id: int) =
  sequence = addr(env[id].sequence)
  count = addr(env[id].count)

#---------------------------------------------------------------------------------------------------

template forAllJobs(statements: untyped): untyped =
  for i in 0..<Jobs:
    switchTo(i)
    statements

#———————————————————————————————————————————————————————————————————————————————————————————————————

for i in 0..<Jobs:
  switchTo(i)
  env[i].sequence = i + 1

var terminated = false
while not terminated:

  forAllJobs:
    hail()
  echo ""

  terminated = true
  forAllJobs:
    if sequence[] != 1:
      terminated = false
      break

echo ""
echo "Counts:"
forAllJobs:
  stdout.write fmt"{count[]: 4d}"
echo ""


#include <order/interpreter.h>

#define ORDER_PP_DEF_8hail ORDER_PP_FN(                \
8fn(8N, 8cond((8equal(8N, 1), 1)                       \
          (8is_0(8remainder(8N, 2)), 8quotient(8N, 2)) \
          (8else, 8inc(8times(8N, 3))))) )

#define ORDER_PP_DEF_8h_loop ORDER_PP_FN(                           \
8fn(8S,                                                             \
    8let((8F, 8fn(8E, 8env_ref(8(8H), 8E))),                        \
         8do(                                                       \
           8print(8seq_to_tuple(8seq_map(8F, 8S)) 8space),          \
           8let((8S, 8h_once(8S)),                                  \
                8if(8equal(1,                                       \
                           8seq_fold(8times, 1, 8seq_map(8F, 8S))), \
                    8print_counts(8S),                              \
                    8h_loop(8S)))))) )

#define ORDER_PP_DEF_8h_once ORDER_PP_FN(                          \
8fn(8S,                                                            \
    8seq_map(                                                      \
      8fn(8E,                                                      \
          8eval(8E,                                                \
                8quote(                                            \
                  8env_bind(8(8C),                                 \
                            8env_bind(8(8H),                       \
                                      8env_bind(8(8E), 8E, 8E),    \
                                      8hail(8H)),                  \
                            8if(8equal(8H, 1), 8C, 8inc(8C))) ))), \
      8S)) )

#define ORDER_PP_DEF_8print_counts ORDER_PP_FN( \
8fn(8S,                                         \
    8print(8space 8(Counts:)                    \
           8seq_to_tuple(8seq_map(8fn(8E, 8env_ref(8(8C), 8E)), 8S)))) )

ORDER_PP(
  8let((8S,    // Build a list of environments
        8seq_map(8fn(8N, 8seq_of_pairs_to_env(
                           8seq(8pair(8(8H), 8N), 8pair(8(8C), 0),
                                8pair(8(8E), 8env_nil)))),
                 8seq_iota(1, 13))),
       8h_loop(8S))
)


define :vector [x, y, z][]

addv: function [v1 :vector, v2 :vector]->
    to :vector @[v1\x+v2\x, v1\y+v2\y, v1\z+v2\z]

subv: function [v1 :vector, v2 :vector]->
    to :vector @[v1\x-v2\x, v1\y-v2\y, v1\z-v2\z]

mulv: function [v1 :vector, v2 :vector :floating][
    if? is? :vector v2
        -> return sum @[v1\x*v2\x v1\y*v2\y v1\z*v2\z]
    else
        -> return to :vector @[v1\x*v2, v1\y*v2, v1\z*v2]
]

intersect: function [lV, lP, pV, pP][
    tdenom: mulv pV lV
    if zero? tdenom -> return to :vector @[∞, ∞, ∞]
    t: (mulv pV subv pP lP) / tdenom
    return addv mulv lV t lP
]

coords: intersect to :vector @[0.0, neg 1.0, neg 1.0]
                  to :vector @[0.0, 0.0, 10.0]
                  to :vector @[0.0, 0.0, 1.0]
                  to :vector @[0.0, 0.0, 5.0]

print ["Intersection at:" coords]


/*
; https://en.wikipedia.org/wiki/Line%E2%80%93plane_intersection#Algebraic_form
l	= line vector
lo	= point on the line
n	= plane normal vector
Po	= point on the plane

if (l . n) = 0						; line and plane are parallel.
if (Po - lo) . n = 0					; line is contained in the plane.

(P - Po) . n = 0					; vector equation of plane.
P = lo + l * d						; vector equation of line.
((lo + l * d) - Po) . n = 0				; Substitute line into plane equation.
(l . n) * d + (lo - Po) . n = 0				; Expanding.
d = ((Po - lo) . n) / (l . n)				; solving for d.
P = lo + l * ((Po - lo) . n) / (l . n)			; solving P.
*/

intersectPoint(l, lo, n, Pn ){
	if (Vector_dot(Vector_sub(Pn, lo), n) = 0)	; line is contained in the plane
		return [1]
	if (Vector_dot(l, n) = 0)			; line and plane are parallel
		return [0]
    diff  := Vector_Sub(Pn, lo)				; (Po - lo)
    prod1 := Vector_Dot(diff, n)			; ((Po - lo) . n)
    prod2 := Vector_Dot(l, n)				; (l . n)
    d := prod1 / prod2					; d = ((Po - lo) . n) / (l . n)
    return Vector_Add(lo, Vector_Mul(l, d))		; P = lo + l * d
}

Vector_Add(v, w){
    return [v.1+w.1, v.2+w.2, v.3+w.3]
}
Vector_Sub(v, w){
    return [v.1-w.1, v.2-w.2, v.3-w.3]
}
Vector_Mul(v, s){
    return [s*v.1, s*v.2, s*v.3]
}
Vector_Dot(v, w){
    return v.1*w.1 + v.2*w.2 + v.3*w.3
}


basePlus = []
decList = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
baseList = ["0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"]

see "working..." + nl

for base = 2 to 10
for n = 1 to 40000
    basePlus = []
    nrPow = pow(n,2)
    str = decimaltobase(nrPow,base)
    ln = len(str)
    for m = 1 to ln
        nr = str[m]
        ind = find(baseList,nr)
        num = decList[ind]
        add(basePlus,num)
    next
    flag = 1
    basePlus = sort(basePlus)
    if len(basePlus) = base
       for p = 1 to base
           if basePlus[p] = p-1
              flag = 1
           else
              flag = 0
              exit
           ok
       next
       if flag = 1
          see "in base: " + base + " root: " + n + " square: " + nrPow + " perfect square: " + str + nl
          exit
       ok
     ok
next
next
see "done..." + nl

func decimaltobase(nr,base)
     binList = []
     binary = 0
     remainder = 1
     while(nr != 0)
          remainder = nr % base
          ind = find(decList,remainder)
          rem = baseList[ind]
          add(binList,rem)
          nr = floor(nr/base)
     end
     binlist = reverse(binList)
     binList = list2str(binList)
     binList = substr(binList,nl,"")
     return binList


DIGITS = "1023456789abcdefghijklmnopqrstuvwxyz"

2.upto(16) do |n|
  start = Integer.sqrt( DIGITS[0,n].to_i(n) )
  res = start.step.detect{|i| (i*i).digits(n).uniq.size == n }
  puts "Base %2d:%10s² = %-14s" % [n, res.to_s(n), (res*res).to_s(n)]
end


start_up = proc ()
    po: stream := stream$primary_output()

    for i: int in int$from_to(1, 100) do
        out: string := ""
        if i // 3 = 0 then out := out || "Fizz" end
        if i // 5 = 0 then out := out || "Buzz" end
        if string$empty(out) then out := int$unparse(i) end
        stream$putl(po, out)
    end
end start_up


// version 1.0.6

import java.util.*

fun main(args: Array<String>) {
    val calendar = GregorianCalendar(1900, 0, 1)
    val months31 = arrayOf(1, 3, 5, 7, 8, 10, 12)
    val monthsWithFive = mutableListOf<String>()
    val yearsWithNone  = mutableListOf<Int>()
    for (year in 1900..2100) {
        var countInYear = 0 //  counts months in a given year with 5 weekends
        for (month in 1..12) {
            if ((month in months31) && (Calendar.FRIDAY == calendar[Calendar.DAY_OF_WEEK])) {
                countInYear++
                monthsWithFive.add("%02d".format(month) + "-" + year)
            }
            calendar.add(Calendar.MONTH, 1)
        }
        if (countInYear == 0) yearsWithNone.add(year)
    }
    println("There are ${monthsWithFive.size} months with 5 weekends")
    println("The first 5 are ${monthsWithFive.take(5)}")
    println("The final 5 are ${monthsWithFive.takeLast(5)}")
    println()
    println("There are ${yearsWithNone.size} years with no months which have 5 weekends, namely:")
    println(yearsWithNone)
}


local(
	months		= array(1, 3, 5, 7, 8, 10, 12),
	fivemonths	= array,
	emptyears	= array,
	checkdate	= date,
	countyear
)

#checkdate -> day = 1

loop(-from = 1900, -to = 2100) => {

	#countyear = false

	#checkdate -> year = loop_count

	with month in #months
	do {
		#checkdate -> month = #month
		if(#checkdate -> dayofweek == 6) => {
			#countyear = true
			#fivemonths -> insert(#checkdate -> format(`YYYY MMM`))
		}
	}

	if(not #countyear) => {
		#emptyears -> insert(loop_count)
	}

}
local(
	monthcount	= #fivemonths -> size,
	output		= 'Total number of months ' + #monthcount + '
 Starting five months '
)

loop(5) => {
	#output -> append(#fivemonths -> get(loop_count) + ', ')
}

#output -> append('
 Ending five months ')

loop(-from = #monthcount - 5, -to = #monthcount) => {
	#output -> append(#fivemonths -> get(loop_count) + ', ')
}

#output -> append('
 Years with no five weekend months ' + #emptyears -> size + '
')

with year in #emptyears do {
	#output -> append(#year + ', ')
}

#output


use strict;
use warnings;

use Safe;

sub hail_next {
    my $n = shift;
    return 1 if $n == 1;
    return $n * 3 + 1 if $n % 2;
    $n / 2;
};

my @enviornments;
for my $initial ( 1..12 ) {
   my $env = Safe->new;
   ${ $env->varglob('value') } = $initial;
   ${ $env->varglob('count') } = 0;
   $env->share('&hail_next');
   $env->reval(q{
      sub task {
         return if $value == 1;
         $value = hail_next( $value );
         ++$count;
      }
   });
   push @enviornments, $env;
}

my @value_refs = map $_->varglob('value'), @enviornments;
my @tasks = map $_->varglob('task'), @enviornments;
while( grep { $$_ != 1 } @value_refs ) {
    printf "%4s", $$_ for @value_refs;
    print "\n";
    $_->() for @tasks;
}

print "Counts\n";

printf "%4s", ${$_->varglob('count')} for @enviornments;
print "\n";


with javascript_semantics
function hail(integer n)
    if remainder(n,2)=0 then
        n /= 2
    else
        n = 3*n+1
    end if
    return n
end function

sequence hails = tagset(12),
         counts = repeat(0,12),
         results = columnize({hails})

function step(integer edx)
    integer n = hails[edx]
    if n=1 then return 0 end if
    n = hail(n)
    hails[edx] = n
    counts[edx] += 1
    results[edx] = deep_copy(results[edx]) & n
    return 1
end function

procedure main()
    bool done = false
    while not done do
        done = true
        for i=1 to 12 do
            if step(i) then
                done = false
            end if
        end for
    end while

    for i=1 to max(counts)+1 do
        for j=1 to 12 do
            puts(1,iff(i<=length(results[j])?sprintf("%4d",{results[j][i]}):"    "))
        end for
        puts(1,"\n")
    end for
    printf(1," %s\n",{join(repeat("===",12))})
    for j=1 to 12 do
        printf(1,"%4d",{counts[j]})
    end for
    puts(1,"\n")
end procedure

main()


#include<stdio.h>

typedef struct{
	double x,y,z;
}vector;

vector addVectors(vector a,vector b){
	return (vector){a.x+b.x,a.y+b.y,a.z+b.z};
}

vector subVectors(vector a,vector b){
	return (vector){a.x-b.x,a.y-b.y,a.z-b.z};
}

double dotProduct(vector a,vector b){
	return a.x*b.x + a.y*b.y + a.z*b.z;
}

vector scaleVector(double l,vector a){
	return (vector){l*a.x,l*a.y,l*a.z};
}

vector intersectionPoint(vector lineVector, vector linePoint, vector planeNormal, vector planePoint){
	vector diff = subVectors(linePoint,planePoint);

	return addVectors(addVectors(diff,planePoint),scaleVector(-dotProduct(diff,planeNormal)/dotProduct(lineVector,planeNormal),lineVector));
}

int main(int argC,char* argV[])
{
	vector lV,lP,pN,pP,iP;

	if(argC!=5)
		printf("Usage : %s <line direction, point on line, normal to plane and point on plane given as (x,y,z) tuples separated by space>");
	else{
		sscanf(argV[1],"(%lf,%lf,%lf)",&lV.x,&lV.y,&lV.z);
		sscanf(argV[3],"(%lf,%lf,%lf)",&pN.x,&pN.y,&pN.z);

		if(dotProduct(lV,pN)==0)
			printf("Line and Plane do not intersect, either parallel or line is on the plane");
		else{
			sscanf(argV[2],"(%lf,%lf,%lf)",&lP.x,&lP.y,&lP.z);
			sscanf(argV[4],"(%lf,%lf,%lf)",&pP.x,&pP.y,&pP.z);

			iP = intersectionPoint(lV,lP,pN,pP);

			printf("Intersection point is (%lf,%lf,%lf)",iP.x,iP.y,iP.z);
		}
	}

	return 0;
}


func first_square(b) {

    var start = [1, 0, (2..^b)...].flip.map_kv{|k,v| v * b**k }.sum.isqrt

    start..Inf -> first_by {|k|
        k.sqr.digits(b).freq.len == b
    }.sqr
}

for b in (2..16) {
    var s = first_square(b)
    printf("Base %2d: %10s² == %s\n", b, s.isqrt.base(b), s.base(b))
}


Imports System.Numerics

Module Program
    Dim base, bm1 As Byte, hs As New HashSet(Of Byte), st0 As DateTime
    Const chars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|"

    ' converts base10 to string, using current base
    Function toStr(ByVal b As BigInteger) As String
        toStr = "" : Dim re As BigInteger : While b > 0
            b = BigInteger.DivRem(b, base, re) : toStr = chars(CByte(re)) & toStr : End While
    End Function

    ' checks for all digits present, checks every one (use when extra digit is present)
    Function allIn(ByVal b As BigInteger) As Boolean
        Dim re As BigInteger : hs.Clear() : While b > 0 : b = BigInteger.DivRem(b, base, re)
            hs.Add(CByte(re)) : End While : Return hs.Count = base
    End Function

    ' checks for all digits present, bailing when duplicates occur (can't use when extra digit is present)
    Function allInQ(ByVal b As BigInteger) As Boolean
        Dim re As BigInteger, c As Integer = 0 : hs.Clear() : While b > 0 : b = BigInteger.DivRem(b, base, re)
            hs.Add(CByte(re)) : c += 1 : If c <> hs.Count Then Return False
        End While : Return True
    End Function

    ' converts string to base 10, using current base
    Function to10(s As String) As BigInteger
        to10 = 0 : For Each i As Char In s : to10 = to10 * base + chars.IndexOf(i) : Next
    End Function

    ' returns minimum string representation, optionally inserting a digit
    Function fixup(n As Integer) As String
        fixup = chars.Substring(0, base)
        If n > 0 Then fixup = fixup.Insert(n, n.ToString)
        fixup = "10" & fixup.Substring(2)
    End Function

    ' returns close approx.
    Function IntSqRoot(v As BigInteger) As BigInteger
        IntSqRoot = New BigInteger(Math.Sqrt(CDbl(v))) : Dim term As BigInteger
        Do : term = v / IntSqRoot : If BigInteger.Abs(term - IntSqRoot) < 2 Then Exit Do
            IntSqRoot = (IntSqRoot + term) / 2 : Loop Until False
    End Function

    ' tabulates one base
    Sub doOne()
        bm1 = base - 1 : Dim dr As Byte = 0 : If (base And 1) = 1 Then dr = base >> 1
        Dim id As Integer = 0, inc As Integer = 1, i As Long = 0, st As DateTime = DateTime.Now
        Dim sdr(bm1 - 1) As Byte, rc As Byte = 0 : For i = 0 To bm1 - 1 : sdr(i) = (i * i) Mod bm1
            rc += If(sdr(i) = dr, 1, 0) : sdr(i) += If(sdr(i) = 0, bm1, 0) : Next : i = 0
        If dr > 0 Then
            id = base : For i = 1 To dr : If sdr(i) >= dr Then If id > sdr(i) Then id = sdr(i)
            Next : id -= dr : i = 0 : End If
        Dim sq As BigInteger = to10(fixup(id)), rt As BigInteger = IntSqRoot(sq) + 0,
            dn As BigInteger = (rt << 1) + 1, d As BigInteger = 1
        sq = rt * rt : If base > 3 AndAlso rc > 0 Then
            While sq Mod bm1 <> dr : rt += 1 : sq += dn : dn += 2 : End While ' alligns sq to dr
            inc = bm1 \ rc : If inc > 1 Then dn += rt * (inc - 2) - 1 : d = inc * inc
            dn += dn + d
        End If : d <<= 1 : If base > 5 AndAlso rc > 0 Then : Do : If allInQ(sq) Then Exit Do
                sq += dn : dn += d : i += 1 : Loop Until False : Else : Do : If allIn(sq) Then Exit Do
                sq += dn : dn += d : i += 1 : Loop Until False : End If : rt += i * inc
        Console.WriteLine("{0,3} {1,3} {2,2} {3,20} -> {4,-38} {5,10} {6,8:0.000}s   {7,8:0.000}s",
                          base, inc, If(id = 0, " ", id.ToString), toStr(rt), toStr(sq), i,
                          (DateTime.Now - st).TotalSeconds, (DateTime.Now - st0).TotalSeconds)
    End Sub

    Sub Main(args As String())
        st0 = DateTime.Now
        Console.WriteLine("base inc id                root    square" & _
            "                                 test count    time        total")
        For base = 2 To 28 : doOne() : Next
        Console.WriteLine("Elasped time was {0,8:0.00} minutes", (DateTime.Now - st0).TotalMinutes)
    End Sub
End Module


foreach(i RANGE 1 100)
  math(EXPR off3 "${i} % 3")
  math(EXPR off5 "${i} % 5")
  if(NOT off3 AND NOT off5)
    message(FizzBuzz)
  elseif(NOT off3)
    message(Fizz)
  elseif(NOT off5)
    message(Buzz)
  else()
    message(${i})
  endif()
endforeach(i)


local months={"JAN","MAR","MAY","JUL","AUG","OCT","DEC"}
local daysPerMonth={31+28,31+30,31+30,31,31+30,31+30,0}

function find5weMonths(year)
  local list={}
  local startday=((year-1)*365+math.floor((year-1)/4)-math.floor((year-1)/100)+math.floor((year-1)/400))%7

  for i,v in ipairs(daysPerMonth) do
    if startday==4 then list[#list+1]=months[i] end
    if i==1 and year%4==0 and year%100~=0 or year%400==0 then
      startday=startday+1
    end
    startday=(startday+v)%7
  end
  return list
end

local cnt_months=0
local cnt_no5we=0

for y=1900,2100 do
  local list=find5weMonths(y)
  cnt_months=cnt_months+#list
  if #list==0 then
    cnt_no5we=cnt_no5we+1
  end
  print(y.." "..#list..": "..table.concat(list,", "))
end
print("Months with 5 weekends: ",cnt_months)
print("Years without 5 weekends in the same month:",cnt_no5we)


(let Envs
   (mapcar
      '((N) (list (cons 'N N) (cons 'Cnt 0)))  # Build environments
      (range 1 12) )
   (while (find '((E) (job E (> N 1))) Envs)   # Until all values are 1:
      (for E Envs
         (job E                                # Use environment 'E'
            (prin (align 4 N))
            (unless (= 1 N)
               (inc 'Cnt)                      # Increment step count
               (setq N
                  (if (bit? 1 N)               # Calculate next hailstone value
                     (inc (* N 3))
                     (/ N 2) ) ) ) ) )
      (prinl) )
   (prinl (need 48 '=))
   (for E Envs                                 # For each environment 'E'
      (job E
         (prin (align 4 Cnt)) ) )              # print the step count
   (prinl) )


environments = [{'cnt':0, 'seq':i+1} for i in range(12)]

code = '''
print('% 4d' % seq, end='')
if seq != 1:
    cnt += 1
    seq = 3 * seq + 1 if seq & 1 else seq // 2
'''

while any(env['seq'] > 1 for env in environments):
    for env in environments:
        exec(code, globals(), env)
    print()

print('Counts')
for env in environments:
    print('% 4d' % env['cnt'], end='')
print()


code <- quote(
          if (n == 1) n else {
            count <- count + 1;
            n <- if (n %% 2 == 1) 3 * n + 1 else n/2
          })

eprint <- function(envs, var="n")
  cat(paste(sprintf("%4d", sapply(envs, `[[`, var)), collapse=" "), "\n")

envs <- mapply(function(...) list2env(list(...)), n=1:12, count=0)

while (any(sapply(envs, eval, expr=code) > 1)) {eprint(envs)}
eprint(envs)

cat("\nCounts:\n")
eprint(envs, "count")


#lang racket

(define namespaces
  (for/list ([i (in-range 1 13)])
    (define ns (make-base-namespace))
    (eval `(begin (define N ,i) (define count 0)) ns)
    ns))

(define (get-var-values name)
  (map (curry namespace-variable-value name #t #f) namespaces))

(define code
  '(when (> N 1)
     (set! N (if (even? N) (/ N 2) (+ 1 (* N 3))))
     (set! count (add1 count))))

(define (show-nums nums)
  (for ([n nums]) (display (~a n #:width 4 #:align 'right)))
  (newline))

(let loop ()
  (define Ns (get-var-values 'N))
  (show-nums Ns)
  (unless (andmap (λ(n) (= n 1)) Ns)
    (for ([ns namespaces]) (eval code ns))
    (loop)))
(displayln (make-string (* 4 12) #\=))
(show-nums (get-var-values 'count))


my $calculator = sub ($n is rw) {
    return ($n == 1) ?? 1 !! $n %% 2 ?? $n div 2 !! $n * 3 + 1
};

sub next (%this, &get_next) {
    return %this if %this.<value> == 1;
    %this.<value>.=&get_next;
    %this.<count>++;
    return %this;
};

my @hailstones = map { %(value => $_, count => 0) }, 1 .. 12;

while not all( map { $_.<value> }, @hailstones ) == 1 {
    say [~] map { $_.<value>.fmt("%4s") }, @hailstones;
    @hailstones[$_].=&next($calculator) for ^@hailstones;
}

say 'Counts';

say [~] map { $_.<count>.fmt("%4s") }, @hailstones;


using System;

namespace FindIntersection {
    class Vector3D {
        private double x, y, z;

        public Vector3D(double x, double y, double z) {
            this.x = x;
            this.y = y;
            this.z = z;
        }

        public static Vector3D operator +(Vector3D lhs, Vector3D rhs) {
            return new Vector3D(lhs.x + rhs.x, lhs.y + rhs.y, lhs.z + rhs.z);
        }

        public static Vector3D operator -(Vector3D lhs, Vector3D rhs) {
            return new Vector3D(lhs.x - rhs.x, lhs.y - rhs.y, lhs.z - rhs.z);
        }

        public static Vector3D operator *(Vector3D lhs, double rhs) {
            return new Vector3D(lhs.x * rhs, lhs.y * rhs, lhs.z * rhs);
        }

        public double Dot(Vector3D rhs) {
            return x * rhs.x + y * rhs.y + z * rhs.z;
        }

        public override string ToString() {
            return string.Format("({0:F}, {1:F}, {2:F})", x, y, z);
        }
    }

    class Program {
        static Vector3D IntersectPoint(Vector3D rayVector, Vector3D rayPoint, Vector3D planeNormal, Vector3D planePoint) {
            var diff = rayPoint - planePoint;
            var prod1 = diff.Dot(planeNormal);
            var prod2 = rayVector.Dot(planeNormal);
            var prod3 = prod1 / prod2;
            return rayPoint - rayVector * prod3;
        }

        static void Main(string[] args) {
            var rv = new Vector3D(0.0, -1.0, -1.0);
            var rp = new Vector3D(0.0, 0.0, 10.0);
            var pn = new Vector3D(0.0, 0.0, 1.0);
            var pp = new Vector3D(0.0, 0.0, 5.0);
            var ip = IntersectPoint(rv, rp, pn, pp);
            Console.WriteLine("The ray intersects the plane at {0}", ip);
        }
    }
}


import "/big" for BigInt
import "/math" for Nums
import "/fmt" for Conv, Fmt

var maxBase  = 21
var minSq36  = "1023456789abcdefghijklmnopqrstuvwxyz"
var minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"

var containsAll = Fn.new { |sq, base|
    var found = List.filled(maxBase, 0)
    var le = sq.count
    var reps = 0
    for (r in sq) {
        var d = r.bytes[0] - 48
        if (d > 38) d = d - 39
        found[d] = found[d] + 1
        if (found[d] > 1) {
            reps = reps + 1
            if (le - reps < base) return false
        }
    }
    return true
}

var sumDigits = Fn.new { |n, base|
    var sum = BigInt.zero
    while (n > 0) {
        sum = sum + (n%base)
        n = n/base
    }
    return sum
}

var digitalRoot = Fn.new { |n, base|
    while (n > base - 1) n = sumDigits.call(n, base)
    return n.toSmall
}

var minStart = Fn.new { |base|
    var ms = minSq36[0...base]
    var nn = BigInt.fromBaseString(ms, base)
    var bdr = digitalRoot.call(nn, base)
    var drs = []
    var ixs = []
    for (n in 1...2*base) {
        nn = BigInt.new(n*n)
        var dr = digitalRoot.call(nn, base)
        if (dr == 0) dr = n * n
        if (dr == bdr) ixs.add(n)
        if (n < base && dr >= bdr) drs.add(dr)
    }
    var inc = 1
    if (ixs.count >= 2 && base != 3) inc = ixs[1] - ixs[0]
    if (drs.count == 0) return [ms, inc, bdr]
    var min = Nums.min(drs)
    var rd = min - bdr
    if (rd == 0) return [ms, inc, bdr]
    if (rd == 1) return [minSq36x[0..base], 1, bdr]
    var ins = minSq36[rd]
    return [(minSq36[0...rd] + ins + minSq36[rd..-1])[0..base], inc, bdr]
}

var start = System.clock
var n = 2
var k = 1
var base = 2
while (true) {
    if (base == 2 || (n % base) != 0) {
        var nb = BigInt.new(n)
        var sq = nb.square.toBaseString(base)
        if (containsAll.call(sq, base)) {
            var ns = Conv.itoa(n, base)
            var tt = System.clock - start
            Fmt.print("Base $2d:$15s² = $-27s in $8.3fs", base, ns, sq, tt)
            if (base == maxBase) break
            base = base + 1
            var res = minStart.call(base)
            var ms = res[0]
            var inc = res[1]
            var bdr = res[2]
            k = inc
            var nn = BigInt.fromBaseString(ms, base)
            nb = nn.isqrt
            if (nb < n + 1) nb = BigInt.new(n+1)
            if (k != 1) {
                while (true) {
                    nn = nb.square
                    var dr = digitalRoot.call(nn, base)
                    if (dr == bdr) {
                        n = nb.toSmall - k
                        break
                    }
                    nb = nb.inc
                }
            } else {
                n = nb.toSmall - k
            }
        }
    }
    n = n + k
}


      * FIZZBUZZ.COB
      * cobc -x -g FIZZBUZZ.COB
      *
       IDENTIFICATION        DIVISION.
       PROGRAM-ID.           fizzbuzz.
       DATA                  DIVISION.
       WORKING-STORAGE       SECTION.
       01 CNT      PIC 9(03) VALUE 1.
       01 REM      PIC 9(03) VALUE 0.
       01 QUOTIENT PIC 9(03) VALUE 0.
       PROCEDURE             DIVISION.
      *
       PERFORM UNTIL CNT > 100
         DIVIDE 15 INTO CNT GIVING QUOTIENT REMAINDER REM
         IF REM = 0
           THEN
             DISPLAY "FizzBuzz " WITH NO ADVANCING
           ELSE
             DIVIDE 3 INTO CNT GIVING QUOTIENT REMAINDER REM
             IF REM = 0
               THEN
                 DISPLAY "Fizz " WITH NO ADVANCING
               ELSE
                 DIVIDE 5 INTO CNT GIVING QUOTIENT REMAINDER REM
                 IF REM = 0
                   THEN
                     DISPLAY "Buzz " WITH NO ADVANCING
                   ELSE
                     DISPLAY CNT " " WITH NO ADVANCING
                 END-IF
             END-IF
         END-IF
         ADD 1 TO CNT
       END-PERFORM
       DISPLAY ""
       STOP RUN.


five_weekends:= proc()
	local i, month, count;
	#Only months with 31 days can possibly satisfy the condition
	local long_months := [1,3,5,7,8,10,12];
	local months := ["January","February","March","April","May","June","July","August","September","October","November","December"];
	count := 0;
	for i from 1900 to 2100 by 1 do
		for month in long_months do
			if Calendar:-DayOfWeek(Date(i, month, 1)) = 6 then
				printf("%d-%s\n", i, months[month]);
				count++;
			end if;
		end do;
	end do;
	printf("%d months have five full weekends.\n", count);
end proc;
five_weekends();


years = {1900, 2100}; months = {1 ,3 ,5 ,7 ,8 ,10 ,12};
result = Select[Tuples[{[email protected]@years, months}], (DateString[# ~ Join ~ 1, "DayNameShort"] == "Fri")&];

Print[result // Length," months with 5 weekends" ];
Print["First months: ", DateString[#,{"MonthName"," ","Year"}]& /@ result[[1 ;; 5]]];
Print["Last months: " , DateString[#,{"MonthName"," ","Year"}]& /@ result[[-5 ;; All]]];
Print[# // Length, " years without 5 weekend months:\n", #] &@
 Complement[Range @@ years, Part[[email protected], 1]];


longmonth = [1 3 5 7 8 10 12];

i = 1;

for y = 1900:2100
    for m = 1:numel(longmonth)
        [num,name] = weekday(datenum(y,longmonth(m),1));
        if num == 6
            x(i,:) = datestr(datenum(y,longmonth(m),1),'mmm yyyy'); %#ok<SAGROW>
            i = i+1;
        end
    end
end

fprintf('There are %i months with 5 weekends between 1900 and 2100.\n',length(x))

fprintf('\n The first 5 months are:\n')
for j = 1:5
    fprintf('\t %s \n',x(j,:))
end

fprintf('\n The final 5 months are:\n')
for j = length(x)-4:length(x)
    fprintf('\t %s \n',x(j,:))
end


/*REXX pgm illustrates  N  1st─class environments  (using numbers from a hailstone seq).*/
parse arg n .                                    /*obtain optional argument from the CL.*/
if n=='' | n==","  then n= 12                    /*Was N defined?  No, then use default.*/
@.=                                              /*initialize the array   @.  to  nulls.*/
                   do i=1  for n;    @.i= i      /*    "      environments to an index. */
                   end   /*i*/
w= length(n)                                     /*width  (so far)  for columnar output.*/

         do forever  until @.0;  @.0= 1          /* ◄─── process all the environments.  */
            do k=1  for n;       x= hailstone(k) /*obtain next hailstone number in seq. */
            w= max(w, length(x))                 /*determine the maximum width needed.  */
            @.k= @.k  x                          /* ◄─── where the rubber meets the road*/
            end   /*k*/
         end      /*forever*/
#= 0                                             /* [↓]   display the tabular results.  */
      do lines=-1  until _='';     _=            /*process a line for each environment. */
          do j=1  for n                          /*process each of the environments.    */
              select                             /*determine how to process the line.   */
              when #== 1      then _= _ right(words(@.j) - 1, w)    /*environment count.*/
              when lines==-1  then _= _ right(j,  w)                /*the title (header)*/
              when lines== 0  then _= _ right('', w, "─")           /*the separator line*/
              otherwise            _= _ right(word(@.j, lines), w)
              end   /*select*/
          end       /*j*/

      if #==1   then #= 2                                           /*separator line?   */
      if _=''   then #= # + 1                                       /*Null?  Bump the #.*/
      if #==1   then _= copies(" "left('', w, "═"), N)              /*the foot separator*/
      if _\=''  then say strip( substr(_, 2), "T")                  /*display the counts*/
      end   /*lines*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hailstone: procedure expose @.; parse arg y;       _= word(@.y, words(@.y) )
           if _==1  then return '';   @.0= 0;   if _//2  then return _*3 + 1;   return _%2


# Build environments
envs = (1..12).map do |n|
  Object.new.instance_eval {@n = n; @cnt = 0; self}
end

# Until all values are 1:
until envs.all? {|e| e.instance_eval{@n} == 1}
  envs.each do |e|
    e.instance_eval do          # Use environment _e_
      printf "%4s", @n
      if @n > 1
        @cnt += 1               # Increment step count
        @n = if @n.odd?         # Calculate next hailstone value
               @n * 3 + 1
             else
               @n / 2
             end
      end
    end
  end
  puts
end
puts '=' * 48
envs.each do |e|                # For each environment _e_
  e.instance_eval do
    printf "%4s", @cnt          # print the step count
  end
end
puts


#include <iostream>
#include <sstream>

class Vector3D {
public:
	Vector3D(double x, double y, double z) {
		this->x = x;
		this->y = y;
		this->z = z;
	}

	double dot(const Vector3D& rhs) const {
		return x * rhs.x + y * rhs.y + z * rhs.z;
	}

	Vector3D operator-(const Vector3D& rhs) const {
		return Vector3D(x - rhs.x, y - rhs.y, z - rhs.z);
	}

	Vector3D operator*(double rhs) const {
		return Vector3D(rhs*x, rhs*y, rhs*z);
	}

	friend std::ostream& operator<<(std::ostream&, const Vector3D&);

private:
	double x, y, z;
};

std::ostream & operator<<(std::ostream & os, const Vector3D &f) {
	std::stringstream ss;
	ss << "(" << f.x << ", " << f.y << ", " << f.z << ")";
	return os << ss.str();
}

Vector3D intersectPoint(Vector3D rayVector, Vector3D rayPoint, Vector3D planeNormal, Vector3D planePoint) {
	Vector3D diff = rayPoint - planePoint;
	double prod1 = diff.dot(planeNormal);
	double prod2 = rayVector.dot(planeNormal);
	double prod3 = prod1 / prod2;
	return rayPoint - rayVector * prod3;
}

int main() {
	Vector3D rv = Vector3D(0.0, -1.0, -1.0);
	Vector3D rp = Vector3D(0.0, 0.0, 10.0);
	Vector3D pn = Vector3D(0.0, 0.0, 1.0);
	Vector3D pp = Vector3D(0.0, 0.0, 5.0);
	Vector3D ip = intersectPoint(rv, rp, pn, pp);

	std::cout << "The ray intersects the plane at " << ip << std::endl;

	return 0;
}


import std.stdio;

struct Vector3D {
    private real x;
    private real y;
    private real z;

    this(real x, real y, real z) {
        this.x = x;
        this.y = y;
        this.z = z;
    }

    auto opBinary(string op)(Vector3D rhs) const {
        static if (op == "+" || op == "-") {
            mixin("return Vector3D(x" ~ op ~ "rhs.x, y" ~ op ~ "rhs.y, z" ~ op ~ "rhs.z);");
        }
    }

    auto opBinary(string op : "*")(real s) const {
        return Vector3D(s*x, s*y, s*z);
    }

    auto dot(Vector3D rhs) const {
        return x*rhs.x + y*rhs.y + z*rhs.z;
    }

    void toString(scope void delegate(const(char)[]) sink) const {
        import std.format;

        sink("(");
        formattedWrite!"%f"(sink, x);
        sink(",");
        formattedWrite!"%f"(sink, y);
        sink(",");
        formattedWrite!"%f"(sink, z);
        sink(")");
    }
}

auto intersectPoint(Vector3D rayVector, Vector3D rayPoint, Vector3D planeNormal, Vector3D planePoint) {
    auto diff = rayPoint - planePoint;
    auto prod1 = diff.dot(planeNormal);
    auto prod2 = rayVector.dot(planeNormal);
    auto prod3 = prod1 / prod2;
    return rayPoint - rayVector * prod3;
}

void main() {
    auto rv = Vector3D(0.0, -1.0, -1.0);
    auto rp = Vector3D(0.0,  0.0, 10.0);
    auto pn = Vector3D(0.0,  0.0,  1.0);
    auto pp = Vector3D(0.0,  0.0,  5.0);
    auto ip = intersectPoint(rv, rp, pn, pp);
    writeln("The ray intersects the plane at ", ip);
}


fcn squareSearch(B){
   basenumerals:=B.pump(String,T("toString",B)); // 13 --> "0123456789abc"
   highest:=("10"+basenumerals[2,*]).toInt(B);   // 13 --> "10" "23456789abc"
   foreach n in ([highest.toFloat().sqrt().toInt() .. highest]){
     ns:=(n*n).toString(B);
     if(""==(basenumerals - ns) ) return(n.toString(B),ns);
  }
  Void
}


for i from 1 to 100
    console.log do
       if      i % 15 == 0 then 'FizzBuzz'
       else if i % 3 == 0 then 'Fizz'
       else if i % 5 == 0 then 'Buzz'
       else i


FIVE
 ;List and count the months between 1/1900 and 12/2100 that have 5 full weekends
 ;Extra credit - list and count years with no months with five full weekends
 ;Using the test that the 31st of a month is on a Sunday
 ;Uses the VA's public domain routine %DTC (Part of the Kernel) named here DIDTC
 NEW YEAR,MONTH,X,Y,CNTMON,NOT,NOTLIST
 ; YEAR is the year we're testing
 ; MONTH is the month we're testing
 ; X is the date in "internal" format, as an input to DOW^DIDTC
 ; Y is the day of the week (0=Sunday, 1=Monday...) output from DOW^DIDTC
 ; CNTMON is a count of the months that have 5 full weekends
 ; NOT is a flag if there were no months with 5 full weekends yet that year
 ; NOTLIST is a list of years that do not have any months with 5 full weekends
 SET CNTMON=0,NOTLIST=""
 WRITE !!,"The following months have five full weekends:"
 FOR YEAR=200:1:400 DO ;years since 12/31/1700 epoch
 . SET NOT=0
 . FOR MONTH="01","03","05","07","08","10","12" DO
 . . SET X=YEAR_MONTH_"31"
 . . DO DOW^DIDTC
 . . IF (Y=0) DO
 . . . SET NOT=NOT+1,CNTMON=CNTMON+1
 . . . WRITE !,MONTH_"-"_(YEAR+1700)
 . SET:(NOT=0) NOTLIST=NOTLIST_$SELECT($LENGTH(NOTLIST)>1:",",1:"")_(YEAR+1700)
 WRITE !,"For a total of "_CNTMON_" months."
 WRITE !!,"There are "_$LENGTH(NOTLIST,",")_" years with no five full weekends in any month."
 WRITE !,"They are: "_NOTLIST
 KILL YEAR,MONTH,X,Y,CNTMON,NOT,NOTLIST
 QUIT
F ;Same logic as the main entry point, shortened format
 N R,M,X,Y,C,N,L S C=0,L=""
 W !!,"The following months have five full weekends:"
 F R=200:1:400 D
 . S N=0 F M="01","03","05","07","08","10","12" S X=R_M_"31" D DOW^DIDTC I 'Y S N=N+1,C=C+1 W !,M_"-"_(R+1700)
 . S:'N L=L_$S($L(L):",",1:"")_(R+1700)
 W !,"For a total of "_C_" months.",!!,"There are "_$L(L,",")_" years with no five full weekends in any month.",!,"They are: "_L
 Q


func calculator({.is_one}   ) { 1 }
func calculator(n {.is_even}) { n / 2 }
func calculator(n           ) { 3*n + 1 }

func succ(this {_{:value}.is_one}, _) {
    return this
}

func succ(this, get_next) {
    this{:value} = get_next(this{:value})
    this{:count}++
    return this
}

var enviornments = (1..12 -> map {|i| Hash(value => i, count => 0) });

while (!enviornments.map{ _{:value} }.all { .is_one }) {
    say enviornments.map {|h| "%4s" % h{:value} }.join;
    enviornments.range.each { |i|
        enviornments[i] = succ(enviornments[i], calculator);
    }
}

say 'Counts';
say enviornments.map{ |h| "%4s" % h{:count} }.join;


package require Tcl 8.5

for {set i 1} {$i <= 12} {incr i} {
    dict set hailenv hail$i [dict create num $i steps 0]
}
while 1 {
    set loopagain false
    foreach k [dict keys $hailenv] {
	dict with hailenv $k {
	    puts -nonewline [format %4d $num]
	    if {$num == 1} {
		continue
	    } elseif {$num & 1} {
		set num [expr {3*$num + 1}]
	    } else {
		set num [expr {$num / 2}]
	    }
	    set loopagain true
	    incr steps
	}
    }
    puts ""
    if {!$loopagain} break
}
puts "Counts..."
foreach k [dict keys $hailenv] {
    dict with hailenv $k {
	puts -nonewline [format %4d $steps]
    }
}
puts ""


open System

type Vector(x : double, y : double, z : double) =
    member this.x = x
    member this.y = y
    member this.z = z
    static member (-) (lhs : Vector, rhs : Vector) =
        Vector(lhs.x - rhs.x, lhs.y - rhs.y, lhs.z - rhs.z)
    static member (*) (lhs : Vector, rhs : double) =
        Vector(lhs.x * rhs, lhs.y * rhs, lhs.z * rhs)
    override this.ToString() =
        String.Format("({0:F}, {1:F}, {2:F})", x, y, z)

let Dot (lhs:Vector) (rhs:Vector) =
    lhs.x * rhs.x + lhs.y * rhs.y + lhs.z * rhs.z

let IntersectPoint rayVector rayPoint planeNormal planePoint =
    let diff = rayPoint - planePoint
    let prod1 = Dot diff planeNormal
    let prod2 = Dot rayVector planeNormal
    let prod3 = prod1 / prod2
    rayPoint - rayVector * prod3

[<EntryPoint>]
let main _ =
    let rv = Vector(0.0, -1.0, -1.0)
    let rp = Vector(0.0, 0.0, 10.0)
    let pn = Vector(0.0, 0.0, 1.0)
    let pp = Vector(0.0, 0.0, 5.0)
    let ip = IntersectPoint rv rp pn pp
    Console.WriteLine("The ray intersects the plane at {0}", ip)

    0 // return an integer exit code


USING: io locals math.vectors prettyprint ;

:: intersection-point ( rdir rpt pnorm ppt -- loc )
    rpt rdir pnorm rpt ppt v- v. v*n rdir pnorm v. v/n v- ;

"The ray intersects the plane at " write
{ 0 -1 -1 } { 0 0 10 } { 0 0 1 } { 0 0 5 } intersection-point .


def fizzbuzz(n):
      case (n % 3, n % 5):
          match (0, 0): return "FizzBuzz"
          match (0, _): return "Fizz"
          match (_, 0): return "Buzz"
      else: return n |> str
range(1,101)|> map$(fizzbuzz)|> x -> '\n'.join(x)|> print


#!/usr/local/bin/newlisp

(context 'KR)

(define (Kraitchik year month day)
    ; See https://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week#Kraitchik.27s_variation
    ; Function adapted for specific task (not for general usage).
    (if (or (= 1 month) (= 2 month))
        (dec year)
    )
    ;- - - -
    (setf m-table '(_ 1 4 3 6 1 4 6 2 5 0 3 5)) ; - - - First element of list is dummy!
    (setf m (m-table month))
    ;- - - -
    (setf c-table '(0 5 3 1))
    (setf century%4 (mod (int (slice (string year) 0 2)) 4))
    (setf c (c-table century%4))
    ;- - - -
    (setf yy* (slice (string year) -2))
    (if (= "0" (yy* 0))
        (setf yy* (yy* 1))
    )
    (setf yy (int yy*))
    (setf y  (mod (+ (/ yy 4) yy) 7))
    ;- - - -
    (setf dow-table '(6 0 1 2 3 4 5))
    (dow-table (mod (+ day m c y) 7))
)

(context 'MAIN)

(setf Fives 0)
(setf NotFives 0)
(setf Report '())
(setf months-table '((1 "Jan") (3 "Mar") (5 "May") (7 "Jul") (8 "Aug") (10 "Oct") (12 "Dec")))

(for (y 1900 2100)
    (setf FivesFound 0)
    (setf Names "")
    (dolist (m '(1 3 5 7 8 10 12))
        (setf Dow (KR:Kraitchik y m 1))
        (if (= 5 Dow)
            (begin
                (++ FivesFound)
                (setf Names (string Names " " (lookup m months-table)))
            )
        )
    )

    (if (zero? FivesFound)
        (++ NotFives)
        (begin
            (setf Report (append Report (list (list y FivesFound (string "(" Names " )")))))
            (setf Fives (+ Fives FivesFound))
        )
    )
)

;- - - - Display all report data
;(dolist (x Report)
;    (println (x 0) ": " (x 1) " " (x 2))
;)

;- - - - Display only first five and last five records
(dolist (x (slice Report 0 5))
    (println (x 0) ": " (x 1) " " (x 2))
)
(println "...")
(dolist (x (slice Report -5))
    (println (x 0) ": " (x 1) " " (x 2))
)

(println "\nTotal months with five weekends: " Fives)
(println "Years with no five weekends months: " NotFives)
(exit)


import "/fmt" for Fmt

var environment = Fn.new {
    class E {
        construct new(value, count) {
            _value = value
            _count = count
        }

        value { _value }
        count { _count }

        hailstone() {
            Fmt.write("$4d", _value)
            if (_value == 1) return
            _count = _count + 1
            _value = (_value%2 == 0) ? _value/2 : 3*_value + 1
        }
    }
    return E
}

// create and initialize the environments
var jobs = 12
var envs = List.filled(jobs, null)
for (i in 0...jobs) envs[i] = environment.call().new(i+1, 0)
System.print("Sequences:")
var done = false
while (!done) {
    for (env in envs) env.hailstone()
    System.print()
    done = true
    for (env in envs) {
        if (env.value != 1) {
            done = false
            break
        }
    }
}
System.print("Counts:")
for (env in envs) Fmt.write("$4d", env.count)
System.print()


class Env{
   var n,cnt=0;
   fcn init(_n){n=_n; returnClass(self.f)}
   fcn f{
      if(n!=1){
         cnt += 1;
         if(n.isEven) n=n/2; else n=n*3+1;
      }
      n
   }
}


' version 11-07-2018
' compile with: fbc -s console

Type vector3d
    Dim As Double x, y ,z
    Declare Constructor ()
    Declare Constructor (ByVal x As Double, ByVal y As Double, ByVal z As Double)
End Type

Constructor vector3d()
    This.x = 0
    This.y = 0
    This.z = 0
End Constructor

Constructor vector3d(ByVal x As Double, ByVal y As Double, ByVal z As Double)
    This.x = x
    This.y = y
    This.z = z
End Constructor

Operator + (lhs As vector3d, rhs As vector3d) As vector3d
    Return Type(lhs.x + rhs.x, lhs.y + rhs.y, lhs.z + rhs.z)
End Operator

Operator - (lhs As vector3d, rhs As vector3d) As vector3d
    Return Type(lhs.x - rhs.x, lhs.y - rhs.y, lhs.z - rhs.z)
End Operator

Operator * (lhs As vector3d, d As Double) As vector3d
    Return Type(lhs.x * d, lhs.y * d, lhs.z * d)
End Operator

Function dot(lhs As vector3d, rhs As vector3d) As Double
    Return lhs.x * rhs.x + lhs.y * rhs.y + lhs.z * rhs.z
End Function

Function tostring(vec As vector3d) As String
    Return "(" + Str(vec.x) + ", " + Str(vec.y) + ", " + Str(vec.z) + ")"
End Function

Function intersectpoint(rayvector As vector3d, raypoint As vector3d, _
                    planenormal As vector3d, planepoint As vector3d) As vector3d

    Dim As vector3d diff = raypoint - planepoint
    Dim As Double prod1 = dot(diff, planenormal)
    Dim As double prod2 = dot(rayvector, planenormal)
    Return raypoint - rayvector * (prod1 / prod2)

End Function

' ------=< MAIN >=------

Dim As vector3d rv = Type(0, -1, -1)
Dim As vector3d rp = Type(0,  0, 10)
Dim As vector3d pn = Type(0,  0,  1)
Dim As vector3d pp = Type(0,  0,  5)
Dim As vector3d ip = intersectpoint(rv, rp, pn, pp)

print
Print "line intersects the plane at "; tostring(ip)

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


package main

import "fmt"

type Vector3D struct{ x, y, z float64 }

func (v *Vector3D) Add(w *Vector3D) *Vector3D {
    return &Vector3D{v.x + w.x, v.y + w.y, v.z + w.z}
}

func (v *Vector3D) Sub(w *Vector3D) *Vector3D {
    return &Vector3D{v.x - w.x, v.y - w.y, v.z - w.z}
}

func (v *Vector3D) Mul(s float64) *Vector3D {
    return &Vector3D{s * v.x, s * v.y, s * v.z}
}

func (v *Vector3D) Dot(w *Vector3D) float64 {
    return v.x*w.x + v.y*w.y + v.z*w.z
}

func (v *Vector3D) String() string {
    return fmt.Sprintf("(%v, %v, %v)", v.x, v.y, v.z)
}

func intersectPoint(rayVector, rayPoint, planeNormal, planePoint *Vector3D) *Vector3D {
    diff := rayPoint.Sub(planePoint)
    prod1 := diff.Dot(planeNormal)
    prod2 := rayVector.Dot(planeNormal)
    prod3 := prod1 / prod2
    return rayPoint.Sub(rayVector.Mul(prod3))
}

func main() {
    rv := &Vector3D{0.0, -1.0, -1.0}
    rp := &Vector3D{0.0, 0.0, 10.0}
    pn := &Vector3D{0.0, 0.0, 1.0}
    pp := &Vector3D{0.0, 0.0, 5.0}
    ip := intersectPoint(rv, rp, pn, pp)
    fmt.Println("The ray intersects the plane at", ip)
}


for i in [1..100]
  if i % 15 is 0
    console.log "FizzBuzz"
  else if i % 3 is 0
    console.log "Fizz"
  else if i % 5 is 0
    console.log "Buzz"
  else
    console.log i


import times

const LongMonths = {mJan, mMar, mMay, mJul, mAug, mOct, mDec}

var sumNone = 0
for year in 1900..2100:
  var none = true
  for month in LongMonths:
    if initDateTime(1, month, year, 0, 0, 0).weekday == dFri:
      echo month, " ", year
      none = false
  if none: inc sumNone

echo "\nYears without a 5 weekend month: ", sumNone


open CalendarLib

let list_first_five = function
  | x1 :: x2 :: x3 :: x4 :: x5 :: _ -> [x1; x2; x3; x4; x5]
  | _ -> invalid_arg "list_first_five"

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


class LinePlaneIntersection {
    private static class Vector3D {
        private double x, y, z

        Vector3D(double x, double y, double z) {
            this.x = x
            this.y = y
            this.z = z
        }

        Vector3D plus(Vector3D v) {
            return new Vector3D(x + v.x, y + v.y, z + v.z)
        }

        Vector3D minus(Vector3D v) {
            return new Vector3D(x - v.x, y - v.y, z - v.z)
        }

        Vector3D multiply(double s) {
            return new Vector3D(s * x, s * y, s * z)
        }

        double dot(Vector3D v) {
            return x * v.x + y * v.y + z * v.z
        }

        @Override
        String toString() {
            return "($x, $y, $z)"
        }
    }

    private static Vector3D intersectPoint(Vector3D rayVector, Vector3D rayPoint, Vector3D planeNormal, Vector3D planePoint) {
        Vector3D diff = rayPoint - planePoint
        double prod1 = diff.dot(planeNormal)
        double prod2 = rayVector.dot(planeNormal)
        double prod3 = prod1 / prod2
        return rayPoint - rayVector * prod3
    }

    static void main(String[] args) {
        Vector3D rv = new Vector3D(0.0, -1.0, -1.0)
        Vector3D rp = new Vector3D(0.0, 0.0, 10.0)
        Vector3D pn = new Vector3D(0.0, 0.0, 1.0)
        Vector3D pp = new Vector3D(0.0, 0.0, 5.0)
        Vector3D ip = intersectPoint(rv, rp, pn, pp)
        println("The ray intersects the plane at $ip")
    }
}


import Control.Applicative (liftA2)
import Text.Printf (printf)

data V3 a = V3 a a a
    deriving Show

instance Functor V3 where
    fmap f (V3 a b c) = V3 (f a) (f b) (f c)

instance Applicative V3 where
    pure a = V3 a a a
    V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)

instance Num a => Num (V3 a) where
    (+) = liftA2 (+)
    (-) = liftA2 (-)
    (*) = liftA2 (*)
    negate = fmap negate
    abs = fmap abs
    signum = fmap signum
    fromInteger = pure . fromInteger

dot ::Num a => V3 a -> V3 a -> a
dot a b = x + y + z
  where
    V3 x y z = a * b

intersect :: Fractional a => V3 a -> V3 a -> V3 a -> V3 a -> V3 a
intersect rayVector rayPoint planeNormal planePoint =
    rayPoint - rayVector * pure prod3
  where
    diff = rayPoint - planePoint
    prod1 = diff `dot` planeNormal
    prod2 = rayVector `dot` planeNormal
    prod3 = prod1 / prod2

main = printf "The ray intersects the plane at (%f, %f, %f)\n" x y z
  where
    V3 x y z = intersect rv rp pn pp :: V3 Double
    rv = V3 0 (-1) (-1)
    rp = V3 0 0 10
    pn = V3 0 0 1
    pp = V3 0 0 5


<Cfloop from="1" to="100" index="i">
  <Cfif i mod 15 eq 0>FizzBuzz
  <Cfelseif i mod 5 eq 0>Fizz
  <Cfelseif i mod 3 eq 0>Buzz
  <Cfelse><Cfoutput>#i# </Cfoutput>
  </Cfif>
</Cfloop>


: fiveWeekEnd(y1, y2)
| y m |

   ListBuffer new
   y1 y2 for: y [
      Date.JANUARY Date.DECEMBER for: m [
         Date.DaysInMonth(y, m) 31 ==
         [ y, m, 01 ] asDate dayOfWeek Date.FRIDAY == and
            ifTrue: [ [ y, m ] over add ]
         ]
      ]
   dup size println dup left(5) println right(5) println ;


mp=: +/ .*                          NB. matrix product
p=: mp&{: %~ -~&{. mp {:@]          NB. solve
intersectLinePlane=: [ +/@:* 1 , p  NB. substitute