# syntax: GAWK -f PYTHAGOREAN_TRIPLES.AWK
# converted from Go
BEGIN {
    printf("%5s %11s %11s %11s %s\n","limit","limit","triples","primitives","seconds")
    for (max_peri=10; max_peri<=1E9; max_peri*=10) {
      t = systime()
      prim = 0
      total = 0
      new_tri(3,4,5)
      printf("10^%-2d %11d %11d %11d %d\n",++n,max_peri,total,prim,systime()-t)
    }
    exit(0)
}
function new_tri(s0,s1,s2,  p) {
    p = s0 + s1 + s2
    if (p <= max_peri) {
      prim++
      total += int(max_peri / p)
      new_tri(+1*s0-2*s1+2*s2,+2*s0-1*s1+2*s2,+2*s0-2*s1+3*s2)
      new_tri(+1*s0+2*s1+2*s2,+2*s0+1*s1+2*s2,+2*s0+2*s1+3*s2)
      new_tri(-1*s0+2*s1+2*s2,-2*s0+1*s1+2*s2,-2*s0+2*s1+3*s2)
    }
}


function uint32(n)
    return n & 0xffffffff
end

function uint64(n)
    return n & 0xffffffffffffffff
end

N = 6364136223846793005
state = 0x853c49e6748fea9b
inc = 0xda3e39cb94b95bdb

function pcg32_seed(seed_state, seed_sequence)
    state = 0
    inc = (seed_sequence << 1) | 1
    pcg32_int()
    state = state + seed_state
    pcg32_int()
end

function pcg32_int()
    local old = state
    state = uint64(old * N + inc)
    local shifted = uint32(((old >> 18) ~ old) >> 27)
    local rot = uint32(old >> 59)
    return uint32((shifted >> rot) | (shifted << ((~rot + 1) & 31)))
end

function pcg32_float()
    return 1.0 * pcg32_int() / (1 << 32)
end

-------------------------------------------------------------------

pcg32_seed(42, 54)
print(pcg32_int())
print(pcg32_int())
print(pcg32_int())
print(pcg32_int())
print(pcg32_int())
print()

counts = { 0, 0, 0, 0, 0 }
pcg32_seed(987654321, 1)
for i=1,100000 do
    local j = math.floor(pcg32_float() * 5.0) + 1
    counts[j] = counts[j] + 1
end

print("The counts for 100,000 repetitions are:")
for i=1,5 do
    print("  " .. (i - 1) .. ": " .. counts[i])
end


(pythagoreanTriples=
  total prim max-peri U
.       (.(1,-2,2) (2,-1,2) (2,-2,3))
        (.(1,2,2) (2,1,2) (2,2,3))
        (.(-1,2,2) (-2,1,2) (-2,2,3))
    : ?U
  & ( new-tri
    =     i t p Urows Urow Ucols
        , a b c loop A B C
      .     !arg:(,?a,?b,?c)
          & !a+!b+!c:~>!max-peri:?p
          & 1+!prim:?prim
          & div$(!max-peri.!p)+!total:?total
          & !U:?Urows
          & ( loop
            =   !Urows:(.?Urow) ?Urows
              & !Urow:?Ucols
              & :?t
              &   whl
                ' ( !Ucols:(?A,?B,?C) ?Ucols
                  & (!t,!a*!A+!b*!B+!c*!C):?t
                  )
              & new-tri$!t
              & !loop
            )
          & !loop
        |
    )
  & ( Main
    =   seed
      .   (,3,4,5):?seed
        & 10:?max-peri
        &   whl
          ' ( 0:?total:?prim
            & new-tri$!seed
            &   out
              $ ( str
                $ ( "Up to "
                    !max-peri
                    ": "
                    !total
                    " triples, "
                    !prim
                    " primitives."
                  )
                )
            & !max-peri*10:~>10000000:?max-peri
            )
    )
  & Main$
);

pythagoreanTriples$;


#include <stdio.h>
#include <stdlib.h>

typedef unsigned long long xint;
typedef unsigned long ulong;

inline ulong gcd(ulong m, ulong n)
{
    ulong t;
    while (n) { t = n; n = m % n; m = t; }
    return m;
}

int main()
{
    ulong a, b, c, pytha = 0, prim = 0, max_p = 100;
    xint aa, bb, cc;

    for (a = 1; a <= max_p / 3; a++) {
        aa = (xint)a * a;
        printf("a = %lu\r", a); /* show that we are working */
        fflush(stdout);

        /*  max_p/2: valid limit, because one side of triangle
         *  must be less than the sum of the other two
         */
        for (b = a + 1; b < max_p/2; b++) {
            bb = (xint)b * b;
            for (c = b + 1; c < max_p/2; c++) {
                cc = (xint)c * c;
                if (aa + bb < cc) break;
                if (a + b + c > max_p) break;

                if (aa + bb == cc) {
                    pytha++;
                    if (gcd(a, b) == 1) prim++;
                }
            }
        }
    }

    printf("Up to %lu, there are %lu triples, of which %lu are primitive\n",
        max_p, pytha, prim);

    return 0;
}


INCLUDE "H6:REALMATH.ACT"

DEFINE A_="+0"
DEFINE B_="+6"
DEFINE C_="+12"
DEFINE D_="+18"

TYPE Quaternion=[CARD a1,a2,a3,b1,b2,b3,c1,c2,c3,d1,d2,d3]
REAL neg

PROC Init()
  ValR("-1",neg)
RETURN

BYTE FUNC Positive(REAL POINTER x)
  BYTE ARRAY tmp

  tmp=x
  IF (tmp(0)&$80)=$00 THEN
    RETURN (1)
  FI
RETURN (0)

PROC PrintQuat(Quaternion POINTER q)
  PrintR(q A_)
  IF Positive(q B_) THEN Put('+) FI
  PrintR(q B_) Put('i)
  IF Positive(q C_) THEN Put('+) FI
  PrintR(q C_) Put('j)
  IF Positive(q D_) THEN Put('+) FI
  PrintR(q D_) Put('k)
RETURN

PROC PrintQuatE(Quaternion POINTER q)
  PrintQuat(q) PutE()
RETURN

PROC QuatIntInit(Quaternion POINTER q INT ia,ib,ic,id)
  IntToReal(ia,q A_)
  IntToReal(ib,q B_)
  IntToReal(ic,q C_)
  IntToReal(id,q D_)
RETURN

PROC Sqr(REAL POINTER a,b)
  RealMult(a,a,b)
RETURN

PROC QuatNorm(Quaternion POINTER q REAL POINTER res)
  REAL r1,r2,r3

  Sqr(q A_,r1)      ;r1=q.a^2
  Sqr(q B_,r2)      ;r2=q.b^2
  RealAdd(r1,r2,r3) ;r3=q.a^2+q.b^2
  Sqr(q C_,r1)      ;r1=q.c^2
  RealAdd(r3,r1,r2) ;r2=q.a^2+q.b^2+q.c^2
  Sqr(q D_,r1)      ;r1=q.d^2
  RealAdd(r2,r1,r3) ;r3=q.a^2+q.b^2+q.c^2+q.d^2
  Sqrt(r3,res)      ;res=sqrt(q.a^2+q.b^2+q.c^2+q.d^2)
RETURN

PROC QuatNegative(Quaternion POINTER q,res)
  RealMult(q A_,neg,res A_) ;res.a=-q.a
  RealMult(q B_,neg,res B_) ;res.b=-q.b
  RealMult(q C_,neg,res C_) ;res.c=-q.c
  RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN

PROC QuatConjugate(Quaternion POINTER q,res)
  RealAssign(q A_,res A_)   ;res.a=q.a
  RealMult(q B_,neg,res B_) ;res.b=-q.b
  RealMult(q C_,neg,res C_) ;res.c=-q.c
  RealMult(q D_,neg,res D_) ;res.d=-q.d
RETURN

PROC QuatAddReal(Quaternion POINTER q REAL POINTER r
                 Quaternion POINTER res)
  RealAdd(q A_,r,res A_)  ;res.a=q.a+r
  RealAssign(q B_,res B_) ;res.b=q.b
  RealAssign(q C_,res C_) ;res.c=q.c
  RealAssign(q D_,res D_) ;res.d=q.d
RETURN

PROC QuatAdd(Quaternion POINTER q1,q2,res)
  RealAdd(q1 A_,q2 A_,res A_) ;res.a=q1.a+q2.a
  RealAdd(q1 B_,q2 B_,res B_) ;res.b=q1.b+q2.b
  RealAdd(q1 C_,q2 C_,res C_) ;res.c=q1.c+q2.c
  RealAdd(q1 D_,q2 D_,res D_) ;res.d=q1.d+q2.d
RETURN

PROC QuatMultReal(Quaternion POINTER q REAL POINTER r
                  Quaternion POINTER res)
  RealMult(q A_,r,res A_) ;res.a=q.a*r
  RealMult(q B_,r,res B_) ;res.b=q.b*r
  RealMult(q C_,r,res C_) ;res.c=q.c*r
  RealMult(q D_,r,res D_) ;res.d=q.d*r
RETURN

PROC QuatMult(Quaternion POINTER q1,q2,res)
  REAL r1,r2

  RealMult(q1 A_,q2 A_,r1) ;r1=q1.a*q2.a
  RealMult(q1 B_,q2 B_,r2) ;r2=q1.b*q2.b
  RealSub(r1,r2,r3)        ;r3=q1.a*q2.a-q1.b*q2.b
  RealMult(q1 C_,q2 C_,r1) ;r1=q1.c*q2.c
  RealSub(r3,r1,r2)        ;r2=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c
  RealMult(q1 D_,q2 D_,r1) ;r1=q1.d*q2.d
  RealSub(r2,r1,res A_)    ;res.a=q1.a*q2.a-q1.b*q2.b-q1.c*q2.c-q1.d*q2.d

  RealMult(q1 A_,q2 B_,r1) ;r1=q1.a*q2.b
  RealMult(q1 B_,q2 A_,r2) ;r2=q1.b*q2.a
  RealAdd(r1,r2,r3)        ;r3=q1.a*q2.b+q1.b*q2.a
  RealMult(q1 C_,q2 D_,r1) ;r1=q1.c*q2.d
  RealAdd(r3,r1,r2)        ;r2=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d
  RealMult(q1 D_,q2 C_,r1) ;r1=q1.d*q2.c
  RealSub(r2,r1,res B_)    ;res.b=q1.a*q2.b+q1.b*q2.a+q1.c*q2.d-q1.d*q2.c

  RealMult(q1 A_,q2 C_,r1) ;r1=q1.a*q2.c
  RealMult(q1 B_,q2 D_,r2) ;r2=q1.b*q2.d
  RealSub(r1,r2,r3)        ;r3=q1.a*q2.c-q1.b*q2.d
  RealMult(q1 C_,q2 A_,r1) ;r1=q1.c*q2.a
  RealAdd(r3,r1,r2)        ;r2=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a
  RealMult(q1 D_,q2 B_,r1) ;r1=q1.d*q2.b
  RealAdd(r2,r1,res C_)    ;res.c=q1.a*q2.c-q1.b*q2.d+q1.c*q2.a+q1.d*q2.b

  RealMult(q1 A_,q2 D_,r1) ;r1=q1.a*q2.d
  RealMult(q1 B_,q2 C_,r2) ;r2=q1.b*q2.c
  RealAdd(r1,r2,r3)        ;r3=q1.a*q2.d+q1.b*q2.c
  RealMult(q1 C_,q2 B_,r1) ;r1=q1.c*q2.b
  RealSub(r3,r1,r2)        ;r2=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b
  RealMult(q1 D_,q2 A_,r1) ;r1=q1.d*q2.a
  RealAdd(r2,r1,res D_)    ;res.d=q1.a*q2.d+q1.b*q2.c-q1.c*q2.b+q1.d*q2.a
RETURN

PROC Main()
  Quaternion q,q1,q2,q3
  REAL r,r2

  Put(125) PutE() ;clear the screen
  MathInit()
  Init()

  QuatIntInit(q,1,2,3,4)
  QuatIntInit(q1,2,3,4,5)
  QuatIntInit(q2,3,4,5,6)
  IntToReal(7,r)

  Print(" q = ") PrintQuatE(q)
  Print("q1 = ") PrintQuatE(q1)
  Print("q2 = ") PrintQuatE(q2)
  Print(" r = ") PrintRE(r) PutE()

  QuatNorm(q,r2) Print(" Norm(q) = ") PrintRE(r2)
  QuatNorm(q1,r2) Print("Norm(q1) = ") PrintRE(r2)
  QuatNorm(q2,r2) Print("Norm(q2) = ") PrintRE(r2)
  QuatNegative(q,q3) Print("      -q = ") PrintQuatE(q3)
  QuatConjugate(q,q3) Print(" Conj(q) = ") PrintQuatE(q3)
  QuatAddReal(q,r,q3) Print("     q+r = ") PrintQuatE(q3)
  QuatAdd(q1,q2,q3) Print("   q1+q2 = ") PrintQuatE(q3)
  QuatAdd(q2,q1,q3) Print("   q2+q1 = ") PrintQuatE(q3)
  QuatMultReal(q,r,q3) Print("     q*r = ") PrintQuatE(q3)
  QuatMult(q1,q2,q3) Print("   q1*q2 = ") PrintQuatE(q3)
  QuatMult(q2,q1,q3) Print("   q2*q1 = ") PrintQuatE(q3)
RETURN


import algorithm, sequtils, strutils, tables

const N = 6364136223846793005u64

type PCG32 = object
  inc: uint64
  state: uint64

func seed(gen: var PCG32; seedState, seedSequence: uint64) =
  gen.inc = seedSequence shl 1 or 1
  gen.state = (gen.inc + seedState) * N + gen.inc

func nextInt(gen: var PCG32): uint32 =
  let xs = uint32((gen.state shr 18 xor gen.state) shr 27)
  let rot = int32(gen.state shr 59)
  result = uint32(xs shr rot or xs shl (-rot and 31))
  gen.state = gen.state * N + gen.inc

func nextFloat(gen: var PCG32): float =
  gen.nextInt().float / float(0xFFFFFFFFu32)

when isMainModule:

  var gen: PCG32

  gen.seed(42, 54)
  for _ in 1..5:
    echo gen.nextInt()

  echo ""
  gen.seed(987654321, 1)
  var counts: CountTable[int]
  for _ in 1..100_000:
    counts.inc int(gen.nextFloat() * 5)
  echo sorted(toSeq(counts.pairs)).mapIt($it[0] & ": " & $it[1]).join(", ")


use strict;
use warnings;
use feature 'say';
use Math::AnyNum qw(:overload);

package PCG32 {

    use constant {
        mask32 => 2**32 - 1,
        mask64 => 2**64 - 1,
        const  => 6364136223846793005,
    };

    sub new {
        my ($class, %opt) = @_;
        my $seed = $opt{seed} // 1;
        my $incr = $opt{incr} // 2;
        $incr = $incr << 1 | 1 & mask64;
        my $state = (($incr + $seed) * const + $incr) & mask64;
        bless {incr => $incr, state => $state}, $class;
    }

    sub next_int {
        my ($self) = @_;
        my $state  = $self->{state};
        my $shift  = ($state >> 18 ^ $state) >> 27 & mask32;
        my $rotate = $state >> 59 & mask32;
        $self->{state} = ($state * const + $self->{incr}) & mask64;
        ($shift >> $rotate) | $shift << (32 - $rotate) & mask32;
    }

    sub next_float {
        my ($self) = @_;
        $self->next_int / 2**32;
    }
}

say "Seed: 42, Increment: 54, first 5 values:";
my $rng = PCG32->new(seed => 42, incr => 54);
say $rng->next_int for 1 .. 5;

say "\nSeed: 987654321, Increment: 1, values histogram:";
my %h;
$rng = PCG32->new(seed => 987654321, incr => 1);
$h{int 5 * $rng->next_float}++ for 1 .. 100_000;
say "$_ $h{$_}" for sort keys %h;


#include <cmath>
#include <iostream>
#include <numeric>
#include <tuple>
#include <vector>

using namespace std;

auto CountTriplets(unsigned long long maxPerimeter)
{
    unsigned long long totalCount = 0;
    unsigned long long primitveCount = 0;
    auto max_M = (unsigned long long)sqrt(maxPerimeter/2) + 1;
    for(unsigned long long m = 2; m < max_M; ++m)
    {
        for(unsigned long long n = 1 + m % 2; n < m; n+=2)
        {
            if(gcd(m,n) != 1)
            {
                continue;
            }

            // The formulas below will generate primitive triples if:
            //   0 < n < m
            //   m and n are relatively prime (gcd == 1)
            //   m + n is odd

            auto a = m * m - n * n;
            auto b = 2 * m * n;
            auto c = m * m + n * n;
            auto perimeter = a + b + c;
            if(perimeter <= maxPerimeter)
            {
                primitveCount++;
                totalCount+= maxPerimeter / perimeter;
            }
        }
    }

    return tuple(totalCount, primitveCount);
}

int main()
{
    vector<unsigned long long> inputs{100, 1000, 10'000, 100'000,
        1000'000, 10'000'000, 100'000'000, 1000'000'000,
        10'000'000'000};  // This last one takes almost a minute
    for(auto maxPerimeter : inputs)
    {
        auto [total, primitive] = CountTriplets(maxPerimeter);
        cout << "\nMax Perimeter: " << maxPerimeter << ", Total: " << total << ", Primitive: " << primitive ;
    }
}


generic
   type Real is digits <>;
package Quaternions is
   type Quaternion is record
      A, B, C, D : Real;
   end record;
   function "abs" (Left : Quaternion) return Real;
   function Conj (Left : Quaternion) return Quaternion;
   function "-" (Left : Quaternion) return Quaternion;
   function "+" (Left, Right : Quaternion) return Quaternion;
   function "-" (Left, Right : Quaternion) return Quaternion;
   function "*" (Left : Quaternion; Right : Real) return Quaternion;
   function "*" (Left : Real; Right : Quaternion) return Quaternion;
   function "*" (Left, Right : Quaternion) return Quaternion;
   function Image (Left : Quaternion) return String;
end Quaternions;


puts(1,"NB: These are not expected to match the task spec!\n")
set_rand(42)
for i=1 to 5 do
    printf(1,"%d\n",rand(-1))
end for
set_rand(987654321)
sequence s = repeat(0,5)
for i=1 to 100000 do
    s[floor(rnd()*5)+1] += 1
end for
?s


mask64 = (1 << 64) - 1
mask32 = (1 << 32) - 1
CONST = 6364136223846793005

class PCG32():

    def __init__(self, seed_state=None, seed_sequence=None):
        if all(type(x) == int for x in (seed_state, seed_sequence)):
            self.seed(seed_state, seed_sequence)
        else:
            self.state = self.inc = 0

    def seed(self, seed_state, seed_sequence):
        self.state = 0
        self.inc = ((seed_sequence << 1) | 1) & mask64
        self.next_int()
        self.state = (self.state + seed_state)
        self.next_int()

    def next_int(self):
        "return random 32 bit unsigned int"
        old = self.state
        self.state = ((old * CONST) + self.inc) & mask64
        xorshifted = (((old >> 18) ^ old) >> 27) & mask32
        rot = (old >> 59) & mask32
        answer = (xorshifted >> rot) | (xorshifted << ((-rot) & 31))
        answer = answer &mask32

        return answer

    def  next_float(self):
        "return random float between 0 and 1"
        return self.next_int() / (1 << 32)

if __name__ == '__main__':
    random_gen = PCG32()
    random_gen.seed(42, 54)
    for i in range(5):
        print(random_gen.next_int())

    random_gen.seed(987654321, 1)
    hist = {i:0 for i in range(5)}
    for i in range(100_000):
        hist[int(random_gen.next_float() *5)] += 1
    print(hist)


using System;

namespace RosettaCode.CSharp
{
    class Program
    {
        static void Count_New_Triangle(ulong A, ulong B, ulong C, ulong Max_Perimeter, ref ulong Total_Cnt, ref ulong Primitive_Cnt)
        {
            ulong Perimeter = A + B + C;

            if (Perimeter <= Max_Perimeter)
            {
                Primitive_Cnt = Primitive_Cnt + 1;
                Total_Cnt = Total_Cnt + Max_Perimeter / Perimeter;
                Count_New_Triangle(A + 2 * C - 2 * B, 2 * A + 2 * C - B, 2 * A + 3 * C - 2 * B, Max_Perimeter, ref Total_Cnt, ref Primitive_Cnt);
                Count_New_Triangle(A + 2 * B + 2 * C, 2 * A + B + 2 * C, 2 * A + 2 * B + 3 * C, Max_Perimeter, ref Total_Cnt, ref Primitive_Cnt);
                Count_New_Triangle(2 * B + 2 * C - A, B + 2 * C - 2 * A, 2 * B + 3 * C - 2 * A, Max_Perimeter, ref Total_Cnt, ref Primitive_Cnt);
            }
        }

        static void Count_Pythagorean_Triples()
        {
            ulong T_Cnt, P_Cnt;

            for (int I = 1; I <= 8; I++)
            {
                T_Cnt = 0;
                P_Cnt = 0;
                ulong ExponentNumberValue = (ulong)Math.Pow(10, I);
                Count_New_Triangle(3, 4, 5, ExponentNumberValue, ref T_Cnt, ref P_Cnt);
                Console.WriteLine("Perimeter up to 10E" + I + " : " + T_Cnt + " Triples, " + P_Cnt + " Primitives");
            }
        }

        static void Main(string[] args)
        {
            Count_Pythagorean_Triples();
        }
    }
}


# -*- coding: utf-8 -*- #

COMMENT REQUIRES:
  MODE QUATSCAL = REAL; # Scalar #
  QUATSCAL quat small scal = small real;
END COMMENT

# PROVIDES: #
FORMAT quat scal fmt := $g(-0, 4)$;
FORMAT signed fmt = $b("+", "")f(quat scal fmt)$;

FORMAT quat fmt = $f(quat scal fmt)"+"f(quat scal fmt)"i+"f(quat scal fmt)"j+"f(quat scal fmt)"k"$;
FORMAT squat fmt = $f(signed fmt)f(signed fmt)"i"f(signed fmt)"j"f(signed fmt)"k"$;

MODE QUAT = STRUCT(QUATSCAL r, i, j, k);
QUAT i=(0, 1, 0, 0),
     j=(0, 0, 1, 0),
     k=(0, 0, 0, 1);

MODE QUATCOSCAL = UNION(INT, SHORT REAL, SHORT INT);
MODE QUATSUBSCAL = UNION(QUATCOSCAL, QUATSCAL);

MODE COMPLSCAL = STRUCT(QUATSCAL r, im);
# compatable but not the same #
MODE ISOQUAT = UNION([]REAL, []INT, []SHORT REAL, []SHORT INT, []QUATSCAL);
MODE COQUAT  = UNION(COMPLSCAL, QUATCOSCAL, ISOQUAT);
MODE SUBQUAT = UNION(COQUAT, QUAT); # subset is itself #

MODE QUATERNION = QUAT;

PROC quat fix type error = (QUAT quat, []STRING msg)BOOL: (
  putf(stand error, ($"Type error:"$,$" "g$, msg, quat fmt, quat, $l$));
  stop
);

COMMENT
For a list of coercions expected in A68 c.f.
* http://rosettacode.org/wiki/ALGOL_68#Coercion_.28casting.29 # ...

Pre-Strong context: Deproceduring, dereferencing & uniting. e.g. OP arguments
  * soft(deproceduring for assignment),
  * weak(dereferencing for slicing and OF selection),
  * meek(dereferencing for indexing, enquiries and PROC calls),
  * firm(uniting of OPerators),
Strong context only: widening (INT=>REAL=>COMPL), rowing (REAL=>[]REAL) & voiding
  * strong(widening,rowing,voiding for identities/initialisations, arguments and casts et al)
Key points:
  * arguments to OPerators do not widen or row!
  * UNITING is permitted in OP/String ccontext.

There are 4 principle scenerios for most operators:
+---------------+-------------------------------+-------------------------------+
|  OP e.g. *    |  SCALar                       |  QUATernion                   |
+---------------+-------------------------------+-------------------------------+
|  SCALar       |  SCAL * SCAL ... inherit      |  SCAL * QUAT                  |
+---------------+-------------------------------+-------------------------------+
|  QUATernion   |  QUAT * SCAL                  |  QUAT * QUAT                  |
+---------------+-------------------------------+-------------------------------+
However this is compounded with SUBtypes of the SCALar & isomorphs the QUATernion,
e.g.
* SCAL may be a superset of SHORT REAL or INT - a widening coercion is required
* QUAT may be a superset eg of COMPL or [4]INT
* QUAT may be a structural isomorph eg of [4]REAL
+---------------+---------------+---------------+---------------+---------------+
|  OP e.g. *    |  SUBSCAL      |  SCALar       |  COQUAT       |  QUATernion   |
+---------------+---------------+---------------+---------------+---------------+
|  SUBSCAL      |                               |  inherit      |  SUBSCAT*QUAT |
+---------------+           inherit             +---------------+---------------+
|  SCALar       |                               |  inherit      |  SCAL * QUAT  |
+---------------+---------------+---------------+---------------+---------------+
|  COQUAT       |  inherit      |  inherit      |  inherit      |  COQUAT*QUAT  |
+---------------+---------------+---------------+---------------+---------------+
|  QUATernion   | QUAT*SUBSCAL  |  QUAT*SCAL    | QUAT * COQUAT |  QUAT * QUAT  |
+---------------+---------------+---------------+---------------+---------------+
Keypoint: if an EXPLICIT QUAT is not involved, then we can simple inherit, OR QUATINIT!
END COMMENT

MODE CLASSQUAT = STRUCT(
    PROC (REF QUAT #new#, QUATSCAL #r#, QUATSCAL #i#, QUATSCAL #j#, QUATSCAL #k#)REF QUAT new,
    PROC (REF QUAT #self#)QUAT conjugate,
    PROC (REF QUAT #self#)QUATSCAL norm sq,
    PROC (REF QUAT #self#)QUATSCAL norm,
    PROC (REF QUAT #self#)QUAT reciprocal,
    PROC (REF QUAT #self#)STRING repr,
    PROC (REF QUAT #self#)QUAT neg,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT add,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT radd,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT sub,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT mul,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rmul,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT div,
    PROC (REF QUAT #self#, SUBQUAT #other#)QUAT rdiv,
    PROC (REF QUAT #self#)QUAT exp
);

CLASSQUAT class quat = (

  # PROC new =#(REF QUAT new, QUATSCAL r, i, j, k)REF QUAT: (
        # 'Defaults all parts of quaternion to zero' #
        IF new ISNT REF QUAT(NIL) THEN new ELSE HEAP QUAT FI := (r, i, j, k)
    ),

  # PROC conjugate =#(REF QUAT self)QUAT:
        (r OF self, -i OF self, -j OF self, -k OF self),

  # PROC norm sq =#(REF QUAT self)QUATSCAL:
        r OF self**2 + i OF self**2 + j OF self**2 + k OF self**2,

  # PROC norm =#(REF QUAT self)QUATSCAL:
        sqrt((norm sq OF class quat)(self)),

  # PROC reciprocal =#(REF QUAT self)QUAT:(
        QUATSCAL n2 = (norm sq OF class quat)(self);
        QUAT conj = (conjugate OF class quat)(self);
        (r OF conj/n2, i OF conj/n2, j OF conj/n2, k OF conj/n2)
    ),

  # PROC repr =#(REF QUAT self)STRING: (
        # 'Shorter form of Quaternion as string' #
        FILE f; STRING s; associate(f, s);
        putf(f, (squat fmt, r OF self>=0, r OF self,
             i OF self>=0, i OF self, j OF self>=0, j OF self, k OF self>=0, k OF self));
        close(f);
        s
    ),

  # PROC neg =#(REF QUAT self)QUAT:
        (-r OF self, -i OF self, -j OF self, -k OF self),

  # PROC add =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
            (QUAT other): (r OF self + r OF other, i OF self + i OF other, j OF self + j OF other, k OF self + k OF other),
            (QUATSUBSCAL other): (r OF self + QUATSCALINIT other, i OF self, j OF self, k OF self)
        OUT IF quat fix type error(SKIP,"in add") THEN SKIP ELSE stop FI
        ESAC,

  # PROC radd =#(REF QUAT self, SUBQUAT other)QUAT:
        (add OF class quat)(self, other),

  # PROC sub =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
            (QUAT other): (r OF self - r OF other, i OF self - i OF other, j OF self - j OF other, k OF self - k OF other),
            (QUATSCAL other): (r OF self - other, i OF self, j OF self, k OF self)
        OUT IF quat fix type error(self,"in sub") THEN SKIP ELSE stop FI
        ESAC,

  # PROC mul =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
            (QUAT other):(
                 r OF self*r OF other - i OF self*i  OF other - j OF self*j  OF other - k OF self*k  OF other,
                 r OF self*i  OF other + i OF self*r OF other + j OF self*k  OF other - k OF self*j  OF other,
                 r OF self*j  OF other - i OF self*k  OF other + j OF self*r OF other + k OF self*i  OF other,
                 r OF self*k  OF other + i OF self*j  OF other - j OF self*i  OF other + k OF self*r OF other
            ),
            (QUATSCAL other): ( r OF self * other, i OF self * other, j OF self * other, k OF self * other)
        OUT IF quat fix type error(self,"in mul") THEN SKIP ELSE stop FI
        ESAC,

  # PROC rmul =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
          (QUAT other): (mul OF class quat)(LOC QUAT := other, self),
          (QUATSCAL other): (mul OF class quat)(self, other)
        OUT IF quat fix type error(self,"in rmul") THEN SKIP ELSE stop FI
        ESAC,

  # PROC div =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
            (QUAT other): (mul OF class quat)(self, (reciprocal OF class quat)(LOC QUAT := other)),
            (QUATSCAL other): (mul OF class quat)(self, 1/other)
        OUT IF quat fix type error(self,"in div") THEN SKIP ELSE stop FI
        ESAC,

  # PROC rdiv =#(REF QUAT self, SUBQUAT other)QUAT:
        CASE other IN
          (QUAT other): (div OF class quat)(LOC QUAT := other, self),
          (QUATSCAL other): (div OF class quat)(LOC QUAT := (other, 0, 0, 0), self)
        OUT IF quat fix type error(self,"in rdiv") THEN SKIP ELSE stop FI
        ESAC,

  # PROC exp =#(REF QUAT self)QUAT: (
    QUAT fac := self;
    QUAT sum := 1.0 + fac;
    FOR i FROM 2 TO bits width WHILE ABS(fac + quat small scal) /= quat small scal DO
      VOID(sum +:= (fac *:= self / ##QUATSCAL(i)))
    OD;
    sum
  )
);

PRIO INIT = 1;
OP QUATSCALINIT = (QUATSUBSCAL scal)QUATSCAL:
  CASE scal IN
    (INT scal): scal,
    (SHORT INT scal): scal,
    (SHORT REAL scal): scal
    OUT IF quat fix type error(SKIP,"in QUATSCALINIT") THEN SKIP ELSE stop FI
  ESAC;

OP INIT = (REF QUAT new, SUBQUAT from)REF QUAT:
  new :=
    CASE from IN
      (QUATSUBSCAL scal):(QUATSCALINIT scal, 0, 0, 0)
      #(COQUAT rijk):(new OF class quat)(LOC QUAT := new, rijk[1], rijk[2], rijk[3], rijk[4]),#
    OUT IF quat fix type error(SKIP,"in INIT") THEN SKIP ELSE stop FI
    ESAC;

OP QUATINIT = (COQUAT lhs)REF QUAT: (HEAP QUAT)INIT lhs;

OP +    = (QUAT q)QUAT:   q,
   -    = (QUAT q)QUAT:   (neg  OF class quat)(LOC QUAT := q),
   CONJ = (QUAT q)QUAT:   (conjugate OF class quat)(LOC QUAT := q),
   ABS  = (QUAT q)QUATSCAL:   (norm OF class quat)(LOC QUAT := q),
   REPR = (QUAT q)STRING: (repr OF class quat)(LOC QUAT := q);
# missing: Diadic: I, J, K END #

OP +:= = (REF QUAT a, QUAT b)QUAT: a:=( add OF class quat)(a, b),
   +:= = (REF QUAT a, COQUAT b)QUAT: a:=( add OF class quat)(a, b),
   +=: = (QUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a),
   +=: = (COQUAT a, REF QUAT b)QUAT: b:=(radd OF class quat)(b, a);
# missing: Worthy PLUSAB, PLUSTO for SHORT/LONG INT QUATSCAL & COMPL #

OP -:= = (REF QUAT a, QUAT b)QUAT: a:=( sub OF class quat)(a, b),
   -:= = (REF QUAT a, COQUAT b)QUAT: a:=( sub OF class quat)(a, b);
# missing: Worthy MINUSAB for SHORT/LONG INT ##COQUAT & COMPL #

PRIO *=: = 1, /=: = 1;
OP *:= = (REF QUAT a, QUAT b)QUAT: a:=( mul OF class quat)(a, b),
   *:= = (REF QUAT a, COQUAT b)QUAT: a:=( mul OF class quat)(a, b),
   *=: = (QUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a),
   *=: = (COQUAT a, REF QUAT b)QUAT: b:=(rmul OF class quat)(b, a);
# missing: Worthy TIMESAB, TIMESTO for SHORT/LONG INT ##COQUAT & COMPL #

OP /:= = (REF QUAT a, QUAT b)QUAT: a:=( div OF class quat)(a, b),
   /:= = (REF QUAT a, COQUAT b)QUAT: a:=( div OF class quat)(a, b),
   /=: = (QUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a),
   /=: = (COQUAT a, REF QUAT b)QUAT: b:=(rdiv OF class quat)(b, a);
# missing: Worthy OVERAB, OVERTO for SHORT/LONG INT ##COQUAT & COMPL #

OP + = (QUAT a, b)QUAT:      ( add OF class quat)(LOC QUAT := a, b),
   + = (QUAT a, COQUAT b)QUAT: ( add OF class quat)(LOC QUAT := a, b),
   + = (COQUAT a, QUAT b)QUAT: (radd OF class quat)(LOC QUAT := b, a);

OP - = (QUAT a, b)QUAT:      ( sub OF class quat)(LOC QUAT := a, b),
   - = (QUAT a, COQUAT b)QUAT: ( sub OF class quat)(LOC QUAT := a, b),
   - = (COQUAT a, QUAT b)QUAT:-( sub OF class quat)(LOC QUAT := b, a);

OP * = (QUAT a, b)QUAT:      ( mul OF class quat)(LOC QUAT := a, b),
   * = (QUAT a, COQUAT b)QUAT: ( mul OF class quat)(LOC QUAT := a, b),
   * = (COQUAT a, QUAT b)QUAT: (rmul OF class quat)(LOC QUAT := b, a);

OP / = (QUAT a, b)QUAT:      ( div OF class quat)(LOC QUAT := a, b),
   / = (QUAT a, COQUAT b)QUAT: ( div OF class quat)(LOC QUAT := a, b),
   / = (COQUAT a, QUAT b)QUAT:
         ( div OF class quat)(LOC QUAT := QUATINIT 1, a);

PROC quat exp = (QUAT q)QUAT:   (exp OF class quat)(LOC QUAT := q);

SKIP # missing: quat arc{sin, cos, tan}h, log, exp, ln etc END #


class PCG32 {
    has $!state;
    has $!incr;
    constant mask32 = 2³² - 1;
    constant mask64 = 2⁶⁴ - 1;
    constant const = 6364136223846793005;

    submethod BUILD (
        Int :$seed = 0x853c49e6748fea9b, # default seed
        Int :$incr = 0xda3e39cb94b95bdb  # default increment
      ) {
        $!incr  = $incr +< 1 +| 1 +& mask64;
        $!state = (($!incr + $seed) * const + $!incr) +& mask64;
    }

    method next-int {
        my $shift  = ($!state +> 18 +^ $!state) +> 27 +& mask32;
        my $rotate =  $!state +> 59 +& 31;
        $!state    = ($!state * const + $!incr) +& mask64;
        ($shift +> $rotate) +| ($shift +< (32 - $rotate) +& mask32)
    }

    method next-rat { self.next-int / 2³² }
}

# Test next-int with custom seed and increment
say 'Seed: 42, Increment: 54; first five Int values:';
my $rng = PCG32.new( :seed(42), :incr(54) );
.say for $rng.next-int xx 5;

# Test next-rat (since these are rational numbers by default)
say "\nSeed: 987654321, Increment: 1; first 1e5 Rat values histogram:";
$rng = PCG32.new( :seed(987654321), :incr(1) );
say ( ($rng.next-rat * 5).floor xx 100_000 ).Bag;

# Test next-int with default seed and increment
say "\nSeed: default, Increment: default; first five Int values:";
$rng = PCG32.new;
.say for $rng.next-int xx 5;


(defn gcd [a b] (if (zero? b) a (recur b (mod a b))))

(defn pyth [peri]
  (for [m (range 2 (Math/sqrt (/ peri 2)))
        n (range (inc (mod m 2)) m 2) ; n<m, opposite polarity
        :let [p (* 2 m (+ m n))]      ; = a+b+c for this (m,n)
        :while (<= p peri)
        :when (= 1 (gcd m n))
        :let [m2 (* m m), n2 (* n n),
              [a b] (sort [(- m2 n2) (* 2 m n)]), c (+ m2 n2)]
        k (range 1 (inc (quot peri p)))]
    [(= k 1) (* k a) (* k b) (* k c)]))

(defn rcount [ts] ; (->> peri pyth rcount) produces [total, primitive] counts
  (reduce (fn [[total prims] t] [(inc total), (if (first t) (inc prims) prims)])
    [0 0]
    ts))


begin
    % Quaternion record type                                                 %
    record Quaternion ( real a, b, c, d );

    % returns the norm of the specified quaternion                           %
    real procedure normQ ( reference(Quaternion) value q ) ;
        sqrt( (a(q) * a(q)) + (b(q) * b(q)) + (c(q) * c(q)) + (d(q) * d(q)) );

    % returns the negative of the specified quaternion                       %
    reference(Quaternion) procedure negQ ( reference(Quaternion) value q ) ;
        Quaternion( - a(q), - b(q), - c(q), - d(q) );

    % returns the conjugate of the specified quaternion                      %
    reference(Quaternion) procedure conjQ ( reference(Quaternion) value q ) ;
        Quaternion(   a(q), - b(q), - c(q), - d(q) );

    % returns the sum of a real and a quaternion                             %
    reference(Quaternion) procedure addRQ ( real                  value r
                                          ; reference(Quaternion) value q
                                          ) ;
        Quaternion( r + a(q), b(q), c(q), d(q) );

    % returns the sum of a quaternion and a real                             %
    reference(Quaternion) procedure addQR ( reference(Quaternion) value q
                                          ; real                  value r
                                          ) ;
        Quaternion( r + a(q), b(q), c(q), d(q) );

    % returns the sum of the specified quaternions                           %
    reference(Quaternion) procedure addQQ ( reference(Quaternion) value q1
                                          ; reference(Quaternion) value q2
                                          ) ;
        Quaternion( a(q1) + a(q2), b(q1) + b(q2), c(q1) + c(q2), d(q1) + d(q2) );

    % returns the specified quaternion multiplied by a real                  %
    reference(Quaternion) procedure mulQR ( reference(Quaternion) value q
                                          ; real                  value r
                                          ) ;
        Quaternion( r * a(q), r * b(q), r * c(q), r * d(q) );

    % returns a real multiplied by the specified quaternion                  %
    reference(Quaternion) procedure mulRQ ( real                  value r
                                          ; reference(Quaternion) value q
                                          ) ;
        mulQR( q, r );

    % returns the Quaternion product of the specified quaternions            %
    reference(Quaternion) procedure mulQQ( reference(Quaternion) value q1
                                         ; reference(Quaternion) value q2
                                         ) ;
        Quaternion( (a(q1) * a(q2)) - (b(q1) * b(q2)) - (c(q1) * c(q2)) - (d(q1) * d(q2))
                  , (a(q1) * b(q2)) + (b(q1) * a(q2)) + (c(q1) * d(q2)) - (d(q1) * c(q2))
                  , (a(q1) * c(q2)) - (b(q1) * d(q2)) + (c(q1) * a(q2)) + (d(q1) * b(q2))
                  , (a(q1) * d(q2)) + (b(q1) * c(q2)) - (c(q1) * b(q2)) + (d(q1) * a(q2))
                  );

    % returns true if the two quaternions are equal, false otherwise         %
    logical procedure equalQ( reference(Quaternion) value q1
                            ; reference(Quaternion) value q2
                            ) ;
        a(q1) = a(q2) and b(q1) = b(q2) and c(q1) = c(q2) and d(q1) = d(q2);

    % writes a quaternion                                                    %
    procedure writeonQ( reference(Quaternion) value q ) ;
        writeon( "(", a(q), ", ", b(q), ", ", c(q), ", ", d(q), ")" );

    % test q1q2 = q2q1                                                       %
    reference(Quaternion) q, q1, q2;

    q  := Quaternion( 1, 2, 3, 4 );
    q1 := Quaternion( 2, 3, 4, 5 );
    q2 := Quaternion( 3, 4, 5, 6 );

    % set output format                                                      %
    s_w := 0; r_format := "A"; r_w := 5; r_d := 1;

    write( "      q:" );writeonQ( q );
    write( "     q1:" );writeonQ( q1 );
    write( "     q2:" );writeonQ( q2 );
    write( "norm  q:" );writeon( normQ( q ) );
    write( "norm q1:" );writeon( normQ( q1 ) );
    write( "norm q2:" );writeon( normQ( q2 ) );

    write( " conj q:" );writeonQ( conjQ( q ) );
    write( "    - q:" );writeonQ( negQ( q ) );
    write( "  7 + q:" );writeonQ( addRQ( 7, q ) );
    write( "  q + 9:" );writeonQ( addQR( q, 9 ) );
    write( " q + q1:" );writeonQ( addQQ( q, q1 ) );
    write( "  3 * q:" );writeonQ( mulRQ( 3, q ) );
    write( "  q * 4:" );writeonQ( mulQR( q, 4 ) );

    % check that q1q2 not = q2q1                                             %
    if equalQ( mulQQ( q1, q2 ), mulQQ( q2, q1 ) )
    then write( "q1q2 = q2q1 ??" )
    else write( "q1q2 <> q2q1" );

    write( "   q1q2:" );writeonQ( mulQQ( q1, q2 ) );
    write( "   q2q1:" );writeonQ( mulQQ( q2, q1 ) );

end.


Numeric Digits 40
N     = 6364136223846793005
state = x2d('853c49e6748fea9b',16)
inc   = x2d('da3e39cb94b95bdb',16)
Call seed 42,54
Do zz=1 To 5
  res=nextint()
  Say int2str(res)
  End
Call seed 987654321,1
cnt.=0
Do i=1 To 100000
  z=nextfloat()
  cnt.z=cnt.z+1
  End
Say ''
Say 'The counts for 100,000 repetitions are:'
Do z=0 To 4
  Say format(z,2) ':' format(cnt.z,5)
  End
Exit

int2str: Procedure
int=arg(1)
intx=d2x(int,8)
res=x2d(copies(0,8)intx,16)
Return res

seed:
Parse Arg seedState,seedSequence
state=0
inc=dshift(seedSequence,-1)
inc=x2d(or(d2x(inc,16),d2x(1,16)),16)
z=nextint()
state=javaadd(state,seedState)
z=nextint()
Return

nextInt:
old = state
oldxN = javamult(old,n)
statex= javaadd(oldxN,inc)
state=statex
oldx=d2x(old,16)
oldb=x2b(oldx)
oldb18=copies(0,18)left(oldb,64-18)
oldb18o=bxor(oldb18,oldb)
rb=copies(0,27)left(oldb18o,64-27)
rx=b2x(rb)
shifted=x2d(substr(rx,9),8)
oldx=d2x(old,16)
oldb=x2b(oldx)
oldb2=copies(0,59)left(oldb,length(oldb)-59)
oldx2=b2x(oldb2)
rotx=x2d(substr(oldx2,9),8)
t1=ishift(shifted,rotx,'L')
t2=x2d(xneg(d2x(rotx,8)),8)
t3=t2+1
t4=x2d(xand(d2x(t3,8),d2x(31,8)),8)
t5=dshift(shifted,-t4)
t5x=d2x(t5,16)
t5y=substr(t5x,9)
t5z=x2d(t5y,16)
t7=x2d(or(d2x(t1,16),d2x(t5z,16)),16)
t8=long2int(t7)
Return t8

nextfloat:
ni=nextint()
nix=d2x(ni,8)
niz=copies(0,8)nix
u=x2d(niz,16)
uu=u/(2**32)
z=uu*5%1
Return z

javaadd: Procedure
/**********************************************************************
* Add two long integers and ignore the possible overflow
**********************************************************************/
Numeric Digits 40
Parse Arg a,b
r=a+b
rx=d2x(r,18)
res=right(rx,16)
return x2d(res,16)

javamult: Procedure
/**********************************************************************
* Multiply java style
**********************************************************************/
Numeric Digits 40
Parse Arg a,b
m=d2x(a*b,16)
res=x2d(m,16)
Return res

bxor: Procedure
/**********************************************************************
* Exclusive Or two bit strings
**********************************************************************/
Parse arg a,b
res=''
Do i=1 To length(a)
  res=res||(substr(a,i,1)<>substr(b,i,1))
  End
Return res

xxor: Procedure
/**********************************************************************
* Exclusive Or two hex strings
**********************************************************************/
Parse Arg u,v
ub=x2b(u)
vb=x2b(v)
res=''
Do i=1 To 64
  res=res||(substr(ub,i,1)<>substr(vb,i,1))
  End
res=b2x(res)
Return res

xand: Procedure
/**********************************************************************
* And two hex strings
**********************************************************************/
Parse Arg u,v
ub=x2b(u)
vb=x2b(v)
res=''
Do i=1 To length(ub)
  res=res||(substr(ub,i,1)&substr(vb,i,1))
  End
res=b2x(res)
Return res

or: Procedure
/**********************************************************************
* Or two hex strings
**********************************************************************/
Parse Arg u,v
ub=x2b(u)
vb=x2b(v)
res=''
Do i=1 To length(ub)
  res=res||(substr(ub,i,1)|substr(vb,i,1))
  End
res=b2x(res)
Return res

long2int: Procedure
/**********************************************************************
* Cast long to int
**********************************************************************/
Parse Arg long
longx=d2x(long,16)
int=x2d(substr(longx,9),8)
Return int

xneg: Procedure
/**********************************************************************
* Negate a hex string
**********************************************************************/
Parse Arg s
sb=x2b(s)
res=''
Do i=1 To length(sb)
  res=res||\substr(sb,i,1)
  End
res=b2x(res)
Return res

dshift: Procedure
/**********************************************************************
* Implement the shift operations for a long variable
* r = dshift(long,shift[,mode])  >>  Mode='L' logical right shift
*                                >>> Mode='A' arithmetic right shift
*                                <<  xhift<0  left shift
********************************************`*************************/
Parse Upper Arg n,s,o
Numeric Digits 40
If o='' Then o='L'
nx=d2x(n,16)
nb=x2b(nx)
If s<0 Then Do
  s=abs(s)
  rb=substr(nb,s+1)||copies('0',s)
  rx=b2x(rb)
  r=x2d(rx,16)
  End
Else Do
  If o='L' Then Do
    rb=left(copies('0',s)nb,length(nb))
    rx=b2x(rb)
    r=x2d(rx,16)
    End
  Else Do
    rb=left(copies(left(nb,1),s)nb,length(nb))
    rx=b2x(rb)
    r=x2d(rx,16)
    End
  End
Return r

ishift: Procedure
/**********************************************************************
* Implement the shift operations for an int variable
* r = dshift(int,shift[,mode])   >>  Mode='L' logical right shift
*                                >>> Mode='A' arithmetic right shift
*                                <<  xhift<0  left shift
********************************************`*************************/
Parse Upper Arg n,s,o
Numeric Digits 40
If o='' Then o='L'
nx=d2x(n,8)
nb=x2b(nx)
If s<0 Then Do
  s=abs(s)
  rb=substr(nb,s+1)||copies('0',s)
  rx=b2x(rb)
  r=x2d(rx,8)
  End
Else Do
  If o='L' Then Do
    rb=left(copies('0',s)nb,length(nb))
    rx=b2x(rb)
    r=x2d(rx,8)
    End
  Else Do
    rb=left(copies(left(nb,1),s)nb,length(nb))
    rx=b2x(rb)
    r=x2d(rx,8)
    End
  End
Return r

b2x: Procedure Expose x.
/**********************************************************************
* Convert a Bit string to a Hex stríng
**********************************************************************/
Parse Arg b
z='0'; bits.z='0000'; y=bits.z; x.y=z
z='1'; bits.z='0001'; y=bits.z; x.y=z
z='2'; bits.z='0010'; y=bits.z; x.y=z
z='3'; bits.z='0011'; y=bits.z; x.y=z
z='4'; bits.z='0100'; y=bits.z; x.y=z
z='5'; bits.z='0101'; y=bits.z; x.y=z
z='6'; bits.z='0110'; y=bits.z; x.y=z
z='7'; bits.z='0111'; y=bits.z; x.y=z
z='8'; bits.z='1000'; y=bits.z; x.y=z
z='9'; bits.z='1001'; y=bits.z; x.y=z
z='A'; bits.z='1010'; y=bits.z; x.y=z
z='B'; bits.z='1011'; y=bits.z; x.y=z
z='C'; bits.z='1100'; y=bits.z; x.y=z
z='D'; bits.z='1101'; y=bits.z; x.y=z
z='E'; bits.z='1110'; y=bits.z; x.y=z
z='F'; bits.z='1111'; y=bits.z; x.y=z
x=''
Do While b<>''
  Parse Var b b4 +4 b
  x=x||x.b4
  End
Return x

x2b: Procedure Expose bits.
/***********************************************************************
* Convert a Hex string to a Bit stríng
***********************************************************************/
Parse Arg x
z='0'; bits.z='0000'; y=bits.z; x.y=z
z='1'; bits.z='0001'; y=bits.z; x.y=z
z='2'; bits.z='0010'; y=bits.z; x.y=z
z='3'; bits.z='0011'; y=bits.z; x.y=z
z='4'; bits.z='0100'; y=bits.z; x.y=z
z='5'; bits.z='0101'; y=bits.z; x.y=z
z='6'; bits.z='0110'; y=bits.z; x.y=z
z='7'; bits.z='0111'; y=bits.z; x.y=z
z='8'; bits.z='1000'; y=bits.z; x.y=z
z='9'; bits.z='1001'; y=bits.z; x.y=z
z='A'; bits.z='1010'; y=bits.z; x.y=z
z='B'; bits.z='1011'; y=bits.z; x.y=z
z='C'; bits.z='1100'; y=bits.z; x.y=z
z='D'; bits.z='1101'; y=bits.z; x.y=z
z='E'; bits.z='1110'; y=bits.z; x.y=z
z='F'; bits.z='1111'; y=bits.z; x.y=z
b=''
Do While x<>''
  Parse Var x c +1 x
  b=b||bits.c
  End
Return b


gcd = (x, y) ->
  return x if y == 0
  gcd(y, x % y)

# m,n generate primitive Pythag triples
#
# preconditions:
#   m, n are integers of different parity
#   m > n
#   gcd(m,n) == 1 (coprime)
#
# m, n generate: [m*m - n*n, 2*m*n, m*m + n*n]
# perimeter is 2*m*m + 2*m*n = 2 * m * (m+n)
count_triples = (max_perim) ->
  num_primitives = 0
  num_triples = 0
  m = 2
  upper_limit = Math.sqrt max_perim / 2
  while m <= upper_limit
    n = m % 2 + 1
    p = 2*m*m + 2*m*n
    delta = 4*m
    while n < m and p <= max_perim
      if gcd(m, n) == 1
        num_primitives += 1
        num_triples += Math.floor max_perim / p
      n += 2
      p += delta
    m += 1
  console.log num_primitives, num_triples

max_perim = Math.pow 10, 9 # takes under a minute
count_triples(max_perim)


(defun mmul (a b)
  (loop for x in a collect
    (loop for y in x
          for z in b sum (* y z))))

(defun count-tri (lim &aux (prim 0) (cnt 0))
  (labels ((count1 (tr &aux (peri (reduce #'+ tr)))
             (when (<= peri lim)
               (incf prim)
               (incf cnt (truncate lim peri))
               (count1 (mmul '(( 1 -2 2) ( 2 -1 2) ( 2 -2 3)) tr))
               (count1 (mmul '(( 1  2 2) ( 2  1 2) ( 2  2 3)) tr))
               (count1 (mmul '((-1  2 2) (-2  1 2) (-2  2 3)) tr)))))
    (count1 '(3 4 5))
    (format t "~a: ~a prim, ~a all~%" lim prim cnt)))

(loop for p from 2 do (count-tri (expt 10 p)))


qi := quatern$Quaternion(Integer);

             Type: ((Integer,Integer,Integer,Integer) -> Quaternion(Integer))
q  := qi(1,2,3,4);

                                                    Type: Quaternion(Integer)
q1 := qi(2,3,4,5);

                                                    Type: Quaternion(Integer)
q2 := qi(3,4,5,6);

                                                    Type: Quaternion(Integer)
r : Integer := 7;

                                                                Type: Integer
sqrt norm q

         +--+
   (6)  \|30
                                                        Type: AlgebraicNumber
-q

   (7)  - 1 - 2i - 3j - 4k
                                                    Type: Quaternion(Integer)
conjugate q

   (8)  1 - 2i - 3j - 4k
                                                    Type: Quaternion(Integer)
r + q

   (9)  8 + 2i + 3j + 4k
                                                    Type: Quaternion(Integer)
q1 + q2

   (10)  5 + 7i + 9j + 11k
                                                    Type: Quaternion(Integer)
q*r

   (11)  7 + 14i + 21j + 28k
                                                    Type: Quaternion(Integer)
r*q

   (12)  7 + 14i + 21j + 28k
                                                    Type: Quaternion(Integer)
q1*q2 ~= q2*q1

   (13)  true
                                                                Type: Boolean


dim q(4)
dim q1(4)
dim q2(4)
q[0] = 1: q[1] = 2: q[2] = 3: q[3] = 4
q1[0] = 2: q1[1] = 3: q1[2] = 4: q1[3] = 5
q2[0] = 3: q2[1] = 4: q2[2] = 5: q2[3] = 6
r = 7

function printq(q)
 return "("+q[0]+", "+q[1]+", "+q[2]+", "+q[3]+")"
end function

function q_equal(q1, q2)
 return q1[0]=q2[0] and q1[1]=q2[1] and q1[2]=q2[2] and q1[3]=q2[3]
end function

function q_norm(q)
 return sqr(q[0]*q[0]+q[1]*q[1]+q[2]*q[2]+q[3]*q[3])
end function

function q_neg(q)
 dim result[4]
 result[0] = -q[0]
 result[1] = -q[1]
 result[2] = -q[2]
 result[3] = -q[3]
 return result
end function

function q_conj(q)
 dim result[4]
 result[0] = q[0]
 result[1] = -q[1]
 result[2] = -q[2]
 result[3] = -q[3]
 return result
end function

function q_addreal(q, r)
 dim result[4]
 result[0] = q[0]+r
 result[1] = q[1]
 result[2] = q[2]
 result[3] = q[3]
 return result
end function

function q_add(q1, q2)
 dim result[4]
 result[0] = q1[0]+q2[0]
 result[1] = q1[1]+q2[1]
 result[2] = q1[2]+q2[2]
 result[3] = q1[3]+q2[3]
 return result
end function

function q_mulreal(q, r)
 dim result[4]
 result[0] = q[0]*r
 result[1] = q[1]*r
 result[2] = q[2]*r
 result[3] = q[3]*r
 return result
end function

function q_mul(q1, q2)
 dim result[4]
 result[0] = q1[0]*q2[0]-q1[1]*q2[1]-q1[2]*q2[2]-q1[3]*q2[3]
 result[1] = q1[0]*q2[1]+q1[1]*q2[0]+q1[2]*q2[3]-q1[3]*q2[2]
 result[2] = q1[0]*q2[2]-q1[1]*q2[3]+q1[2]*q2[0]+q1[3]*q2[1]
 result[3] = q1[0]*q2[3]+q1[1]*q2[2]-q1[2]*q2[1]+q1[3]*q2[0]
 return result
end function

print "q = ";printq(q)
print "q1 = ";printq(q1)
print "q2 = ";printq(q2)
print "r = "; r
print "norm(q) = "; q_norm(q)
print "neg(q) = ";printq(q_neg(q))
print "conjugate(q) = ";printq(q_conj(q))
print "q+r = ";printq(q_addreal(q,r))
print "q1+q2 = ";printq(q_add(q1,q2))
print "qr = ";printq(q_mulreal(q,r))
print "q1q2 = ";printq(q_mul(q1,q2))
print "q2q1 = ";printq(q_mul(q2,q1))


class PCG32
  MASK64 = (1 << 64) - 1
  MASK32 = (1 << 32) - 1
  CONST  = 6364136223846793005

  def seed(seed_state, seed_sequence)
    @state = 0
    @inc = ((seed_sequence << 1) | 1) & MASK64
    next_int
    @state = @state + seed_state
    next_int
  end

  def next_int
    old = @state
    @state = ((old * CONST) + @inc) & MASK64
    xorshifted = (((old >> 18) ^ old) >> 27) & MASK32
    rot = (old >> 59) & MASK32
    answer = (xorshifted >> rot) | (xorshifted << ((-rot) & 31))
    answer & MASK32
  end

  def next_float
    next_int.fdiv(1 << 32)
  end

end

random_gen = PCG32.new
random_gen.seed(42, 54)
5.times{puts random_gen.next_int}

random_gen.seed(987654321, 1)
p 100_000.times.each{(random_gen.next_float * 5).floor}.tally.sort.to_h


(import (scheme small) (srfi 33))

(define PCG-DEFAULT-MULTIPLIER 6364136223846793005)
(define MASK64 (- (arithmetic-shift 1 64) 1))
(define MASK32 (- (arithmetic-shift 1 32) 1))

(define-record-type <pcg32-random> (make-pcg32-random-record) pcg32?
  (state pcg32-state pcg32-state!)
  (inc   pcg32-inc   pcg32-inc!))

(define (make-pcg32)
  (define rng (make-pcg32-random-record))
  (pcg32-seed rng 31415926 535897932)
  rng)

(define (pcg32-seed rng init-state init-seq)
  (pcg32-state! rng 0)
  (pcg32-inc!   rng
    (bitwise-and
      (bitwise-ior (arithmetic-shift init-seq 1) 1)
      MASK64))
  (pcg32-next-int rng)
  (pcg32-state! rng (bitwise-and (+ (pcg32-state rng) init-state) MASK64))
  (pcg32-next-int rng))

(define (pcg32-next-int rng)
  (define xorshifted 0)
  (define rot        0)
  (define answer     0)
  (define oldstate (pcg32-state rng))
  (pcg32-state! rng
    (bitwise-and
      (+ (* oldstate PCG-DEFAULT-MULTIPLIER) (pcg32-inc rng))
      MASK64))
  (set! xorshifted  (bitwise-xor (arithmetic-shift oldstate -18) oldstate))
  (set! xorshifted  (arithmetic-shift xorshifted -27))
  (set! xorshifted  (bitwise-and xorshifted MASK32))
  (set! rot (bitwise-and (arithmetic-shift oldstate -59) MASK32))
  (set! answer (bitwise-ior
    (arithmetic-shift xorshifted (- rot))
    (arithmetic-shift xorshifted (bitwise-and (- rot) 31))))
  (set! answer (bitwise-and answer MASK32))
  answer)

(define (pcg32-next-float rng)
  (inexact (/ (pcg32-next-int rng) (arithmetic-shift 1 32))))

;; task

(define rng (make-pcg32))
(pcg32-seed rng 42 54)
(let lp ((i 0)) (when (< i 5)
  (display (pcg32-next-int rng))(newline)
  (lp (+ i 1))))
(newline)

(pcg32-seed rng 987654321 1)
(define vec (make-vector 5 0))
(let lp ((i 0)) (when (< i 100000)
  (let ((j (exact (floor (* (pcg32-next-float rng) 5)))))
    (vector-set! vec j (+ (vector-ref vec j) 1)))
  (lp (+ i 1))))
(let lp ((i 0)) (when (< i 5)
  (display i)
  (display " : ")
  (display (vector-ref vec i))
  (newline)
  (lp (+ i 1))))


class PythagoranTriplesCounter
  def initialize(limit = 0)
    @limit = limit
    @total = 0
    @primitives = 0
    generate_triples(3, 4, 5)
  end

  def total; @total end
  def primitives; @primitives end

  private def generate_triples(a, b, c)
    perim = a + b + c
    return if perim > @limit

    @primitives += 1
    @total += @limit // perim

    generate_triples( a-2*b+2*c, 2*a-b+2*c, 2*a-2*b+3*c )
    generate_triples( a+2*b+2*c, 2*a+b+2*c, 2*a+2*b+3*c )
    generate_triples(-a+2*b+2*c,-2*a+b+2*c,-2*a+2*b+3*c )
  end
end

perim = 10
while perim <= 100_000_000
  c = PythagoranTriplesCounter.new perim
  p [perim, c.total, c.primitives]
  perim *= 10
end


void main() @safe {
    import std.stdio, std.range, std.algorithm, std.typecons, std.numeric;

    enum triples = (in uint n) pure nothrow @safe /*@nogc*/ =>
        iota(1, n + 1)
        .map!(z => iota(1, z + 1)
                   .map!(x => iota(x, z + 1).map!(y => tuple(x, y, z))))
        .joiner.joiner
        .filter!(t => t[0] ^^ 2 + t[1] ^^ 2 == t[2] ^^ 2 && t[].only.sum <= n)
        .map!(t => tuple(t[0 .. 2].gcd == 1, t[]));

    auto xs = triples(100);
    writeln("Up to 100 there are ", xs.count, " triples, ",
            xs.filter!q{ a[0] }.count, " are primitive.");
}


with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Rectangles;
with SDL.Events.Events;

procedure Pythagoras_Tree is

   Width   : constant := 600;
   Height  : constant := 600;
   Level   : constant := 7;

   type Point is record X, Y : Float; end record;
   B1 : constant Point := (X => 250.0, Y => 550.0);
   B2 : constant Point := (X => 350.0, Y => 550.0);

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   procedure Draw_Pythagoras_Tree (Level  : in Natural;
                                   P1, P2 : in Point)
   is
      use SDL.Video.Rectangles;
      Dx : constant Float := P2.X - P1.X;
      Dy : constant Float := P1.Y - P2.Y;
      R  : constant Point := (X => P2.X - Dy, Y => P2.Y - Dx);
      L  : constant Point := (X => P1.X - Dy, Y => P1.Y - Dx);
      M  : constant Point := (X => L.X + (Dx - Dy) / 2.0,
                              Y => L.Y - (Dx + Dy) / 2.0);

      CP1 : constant SDL.Video.Rectangles.Point := (C.int (P1.X), C.int (P1.Y));
      CP2 : constant SDL.Video.Rectangles.Point := (C.int (P2.X), C.int (P2.Y));
      CL  : constant SDL.Video.Rectangles.Point := (C.int (L.X),  C.int (L.Y));
      CR  : constant SDL.Video.Rectangles.Point := (C.int (R.X),  C.int (R.Y));
      CM  : constant SDL.Video.Rectangles.Point := (C.int (M.X),  C.int (M.Y));

      Square : constant SDL.Video.Rectangles.Line_Arrays :=
        ((CP1, CP2), (CP2, CR), (CR, CL), (CL, CP1));
      Triang : constant SDL.Video.Rectangles.Line_Arrays :=
        ((CR, CL), (CL, CM), (CM, CR));
   begin
      if Level > 0 then
         Renderer.Set_Draw_Colour (Colour => (0, 220, 0, 255));
         Renderer.Draw (Lines => Square);
         Renderer.Draw (Lines => Triang);

         Draw_Pythagoras_Tree (Level - 1, L, M);
         Draw_Pythagoras_Tree (Level - 1, M, R);
      end if;
   end Draw_Pythagoras_Tree;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Pythagoras tree",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));
   Renderer.Set_Draw_Colour ((0, 220, 0, 255));

   Draw_Pythagoras_Tree (Level, B1, B2);
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Pythagoras_Tree;


      DIM q(3), q1(3), q2(3), t(3)
      q() = 1, 2, 3, 4
      q1() = 2, 3, 4, 5
      q2() = 3, 4, 5, 6
      r = 7

      PRINT "q = " FNq_show(q())
      PRINT "q1 = " FNq_show(q1())
      PRINT "q2 = " FNq_show(q2())
      PRINT "r = "; r
      PRINT "norm(q) = "; FNq_norm(q())
      t() = q() : PROCq_neg(t()) : PRINT "neg(q) = " FNq_show(t())
      t() = q() : PROCq_conj(t()) : PRINT "conjugate(q) = " FNq_show(t())
      t() = q() : PROCq_addreal(t(),r) : PRINT "q + r = " FNq_show(t())
      t() = q1() : PROCq_add(t(),q2()) : PRINT "q1 + q2 = " FNq_show(t())
      t() = q2() : PROCq_add(t(),q1()) : PRINT "q2 + q1 = " FNq_show(t())
      t() = q() : PROCq_mulreal(t(),r) : PRINT "qr = " FNq_show(t())
      t() = q1() : PROCq_mul(t(),q2()) : PRINT "q1q2 = " FNq_show(t())
      t() = q2() : PROCq_mul(t(),q1()) : PRINT "q2q1 = " FNq_show(t())
      END

      DEF FNq_norm(q()) = MOD(q())

      DEF PROCq_neg(q()) : q() *= -1 : ENDPROC

      DEF PROCq_conj(q()) : q() *= -1 : q(0) *= -1 : ENDPROC

      DEF PROCq_addreal(q(), r) : q(0) += r : ENDPROC

      DEF PROCq_add(q(), r()) : q() += r() : ENDPROC

      DEF PROCq_mulreal(q(), r) : q() *= r : ENDPROC

      DEF PROCq_mul(q(), r()) : LOCAL s() : DIM s(3,3)
      s() = r(0), -r(1), -r(2), -r(3), r(1), r(0),  r(3), -r(2), \
      \     r(2), -r(3),  r(0),  r(1), r(3), r(2), -r(1),  r(0)
      q() = s() . q()
      ENDPROC

      DEF FNq_show(q()) : LOCAL i%, a$ : a$ = "("
      FOR i% = 0 TO 3 : a$ += STR$(q(i%)) + ", " : NEXT
      = LEFT$(LEFT$(a$)) + ")"


#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <math.h>

typedef struct quaternion
{
  double q[4];
} quaternion_t;

quaternion_t *quaternion_new(void)
{
  return malloc(sizeof(quaternion_t));
}

quaternion_t *quaternion_new_set(double q1,
				 double q2,
				 double q3,
				 double q4)
{
  quaternion_t *q = malloc(sizeof(quaternion_t));
  if (q != NULL) {
    q->q[0] = q1; q->q[1] = q2; q->q[2] = q3; q->q[3] = q4;
  }
  return q;
}

void quaternion_copy(quaternion_t *r, quaternion_t *q)
{
  size_t i;

  if (r == NULL || q == NULL) return;
  for(i = 0; i < 4; i++) r->q[i] = q->q[i];
}

double quaternion_norm(quaternion_t *q)
{
  size_t i;
  double r = 0.0;

  if (q == NULL) {
    fprintf(stderr, "NULL quaternion in norm\n");
    return 0.0;
  }

  for(i = 0; i < 4; i++) r += q->q[i] * q->q[i];
  return sqrt(r);
}

void quaternion_neg(quaternion_t *r, quaternion_t *q)
{
  size_t i;

  if (q == NULL || r == NULL) return;
  for(i = 0; i < 4; i++) r->q[i] = -q->q[i];
}

void quaternion_conj(quaternion_t *r, quaternion_t *q)
{
  size_t i;

  if (q == NULL || r == NULL) return;
  r->q[0] = q->q[0];
  for(i = 1; i < 4; i++) r->q[i] = -q->q[i];
}

void quaternion_add_d(quaternion_t *r, quaternion_t *q, double d)
{
  if (q == NULL || r == NULL) return;
  quaternion_copy(r, q);
  r->q[0] += d;
}

void quaternion_add(quaternion_t *r, quaternion_t *a, quaternion_t *b)
{
  size_t i;

  if (r == NULL || a == NULL || b == NULL) return;
  for(i = 0; i < 4; i++) r->q[i] = a->q[i] + b->q[i];
}

void quaternion_mul_d(quaternion_t *r, quaternion_t *q, double d)
{
  size_t i;

  if (r == NULL || q == NULL) return;
  for(i = 0; i < 4; i++) r->q[i] = q->q[i] * d;
}

bool quaternion_equal(quaternion_t *a, quaternion_t *b)
{
  size_t i;

  for(i = 0; i < 4; i++) if (a->q[i] != b->q[i]) return false;
  return true;
}

#define A(N) (a->q[(N)])
#define B(N) (b->q[(N)])
#define R(N) (r->q[(N)])
void quaternion_mul(quaternion_t *r, quaternion_t *a, quaternion_t *b)
{
  size_t i;
  double ri = 0.0;

  if (r == NULL || a == NULL || b == NULL) return;
  R(0) = A(0)*B(0) - A(1)*B(1) - A(2)*B(2) - A(3)*B(3);
  R(1) = A(0)*B(1) + A(1)*B(0) + A(2)*B(3) - A(3)*B(2);
  R(2) = A(0)*B(2) - A(1)*B(3) + A(2)*B(0) + A(3)*B(1);
  R(3) = A(0)*B(3) + A(1)*B(2) - A(2)*B(1) + A(3)*B(0);
}
#undef A
#undef B
#undef R

void quaternion_print(quaternion_t *q)
{
  if (q == NULL) return;
  printf("(%lf, %lf, %lf, %lf)\n",
	 q->q[0], q->q[1], q->q[2], q->q[3]);
}


class PCG32(seed, incr) {

    has state

    define (
        mask32 = (2**32 - 1),
        mask64 = (2**64 - 1),
        N      = 6364136223846793005,
    )

    method init {
        seed := 1
        incr := 2
        incr  = (((incr << 1) | 1) & mask64)
        state = (((incr + seed)*N + incr) & mask64)
    }

    method next_int {
        var shift  = ((((state >> 18) ^ state) >> 27) & mask32)
        var rotate = ((state >> 59) & mask32)
            state  = ((state*N + incr) & mask64)
        ((shift >> rotate) | (shift << (32-rotate))) & mask32
    }

    method next_float {
        self.next_int / (mask32+1)
    }
}

say "Seed: 42, Increment: 54, first 5 values:";
var rng = PCG32(seed: 42, incr: 54)
say 5.of { rng.next_int }

say "\nSeed: 987654321, Increment: 1, values histogram:";
var rng = PCG32(seed: 987654321, incr: 1)
var histogram = Bag(1e5.of { floor(5*rng.next_float) }...)
histogram.pairs.sort.each { .join(": ").say }


type pcg32 = LargeWord.word * LargeWord.word

local
  infix 5 >>
  val op >> = LargeWord.>>
  and m = 0w6364136223846793005 : LargeWord.word
  and rotate32 = fn a as (x, n) =>
    Word32.orb (Word32.>> a, Word32.<< (x, Word.andb (~ n, 0w31)))
in
  fun pcg32Init (seed, seq) : pcg32 =
    let
      val inc = LargeWord.<< (LargeWord.fromInt seq, 0w1) + 0w1
    in
      ((LargeWord.fromInt seed + inc) * m + inc, inc)
    end
  fun pcg32Random ((state, inc) : pcg32) : Word32.word * pcg32 = (
    rotate32 (
      Word32.xorb (
        Word32.fromLarge (state >> 0w27),
        Word32.fromLarge (state >> 0w45)),
      Word.fromLarge (state >> 0w59)),
    (state * m + inc, inc))
end


import "/big" for BigInt

var Const  = BigInt.new("6364136223846793005")
var Mask64 = (BigInt.one << 64) - BigInt.one
var Mask32 = (BigInt.one << 32) - BigInt.one

class Pcg32 {
    construct new() {
        _state  = BigInt.fromBaseString("853c49e6748fea9b", 16)
        _inc    = BigInt.fromBaseString("da3e39cb94b95bdb", 16)
    }

    seed(seedState, seedSequence) {
        _state = BigInt.zero
        _inc = ((seedSequence << BigInt.one) | BigInt.one) & Mask64
        nextInt
        _state = _state + seedState
        nextInt
    }

    nextInt {
        var old = _state
        _state = (old*Const + _inc) & Mask64
        var xorshifted = (((old >> 18) ^ old) >> 27) & Mask32
        var rot = (old >> 59) & Mask32
        return ((xorshifted >> rot) | (xorshifted << ((-rot) & 31))) & Mask32
    }

    nextFloat { nextInt.toNum / 2.pow(32) }
}

var randomGen = Pcg32.new()
randomGen.seed(BigInt.new(42), BigInt.new(54))
for (i in 0..4) System.print(randomGen.nextInt)

var counts = List.filled(5, 0)
randomGen.seed(BigInt.new(987654321), BigInt.one)
for (i in 1..1e5) {
    var i = (randomGen.nextFloat * 5).floor
    counts[i] = counts[i] + 1
}
System.print("\nThe counts for 100,000 repetitions are:")
for (i in 0..4) System.print("  %(i) : %(counts[i])")


[Pythagorean triples for Rosetta code.
Counts (1) all Pythagorean triples (2) primitive Pythagorean triples,
with perimeter not greater than a given value.

Library subroutine M3, Prints header and is then overwritten.
Here, the last character sets the teleprinter to figures.]
            ..PZ [simulate blank tape]
  [email protected]@E8FEZPF
  @&*[email protected]&#.
            ..PZ

[Library subroutine P7, prints long strictly positive integer;
10 characters, right justified, padded left with spaces.
Closed, even; 35 storage locations; working position 4D.]
            T   56 K
  [email protected]#@[email protected]@[email protected]@SFLDUFOFFFSFL4F
  [email protected]@XFT28#[email protected][email protected]@

  [Subroutine for positive integer division.
  Input:  4D = dividend, 6D = divisor.
  Output: 4D = remainder, 6D = quotient.
  37 locations; working locations 0D, 8D.]
            T  100 K
  [email protected]@[email protected]@[email protected]@
  [email protected]@[email protected]@EFPF

 [Subroutine to return GCD of two non-negative 35-bit integers.
  Input:  Integers at 4D, 6D.
  Output: GCD at 4D; changes 6D.
  41 locations; working location 0D.]
            T  200 K
  [email protected]@[email protected]@[email protected]@[email protected]@T6D
  [email protected]@[email protected]@[email protected]@A6DT4DEFPF

  [************************ ROSETTA CODE TASK *************************
  Subroutine to count Pythagorean triples with given maximum perimeter.
  Input:  0D = maximum perimeter.
  Output: 4D = number of triples, 6D = number of primitive.
          0D is changed.
  Must be loaded at an even address.
  Uses the well-known fact that a primitive Pythagorean triple is of the form
  (m^2 - n^2, 2*m*n, m^2 + n^2) where m, n are coprime and of opposite parity.]
            T  300 K
            G      K
            A    3 F  [make link]
            E   16 @  [jump over variables and constants]

        [Double values are put here to ensure even address]
  [Variables]
      [2]   P F  P F  [maximum perimeter]
      [4]   P F  P F  [total number of Pythagorean triples]
      [6]   P F  P F  [number of primitive Pythagorean triples]
      [8]   P F  P F  [m]
     [10]   P F  P F  [n]
  [Constants]
            T12#Z PF T12Z  [clears sandwich digit between 12 and 13]
     [12]   P D  P F  [double-value 1]
            T14#Z PF T14Z  [clears sandwich digit between 14 and 15]
     [14]   P1F  P F  [double-value 2]

         [Continue with code]
     [16]   T   69 @  [plant link for return]
            A      D  [load maximum perimeter]
            T    2#@  [store locally]
            T    4#@  [initialize counts of triangles to 0]
            T    6#@
            A   12#@  [load 1]
            T    8#@  [m := 1]
         [Next m, inc by 1]
     [23]   T      F  [clear acc]
            A    8#@  [load m]
            A   12#@  [add 1]
            T    8#@  [update m]
            H    8#@  [mult reg := m]
            C   12#@  [acc := m AND 1]
            A   12#@  [add 1]
            T   10#@  [n := 1 if m even, 2 if m odd]
         [Here to count triangles arising from m, n.
          It's assumed m and n are known coprime.]
     [31]   A   31 @  [call the count subroutine,]
            G   70 @    [result is in 6D]
            S    6 D  [load negative count]
            G   40 @  [jump if count > 0]
         [No triangles found for this n.
          If n = 1 or 2 then whole thing is finished.
          Else move on to next m.]
            T      F  [clear acc]
            A   14#@  [load 2]
            S   10#@  [2 - n]
            G   23 @  [if n > 2, go to next m]
            E   64 @  [if n <= 2, exit]
         [Found triangles, count is in 6D]
     [40]   T      F  [clear acc]
            A    4#@  [load total count]
            A    6 D  [add count just found]
            T    4#@  [update total count]
            A    6#@  [load primitive count]
            A   12#@  [add 1]
            T    6#@  [update primitive count]
     [47]   T      F  [clear acc]
            A   10#@  [load n]
            A   14#@  [add 2]
            U   10#@  [update n]
            S    8#@  [is n > m?]
            E   23 @  [if so, loop back for next m]
         [Test whether m and n are coprime.]
            T      F  [clear acc]
            A    8#@  [load m]
            T    4 D  [to 4D for GCD routine]
            A   10#@  [load n]
            T    6 D  [to 6D for GCD routine]
            A   58 @  [call GCD routine,]
            G  200 F  [GCD is returned in 4D]
            A    4 D  [load GCD]
            S   14#@  [is GCD = 1? (test by subtracting 2)]
            E   47 @  [no, go straight to next n]
            G   31 @  [yes, count triangles, then next n]
     [64]   T      F  [exit, clear acc]
            A    4#@  [load total number of triples]
            T    4 D  [return in 4D]
            A    6#@  [load number of primitive triples]
            T    6 D  [return in 6D]
     [69]   E      F

 [2nd-level subroutine to count triangles arising from m, n.
  Assumes m, n are coprime and of opposite parity,
    and m is in the multiplier register.
  Result is returned in 6D.]
     [70]   A    3 F  [make and plant link for return]
            T   91 @
            A    2#@  [acc := maximum perimeter]
            T    4 D  [to 4D for division routine]
            A    8#@  [load m]
            A   10#@  [add n]
            T      D  [m + n to 0D]
            V      D  [acc := m*(m + n)]
        [Need to shift product 34 left to restore integer scaling.
         Since we want 2*m*(m+n), shift 35 left.]
            L      F  [13 left (maximum possible)]
            L      F  [13 more]
            L  128 F   [9 more]
            T    6 D  [perimeter to 6D for division routine]
            A    4 D  [load maximum perimeter]
            S    6 D  [is perimeter > maximum?]
            G   89 @  [quick exit if so]
            T      F  [clear acc]
            A   86 @  [call division routine,]
            G  100 F    [leaves count in 6D]
            E   91 @  [jump to exit]
     [89]   T      F  [acc := 0]
            T    6 D  [return count = 0]
     [91]   E      F

  [Main routine. Load at an even address.]
            T  500 K
            G      K
        [The initial maximum perimeter is repeatedly multiplied by 10]
            T#Z PF TZ  [clears sandwich digit between 0 and 1]
      [0]   P50F  PF  [initial maximum perimeter     <---------- EDIT HERE]
      [2]   P    3 F  [number of values to calculate <---------- EDIT HERE]
      [3]   P      D  [1]
      [4]   P F  P F  [maximum perimeter]
      [6]   P F  P F  [total number of triples]
      [8]   P F  P F  [number of primitive triples]
     [10]   P      F  [negative count of values]
     [11]   #      F  [figures shift]
     [12]   @      F  [carriage return]
     [13]   &      F  [line feed]
     [14]   K 4096 F  [null char]
  [Enter with acc = 0]
     [15]   S    2 @  [initialize a negative counter]
            T   10 @    [(standard EDSAC practice)]
            A     #@  [initialize maximum perimeter]
            T    4#@
     [19]   T      F  [clear acc]
            A    4#@  [load maximum perimeter]
            T      D  [to 0D for subroutine]
            A   22 @  [call subroutine to count triples]
            G  300 F
            A    4 D  [returns total number in 4D]
            T    6#@  [save locally]
            A    6 D  [returns number of primitive in 6D]
            T    8#@  [save locally]
        [Print the result]
            A    4#@  [load maximum perimeter]
            T      D  [to 0D for print subroutine]
            A   30 @  [call print subroutine]
            G   56 F
            A    6#@  [repeat for total number of triples]
            T      D
            A   34 @
            G   56 F
            A    8#@  [repeat for number of primitive triples]
            T      D
            A   38 @
            G   56 F
            O   12 @
            O   13 @
            A   10 @  [load negative count]
            A    3 @  [add 1]
            E   53 @  [out if reached 0]
            T   10 @  [else update count]
            A    4#@  [load max perimeter]
            U      D  [temp store]
            L    1 F  [times 4]
            A      D  [times 5]
            L      D  [times 10]
            T    4#@  [update]
            E   19 @  [loop back]
     [53]   O   14 @  [done; print null to flush printer buffer]
            Z      F  [stop]
            E   15 Z  [define entry point]
            P      F  [acc = 0 on entry]


pToken := Gdip_Startup()
gdip1()
Pythagoras_tree(600, 600, 712, 600, 1)
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
OnExit, Exit
return

Pythagoras_tree(x1, y1, x2, y2, depth){
    global G, hwnd1, hdc, Width, Height
    if (depth > 7)
        Return

    Pen := Gdip_CreatePen(0xFF808080, 1)
    Brush1 := Gdip_BrushCreateSolid(0xFFFFE600)
    Brush2 := Gdip_BrushCreateSolid(0xFFFAFF00)
    Brush3 := Gdip_BrushCreateSolid(0xFFDBFF00)
    Brush4 := Gdip_BrushCreateSolid(0xFFDBFF00)
    Brush5 := Gdip_BrushCreateSolid(0xFF9EFF00)
    Brush6 := Gdip_BrushCreateSolid(0xFF80FF00)
    Brush7 := Gdip_BrushCreateSolid(0xFF60FF00)

    dx := x2 - x1 , dy := y1 - y2
    x3 := x2 - dy , y3 := y2 - dx
    x4 := x1 - dy , y4 := y1 - dx
    x5 := x4 + (dx - dy) / 2
    y5 := y4 - (dx + dy) / 2

    ; draw box/triangle
    Gdip_FillPolygon(G, Brush%depth%, x1 "," y1 "|" x2 "," y2 "|" x3 "," y3 "|" x4 "," y4 "|" x1 "," y1)
    Gdip_FillPolygon(G, Brush%depth%, x4 "," y4 "|" x5 "," y5 "|" x3 "," y3 "|" x4 "," y4)

    ; draw outline
    Gdip_DrawLines(G, Pen, x1 "," y1 "|" x2 "," y2 "|" x3 "," y3 "|" x4 "," y4 "|" x1 "," y1)
    Gdip_DrawLines(G, Pen, x4 "," y4 "|" x5 "," y5 "|" x3 "," y3 "|" x4 "," y4)

    Pythagoras_tree(x4, y4, x5, y5, depth+1)
    Pythagoras_tree(x5, y5, x3, y3, depth+1)
}

gdip1(){
    global
    Width := A_ScreenWidth, Height := A_ScreenHeight
    Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
    Gui, 1: Show, NA
    hwnd1 := WinExist()
    OnMessage(0x201, "WM_LBUTTONDOWN")
    hbm := CreateDIBSection(Width, Height)
    hdc := CreateCompatibleDC()
    obm := SelectObject(hdc, hbm)
    G := Gdip_GraphicsFromHDC(hdc)
    Gdip_SetSmoothingMode(G, 4)
}
; ---------------------------------------------------------------
WM_LBUTTONDOWN(){
    PostMessage, 0xA1, 2
}
; ---------------------------------------------------------------
gdip2(){
    global
    Gdip_DeleteBrush(pBrush)
    Gdip_DeletePen(pPen)
    SelectObject(hdc, obm)
    DeleteObject(hbm)
    DeleteDC(hdc)
    Gdip_DeleteGraphics(G)
}
; ---------------------------------------------------------------
exit:
gdip2()
ExitApp
return


using System;

struct Quaternion : IEquatable<Quaternion>
{
    public readonly double A, B, C, D;

    public Quaternion(double a, double b, double c, double d)
    {
        this.A = a;
        this.B = b;
        this.C = c;
        this.D = d;
    }

    public double Norm()
    {
        return Math.Sqrt(A * A + B * B + C * C + D * D);
    }

    public static Quaternion operator -(Quaternion q)
    {
        return new Quaternion(-q.A, -q.B, -q.C, -q.D);
    }

    public Quaternion Conjugate()
    {
        return new Quaternion(A, -B, -C, -D);
    }

    // implicit conversion takes care of real*quaternion and real+quaternion
    public static implicit operator Quaternion(double d)
    {
        return new Quaternion(d, 0, 0, 0);
    }

    public static Quaternion operator +(Quaternion q1, Quaternion q2)
    {
        return new Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D);
    }

    public static Quaternion operator *(Quaternion q1, Quaternion q2)
    {
        return new Quaternion(
            q1.A * q2.A - q1.B * q2.B - q1.C * q2.C - q1.D * q2.D,
            q1.A * q2.B + q1.B * q2.A + q1.C * q2.D - q1.D * q2.C,
            q1.A * q2.C - q1.B * q2.D + q1.C * q2.A + q1.D * q2.B,
            q1.A * q2.D + q1.B * q2.C - q1.C * q2.B + q1.D * q2.A);
    }

    public static bool operator ==(Quaternion q1, Quaternion q2)
    {
        return q1.A == q2.A && q1.B == q2.B && q1.C == q2.C && q1.D == q2.D;
    }

    public static bool operator !=(Quaternion q1, Quaternion q2)
    {
        return !(q1 == q2);
    }

    #region Object Members

    public override bool Equals(object obj)
    {
        if (obj is Quaternion)
            return Equals((Quaternion)obj);

        return false;
    }

    public override int GetHashCode()
    {
        return A.GetHashCode() ^ B.GetHashCode() ^ C.GetHashCode() ^ D.GetHashCode();
    }

    public override string ToString()
    {
        return string.Format("Q({0}, {1}, {2}, {3})", A, B, C, D);
    }

    #endregion

    #region IEquatable<Quaternion> Members

    public bool Equals(Quaternion other)
    {
        return other == this;
    }

    #endregion
}


class
	APPLICATION

create
	make

feature

	make
		local
			perimeter: INTEGER
		do
			perimeter := 100
			from
			until
				perimeter > 1000000
			loop
				total := 0
				primitive_triples := 0
				count_pythagorean_triples (3, 4, 5, perimeter)
				io.put_string ("There are " + total.out + " triples, below " + perimeter.out + ". Of which " + primitive_triples.out + " are primitives.%N")
				perimeter := perimeter * 10
			end
		end

	count_pythagorean_triples (a, b, c, perimeter: INTEGER)
			-- Total count of pythagorean triples and total count of primitve triples below perimeter.
		local
			p: INTEGER
		do
			p := a + b + c
			if p <= perimeter then
				primitive_triples := primitive_triples + 1
				total := total + perimeter // p
				count_pythagorean_triples (a + 2 * (- b + c), 2 * (a + c) - b, 2 * (a - b + c) + c, perimeter)
				count_pythagorean_triples (a + 2 * (b + c), 2 * (a + c) + b, 2 * (a + b + c) + c, perimeter)
				count_pythagorean_triples (- a + 2 * (b + c), 2 * (- a + c) + b, 2 * (- a + b + c) + c, perimeter)
			end
		end

feature {NONE}

	primitive_triples: INTEGER

	total: INTEGER

end


Subroutine pythagoras_tree(x1, y1, x2, y2, depth)
	If depth > 10 Then Return

	dx = x2 - x1 : dy = y1 - y2
	x3 = x2 - dy : y3 = y2 - dx
	x4 = x1 - dy : y4 = y1 - dx
	x5 = x4 + (dx - dy) / 2
	y5 = y4 - (dx + dy) / 2
	#draw the box
	Line x1, y1, x2, y2 : Line x2, y2, x3, y3
	Line x3, y3, x4, y4 : Line x4, y4, x1, y1

	Call pythagoras_tree(x4, y4, x5, y5, depth +1)
	Call pythagoras_tree(x5, y5, x3, y3, depth +1)
End Subroutine

w = 800 : h = w * 11 \ 16
w2 = w \ 2 : diff = w \ 12

Clg
FastGraphics
Graphsize w, h
Color green
Call pythagoras_tree(w2 - diff, h - 10, w2 + diff, h - 10, 0)
Refresh
ImgSave "pythagoras_tree.jpg", "jpg"
End


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

typedef struct{
	double x,y;
}point;

void pythagorasTree(point a,point b,int times){

	point c,d,e;

	c.x = b.x - (a.y -  b.y);
	c.y = b.y - (b.x - a.x);

	d.x = a.x - (a.y -  b.y);
	d.y = a.y - (b.x - a.x);

	e.x = d.x +  ( b.x - a.x - (a.y -  b.y) ) / 2;
	e.y = d.y -  ( b.x - a.x + a.y -  b.y ) / 2;

	if(times>0){
		setcolor(rand()%15 + 1);

		line(a.x,a.y,b.x,b.y);
		line(c.x,c.y,b.x,b.y);
		line(c.x,c.y,d.x,d.y);
		line(a.x,a.y,d.x,d.y);

		pythagorasTree(d,e,times-1);
		pythagorasTree(e,c,times-1);
	}
}

int main(){

	point a,b;
	double side;
	int iter;

	time_t t;

	printf("Enter initial side length : ");
	scanf("%lf",&side);

	printf("Enter number of iterations : ");
	scanf("%d",&iter);

	a.x = 6*side/2 - side/2;
	a.y = 4*side;
	b.x = 6*side/2 + side/2;
	b.y = 4*side;

	initwindow(6*side,4*side,"Pythagoras Tree ?");

	srand((unsigned)time(&t));

	pythagorasTree(a,b,iter);

	getch();

	closegraph();

	return 0;

}


#include <iostream>
using namespace std;

template<class T = double>
class Quaternion
{
public:
  T w, x, y, z;

  // Numerical constructor
  Quaternion(const T &w, const T &x, const T &y, const T &z): w(w), x(x), y(y), z(z) {};
  Quaternion(const T &x, const T &y, const T &z): w(T()), x(x), y(y), z(z) {}; // For 3-rotations
  Quaternion(const T &r): w(r), x(T()), y(T()), z(T()) {};
  Quaternion(): w(T()), x(T()), y(T()), z(T()) {};

  // Copy constructor and assignment
  Quaternion(const Quaternion &q): w(q.w), x(q.x), y(q.y), z(q.z) {};
  Quaternion& operator=(const Quaternion &q) { w=q.w; x=q.x; y=q.y; z=q.z; return *this; }

  // Unary operators
  Quaternion operator-() const { return Quaternion(-w, -x, -y, -z); }
  Quaternion operator~() const { return Quaternion(w, -x, -y, -z); } // Conjugate

  // Norm-squared. SQRT would have to be made generic to be used here
  T normSquared() const { return w*w + x*x + y*y + z*z; }

  // In-place operators
  Quaternion& operator+=(const T &r)
    { w += r; return *this; }
  Quaternion& operator+=(const Quaternion &q)
    { w += q.w; x += q.x; y += q.y; z += q.z; return *this; }

  Quaternion& operator-=(const T &r)
    { w -= r; return *this; }
  Quaternion& operator-=(const Quaternion &q)
    { w -= q.w; x -= q.x; y -= q.y; z -= q.z; return *this; }

  Quaternion& operator*=(const T &r)
    { w *= r; x *= r; y *= r; z *= r; return *this; }
  Quaternion& operator*=(const Quaternion &q)
  {
    T oldW(w), oldX(x), oldY(y), oldZ(z);
    w = oldW*q.w - oldX*q.x - oldY*q.y - oldZ*q.z;
    x = oldW*q.x + oldX*q.w + oldY*q.z - oldZ*q.y;
    y = oldW*q.y + oldY*q.w + oldZ*q.x - oldX*q.z;
    z = oldW*q.z + oldZ*q.w + oldX*q.y - oldY*q.x;
    return *this;
  }

  Quaternion& operator/=(const T &r)
    { w /= r; x /= r; y /= r; z /= r; return *this; }
  Quaternion& operator/=(const Quaternion &q)
  {
    T oldW(w), oldX(x), oldY(y), oldZ(z), n(q.normSquared());
    w = (oldW*q.w + oldX*q.x + oldY*q.y + oldZ*q.z) / n;
    x = (oldX*q.w - oldW*q.x + oldY*q.z - oldZ*q.y) / n;
    y = (oldY*q.w - oldW*q.y + oldZ*q.x - oldX*q.z) / n;
    z = (oldZ*q.w - oldW*q.z + oldX*q.y - oldY*q.x) / n;
    return *this;
  }

  // Binary operators based on in-place operators
  Quaternion operator+(const T &r) const { return Quaternion(*this) += r; }
  Quaternion operator+(const Quaternion &q) const { return Quaternion(*this) += q; }
  Quaternion operator-(const T &r) const { return Quaternion(*this) -= r; }
  Quaternion operator-(const Quaternion &q) const { return Quaternion(*this) -= q; }
  Quaternion operator*(const T &r) const { return Quaternion(*this) *= r; }
  Quaternion operator*(const Quaternion &q) const { return Quaternion(*this) *= q; }
  Quaternion operator/(const T &r) const { return Quaternion(*this) /= r; }
  Quaternion operator/(const Quaternion &q) const { return Quaternion(*this) /= q; }

  // Comparison operators, as much as they make sense
  bool operator==(const Quaternion &q) const
    { return (w == q.w) && (x == q.x) && (y == q.y) && (z == q.z); }
  bool operator!=(const Quaternion &q) const { return !operator==(q); }

  // The operators above allow quaternion op real. These allow real op quaternion.
  // Uses the above where appropriate.
  template<class T> friend Quaternion<T> operator+(const T &r, const Quaternion<T> &q);
  template<class T> friend Quaternion<T> operator-(const T &r, const Quaternion<T> &q);
  template<class T> friend Quaternion<T> operator*(const T &r, const Quaternion<T> &q);
  template<class T> friend Quaternion<T> operator/(const T &r, const Quaternion<T> &q);

  // Allows cout << q
  template<class T> friend ostream& operator<<(ostream &io, const Quaternion<T> &q);
};

// Friend functions need to be outside the actual class definition
template<class T>
Quaternion<T> operator+(const T &r, const Quaternion<T> &q)
  { return q+r; }

template<class T>
Quaternion<T> operator-(const T &r, const Quaternion<T> &q)
  { return Quaternion<T>(r-q.w, q.x, q.y, q.z); }

template<class T>
Quaternion<T> operator*(const T &r, const Quaternion<T> &q)
  { return q*r; }

template<class T>
Quaternion<T> operator/(const T &r, const Quaternion<T> &q)
{
  T n(q.normSquared());
  return Quaternion(r*q.w/n, -r*q.x/n, -r*q.y/n, -r*q.z/n);
}

template<class T>
ostream& operator<<(ostream &io, const Quaternion<T> &q)
{
  io << q.w;
  (q.x < T()) ? (io << " - " << (-q.x) << "i") : (io << " + " << q.x << "i");
  (q.y < T()) ? (io << " - " << (-q.y) << "j") : (io << " + " << q.y << "j");
  (q.z < T()) ? (io << " - " << (-q.z) << "k") : (io << " + " << q.z << "k");
  return io;
}


defmodule RC do
  def count_triples(limit), do: count_triples(limit,3,4,5)

  defp count_triples(limit, a, b, c) when limit<(a+b+c), do: {0,0}
  defp count_triples(limit, a, b, c) do
    {p1, t1} = count_triples(limit, a-2*b+2*c, 2*a-b+2*c, 2*a-2*b+3*c)
    {p2, t2} = count_triples(limit, a+2*b+2*c, 2*a+b+2*c, 2*a+2*b+3*c)
    {p3, t3} = count_triples(limit,-a+2*b+2*c,-2*a+b+2*c,-2*a+2*b+3*c)
    {1+p1+p2+p3, div(limit, a+b+c)+t1+t2+t3}
  end
end

list = for n <- 1..8, do: Enum.reduce(1..n, 1, fn(_,acc)->10*acc end)
Enum.each(list, fn n -> IO.inspect {n, RC.count_triples(n)} end)


%%
%% Pythagorian triples in Erlang, J.W. Luiten
%%
-module(triples).
-export([main/1]).

%% Transformations t1, t2 and t3 to generate new triples
t1(A, B, C) ->
  {A-2*B+2*C, 2*A-B+2*C, 2*A-2*B+3*C}.
t2(A, B, C) ->
  {A+2*B+2*C, 2*A+B+2*C, 2*A+2*B+3*C}.
t3(A, B, C) ->
  {2*B+2*C-A, B+2*C-2*A, 2*B+3*C-2*A}.

%% Generation of triples
count_triples(A, B, C, Tot_acc, Cnt_acc, Max_perimeter) when (A+B+C) =< Max_perimeter ->
  Tot1 = Tot_acc + Max_perimeter div (A+B+C),
  {A1, B1, C1} = t1(A, B, C),
  {Tot2, Cnt2} = count_triples(A1, B1, C1, Tot1, Cnt_acc+1, Max_perimeter),

  {A2, B2, C2} = t2(A, B, C),
  {Tot3, Cnt3} = count_triples(A2, B2, C2, Tot2, Cnt2, Max_perimeter),

  {A3, B3, C3} = t3(A, B, C),
  {Tot4, Cnt4} = count_triples(A3, B3, C3, Tot3, Cnt3, Max_perimeter),
  {Tot4, Cnt4};
count_triples(_A, _B, _C, Tot_acc, Cnt_acc, _Max_perimeter) ->
  {Tot_acc, Cnt_acc}.

count_triples(A, B, C, Pow) ->
  Max = trunc(math:pow(10, Pow)),
  {Tot, Prim} = count_triples(A, B, C, 0, 0, Max),
  {Pow, Tot, Prim}.

count_triples(Pow) ->
  count_triples(3, 4, 5, Pow).

%% Display a single result.
display_result({Pow, Tot, Prim}) ->
  io:format("Up to 10 ** ~w : ~w triples, ~w primitives~n", [Pow, Tot, Prim]).

main(Max) ->
  L = lists:seq(1, Max),
  Answer = lists:map(fun(X) -> count_triples(X) end, L),
  lists:foreach(fun(Result) -> display_result(Result) end, Answer).


#include <windows.h>
#include <string>
#include <iostream>

const int BMP_SIZE = 720, LINE_LEN = 120, BORDER = 100;

class myBitmap {
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap() {
        DeleteObject( pen ); DeleteObject( brush );
        DeleteDC( hdc ); DeleteObject( bmp );
    }
    bool create( int w, int h ) {
        BITMAPINFO bi;
        ZeroMemory( &bi, sizeof( bi ) );
        bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
        bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
        bi.bmiHeader.biCompression = BI_RGB;
        bi.bmiHeader.biPlanes      = 1;
        bi.bmiHeader.biWidth       =  w;
        bi.bmiHeader.biHeight      = -h;
        HDC dc = GetDC( GetConsoleWindow() );
        bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
        if( !bmp ) return false;
        hdc = CreateCompatibleDC( dc );
        SelectObject( hdc, bmp );
        ReleaseDC( GetConsoleWindow(), dc );
        width = w; height = h;
        return true;
    }
    void clear( BYTE clr = 0 ) {
        memset( pBits, clr, width * height * sizeof( DWORD ) );
    }
    void setBrushColor( DWORD bClr ) {
        if( brush ) DeleteObject( brush );
        brush = CreateSolidBrush( bClr );
        SelectObject( hdc, brush );
    }
    void setPenColor( DWORD c ) {
        clr = c; createPen();
    }
    void setPenWidth( int w ) {
        wid = w; createPen();
    }
    void saveBitmap( std::string path ) {
        BITMAPFILEHEADER fileheader;
        BITMAPINFO       infoheader;
        BITMAP           bitmap;
        DWORD            wb;
        GetObject( bmp, sizeof( bitmap ), &bitmap );
        DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];
        ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
        ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
        ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );
        infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
        infoheader.bmiHeader.biCompression = BI_RGB;
        infoheader.bmiHeader.biPlanes = 1;
        infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
        infoheader.bmiHeader.biHeight = bitmap.bmHeight;
        infoheader.bmiHeader.biWidth = bitmap.bmWidth;
        infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );
        fileheader.bfType    = 0x4D42;
        fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
        fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;
        GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );
        HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
                                  FILE_ATTRIBUTE_NORMAL, NULL );
        WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
        WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
        WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
        CloseHandle( file );
        delete [] dwpBits;
    }
    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }
private:
    void createPen() {
        if( pen ) DeleteObject( pen );
        pen = CreatePen( PS_SOLID, wid, clr );
        SelectObject( hdc, pen );
    }
    HBITMAP bmp; HDC    hdc;
    HPEN    pen; HBRUSH brush;
    void    *pBits; int    width, height, wid;
    DWORD    clr;
};
class tree {
public:
    tree() {
        bmp.create( BMP_SIZE, BMP_SIZE ); bmp.clear();
        clr[0] = RGB( 90, 30, 0 );   clr[1] = RGB( 255, 255, 0 );
        clr[2] = RGB( 0, 255, 255 ); clr[3] = RGB( 255, 255, 255 );
        clr[4] = RGB( 255, 0, 0 );   clr[5] = RGB( 0, 100, 190 );
    }
    void draw( int it, POINT a, POINT b ) {
        if( !it ) return;
        bmp.setPenColor( clr[it % 6] );
        POINT df = { b.x - a.x, a.y -  b.y }; POINT c = { b.x - df.y, b.y - df.x };
        POINT d = { a.x - df.y, a.y - df.x };
        POINT e = { d.x + ( ( df.x - df.y ) / 2 ), d.y - ( ( df.x + df.y ) / 2 )};
        drawSqr( a, b, c, d ); draw( it - 1, d, e ); draw( it - 1, e, c );
    }
    void save( std::string p ) { bmp.saveBitmap( p ); }
private:
    void drawSqr( POINT a, POINT b, POINT c, POINT d ) {
        HDC dc = bmp.getDC();
        MoveToEx( dc, a.x, a.y, NULL );
        LineTo( dc, b.x, b.y );
        LineTo( dc, c.x, c.y );
        LineTo( dc, d.x, d.y );
        LineTo( dc, a.x, a.y );
    }
    myBitmap bmp;
    DWORD clr[6];
};
int main( int argc, char* argv[] ) {
    POINT ptA = { ( BMP_SIZE >> 1 ) - ( LINE_LEN >> 1 ), BMP_SIZE - BORDER },
          ptB = { ptA.x + LINE_LEN, ptA.y };
    tree t; t.draw( 12, ptA, ptB );
    // change this path
    t.save( "?:/pt.bmp" );
    return 0;
}


quat = cluster is make, minus, norm, conj, add, addr, mul, mulr,
                  equal, get_a, get_b, get_c, get_d, q_form
    rep = struct[a,b,c,d: real]

    make = proc (a,b,c,d: real) returns (cvt)
        return (rep${a:a, b:b, c:c, d:d})
    end make

    minus = proc (q: cvt) returns (cvt)
        return (down(make(-q.a, -q.b, -q.c, -q.d)))
    end minus

    norm = proc (q: cvt) returns (real)
        return ((q.a**2.0 + q.b**2.0 + q.c**2.0 + q.d**2.0) ** 0.5)
    end norm

    conj = proc (q: cvt) returns (cvt)
        return (down(make(q.a, -q.b, -q.c, q.d)))
    end conj

    add = proc (q1, q2: cvt) returns (cvt)
        return (down(make(q1.a+q2.a, q1.b+q2.b, q1.c+q2.c, q1.d+q2.d)))
    end add

    addr = proc (q: cvt, r: real) returns (cvt)
        return (down(make(q.a+r, q.b+r, q.c+r, q.d+r)))
    end addr

    mul = proc (q1, q2: cvt) returns (cvt)
        a: real := q1.a*q2.a - q1.b*q2.b - q1.c*q2.c - q1.d*q2.d
        b: real := q1.a*q2.b + q1.b*q2.a + q1.c*q2.d - q1.d*q2.c
        c: real := q1.a*q2.c - q1.b*q2.d + q1.c*q2.a + q1.d*q2.b
        d: real := q1.a*q2.d + q1.b*q2.c - q1.c*q2.b + q1.d*q2.a
        return (down(make(a,b,c,d)))
    end mul

    mulr = proc (q: cvt, r: real) returns (cvt)
        return (down(make(q.a*r, q.b*r, q.c*r, q.d*r)))
    end mulr

    equal = proc (q1, q2: cvt) returns (bool)
        return (q1.a = q2.a & q1.b = q2.b & q1.c = q2.c & q1.d = q2.d)
    end equal

    get_a = proc (q: cvt) returns (real) return (q.a) end get_a
    get_b = proc (q: cvt) returns (real) return (q.b) end get_b
    get_c = proc (q: cvt) returns (real) return (q.c) end get_c
    get_d = proc (q: cvt) returns (real) return (q.d) end get_d

    q_form = proc (q: cvt, a, b: int) returns (string)
        return ( f_form(q.a, a, b) || " + "
              || f_form(q.b, a, b) || "i + "
              || f_form(q.c, a, b) || "j + "
              || f_form(q.d, a, b) || "k" )
    end q_form
end quat

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

    q0: quat := quat$make(1.0, 2.0, 3.0, 4.0)
    q1: quat := quat$make(2.0, 3.0, 4.0, 5.0)
    q2: quat := quat$make(3.0, 4.0, 5.0, 6.0)
    r:  real := 7.0

    stream$putl(po, "      q0 = " || quat$q_form(q0, 3, 3))
    stream$putl(po, "      q1 = " || quat$q_form(q1, 3, 3))
    stream$putl(po, "      q2 = " || quat$q_form(q2, 3, 3))
    stream$putl(po, "       r = " || f_form(r, 3, 3))
    stream$putl(po, "")

    stream$putl(po, "norm(q0) = " || f_form(quat$norm(q0), 3, 3))
    stream$putl(po, "     -q0 = " || quat$q_form(-q0, 3, 3))
    stream$putl(po, "conj(q0) = " || quat$q_form(quat$conj(q0), 3, 3))
    stream$putl(po, "  q0 + r = " || quat$q_form(quat$addr(q0, r), 3, 3))
    stream$putl(po, " q1 + q2 = " || quat$q_form(q1 + q2, 3, 3))
    stream$putl(po, "  q0 * r = " || quat$q_form(quat$mulr(q0, r), 3, 3))
    stream$putl(po, " q1 * q2 = " || quat$q_form(q1 * q2, 3, 3))
    stream$putl(po, " q2 * q1 = " || quat$q_form(q2 * q1, 3, 3))

    if q1*q2 ~= q2*q1 then stream$putl(po, "q1 * q2 ~= q2 * q1") end
end start_up


(defclass quaternion () ((a :accessor q-a :initarg :a :type real)
                         (b :accessor q-b :initarg :b :type real)
                         (c :accessor q-c :initarg :c :type real)
                         (d :accessor q-d :initarg :d :type real))
  (:default-initargs :a 0 :b 0 :c 0 :d 0))

(defun make-q (&optional (a 0) (b 0) (c 0) (d 0))
  (make-instance 'quaternion :a a :b b :c c :d d))

(defgeneric sum (x y))

(defmethod sum ((x quaternion) (y quaternion))
  (make-q  (+ (q-a x) (q-a y))
           (+ (q-b x) (q-b y))
           (+ (q-c x) (q-c y))
           (+ (q-d x) (q-d y))))

(defmethod sum ((x quaternion) (y real))
  (make-q  (+ (q-a x) y) (q-b x) (q-c x) (q-d x)))

(defmethod sum ((x real) (y quaternion))
  (make-q  (+ (q-a y) x) (q-b y) (q-c y) (q-d y)))

(defgeneric sub (x y))

(defmethod sub ((x quaternion) (y quaternion))
  (make-q  (- (q-a x) (q-a y))
           (- (q-b x) (q-b y))
           (- (q-c x) (q-c y))
           (- (q-d x) (q-d y))))

(defmethod sub ((x quaternion) (y real))
  (make-q  (- (q-a x) y)
           (q-b x)
           (q-c x)
           (q-d x)))

(defmethod sub ((x real) (y quaternion))
  (make-q  (- (q-a y) x)
           (q-b y)
           (q-c y)
           (q-d y)))

(defgeneric mul (x y))

(defmethod mul ((x quaternion) (y real))
  (make-q  (* (q-a x) y)
           (* (q-b x) y)
           (* (q-c x) y)
           (* (q-d x) y)))

(defmethod mul ((x real) (y quaternion))
  (make-q  (* (q-a y) x)
           (* (q-b y) x)
           (* (q-c y) x)
           (* (q-d y) x)))

(defmethod mul ((x quaternion) (y quaternion))
  (make-q  (- (* (q-a x) (q-a y)) (* (q-b x) (q-b y)) (* (q-c x) (q-c y)) (* (q-d x) (q-d y)))
           (- (+ (* (q-a x) (q-b y)) (* (q-b x) (q-a y)) (* (q-c x) (q-d y))) (* (q-d x) (q-c y)))
           (- (+ (* (q-a x) (q-c y)) (* (q-c x) (q-a y)) (* (q-d x) (q-b y))) (* (q-b x) (q-d y)))
           (- (+ (* (q-a x) (q-d y)) (* (q-b x) (q-c y)) (* (q-d x) (q-a y))) (* (q-c x) (q-b y)))))

(defmethod norm ((x quaternion))
  (+ (sqrt (q-a x)) (sqrt (q-b x)) (sqrt (q-c x)) (sqrt (q-d x))))

(defmethod print-object ((x quaternion) stream)
  (format stream "[email protected][email protected][email protected][email protected]" (q-a x) (q-b x) (q-c x) (q-d x)))

(defvar q (make-q 0 1 0 0))
(defvar q1 (make-q 0 0 1 0))
(defvar q2 (make-q 0 0 0 1))
(defvar r 7)
(format t "q+q1+q2 = ~a~&" (reduce #'sum (list q q1 q2)))
(format t "r*(q+q1+q2) = ~a~&" (mul r (reduce #'sum (list q q1 q2))))
(format t "q*q1*q2 = ~a~&" (reduce #'mul (list q q1 q2)))
(format t "q-q1-q2 = ~a~&" (reduce #'sub (list q q1 q2)))


PROGRAM PIT

BEGIN

  PRINT(CHR$(12);) !CLS
  PRINT(TIME$)

  FOR POWER=1 TO 7 DO
    PLIMIT=10#^POWER
    UPPERBOUND=INT(1+PLIMIT^0.5)
    PRIMITIVES=0
    TRIPLES=0
    EXTRAS=0          ! will count the in-range multiples of any primitive

    FOR M=2 TO UPPERBOUND DO
        FOR N=1+(M MOD 2=1) TO M-1 STEP 2 DO
            TERM1=2*M*N
            TERM2=M*M-N*N
            TERM3=M*M+N*N
            PERIMETER=TERM1+TERM2+TERM3

            IF PERIMETER<=PLIMIT THEN TRIPLES=TRIPLES+1

            A=TERM1
            B=TERM2

            REPEAT
                R=A-B*INT(A/B)
                A=B
                B=R
            UNTIL R<=0

            ! we've found a primitive triple if a = 1, since hcf =1.
            ! and it is inside perimeter range. Save it in an array
            IF (A=1) AND (PERIMETER<=PLIMIT) THEN
                PRIMITIVES=PRIMITIVES+1

                !-----------------------------------------------
                !swap so in increasing order of side length
                !-----------------------------------------------
                IF TERM1>TERM2 THEN SWAP(TERM1,TERM2)
                !-----------------------------------------------
                !we have the primitive & removed any multiples.
                !Now calculate ALL the multiples in range.
                !-----------------------------------------------
                NEX=INT(PLIMIT/PERIMETER)
                EXTRAS=EXTRAS+NEX
            END IF

            !scan
        END FOR
    END FOR

    PRINT("Primit. with perimeter <=";10#^power;"is";primitives;"&";extras;"non-prim.triples.")
    PRINT(TIME$)
  END FOR

  PRINT PRINT("** End **")
END PROGRAM


function tri(atom lim, sequence in)
    sequence r
    atom p
    p = in[1] + in[2] + in[3]
    if p > lim then
        return {0, 0}
    end if
    r = {1, floor(lim / p)}
    r += tri(lim, { in[1]-2*in[2]+2*in[3],  2*in[1]-in[2]+2*in[3],  2*in[1]-2*in[2]+3*in[3]})
    r += tri(lim, { in[1]+2*in[2]+2*in[3],  2*in[1]+in[2]+2*in[3],  2*in[1]+2*in[2]+3*in[3]})
    r += tri(lim, {-in[1]+2*in[2]+2*in[3], -2*in[1]+in[2]+2*in[3], -2*in[1]+2*in[2]+3*in[3]})
    return r
end function

atom max_peri
max_peri = 10
while max_peri <= 100000000 do
    printf(1,"%d: ", max_peri)
    ? tri(max_peri, {3, 4, 5})
    max_peri *= 10
end while


func tree x1 y1 x2 y2 depth . .
  if depth < 8
    dx = x2 - x1
    dy = y1 - y2
    x3 = x2 - dy
    y3 = y2 - dx
    x4 = x1 - dy
    y4 = y1 - dx
    x5 = x4 + 0.5 * (dx - dy)
    y5 = y4 - 0.5 * (dx + dy)
    color3 0.3 0.2 + depth / 18 0.1
    polygon [ x1 y1 x2 y2 x3 y3 x4 y4 ]
    polygon [ x3 y3 x4 y4 x5 y5 ]
    call tree x4 y4 x5 y5 depth + 1
    call tree x5 y5 x3 y3 depth + 1
  .
.
color3 0.3 0 0.1
call tree 41 90 59 90 0


type Point = { x:float; y:float }
type Line = { left : Point; right : Point }

let draw_start_html = """<!DOCTYPE html>
<title>Phytagoras tree</title>

<svg width="640" height="640">"""

let draw_end_html = """Sorry, your browser does not support inline SVG.
</svg>"""

let svg_square x1 y1 x2 y2 x3 y3 x4 y4 =
    sprintf """<polygon points="%i %i %i %i %i %i %i %i" />"""
        (int x1) (int y1) (int x2) (int y2) (int x3) (int y3) (int x4) (int y4)

let out (x : string) = System.Console.WriteLine(x)

let sprout line =
    let dx = line.right.x - line.left.x
    let dy = line.left.y - line.right.y
    let line2 = {
        left = { x = line.left.x - dy; y = line.left.y - dx };
        right = { x = line.right.x - dy ; y = line.right.y - dx }
    }
    let triangleTop = {
        x = line2.left.x + (dx - dy) / 2.;
        y = line2.left.y - (dx + dy) / 2.
    }
    [
        { left = line2.left; right = triangleTop }
        { left = triangleTop; right = line2.right }
    ]

let draw_square line =
    let dx = line.right.x - line.left.x
    let dy = line.left.y - line.right.y
    svg_square line.left.x line.left.y line.right.x line.right.y
               (line.right.x - dy) (line.right.y - dx) (line.left.x - dy) (line.left.y - dx)

let rec generate lines = function
| 0 -> ()
| n ->
    let next =
        lines
        |> List.collect (fun line ->
            (draw_square >> out) line
            sprout line
        )
    generate next (n-1)

[<EntryPoint>]
let main argv =
    let depth = 1 + if argv.Length > 0 then (System.UInt32.Parse >> int) argv.[0] else 2
    out draw_start_html
    generate [{ left = { x = 275.; y = 500. }; right = { x = 375.; y = 500. } }] depth
    out draw_end_html
    0