:- module comprehension.
:- interface.
:- import_module io.
:- import_module int.

:- type triple ---> triple(int, int, int).

:- pred pythTrip(int::in,triple::out) is nondet.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module solutions.

pythTrip(Limit,triple(X,Y,Z)) :-
    nondet_int_in_range(1,Limit,X),
    nondet_int_in_range(X,Limit,Y),
    nondet_int_in_range(Y,Limit,Z),
    pow(Z,2) = pow(X,2) + pow(Y,2).

main(!IO) :-
    solutions((pred(Triple::out) is nondet :- pythTrip(20,Triple)),Result),
    write(Result,!IO).


MODULE PyTriple64 EXPORTS Main;

IMPORT IO, Fmt;

VAR tcnt, pcnt, max, i: INTEGER;

PROCEDURE NewTriangle(a, b, c: INTEGER; VAR tcount, pcount: INTEGER) =
  VAR perim := a + b + c;
  BEGIN
    IF perim <= max THEN
      pcount := pcount + 1;
      tcount := tcount + max DIV perim;
      NewTriangle(a-2*b+2*c, 2*a-b+2*c, 2*a-2*b+3*c, tcount, pcount);
      NewTriangle(a+2*b+2*c, 2*a+b+2*c, 2*a+2*b+3*c, tcount, pcount);
      NewTriangle(2*b+2*c-a, b+2*c-2*a, 2*b+3*c-2*a, tcount, pcount);
    END;
  END NewTriangle;

BEGIN
  i := 100;

  REPEAT
    max := i;
    tcnt := 0;
    pcnt := 0;
    NewTriangle(3, 4, 5, tcnt, pcnt);
    IO.Put(Fmt.Int(i) & ": " & Fmt.Int(tcnt) & " Triples, " &
      Fmt.Int(pcnt) & " Primitives\n");
    i := i * 10;
  UNTIL i = 10000000;
END PyTriple64.


import java.awt._
import java.awt.geom.Path2D

import javax.swing.{JFrame, JPanel, SwingUtilities, WindowConstants}

object PythagorasTree extends App {

  SwingUtilities.invokeLater(() => {
    new JFrame {

      class PythagorasTree extends JPanel {
        setPreferredSize(new Dimension(640, 640))
        setBackground(Color.white)

        override def paintComponent(g: Graphics): Unit = {
          val (depthLimit, hue) = (7, 0.15f)

          def drawTree(g: Graphics2D, x1: Float, y1: Float, x2: Float, y2: Float, depth: Int): Unit = {
            if (depth == depthLimit) return
            val (dx, dy) = (x2 - x1, y1 - y2)
            val (x3, y3) = (x2 - dy, y2 - dx)
            val (x4, y4) = (x1 - dy, y1 - dx)
            val (x5, y5) = (x4 + 0.5F * (dx - dy), y4 - 0.5F * (dx + dy))
            val square = new Path2D.Float {
              moveTo(x1, y1); lineTo(x2, y2); lineTo(x3, y3); lineTo(x4, y4); closePath()
            }
            val triangle = new Path2D.Float {
              moveTo(x3, y3); lineTo(x4, y4); lineTo(x5, y5); closePath()
            }
            g.setColor(Color.getHSBColor(hue + depth * 0.02f, 1, 1))
            g.fill(square)
            g.setColor(Color.lightGray)
            g.draw(square)
            g.setColor(Color.getHSBColor(hue + depth * 0.035f, 1, 1))
            g.fill(triangle)
            g.setColor(Color.lightGray)
            g.draw(triangle)
            drawTree(g, x4, y4, x5, y5, depth + 1)
            drawTree(g, x5, y5, x3, y3, depth + 1)
          }

          super.paintComponent(g)
          drawTree(g.asInstanceOf[Graphics2D], 275, 500, 375, 500, 0)
        }
      }

      setDefaultCloseOperation(WindowConstants.EXIT_ON_CLOSE)
      setTitle("Pythagoras Tree")
      setResizable(false)
      add(new PythagorasTree, BorderLayout.CENTER)
      pack()
      setLocationRelativeTo(null)
      setVisible(true)
    }
  })

}


module CayleyDickson

data CD : Nat -> Type -> Type where
    CDBase : a -> CD 0 a
    CDProd : CD n a -> CD n a -> CD (S n) a

pairTy : Nat -> Type -> Type
pairTy Z a = a
pairTy (S n) a = let b = pairTy n a in (b, b)

fromPair : (n : Nat) -> pairTy n a -> CD n a
fromPair Z x = CDBase x
fromPair (S m) (x, y) = CDProd (fromPair m x) $ fromPair m y

toPair : CD n a -> pairTy n a
toPair (CDBase x) = x
toPair (CDProd x v) = (toPair x, toPair v)

first : CD n a -> a
first (CDBase x) = x
first (CDProd x v) = first x

fromBase : Num a => (n : Nat) -> a -> CD n a
fromBase Z x = CDBase x
fromBase (S m) x = CDProd (fromBase m x) $ fromBase m 0

multSclr : Num a => CD n a -> a -> CD n a
multSclr (CDBase x) y = CDBase $ x * y
multSclr (CDProd x v) y = CDProd (multSclr x y) $ multSclr v y

divSclr : Fractional a => CD n a -> a -> CD n a
divSclr (CDBase x) y = CDBase $ x / y
divSclr (CDProd x v) y = CDProd (divSclr x y) $ divSclr v y

plusCD : Num a => CD n a -> CD n a -> CD n a
plusCD (CDBase x) (CDBase y) = CDBase $ x + y
plusCD (CDProd x v) (CDProd y w) = CDProd (plusCD x y) $ plusCD v w

negCD : Neg a => CD n a -> CD n a
negCD (CDBase x) = CDBase $ negate x
negCD (CDProd x v) = CDProd (negCD x) $ negCD v

minusCD : Neg a => CD n a -> CD n a -> CD n a
minusCD (CDBase x) (CDBase y) = CDBase $ x - y
minusCD (CDProd x v) (CDProd y w) = CDProd (minusCD x y) $ minusCD v w

conjCD : Neg a => CD n a -> CD n a
conjCD (CDBase x) = CDBase x
conjCD (CDProd x v) = CDProd (conjCD x) $ negCD v

multCD : Neg a => CD n a -> CD n a -> CD n a
multCD (CDBase x) (CDBase y) = CDBase $ x * y
multCD (CDProd x v) (CDProd y w) = CDProd (minusCD (multCD x y) (multCD (conjCD w) v)) $ plusCD (multCD w x) $ multCD v $ conjCD y

absSqrCD : Neg a => CD n a -> CD n a
absSqrCD x = multCD x $ conjCD x

sqrLnCD : Neg a => CD n a -> a
sqrLnCD = first . absSqrCD

recipCD : Neg a => Fractional a => CD n a -> CD n a
recipCD x = conjCD $ divSclr x $ sqrLnCD x

divCD : Neg a => Fractional a => CD n a -> CD n a -> CD n a
divCD x y = multCD x $ recipCD y

absCD : CD n Double -> Double
absCD x = sqrt $ sqrLnCD x

showComps : Show a => CD n a -> String
showComps (CDBase x) = show x
showComps (CDProd x v) = showComps x ++ ", " ++ showComps v

Eq a => Eq (CD n a) where
    (CDBase x) == (CDBase y) = x == y
    (CDProd x v) == (CDProd y w) = x == y && v == w

Show a => Show (CD n a) where
    show x = "(" ++ showComps x ++ ")"

Neg a => Num (CD n a) where
    (+) = plusCD
    (*) = multCD
    fromInteger m {n} = fromBase n $ fromInteger m

Neg a => Neg (CD n a) where
    negate = negCD
    (-) = minusCD

(Neg a, Fractional a) => Fractional (CD n a) where
    (/) = divCD
    recip = recipCD

Abs (CD n Double) where
    abs {n} = fromBase n . absCD


   NB. utilities
   ip=:   +/ .*             NB. inner product
   T=. (_1^#:0 10 9 12)*0 7 16 23 A.=i.4
   toQ=:  4&{."1 :[:        NB. real scalars -> quaternion

   NB. task
   norm=: %:@[email protected]        NB. | y
   neg=:  -&toQ             NB. - y  and  x - y
   conj=: 1 _1 _1 _1 * toQ  NB. + y
   add=:  +&toQ             NB. x + y
   mul=:  (ip T ip ])&toQ   NB. x * y


import math

// a function to check if three numbers are a valid triple
def is_triple(a, b, c)
    if not (a < b) and (b < c)
        return false
    end

    return (a^2 + b^2) = c^2
end

// a function to check if the numbers are coprime
def is_coprime(a, b, c)
    global math
    return (math.gcd(a, b)=1) && (math.gcd(a, c)=1) && (math.gcd(b, c)=1)
end

// the maximum perimeter to check
perimeter  = 100
perimeter2 = int(perimeter / 2) - 1
perimeter3 = int(perimeter / 3) - 1

// loop though and look for pythagorean triples
ts = 0
ps = 0
for a in range(1, perimeter3)
    for b in range(a + 1, perimeter2)
        for c in range(b + 1, perimeter2)
            if (a + b + c) <= perimeter
                if is_triple(a,b,c)
                    ts += 1
                    print a + ", " + b + ", " + c
                    if is_coprime(a,b,c)
                        ps += 1
                        print " primitive"
                    end
                    println
                end
            end
        end
    end
end

print   "Up to a perimeter of " + perimeter + ", there are " + ts
println " triples, of which " + ps + " are primitive."


let isqrt n =
   let rec iter t =
      let d = n - t*t in
      if (0 <= d) && (d < t+t+1) (* t*t <= n < (t+1)*(t+1) *)
      then t else iter ((t+(n/t))/2)
   in iter 1

let rec gcd a b =
   let t = a mod b in
   if t = 0 then b else gcd b t

let coprime a b = gcd a b = 1

let num_to ms =
   let ctr = ref 0 in
   let prim_ctr = ref 0 in
   let max_m = isqrt (ms/2) in
   for m = 2 to max_m do
      for j = 0 to (m/2) - 1 do
         let n = m-(2*j+1) in
         if coprime m n then
            let s = 2*m*(m+n) in
            if s <= ms then
               (ctr := !ctr + (ms/s); incr prim_ctr)
      done
   done;
  (!ctr, !prim_ctr)

let show i =
  let s, p = num_to i in
  Printf.printf "For perimeters up to %d there are %d total and %d primitive\n%!" i s p;;

List.iter show [ 100; 1000; 10000; 100000; 1000000; 10000000; 100000000 ]


side = 1;       //side length of the square
depth = 8;      //final number of branch levels

//L-system definition:
//Alphabet: UTDB+-[]
    //U: go upwards             T: top of the square
    //D: go downwards           B: bottom of the square
    //[: start new branch       ]: end current branch
    //+: branch to the right    -: branch to the left
//Axiom:    UTDB
//Rule:     T -> [+UTD-UTD]

//L-system sentence generation
sentence = 'UTDB'
rule = '[+UTD-UTD]';
for i=1:depth
    sentence = strsubst(sentence,'T',rule);
end
sentence = strsplit(sentence)';

//Empty tree
tree_size = 1.0...
            + length(find(sentence == "U" | sentence == "T" |...
                          sentence == "D" | sentence == "B"))...
            + 2 * length(find(sentence == "]" | sentence == "-" |...
                              sentence == "+"));
tree=zeros(tree_size,1);

//Vectorial operation to calculate a new point in the tree
deff('z = new_point(origin,rho,theta)',...
     'z = origin + rho * exp(%i*theta)');

//Drawing the tree
curr_angle = %pi/2;
curr_pos = 1;
ratio = 1/sqrt(2);
for ind = 1:size(sentence,'c')
    charac = sentence(ind);

    select charac
    case 'U' then //Draw line upwards
        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
        curr_pos = curr_pos + 1;

    case 'T' then //Draw top of the square
        curr_angle = curr_angle - %pi/2;
        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
        curr_pos = curr_pos + 1;

    case 'D' then //Draw line downwards
        curr_angle = curr_angle - %pi/2;
        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
        curr_pos = curr_pos + 1;

    case 'B' then //Draw the bottom
        curr_angle = curr_angle - %pi/2;
        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
        curr_pos = curr_pos + 1;

    case '[' then //Start branch
        side = side * ratio;

    case '+' then //Start going to the left
        curr_angle = curr_angle - %pi/4;
//        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
//        tree(curr_pos+2) = new_point(tree(curr_pos+1),side,%pi+curr_angle);
//        curr_pos = curr_pos + 2;
        curr_angle = curr_angle + %pi/2;

    case '-' then //Start going to the left
//        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
//        tree(curr_pos+2) = new_point(tree(curr_pos+1),side,%pi+curr_angle);
//        curr_pos = curr_pos + 2;
        curr_angle = curr_angle + %pi/2;
    case ']' then
        side = side / ratio;
        curr_angle = curr_angle - %pi/4;
//        tree(curr_pos+1) = new_point(tree(curr_pos),side,curr_angle);
//        tree(curr_pos+2) = new_point(tree(curr_pos+1),side,%pi+curr_angle);
//        curr_pos = curr_pos + 2;
        curr_angle = curr_angle + %pi;

    else
        error('L-system sentence error');
    end
end

scf(); clf();
xname('Pythagoras tree: '+string(depth)+' levels')
plot2d(real(tree),imag(tree),14);
set(gca(),'isoview','on');
set(gca(),'axes_visible',['off','off','off']);


require('Imager')

func tree(img, x1, y1, x2, y2, depth) {

    depth <= 0 && return()

    var dx = (x2 - x1)
    var dy = (y1 - y2)

    var x3 = (x2 - dy)
    var y3 = (y2 - dx)
    var x4 = (x1 - dy)
    var y4 = (y1 - dx)
    var x5 = (x4 + 0.5*(dx - dy))
    var y5 = (y4 - 0.5*(dx + dy))

    # square
    img.polygon(
        points => [
            [x1, y1],
            [x2, y2],
            [x3, y3],
            [x4, y4],
        ],
        color => [0, 255/depth, 0],
    )

    # triangle
    img.polygon(
        points => [
            [x3, y3],
            [x4, y4],
            [x5, y5],
        ],
        color => [0, 255/depth, 0],
    )

    tree(img, x4, y4, x5, y5, depth - 1)
    tree(img, x5, y5, x3, y3, depth - 1)
}

var (width=1920, height=1080)
var img = %O<Imager>.new(xsize => width, ysize => height)
img.box(filled => 1, color => 'white')
tree(img, width/2.3, height, width/1.8, height, 10)
img.write(file => 'pythagoras_tree.png')


public class Quaternion {
    private final 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 Quaternion(double r) {
        this(r, 0.0, 0.0, 0.0);
    }

    public double norm() {
        return Math.sqrt(a * a + b * b + c * c + d * d);
    }

    public Quaternion negative() {
        return new Quaternion(-a, -b, -c, -d);
    }

    public Quaternion conjugate() {
        return new Quaternion(a, -b, -c, -d);
    }

    public Quaternion add(double r) {
        return new Quaternion(a + r, b, c, d);
    }
    public static Quaternion add(Quaternion q, double r) {
        return q.add(r);
    }
    public static Quaternion add(double r, Quaternion q) {
        return q.add(r);
    }
    public Quaternion add(Quaternion q) {
        return new Quaternion(a + q.a, b + q.b, c + q.c, d + q.d);
    }
    public static Quaternion add(Quaternion q1, Quaternion q2) {
        return q1.add(q2);
    }

    public Quaternion times(double r) {
        return new Quaternion(a * r, b * r, c * r, d * r);
    }
    public static Quaternion times(Quaternion q, double r) {
        return q.times(r);
    }
    public static Quaternion times(double r, Quaternion q) {
        return q.times(r);
    }
    public Quaternion times(Quaternion q) {
        return new Quaternion(
            a * q.a - b * q.b - c * q.c - d * q.d,
            a * q.b + b * q.a + c * q.d - d * q.c,
            a * q.c - b * q.d + c * q.a + d * q.b,
            a * q.d + b * q.c - c * q.b + d * q.a
        );
    }
    public static Quaternion times(Quaternion q1, Quaternion q2) {
        return q1.times(q2);
    }

    @Override
    public boolean equals(Object obj) {
        if (!(obj instanceof Quaternion)) return false;
        final Quaternion other = (Quaternion) obj;
        if (Double.doubleToLongBits(this.a) != Double.doubleToLongBits(other.a)) return false;
        if (Double.doubleToLongBits(this.b) != Double.doubleToLongBits(other.b)) return false;
        if (Double.doubleToLongBits(this.c) != Double.doubleToLongBits(other.c)) return false;
        if (Double.doubleToLongBits(this.d) != Double.doubleToLongBits(other.d)) return false;
        return true;
    }
    @Override
    public String toString() {
        return String.format("%.2f + %.2fi + %.2fj + %.2fk", a, b, c, d).replaceAll("\\+ -", "- ");
    }

    public String toQuadruple() {
        return String.format("(%.2f, %.2f, %.2f, %.2f)", a, b, c, d);
    }

    public static void main(String[] args) {
        Quaternion q = new Quaternion(1.0, 2.0, 3.0, 4.0);
        Quaternion q1 = new Quaternion(2.0, 3.0, 4.0, 5.0);
        Quaternion q2 = new Quaternion(3.0, 4.0, 5.0, 6.0);
        double r = 7.0;
        System.out.format("q       = %s%n", q);
        System.out.format("q1      = %s%n", q1);
        System.out.format("q2      = %s%n", q2);
        System.out.format("r       = %.2f%n%n", r);
        System.out.format("\u2016q\u2016     = %.2f%n", q.norm());
        System.out.format("-q      = %s%n", q.negative());
        System.out.format("q*      = %s%n", q.conjugate());
        System.out.format("q + r   = %s%n", q.add(r));
        System.out.format("q1 + q2 = %s%n", q1.add(q2));
        System.out.format("q \u00d7 r   = %s%n", q.times(r));
        Quaternion q1q2 = q1.times(q2);
        Quaternion q2q1 = q2.times(q1);
        System.out.format("q1 \u00d7 q2 = %s%n", q1q2);
        System.out.format("q2 \u00d7 q1 = %s%n", q2q1);
        System.out.format("q1 \u00d7 q2 %s q2 \u00d7 q1%n", (q1q2.equals(q2q1) ? "=" : "\u2260"));
    }
}


; triples generator based on Euclid's formula, creates lazy list
(define (euclid-formula max)
   (let loop ((a 3) (b 4) (c 5) (tail #null))
      (if (<= (+ a b c) max)
         (cons (tuple a b c) (lambda ()
            (let ((d (- b)) (z (- a)))
            (loop (+ a d d c c) (+ a a d c c) (+ a a d d c c c) (lambda ()
               (loop (+ a b b c c) (+ a a b c c) (+ a a b b c c c) (lambda ()
                  (loop (+ z b b c c) (+ z z b c c) (+ z z b b c c c) tail))))))))
         tail)))

; let's do calculations
(define (calculate max)
   (let loop ((p 0) (t 0) (ll (euclid-formula max)))
      (cond
         ((null? ll)
            (cons p t))
         ((function? ll)
            (loop p t (ll)))
         (else
            (let ((triple (car ll)))
               (loop (+ p 1) (+ t (div max (apply + triple)))
               (cdr ll)))))))

; print values for 10..100000
(for-each (lambda (max)
      (print max ": " (calculate max)))
   (map (lambda (n) (expt 10 n)) (iota 6 1)))


import "graphics" for Canvas, Color
import "dome" for Window
import "./polygon" for Polygon

var DepthLimit = 7
var Hue = 0.15

class PythagorasTree {
    construct new(width, height) {
        Window.title = "Pythagoras Tree"
        Window.resize(width, height)
        Canvas.resize(width, height)
    }

    init() {
        Canvas.cls(Color.white)
        drawTree(275, 500, 375, 500, 0)
    }

    drawTree(x1, y1, x2, y2, depth) {
        if (depth == DepthLimit) return
        var dx = x2 - x1
        var dy = y1 - y2

        var x3 = x2 - dy
        var y3 = y2 - dx
        var x4 = x1 - dy
        var y4 = y1 - dx
        var x5 = x4 + 0.5 * (dx - dy)
        var y5 = y4 - 0.5 * (dx + dy)

        // draw a square
        var col = Color.hsv((Hue + depth * 0.02) * 360, 1, 1)
        var square = Polygon.quick([[x1, y1], [x2, y2], [x3, y3], [x4, y4]])
        square.drawfill(col)
        square.draw(Color.lightgray)

        // draw a triangle
        col = Color.hsv((Hue + depth * 0.035) * 360, 1, 1)
        var triangle = Polygon.quick([[x3, y3], [x4, y4], [x5, y5]])
        triangle.drawfill(col)
        triangle.draw(Color.lightgray)

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

    update() {}

    draw(alpha) {}
}

var Game = PythagorasTree.new(640, 640)


var Quaternion = (function() {
    // The Q() function takes an array argument and changes it
    // prototype so that it becomes a Quaternion instance.  This is
    // scoped only for prototype member access.
    function Q(a) {
	a.__proto__ = proto;
	return a;
    }

    // Actual constructor.  This constructor converts its arguments to
    // an array, then that array to a Quaternion instance, then
    // returns that instance.  (using "new" with this constructor is
    // optional)
    function Quaternion() {
	return Q(Array.prototype.slice.call(arguments, 0, 4));
    }

    // Prototype for all Quaternions
    const proto = {
	// Inherits from a 4-element Array
	__proto__ : [0,0,0,0],

	// Properties -- In addition to Array[0..3] access, we
	// also define matching a, b, c, and d properties
	get a() this[0],
	get b() this[1],
	get c() this[2],
	get d() this[3],

	// Methods
	norm : function() Math.sqrt(this.map(function(x) x*x).reduce(function(x,y) x+y)),
	negate : function() Q(this.map(function(x) -x)),
	conjugate : function() Q([ this[0] ].concat(this.slice(1).map(function(x) -x))),
	add : function(x) {
	    if ("number" === typeof x) {
		return Q([ this[0] + x ].concat(this.slice(1)));
	    } else {
		return Q(this.map(function(v,i) v+x[i]));
	    }
	},
	mul : function(r) {
	    var q = this;
	    if ("number" === typeof r) {
		return Q(q.map(function(e) e*r));
	    } else {
		return Q([ q[0] * r[0] - q[1] * r[1] - q[2] * r[2] - q[3] * r[3],
			   q[0] * r[1] + q[1] * r[0] + q[2] * r[3] - q[3] * r[2],
			   q[0] * r[2] - q[1] * r[3] + q[2] * r[0] + q[3] * r[1],
			   q[0] * r[3] + q[1] * r[2] - q[2] * r[1] + q[3] * r[0] ]);
	    }
	},
	equals : function(q) this.every(function(v,i) v === q[i]),
	toString : function() (this[0] + " + " + this[1] + "i + "+this[2] + "j + " + this[3] + "k").replace(/\+ -/g, '- ')
    };

    Quaternion.prototype = proto;
    return Quaternion;
})();


do(lim)={
  my(prim,total,P);
  lim\=1;
  for(m=2,sqrtint(lim\2),
    forstep(n=1+m%2,min(sqrtint(lim-m^2),m-1),2,
      P=2*m*(m+n);
      if(gcd(m,n)==1 && P<=lim,
        prim++;
        total+=lim\P
      )
    )
  );
  [prim,total]
};
do(100)


Program PythagoreanTriples (output);

var
  total, prim, maxPeri: int64;

procedure newTri(s0, s1, s2: int64);
  var
    p: int64;
  begin
    p := s0 + s1 + s2;
    if p <= maxPeri then
    begin
      inc(prim);
      total := total + maxPeri div p;
      newTri( s0 + 2*(-s1+s2),  2*( s0+s2) - s1,  2*( s0-s1+s2) + s2);
      newTri( s0 + 2*( s1+s2),  2*( s0+s2) + s1,  2*( s0+s1+s2) + s2);
      newTri(-s0 + 2*( s1+s2),  2*(-s0+s2) + s1,  2*(-s0+s1+s2) + s2);
    end;
  end;

begin
  maxPeri := 100;
  while maxPeri <= 1e10 do
  begin
    prim := 0;
    total := 0;
    newTri(3, 4, 5);
    writeln('Up to ', maxPeri, ': ', total, ' triples, ', prim, ' primitives.');
    maxPeri := maxPeri * 10;
  end;
end.


Sub pythagoras_tree(x1, y1, x2, y2, depth)
    local dx, dy, x3, y3, x4, y4, x5, y5

    If depth > limit 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
    color 255 - depth * 20, 255, 0
    fill triangle x1, y1, x2, y2, x3, y3
    fill triangle x3, y3, x4, y4, x1, y1
    fill triangle x4, y4, x5, y5, x3, y3

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

End Sub

// ------=< MAIN >=------
w = 800 : h = int(w * 11 / 16)
w2 = int(w / 2) : diff = int(w / 12)
limit = 12

open window w, h
//backcolor 0, 0, 0
clear window

pythagoras_tree(w2 - diff, h -10 , w2 + diff , h -10 , 1)


fcn pythagorasTree{
   bitmap:=PPM(640,640,0xFF|FF|FF);  // White background

   fcn(bitmap, ax,ay, bx,by, depth=0){
      if(depth>10) return();
      dx,dy:=bx-ax, ay-by;
      x3,y3:=bx-dy, by-dx;
      x4,y4:=ax-dy, ay-dx;
      x5,y5:=x4 + (dx - dy)/2, y4 - (dx + dy)/2;
      bitmap.cross(x3,y3);bitmap.cross(x4,y4);bitmap.cross(x5,y5);
      bitmap.line(ax,ay, bx,by, 0); bitmap.line(bx,by, x3,y3, 0);
      bitmap.line(x3,y3, x4,y4, 0); bitmap.line(x4,y4, ax,ay, 0);

      self.fcn(bitmap,x4,y4, x5,y5, depth+1);
      self.fcn(bitmap,x5,y5, x3,y3, depth+1);
   }(bitmap,275,500, 375,500);

   bitmap.writeJPGFile("pythagorasTree.jpg",True);
}();


def Quaternion(q0;q1;q2;q3): { "q0": q0, "q1": q1, "q2": q2, "q3": q3, "type": "Quaternion" };

# promotion of a real number to a quaternion
def Quaternion(r): if (r|type) == "number" then Quaternion(r;0;0;0) else r end;

# thoroughly recursive pretty-print
def pp:

  def signage: if . >= 0 then "+ \(.)" else  "- \(-.)" end;

  if type == "object" then
     if .type == "Quaternion" then
       "\(.q0) \(.q1|signage)i \(.q2|signage)j \(.q3|signage)k"
     else with_entries( {key, "value" : (.value|pp)} )
     end
  elif type == "array" then map(pp)
  else .
  end ;

def real(z): Quaternion(z).q0;

# Note: imag(z) returns the "i" component only,
# reflecting the embedding of the complex numbers within the quaternions:
def imag(z): Quaternion(z).q1;

def conj(z): Quaternion(z) | Quaternion(.q0; -(.q1); -(.q2); -(.q3));

def abs2(z): Quaternion(z) | .q0 * .q0 + .q1*.q1 + .q2*.q2 + .q3*.q3;

def abs(z): abs2(z) | sqrt;

def negate(z): Quaternion(z) | Quaternion(-.q0; -.q1; -.q2; -.q3);

# z + w
def plus(z; w):
  def plusq(z;w): Quaternion(z.q0 + w.q0; z.q1 + w.q1;
                             z.q2 + w.q2; z.q3 + w.q3);
  plusq( Quaternion(z); Quaternion(w) );

# z - w
def minus(z; w):
  def minusq(z;w): Quaternion(z.q0 - w.q0; z.q1 - w.q1;
                              z.q2 - w.q2; z.q3 - w.q3);
  minusq( Quaternion(z); Quaternion(w) );

# *
def times(z; w):
  def timesq(z; w):
       Quaternion(z.q0*w.q0 - z.q1*w.q1 - z.q2*w.q2 - z.q3*w.q3;
                  z.q0*w.q1 + z.q1*w.q0 + z.q2*w.q3 - z.q3*w.q2;
                  z.q0*w.q2 - z.q1*w.q3 + z.q2*w.q0 + z.q3*w.q1;
                  z.q0*w.q3 + z.q1*w.q2 - z.q2*w.q1 + z.q3*w.q0);
  timesq( Quaternion(z); Quaternion(w) );

# (z/w)
def div(z; w):
  if (w|type) == "number" then Quaternion(z.q0/w; z.q1/w; z.q2/w; z.q3/w)
  else times(z; inv(w))
  end;

def inv(z): div(conj(z); abs2(z));

# Example usage and output:

def say(msg; e): "\(msg) => \(e|pp)";

def demo:
  say( "Quaternion(1;0;0;0)"; Quaternion(1;0;0;0)),
  (Quaternion (1; 2; 3; 4) as $q
  | Quaternion(2; 3; 4; 5) as $q1
  | Quaternion(3; 4; 5; 6) as $q2
  | 7 as $r
  | say( "abs($q)";        abs($q) ),   # norm
    say( "negate($q)";     negate($q) ),
    say( "conj($q)";       conj($q) ),
    "",
    say( "plus($r; $q)";   plus($r; $q)),
    say( "plus($q; $r)";   plus($q; $r)),
    "",
    say( "plus($q1; $q2 )"; plus($q1; $q2)),
    "",
    say( "times($r;$q)";    times($r;$q)),
    say( "times($q;$r)";    times($q;$r)),
    "",
    say( "times($q1;$q2)";  times($q1;$q2)),
    say( "times($q2; $q1)"; times($q2; $q1)),
    say( "times($q1; $q2) != times($q2; $q1)";
         times($q1; $q2) != times($q2; $q1) )
    ) ;

demo


import Base: convert, promote_rule, show, conj, abs, +, -, *

immutable Quaternion{T<:Real} <: Number
    q0::T
    q1::T
    q2::T
    q3::T
end

Quaternion(q0::Real,q1::Real,q2::Real,q3::Real) = Quaternion(promote(q0,q1,q2,q3)...)

convert{T}(::Type{Quaternion{T}}, x::Real) =
    Quaternion(convert(T,x), zero(T), zero(T), zero(T))
convert{T}(::Type{Quaternion{T}}, z::Complex) =
    Quaternion(convert(T,real(z)), convert(T,imag(z)), zero(T), zero(T))
convert{T}(::Type{Quaternion{T}}, z::Quaternion) =
    Quaternion(convert(T,z.q0), convert(T,z.q1), convert(T,z.q2), convert(T,z.q3))

promote_rule{T,S}(::Type{Complex{T}}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}
promote_rule{T<:Real,S}(::Type{T}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}
promote_rule{T,S}(::Type{Quaternion{T}}, ::Type{Quaternion{S}}) = Quaternion{promote_type(T,S)}

function show(io::IO, z::Quaternion)
    pm(x) = x <	0 ? " - $(-x)" : " + $x"
    print(io, z.q0, pm(z.q1), "i", pm(z.q2), "j", pm(z.q3), "k")
end

conj(z::Quaternion) = Quaternion(z.q0, -z.q1, -z.q2, -z.q3)
abs(z::Quaternion) = sqrt(z.q0*z.q0 + z.q1*z.q1 + z.q2*z.q2 + z.q3*z.q3)

(-)(z::Quaternion) = Quaternion(-z.q0, -z.q1, -z.q2, -z.q3)

(+)(z::Quaternion, w::Quaternion) = Quaternion(z.q0 + w.q0, z.q1 + w.q1,
                                               z.q2 + w.q2, z.q3 + w.q3)
(-)(z::Quaternion, w::Quaternion) = Quaternion(z.q0 - w.q0, z.q1 - w.q1,
                                               z.q2 - w.q2, z.q3 - w.q3)
(*)(z::Quaternion, w::Quaternion) = Quaternion(z.q0*w.q0 - z.q1*w.q1 - z.q2*w.q2 - z.q3*w.q3,
                                               z.q0*w.q1 + z.q1*w.q0 + z.q2*w.q3 - z.q3*w.q2,
                                               z.q0*w.q2 - z.q1*w.q3 + z.q2*w.q0 + z.q3*w.q1,
                                               z.q0*w.q3 + z.q1*w.q2 - z.q2*w.q1 + z.q3*w.q0)


sub gcd {
    my ($n, $m) = @_;
    while($n){
        my $t = $n;
        $n = $m % $n;
        $m = $t;
    }
    return $m;
}

sub tripel {
    my $pmax  = shift;
    my $prim  = 0;
    my $count = 0;
    my $nmax = sqrt($pmax)/2;
    for( my $n=1; $n<=$nmax; $n++ ) {
        for( my $m=$n+1; (my $p = 2*$m*($m+$n)) <= $pmax; $m+=2 ) {
            next unless 1==gcd($m,$n);
            $prim++;
            $count += int $pmax/$p;
        }
    }
    printf "Max. perimeter: %d, Total: %d, Primitive: %d\n", $pmax, $count, $prim;
}

tripel 10**$_ for 1..8;


with javascript_semantics
atom total, prim, maxPeri = 10

procedure tri(atom s0, s1, s2)
atom p = s0 + s1 + s2
    if p<=maxPeri then
        prim += 1
        total += floor(maxPeri/p)
        tri( s0+2*(-s1+s2), 2*( s0+s2)-s1, 2*( s0-s1+s2)+s2);
        tri( s0+2*( s1+s2), 2*( s0+s2)+s1, 2*( s0+s1+s2)+s2);
        tri(-s0+2*( s1+s2), 2*(-s0+s2)+s1, 2*(-s0+s1+s2)+s2);
    end if
end procedure

while maxPeri<=1e8 do
    prim := 0;
    total := 0;
    tri(3, 4, 5);
    printf(1,"Up to %d: %d triples, %d primitives.\n", {maxPeri,total,prim})
    maxPeri *= 10;
end while


// version 1.1.2

data class Quaternion(val a: Double, val b: Double, val c: Double, val d: Double) {
    operator fun plus(other: Quaternion): Quaternion {
        return Quaternion (this.a + other.a, this.b + other.b,
                           this.c + other.c, this.d + other.d)
    }

    operator fun plus(r: Double) = Quaternion(a + r, b, c, d)

    operator fun times(other: Quaternion): Quaternion {
        return Quaternion(
            this.a * other.a - this.b * other.b - this.c * other.c - this.d * other.d,
            this.a * other.b + this.b * other.a + this.c * other.d - this.d * other.c,
            this.a * other.c - this.b * other.d + this.c * other.a + this.d * other.b,
            this.a * other.d + this.b * other.c - this.c * other.b + this.d * other.a
        )
    }

    operator fun times(r: Double) = Quaternion(a * r, b * r, c * r, d * r)

    operator fun unaryMinus() =  Quaternion(-a, -b, -c, -d)

    fun conj() = Quaternion(a, -b, -c, -d)

    fun norm() = Math.sqrt(a * a + b * b + c * c + d * d)

    override fun toString() = "($a, $b, $c, $d)"
}

// extension functions for Double type
operator fun Double.plus(q: Quaternion) = q + this
operator fun Double.times(q: Quaternion) = q * this

fun main(args: Array<String>) {
    val q  = Quaternion(1.0, 2.0, 3.0, 4.0)
    val q1 = Quaternion(2.0, 3.0, 4.0, 5.0)
    val q2 = Quaternion(3.0, 4.0, 5.0, 6.0)
    val r  = 7.0
    println("q  = $q")
    println("q1 = $q1")
    println("q2 = $q2")
    println("r  = $r\n")
    println("norm(q) = ${"%f".format(q.norm())}")
    println("-q      = ${-q}")
    println("conj(q) = ${q.conj()}\n")
    println("r  + q  = ${r + q}")
    println("q  + r  = ${q + r}")
    println("q1 + q2 = ${q1 + q2}\n")
    println("r  * q  = ${r * q}")
    println("q  * r  = ${q * r}")
    val q3 = q1 * q2
    val q4 = q2 * q1
    println("q1 * q2 = $q3")
    println("q2 * q1 = $q4\n")
    println("q1 * q2 != q2 * q1 = ${q3 != q4}")
}


<?php

function gcd($a, $b)
{
    if ($a == 0)
       return $b;
    if ($b == 0)
       return $a;
    if($a == $b)
        return $a;
    if($a > $b)
        return gcd($a-$b, $b);
    return gcd($a, $b-$a);
}

$pytha = 0;
$prim = 0;
$max_p = 100;

for ($a = 1; $a <= $max_p / 3; $a++) {
    $aa = $a**2;
    for ($b = $a + 1; $b < $max_p/2; $b++) {
        $bb = $b**2;
        for ($c = $b + 1; $c < $max_p/2; $c++) {
            $cc = $c**2;
            if ($aa + $bb < $cc) break;
            if ($a + $b + $c > $max_p) break;

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

echo 'Up to ' . $max_p . ', there are ' . $pytha . ' triples, of which ' . $prim . ' are primitive.';


 q$ = q$( 1 , 2 , 3 , 4 )
q1$ = q$( 2 , 3 , 4 , 5 )
q2$ = q$( 3 , 4 , 5 , 6 )

real = 7

print "q = "  ;  q$
print "q1 = " ; q1$
print "q2 = " ; q2$

print "real = " ; real

print "length /norm q  = " ; length( q$ )               '   =norm                        norm of q
print "negative (-q1)  = " ; negative$( q1$ )           '   =negative                    negated q1
print "conjugate q     = " ; conjugate$( q$ )           '   conjugate                    conjugate q
print "real + q        = " ; add1$( q$ , real )         '   real +quaternion             real +q
print "q + q2          = " ; add2$( q$ , q2$ )          '   sum two quaternions          q +q2
print "real * q        = " ; multiply1$( q$ , real )    '   real *quaternion             real *q
print "q1 * q2         = " ; multiply2$( q1$ , q2$ )    '   product of two quaternions   q1 & q2
print "q2 * q1         = " ; multiply2$( q2$ , q1$ )    '   show q1 *q2 <> q2 *q1

end

function q$( r , i , j , k )
  q$ = str$( r); " "; str$( i); " "; str$( j); " "; str$( k)
end function

function length( q$ )
  r = val( word$( q$ , 1 ) )
  i = val( word$( q$ , 2 ) )
  j = val( word$( q$ , 3 ) )
  k = val( word$( q$ , 4 ) )
  length =sqr( r^2 +i^2 +j^2 +k^2)
end function

function multiply1$( q$ , d )
  r = val( word$( q$ , 1 ) )
  i = val( word$( q$ , 2 ) )
  j = val( word$( q$ , 3 ) )
  k = val( word$( q$ , 4 ) )
  multiply1$ =q$( r*d, i*d, j*d, k*d)
end function

function multiply2$( q$ , b$ )
  ar = val( word$( q$ , 1 ) )   'a1
  ai = val( word$( q$ , 2 ) )   'b1
  aj = val( word$( q$ , 3 ) )   'c1
  ak = val( word$( q$ , 4 ) )   'd1

  br = val( word$( b$ , 1 ) )   'a2
  bi = val( word$( b$ , 2 ) )   'b2
  bj = val( word$( b$ , 3 ) )   'c2
  bk = val( word$( b$ , 4 ) )   'd2

  multiply2$ =q$( _
  ar *br_
  +( 0 -ai) *bi_
  +( 0 -aj) *bj_
  +( 0 -ak) *bk _
  ,_
  ar *bi_
  +ai *br_
  +aj *bk_
  +( 0 -ak) *bj_
  ,_
  ar *bj_
  +( 0 -ai) *bk_
  +aj *br_
  +ak *bi_
  ,_
  ar *bk_
  +ai *bj_
  +( 0 -aj) *bi_
  +ak *br )
end function

function negative$( q$ )
  r = val( word$( q$ , 1 ) )
  i = val( word$( q$ , 2 ) )
  j = val( word$( q$ , 3 ) )
  k = val( word$( q$ , 4 ) )
  negative$ =q$( 0-r, 0-i, 0-j, 0-k)
end function

function conjugate$( q$ )
  r = val( word$( q$ , 1 ) )
  i = val( word$( q$ , 2 ) )
  j = val( word$( q$ , 3 ) )
  k = val( word$( q$ , 4 ) )
  conjugate$ =q$( r, 0-i, 0-j, 0-k)
end function

function add1$( q$ , real )
  r = val( word$( q$ , 1 ) )
  i = val( word$( q$ , 2 ) )
  j = val( word$( q$ , 3 ) )
  k = val( word$( q$ , 4 ) )
  add1$ =q$( r +real, i, j, k)
end function

function add2$( q$ , b$ )
  ar = val( word$( q$ , 1 ) )
  ai = val( word$( q$ , 2 ) )
  aj = val( word$( q$ , 3 ) )
  ak = val( word$( q$ , 4 ) )
  br = val( word$( b$ , 1 ) )
  bi = val( word$( b$ , 2 ) )
  bj = val( word$( b$ , 3 ) )
  bk = val( word$( b$ , 4 ) )
  add2$ =q$( ar +br, ai +bi, aj +bj, ak +bk)
end function


main :-
  garbage_collect(300_000_000),
  Data = [100, 1_000, 10_000, 100_000, 1_000_000, 10_000_000, 100_000_000],
  member(Max, Data),
  count_triples(Max, Total, Prim),
  printf("upto %d, there are %d Pythagorean triples (%d primitive.)%n", Max, Total, Prim),
  fail,
  nl.

count_triples(Max, Total, Prims) :-
  Ps = findall(S, (triple(Max, A, B, C), S is A + B + C)),
  Prims = Ps.len,
  Total = sum([Max div P : P in Ps]).

% - between_by/4
between_by(A, B, N, K) :-
  C = (B - A) div N,
  between(0, C, J),
  K = N*J + A.

% - Pythagorean triple generator
triple(P, A, B, C) :-
  Max = floor(sqrt(P/2)) - 1,
  between(0, Max, M),
  Start = (M /\ 1) + 1,
  Pm = M - 1,
  between_by(Start, Pm, 2, N),
  gcd(M, N) == 1,
  X = M*M - N*N,
  Y = 2*M*N,
  C = M*M + N*N,
  order2(X, Y, A, B),
  (A + B + C) =< P.

order2(A, B, A, B) :- A < B, !.
order2(A, B, B, A).


*process source attributes xref or(!);
 /*********************************************************************
 * REXX pgm counts number of  Pythagorean triples
 * that exist given a max perimeter of  N,
 * and also counts how many of them are primatives.
 * 05.05.2013 Walter Pachl  translated from REXX version 2
 *********************************************************************/
 pyt: Proc Options(main);
 Dcl sysprint Print;
 Dcl (addr,mod,right) Builtin;
 Dcl memn Bin Fixed(31) Init(0);
 Dcl mabca(300) Char(12);
 Dcl 1 mabc,
      2 ma Dec fixed(7),
      2 mb Dec fixed(7),
      2 mc Dec fixed(7);
 Dcl mabce Char(12) Based(addr(mabc));
 Dcl 1 abc,
      2 a Dec fixed(7),
      2 b Dec fixed(7),
      2 c Dec fixed(7);
 Dcl abce Char(12) Based(addr(abc));
 Dcl (prims,trips,m,n,aa,aabb,cc,aeven,ab) Dec Fixed(7);
 mabca='';
 trips=0;
 prims=0;
 n=100;
 la:
 Do a=3 To n/3;
    aa=a*a;                       /* limit side to 1/3 of perimeter.*/
    aeven=mod(a,2)=0;
 lb:Do b=a+1 By 1+aeven;          /* triangle can't be isosceles.   */
      ab=a+b;                     /* compute partial perimeter.     */
      If ab>=n Then
        Iterate la;               /* a+b>perimeter?  Try different A*/
      aabb=aa+b*b;                /* compute sum of  a² + b² (cheat)*/
      Do c=b+1 By 1;
        cc=c*c;                   /* 3rd side:   also compute  c²   */
        If aeven Then
          If mod(c,2)=0 Then
            Iterate;
        If ab+c>n Then
          Iterate la;              /* a+b+c > perimeter?  Try diff A.*/
        If cc>aabb Then
          Iterate lb;              /* c² >  a²+b² ?  Try different B.*/
        If cc^=aabb Then
          Iterate;                 /* c² ¬= a²+b² ?  Try different C.*/
        If mema(abce) Then
          Iterate;
        trips=trips+1;             /* eureka.                        */
        prims=prims+1;             /* count this primitive triple.   */
        Put Edit(a,b,c,'   ',right(a**2+b**2,5),right(c**2,5),a+b+c)
                (Skip,f(4),2(f(5)),a,2(f(6)),f(9));
        Do m=2 By 1;
          ma=a*m;
          mb=b*m;
          mc=c*m;                  /* gen non-primitives.            */
          If ma+mb+mc>n Then
            Leave;
                                   /* is this multiple a triple ?    */
          trips=trips+1;           /* yuppers, then we found another.*/
          If mod(m,2)=1 Then       /* store as even multiple.        */
            call mems(mabce);
          Put Edit(ma,mb,mc,' * ',
                          right(ma**2+mb**2,5),right(mc**2,5),ma+mb+mc)
                (Skip,f(4),2(f(5)),a,2(f(6)),f(9));
          End;                     /* m                              */
        End;                       /* c                              */
      End;                         /* b                              */
    End;                           /* a                              */
  Put Edit('max perimeter = ',n,   /* show a single line of output.  */
           'Pythagorean triples =',trips,
           'primitives =',prims)
          (Skip,a,f(5),2(x(9),a,f(4)));

 mems: Proc(e);
 Dcl e Char(12);
 memn+=1;
 mabca(memn)=e;
 End;

 mema: Proc(e) Returns(bit(1));
 Dcl e Char(12);
 Do memi=1 To memn;
   If mabca(memi)=e Then Return('1'b);
   End;
 Return('0'b);
 End;

 End;


Quaternion = {}

function Quaternion.new( a, b, c, d )
    local q = { a = a or 1, b = b or 0, c = c or 0, d = d or 0 }

    local metatab = {}
    setmetatable( q, metatab )
    metatab.__add = Quaternion.add
    metatab.__sub = Quaternion.sub
    metatab.__unm = Quaternion.unm
    metatab.__mul = Quaternion.mul

    return q
end

function Quaternion.add( p, q )
    if type( p ) == "number" then
	return Quaternion.new( p+q.a, q.b, q.c, q.d )
    elseif type( q ) == "number" then
	return Quaternion.new( p.a+q, p.b, p.c, p.d )
    else
	return Quaternion.new( p.a+q.a, p.b+q.b, p.c+q.c, p.d+q.d )
    end
end

function Quaternion.sub( p, q )
    if type( p ) == "number" then
	return Quaternion.new( p-q.a, q.b, q.c, q.d )
    elseif type( q ) == "number" then
	return Quaternion.new( p.a-q, p.b, p.c, p.d )
    else
	return Quaternion.new( p.a-q.a, p.b-q.b, p.c-q.c, p.d-q.d )
    end
end

function Quaternion.unm( p )
    return Quaternion.new( -p.a, -p.b, -p.c, -p.d )
end

function Quaternion.mul( p, q )
    if type( p ) == "number" then
	return Quaternion.new( p*q.a, p*q.b, p*q.c, p*q.d )
    elseif type( q ) == "number" then
	return Quaternion.new( p.a*q, p.b*q, p.c*q, p.d*q )
    else
	return Quaternion.new( p.a*q.a - p.b*q.b - p.c*q.c - p.d*q.d,
                               p.a*q.b + p.b*q.a + p.c*q.d - p.d*q.c,
 			       p.a*q.c - p.b*q.d + p.c*q.a + p.d*q.b,
			       p.a*q.d + p.b*q.c - p.c*q.b + p.d*q.a )
    end
end

function Quaternion.conj( p )
    return Quaternion.new( p.a, -p.b, -p.c, -p.d )
end

function Quaternion.norm( p )
    return math.sqrt( p.a^2 + p.b^2 + p.c^2 + p.d^2 )
end

function Quaternion.print( p )
    print( string.format( "%f + %fi + %fj + %fk\n", p.a, p.b, p.c, p.d ) )
end


function triples($p) {
    if($p -gt 4) {
        # ai + bi + ci = pi <= p
        # ai < bi < ci --> 3ai < pi <= p and ai + 2bi < pi <= p
        $pa = [Math]::Floor($p/3)
        1..$pa | foreach {
            $ai = $_
            $pb = [Math]::Floor(($p-$ai)/2)
            ($ai+1)..$pb | foreach {
                $bi = $_
                $pc = $p-$ai-$bi
                ($bi+1)..$pc | where {
                    $ci = $_
                    $pi = $ai + $bi + $ci
                    $ci*$ci -eq $ai*$ai + $bi*$bi
                 } |
                foreach {
                    [pscustomobject]@{
                        a = "$ai"
                        b = "$bi"
                        c = "$ci"
                        p = "$pi"
                    }
                }
            }
        }
    }
    else {
        Write-Error "$p is not greater than 4"
    }
}
function gcd ($a, $b)  {
    function pgcd ($n, $m)  {
        if($n -le $m) {
            if($n -eq 0) {$m}
            else{pgcd $n ($m%$n)}
        }
        else {pgcd $m $n}
    }
    $n = [Math]::Abs($a)
    $m = [Math]::Abs($b)
    (pgcd $n $m)
}
$triples = (triples 100)

$coprime = $triples |
where {((gcd $_.a $_.b) -eq 1) -and ((gcd $_.a $_.c) -eq 1) -and  ((gcd $_.b $_.c) -eq 1)}

"There are $(($triples).Count) Pythagorean triples with perimeter no larger than 100
 and $(($coprime).Count) of them are coprime."


Module CheckIt {
      class Quaternion {
            \\ by default are double
            a,b,c,d
            Property ToString$ {
                  Value {
                      link parent a,b,c, d to a,b,c,d
                       value$=format$("{0} + {1}i + {2}j + {3}k",a,b,c,d)
                  }
            }
            Property Norm { Value}
            Operator "==" {
                  read n
                  push .a==n.a and .b==n.b and .c==n.c and .d==n.d
            }
            Module CalcNorm {
                  .[Norm]<=sqrt(.a**2+.b**2+.c**2+.d**2)
             }
            Operator Unary {
                  .a-! : .b-! : .c-! :.d-!
            }
            Function Conj {
                  q=this
                  for q {
                         .b-! : .c-! :.d-!
                  }
                  =q
            }
            Function Add {
                  q=this
                  for q {
                         .a+=Number : .CalcNorm
                  }
                  =q
            }
            Operator "+"  {
                  Read q2
                  For this, q2 {
                        .a+=..a :.b+=..b:.c+=..c:.d+=..d
                        .CalcNorm
                  }
            }
            Function Mul(r)  {
                  q=this
                  for q {
                        .a*=r:.b*=r:.c*=r:.d*=r:.CalcNorm
                  }
                  =q
            }
            Operator "*" {
                  Read q2
                  For This, q2 {
                        Push .a*..a-.b*..b-.c*..c-.d*..d
                        Push .a*..b+.b*..a+.c*..d-.d*..c
                        Push .a*..c-.b*..d+.c*..a+.d*..b
                        .d<=.a*..d+.b*..c-.c*..b+.d*..a
                        Read .c, .b, .a
                        .CalcNorm
                  }
            }
            class:
            module Quaternion {
                  if match("NNNN") then {
                        Read .a,.b,.c,.d
                       .CalcNorm
                  }
            }
      }
      \\ variables
      r=7
      q=Quaternion(1,2,3,4)
      q1=Quaternion(2,3,4,5)
      q2=Quaternion(3,4,5,6)

      \\ perform negate, conjugate, multiply by real, add a real, multiply quanterions, multiply in reverse order
      qneg=-q
      qconj=q.conj()
      qmul=q.Mul(r)
      qadd=q.Add(r)
      q1q2=q1*q2
      q2q1=q2*q1

      Print "q = ";q.ToString$
      Print "Normal q = ";q.Norm
      Print "Neg q = ";qneg.ToString$
      Print "Conj q = ";qconj.ToString$
      Print "Mul q 7 = ";qmul.ToString$
      Print "Add q 7 = ";qadd.ToString$
      Print "q1 = ";q1.ToString$
      Print "q2 = ";q2.ToString$
      Print "q1 * q2 = ";q1q2.ToString$
      Print "q2 * q1 = ";q2q1.ToString$
      Print q1==q1   ' true
      Print q1q2==q2q1 ' false
      \\ multiplication and equality in one expression
      Print (q1 * q2 == q2 * q1)=false
      Print (q1 * q2 == q1 * q2)=True
}
CheckIt


with(ArrayTools);

module Quaternion()
 option object;
 local real := 0;
 local i := 0;
 local j := 0;
 local k := 0;

 export getReal::static := proc(self::Quaternion, $)
  return self:-real;
 end proc;

 export getI::static := proc(self::Quaternion, $)
  return self:-i;
 end proc;

 export getJ::static := proc(self::Quaternion, $)
  return self:-j;
 end proc;

 export getK::static := proc(self::Quaternion, $)
  return self:-k;
 end proc;

 export Norm::static := proc(self::Quaternion, $)
  return sqrt(self:-real^2 + self:-i^2 + self:-j^2 + self:-k^2);
 end proc;

 # NegativeQuaternion returns the additive inverse of the quaternion
 export NegativeQuaternion::static := proc(self::Quaternion, $)
  return Quaternion(- self:-real, - self:-i, - self:-j, - self:-k);
 end proc;

 export Conjugate::static := proc(self::Quaternion, $)
  return Quaternion(self:-real, - self:-i, - self:-j, - self:-k);
 end proc;

 # quaternion addition
 export `+`::static := overload ([
  proc(self::Quaternion, x::Quaternion) option overload;
   return Quaternion(self:-real + getReal(x), self:-i + getI(x), self:-j + getJ(x), self:-k + getK(x));
  end proc,
  proc(self::Quaternion, x::algebraic) option overload;
   return Quaternion(self:-real + x, self:-i, self:-j, self:-k);
  end proc,
  proc(x::algebraic, self::Quaternion) option overload;
   return Quaternion(x + self:-real, self:-i, self:-j, self:-k);
  end
 ]);

 # convert quaternion to additive inverse
 export `-`::static := overload([
  proc(self::Quaternion) option overload;
   return Quaternion(-self:-real, -self:-i, -self:-j, -self:-k);
  end
 ]);

 # quaternion multiplication is non-abelian so the `.` operator needs to be used
 export `.`::static := overload([
  proc(self::Quaternion, x::Quaternion) option overload;
  return Quaternion(self:-real * getReal(x) - self:-i * getI(x) - self:-j * getJ(x) - self:-k * getK(x),
                    self:-real * getI(x) + self:-i * getReal(x) + self:-j * getK(x) - self:-k * getJ(x),
                    self:-real * getJ(x) + self:-j * getReal(x) - self:-i * getK(x) + self:-k * getI(x),
                    self:-real * getK(x) + self:-k * getReal(x) + self:-i * getJ(x) - self:-j * getI(x));
  end proc,
  proc(self::Quaternion, x::algebraic) option overload;
   return Quaternion(self:-real * x, self:-i * x, self:-j * x, self:-k * x);
  end proc,
  proc(x::algebraic, self::Quaternion) option overload;
   return Quaternion(self:-real * x, self:-i * x, self:-j * x, self:-k * x);
  end
 ]);

 # redirect division to `.` operator
 export `*`::static := overload([
  proc(self::Quaternion, x::Quaternion) option overload;
   use `*` = `.` in return self * x; end use
  end proc,
  proc(self::Quaternion, x::algebraic) option overload;
   use `*` = `.` in return x * self; end use
  end proc,
  proc(x::algebraic, self::Quaternion) option overload;
   use `*` = `.` in return x * self; end use
  end
 ]);

 # convert quaternion to multiplicative inverse
 export `/`::static := overload([
  proc(self::Quaternion) option overload;
   return Conjugate(self) . (1/(Norm(self)^2));
  end proc
 ]);

 # QuaternionCommutator computes the commutator of self and x
 export QuaternionCommutator::static := proc(x::Quaternion, y::Quaternion, $)
  return (x . y) - (y . x);
 end proc;

 # display quaternion
 export ModulePrint::static := proc(self::Quaternion, $);
  return cat(self:-real, " + ", self:-i, "i + ", self:-j, "j + ", self:-k, "k"):
 end proc;

 export ModuleApply::static := proc()
  Object(Quaternion, _passed);
 end proc;

 export ModuleCopy::static := proc(new::Quaternion, proto::Quaternion, R::algebraic, imag::algebraic, J::algebraic, K::algebraic, $)
  new:-real := R;
  new:-i := imag;
  new:-j := J;
  new:-k := K;
 end proc;
end module:

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

quats := Array([q, q1, q2]):
print("q, q1, q2"):
seq(quats[i], i = 1..3);
print("norms"):
seq(Norm(quats[i]), i = 1..3);
print("negative"):
seq(NegativeQuaternion(quats[i]), i = 1..3);
print("conjugate"):
seq(Conjugate(quats[i]), i = 1..3);
print("addition of real number 7"):
seq(quats[i] + r, i = 1..3);
print("multiplication by real number 7"):
seq(quats[i] . r, i = 1..3);
print("division by real number 7"):
seq(quats[i] / 7, i = 1..3);
print("add quaternions q1 and q2"):
q1 + q2;
print("multiply quaternions q1 and q2");
q1 . q2;
print("multiply quaternions q2 and q1"):
q2 . q1;
print("quaternion commutator of q1 and q2"):
QuaternionCommutator(q1,q2);
print("divide q1 by q2"):
q1 / q2;


show :-
    Data = [100, 1_000, 10_000, 100_000, 1_000_000, 10_000_000, 100_000_000],
    forall(
        member(Max, Data),
        (count_triples(Max, Total, Prim),
         format("upto ~D, there are ~D Pythagorean triples (~D primitive.)~n", [Max, Total, Prim]))).

div(A, B, C) :- C is A div B.

count_triples(Max, Total, Prims) :-
    findall(S, (triple(Max, A, B, C), S is A + B + C), Ps),
    length(Ps, Prims),
    maplist(div(Max), Ps, Counts), sumlist(Counts, Total).

% - between_by/4

between_by(A, B, N, K) :-
    C is (B - A) div N,
    between(0, C, J),
    K is N*J + A.

% - Pythagorean triple generator

triple(P, A, B, C) :-
    Max is floor(sqrt(P/2)) - 1,
    between(0, Max, M),
    Start is (M /\ 1) + 1, succ(Pm, M),
    between_by(Start, Pm, 2, N),
    gcd(M, N) =:= 1,
    X is M*M - N*N,
    Y is 2*M*N,
    C is M*M + N*N,
    order2(X, Y, A, B),
    (A + B + C) =< P.

order2(A, B, A, B) :- A < B, !.
order2(A, B, B, A).


:- module quaternion.

:- interface.

:- import_module float.

:- type quaternion
    --->    q(  w   :: float,
                i   :: float,
                j   :: float,
                k   :: float    ).

% conversion
:- func r(float) = quaternion is det.

% operations
:- func norm(quaternion) = float is det.
:- func -quaternion = quaternion is det.
:- func conjugate(quaternion) = quaternion is det.
:- func quaternion + quaternion = quaternion is det.
:- func quaternion * quaternion = quaternion is det.

:- implementation.

:- import_module math.

% conversion
r(W) = q(W, 0.0, 0.0, 0.0).

% operations
norm(q(W, I, J, K)) = math.sqrt(W*W + I*I + J*J + K*K).
-q(W, I, J, K) = q(-W, -I, -J, -K).
conjugate(q(W, I, J, K)) = q(W, -I, -J, -K).
q(W0, I0, J0, K0) + q(W1, I1, J1, K1) = q(W0+W1, I0+I1, J0+J1, K0+K1).
q(W0, I0, J0, K0) * q(W1, I1, J1, K1) = q(W0*W1 - I0*I1 - J0*J1 - K0*K1,
                                          W0*I1 + I0*W1 + J0*K1 - K0*J1,
                                          W0*J1 - I0*K1 + J0*W1 + K0*I1,
                                          W0*K1 + I0*J1 - J0*I1 + K0*W1 ).


Procedure.i ConsoleWrite(t.s)  ; compile using /CONSOLE option
        OpenConsole()
        PrintN (t.s)
        CloseConsole()
        ProcedureReturn 1
EndProcedure

Procedure.i StdOut(t.s)  ; compile using /CONSOLE option
        OpenConsole()
        Print(t.s)
        CloseConsole()
        ProcedureReturn 1
EndProcedure

Procedure.i gcDiv(n,m) ; greatest common divisor
if n=0:ProcedureReturn m:endif
while m <> 0
  if n > m
    n - m
  else
    m - n
  endif
wend
ProcedureReturn n
EndProcedure

st=ElapsedMilliseconds()

nmax      =10000
power     =8

dim primitiveA(power)
dim alltripleA(power)
dim pmaxA(power)

x=1
for i=1 to power
  x*10:pmaxA(i)=x/2
next

for n=1 to nmax
  for m=(n+1) to (nmax+1) step 2 ; assure m-n is odd
    d=gcDiv(n,m)
    p=m*m+m*n
    for i=1 to power
      if p<=pmaxA(i)
        if d =1
        primitiveA(i)+1        ; right here we have the primitive perimeter "seed" 'p'
        k=1:q=p*k              ; set k to one to include p : use q as the 'p*k'
          while q<=pmaxA(i)
          alltripleA(i)+1      ; accumulate multiples of this perimeter while q <= pmaxA(i)
          k+1:q=p*k
          wend
        endif
      endif
    next
  next
next

for i=1 to power
  t.s="Up to "+str(pmaxA(i)*2)+": "
  t.s+str(alltripleA(i))+" triples, "
  t.s+str(primitiveA(i))+" primitives."
  ConsoleWrite(t.s)
next
ConsoleWrite("")
et=ElapsedMilliseconds()-st:ConsoleWrite("Elapsed time = "+str(et)+" milliseconds")


import math, tables

type Quaternion* = object
  a, b, c, d: float

func initQuaternion*(a, b, c, d = 0.0): Quaternion =
  Quaternion(a: a, b: b, c: c, d: d)

func `-`*(q: Quaternion): Quaternion =
  initQuaternion(-q.a, -q.b, -q.c, -q.d)

func `+`*(q: Quaternion; r: float): Quaternion =
  initQuaternion(q.a + r, q.b, q.c, q.d)

func `+`*(r: float; q: Quaternion): Quaternion =
  initQuaternion(q.a + r, q.b, q.c, q.d)

func `+`*(q1, q2: Quaternion): Quaternion =
  initQuaternion(q1.a + q2.a, q1.b + q2.b, q1.c + q2.c, q1.d + q2.d)

func `*`*(q: Quaternion; r: float): Quaternion =
  initQuaternion(q.a * r, q.b * r, q.c * r, q.d * r)

func `*`*(r: float; q: Quaternion): Quaternion =
  initQuaternion(q.a * r, q.b * r, q.c * r, q.d * r)

func `*`*(q1, q2: Quaternion): Quaternion =
  initQuaternion(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)

func conjugate*(q: Quaternion): Quaternion =
  initQuaternion(q.a, -q.b, -q.c, -q.d)

func norm*(q: Quaternion): float =
  sqrt(q.a * q.a + q.b * q.b + q.c * q.c + q.d * q.d)

func `==`*(q: Quaternion; r: float): bool =
  if q.b != 0 or q.c != 0 or q.d != 0: false
  else: q.a == r

func `$`(q: Quaternion): string =
  ## Return the representation of a quaternion.
  const Letter = {"a": "", "b": "i", "c": "j", "d": "k"}.toTable
  if q == 0: return "0"
  for name, value in q.fieldPairs:
    if value != 0:
      var val = value
      if result.len != 0:
        result.add if value >= 0: '+' else: '-'
        val = abs(val)
      result.add $val & Letter[name]

when isMainModule:
  let
    q = initQuaternion(1, 2, 3, 4)
    q1 = initQuaternion(2, 3, 4, 5)
    q2 = initQuaternion(3, 4, 5, 6)
    r = 7.0

  echo "∥q∥ = ", norm(q)
  echo "-q = ", -q
  echo "q* = ", conjugate(q)
  echo "q + r = ", q + r
  echo "r + q = ", r + q
  echo "q1 + q2 = ", q1 + q2
  echo "qr = ", q * r
  echo "rq = ", r * q
  echo "q1 * q2 = ", q1 * q2
  echo "q2 * q1 = ", q2 * q1


type quaternion = {a: float; b: float; c: float; d: float}

let norm q = sqrt (q.a**2.0 +.
                   q.b**2.0 +.
                   q.c**2.0 +.
                   q.d**2.0 )

let floatneg r = ~-. r  (* readability *)

let negative q =
  {a = floatneg q.a;
   b = floatneg q.b;
   c = floatneg q.c;
   d = floatneg q.d }

let conjugate q =
  {a = q.a;
   b = floatneg q.b;
   c = floatneg q.c;
   d = floatneg q.d }

let addrq r q = {q with a = q.a +. r}

let addq q1 q2 =
  {a = q1.a +. q2.a;
   b = q1.b +. q2.b;
   c = q1.c +. q2.c;
   d = q1.d +. q2.d  }

let multrq r q =
  {a = q.a *. r;
   b = q.b *. r;
   c = q.c *. r;
   d = q.d *. r  }

let multq q1 q2 =
        {a = q1.a*.q2.a -. q1.b*.q2.b -. q1.c*.q2.c -. q1.d*.q2.d;
         b = q1.a*.q2.b +. q1.b*.q2.a +. q1.c*.q2.d -. q1.d*.q2.c;
         c = q1.a*.q2.c -. q1.b*.q2.d +. q1.c*.q2.a +. q1.d*.q2.b;
         d = q1.a*.q2.d +. q1.b*.q2.c -. q1.c*.q2.b +. q1.d*.q2.a  }

let qmake a b c d = {a;b;c;d} (* readability omitting a= b=... *)

let qstring q =
  Printf.sprintf "(%g, %g, %g, %g)" q.a q.b q.c q.d ;;

(* test data *)
let q  = qmake 1.0  2.0  3.0  4.0
let q1 = qmake 2.0  3.0  4.0  5.0
let q2 = qmake 3.0  4.0  5.0  6.0
let r  = 7.0

let () = (* written strictly to spec *)
  let pf = Printf.printf in
  pf "starting with data q=%s, q1=%s,  q2=%s, r=%g\n" (qstring q) (qstring q1) (qstring q2) r;
  pf "1. norm of      q     = %g \n" (norm q) ;
  pf "2. negative of  q     = %s \n" (qstring (negative q));
  pf "3. conjugate of q     = %s \n" (qstring (conjugate q));
  pf "4. adding r to q      = %s \n" (qstring (addrq r q));
  pf "5. adding q1 and q2   = %s \n" (qstring (addq q1 q2));
  pf "6. multiply r and q   = %s \n" (qstring (multrq r q));
  pf "7. multiply q1 and q2 = %s \n" (qstring (multq q1 q2));
  pf "8. instead q2 * q1    = %s \n" (qstring (multq q2 q1));
  pf "\n";


from fractions import gcd

def pt1(maxperimeter=100):
    '''
# Naive method
    '''
    trips = []
    for a in range(1, maxperimeter):
        aa = a*a
        for b in range(a, maxperimeter-a+1):
            bb = b*b
            for c in range(b, maxperimeter-b-a+1):
                cc = c*c
                if a+b+c > maxperimeter or cc > aa + bb: break
                if aa + bb == cc:
                    trips.append((a,b,c, gcd(a, b) == 1))
    return trips

def pytrip(trip=(3,4,5),perim=100, prim=1):
    a0, b0, c0 = a, b, c = sorted(trip)
    t, firstprim = set(), prim>0
    while a + b + c <= perim:
        t.add((a, b, c, firstprim>0))
        a, b, c, firstprim = a+a0, b+b0, c+c0, False
    #
    t2 = set()
    for a, b, c, firstprim in t:
        a2, a5, b2, b5, c2, c3, c7 = a*2, a*5, b*2, b*5, c*2, c*3, c*7
        if  a5 - b5 + c7 <= perim:
            t2 |= pytrip(( a - b2 + c2,  a2 - b + c2,  a2 - b2 + c3), perim, firstprim)
        if  a5 + b5 + c7 <= perim:
            t2 |= pytrip(( a + b2 + c2,  a2 + b + c2,  a2 + b2 + c3), perim, firstprim)
        if -a5 + b5 + c7 <= perim:
            t2 |= pytrip((-a + b2 + c2, -a2 + b + c2, -a2 + b2 + c3), perim, firstprim)
    return t | t2

def pt2(maxperimeter=100):
    '''
# Parent/child relationship method:
# http://en.wikipedia.org/wiki/Formulas_for_generating_Pythagorean_triples#XI.
    '''
    trips = pytrip((3,4,5), maxperimeter, 1)
    return trips

def printit(maxperimeter=100, pt=pt1):
    trips = pt(maxperimeter)
    print("  Up to a perimeter of %i there are %i triples, of which %i are primitive"
          % (maxperimeter,
             len(trips),
             len([prim for a,b,c,prim in trips if prim])))

for algo, mn, mx in ((pt1, 250, 2500), (pt2, 500, 20000)):
    print(algo.__doc__)
    for maxperimeter in range(mn, mx+1, mn):
        printit(maxperimeter, algo)


160 Number Class newPriority: Quaternion(a, b, c, d)

Quaternion method: _a  @a ;
Quaternion method: _b  @b ;
Quaternion method: _c  @c ;
Quaternion method: _d  @d ;

Quaternion method: initialize  := d := c := b := a ;
Quaternion method: <<  '(' <<c @a << ',' <<c @b << ',' <<c @c << ',' <<c @d << ')' <<c ;

Integer method: asQuaternion  self 0 0 0 Quaternion new ;
Float   method: asQuaternion  self 0 0 0 Quaternion new ;

Quaternion method: ==(q)  q _a @a == q _b @b == and q _c @c == and q _d @d == and ;
Quaternion method: norm   @a sq @b sq + @c sq + @d sq + sqrt ;
Quaternion method: conj   @a  @b neg  @c neg  @d neg Quaternion new ;
Quaternion method: +(q)   Quaternion new(q _a @a +, q _b @b +, q _c @c +, q _d @d +) ;
Quaternion method: -(q)   Quaternion new(q _a @a -, q _b @b -, q _c @c -, q _d @d -) ;

Quaternion method: *(q)
   Quaternion new(q _a @a * q _b @b * - q _c @c * - q _d @d * -,
                  q _a @b * q _b @a * + q _c @d * + q _d @c * -,
                  q _a @c * q _b @d * - q _c @a * + q _d @b * +,
                  q _a @d * q _b @c * + q _c @b * - q _d @a * + ) ;


#lang racket

#| Euclid's enumeration formula and counting is fast enough for extra credit.

 For maximum perimeter P₀, the primitive triples are enumerated by n,m with:

   1 ≤ n < m
   perimeter P(n, m) ≤ P₀ where P(n, m) = (m² - n²) + 2mn + (m² + n²) = 2m(m+n)
   m and n of different parity and coprime.

 Since n < m, a simple close non-tight bound on n is P(n, n) < P₀.
 For each of these the exact set of m's can be enumerated.

 Each primitive triple with perimeter p represents one triple for each kp ≤ P₀,
  of which there are floor(P₀/p) k's. |#

(define (P n m) (* 2 m (+ m n)))
(define (number-of-triples P₀)
  (for/fold ([primitive 0] [all 0])
    ([n (in-naturals 1)]
     #:break (>= (P n n) P₀))
    (for*/fold ([primitive′ primitive] [all′ all])
      ([m (in-naturals (+ n 1))]
       #:break (> (P n m) P₀)
       #:when (and (odd? (- m n)) (coprime? m n)))
      (values (+ primitive′ 1)
              (+ all′ (quotient P₀ (P n m)))))))

(define (print-results P₀)
  (define-values (primitive all) (number-of-triples P₀))
  (printf "~a ~a:\n  ~a, ~a.\n"
          "Number of Pythagorean triples and primitive triples with perimeter ≤"
          P₀
          all primitive))
(print-results 100)
(time (print-results (* 100 1000 1000)))

#|
   Number of Pythagorean triples and primitive triples with perimeter ≤ 100:
     17, 7.
   Number of Pythagorean triples and primitive triples with perimeter ≤ 100000000:
     113236940, 7023027.
   cpu time: 11976 real time: 12215 gc time: 2381
|#


constant limit = 100;

for [X] [^limit] xx 3 -> (\a, \b, \c) {
    say [a, b, c] if a < b < c and a**2 + b**2 == c**2
}


/*REXX program counts the number of  Pythagorean triples  that exist given a maximum    */
/*──────────────────── perimeter of  N, and also counts how many of them are primitives.*/
parse arg N .                                    /*obtain optional argument from the CL.*/
if N=='' | N==","  then N= 100                   /*Not specified?  Then use the default.*/
              do j=1  for N;   @.j= j*j;   end   /*pre-compute some squares.            */
N66= N * 2%3                                     /*calculate  2/3  of  N     (for a+b). */
T= 0;   P= 0                                     /*set the number of Triples, Primitives*/
              do a=3  to N%3                     /*limit  side  to 1/3 of the perimeter.*/
                 do b= a+1                       /*the triangle can't be  isosceles.    */
                 ab= a + b                       /*compute a partial perimeter (2 sides)*/
                 if ab>=N66       then iterate a /*is a+b≥66% perimeter? Try different A*/
                 aabb= @.a + @.b                 /*compute the sum of  a²+b²  (shortcut)*/
                    do c=b+1                     /*compute the value of the third side. */
                    if ab+c > N   then iterate a /*is a+b+c>perimeter ? Try different A.*/
                    if @.c >aabb  then iterate b /*is     c²  > a²+b² ? Try      "    B.*/
                    if @.c\==aabb then iterate   /*is     c² ¬= a²+b² ? Try      "    C.*/
                    T= T + 1                     /*eureka. We found a Pythagorean triple*/
                    P= P + (gcd(a, b)==1)        /*is this  triple  a primitive triple? */
                    end   /*c*/
                 end      /*b*/
              end         /*a*/
_= left('', 7)                                   /*for padding the output with 7 blanks.*/
say 'max perimeter ='    N   _    "Pythagorean triples ="    T    _    'primitives ='    P
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gcd: procedure; parse arg x,y;  do until y==0; parse value x//y y with y x; end;  return x


q = .quaternion~new(1, 2, 3, 4)
q1 = .quaternion~new(2, 3, 4, 5)
q2 = .quaternion~new(3, 4, 5, 6)
r = 7

say "q            =" q
say "q1           =" q1
say "q2           =" q2
say "r            =" r
say "norm(q)      =" q~norm
say "-q           =" (-q)
say "q*           =" q~conjugate
say "q + r        =" q + r
say "q1 + q2      =" q1 + q2
say "q * r        =" q * r
q1q2 = q1 * q2
q2q1 = q2 * q1
say "q1 * q2      =" q1q2
say "q2 * q1      =" q2q1
say "q1 == q1     =" (q1 == q1)
say "q1q2 == q2q1 =" (q1q2 == q2q1)

::class quaternion
::method init
  expose r i j k
  use strict arg r, i = 0, j = 0, k = 0

-- quaternion instances are immutable, so these are
-- read only attributes
::attribute r GET
::attribute i GET
::attribute j GET
::attribute k GET

::method norm
  expose r i j k
  return rxcalcsqrt(r * r + i * i + j * j + k * k)

::method invert
  expose r i j k
  norm = self~norm
  return self~class~new(r / norm, i / norm, j / norm, k / norm)

::method negative
  expose r i j k
  return self~class~new(-r, -i, -j, -k)

::method conjugate
  expose r i j k
  return self~class~new(r, -i, -j, -k)

::method add
  expose r i j k
  use strict arg other
  if other~isa(.quaternion) then
     return self~class~new(r + other~r, i + other~i, j + other~j, k + other~k)
  else return self~class~new(r + other, i, j, k)

::method subtract
  expose r i j k
  use strict arg other
  if other~isa(.quaternion) then
     return self~class~new(r - other~r, i - other~i, j - other~j, k - other~k)
  else return self~class~new(r - other, i, j, k)

::method times
  expose r i j k
  use strict arg other
  if other~isa(.quaternion) then
     return self~class~new(r * other~r - i * other~i - j * other~j - k * other~k, -
                           r * other~i + i * other~r + j * other~k - k * other~j, -
                           r * other~j - i * other~k + j * other~r + k * other~i, -
                           r * other~k + i * other~j - j * other~i + k * other~r)
  else return self~class~new(r * other, i * other, j * other, k * other)

::method divide
  use strict arg other
  -- this is easier if everything is a quaternion
  if \other~isA(.quaternion) then other = .quaternion~new(other)
  -- division is multiplication with the inversion
  return self * other~invert

::method "=="
  expose r i j k
  use strict arg other

  if \other~isa(.quaternion) then return .false
  -- Note:  these are numeric comparisons, so we're using the "="
  -- method so those are handled correctly
  return r = other~r & i = other~i & j = other~j & k = other~k

::method "\=="
  use strict arg other
  return \self~"\=="(other)

::method "="
  -- this is equivalent of "=="
  forward message("==")

::method "\="
  -- this is equivalent of "\=="
  forward message("\==")

::method "<>"
  -- this is equivalent of "\=="
  forward message("\==")

::method "><"
  -- this is equivalent of "\=="
  forward message("\==")

-- some operator overrides -- these only work if the left-hand-side of the
-- subexpression is a quaternion
::method "*"
  forward message("TIMES")

::method "/"
  forward message("DIVIDE")

::method "-"
  -- need to check if this is a prefix minus or a subtract
  if arg() == 0 then
      forward message("NEGATIVE")
  else
      forward message("SUBTRACT")

::method "+"
  -- need to check if this is a prefix plus or an addition
  if arg() == 0 then
      return self  -- we can return this copy since it is immutable
  else
      forward message("ADD")

::method string
  expose r i j k
  return r self~formatnumber(i)"i" self~formatnumber(j)"j" self~formatnumber(k)"k"

::method formatnumber private
  use arg value
  if value > 0 then return "+" value
  else return "-" value~abs

-- override hashcode for collection class hash uses
::method hashCode
  expose r i j k
  return r~hashcode~bitxor(i~hashcode)~bitxor(j~hashcode)~bitxor(k~hashcode)

::requires rxmath LIBRARY


size = 100
sum = 0
prime = 0
for i = 1 to size
   for j = i + 1 to size
       for k = 1 to size
           if pow(i,2) + pow(j,2) = pow(k,2) and (i+j+k) < 101
              if gcd(i,j) = 1 prime += 1 ok
              sum += 1
              see "" + i + " " + j + " " + k + nl ok
       next
   next
next
see "Total : " + sum + nl
see "Primitives : " + prime + nl

func gcd gcd, b
     while b
           c   = gcd
           gcd = b
           b   = c % b
     end
     return gcd


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

  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


use std::thread;

fn f1 (a : u64, b : u64, c : u64, d : u64) -> u64 {
    let mut primitive_count = 0;
    for triangle in [[a - 2*b + 2*c, 2*a - b + 2*c, 2*a - 2*b + 3*c],
                     [a + 2*b + 2*c, 2*a + b + 2*c, 2*a + 2*b + 3*c],
                     [2*b + 2*c - a, b + 2*c - 2*a, 2*b + 3*c - 2*a]] .iter() {
        let l  = triangle[0] + triangle[1] + triangle[2];
        if l > d { continue; }
        primitive_count +=  1 + f1(triangle[0], triangle[1], triangle[2], d);
    }
    primitive_count
}

fn f2 (a : u64, b : u64, c : u64, d : u64) -> u64 {
    let mut triplet_count = 0;
    for triangle in [[a - 2*b + 2*c, 2*a - b + 2*c, 2*a - 2*b + 3*c],
                     [a + 2*b + 2*c, 2*a + b + 2*c, 2*a + 2*b + 3*c],
                     [2*b + 2*c - a, b + 2*c - 2*a, 2*b + 3*c - 2*a]] .iter() {
        let l  = triangle[0] + triangle[1] + triangle[2];
        if l > d { continue; }
        triplet_count +=  (d/l) + f2(triangle[0], triangle[1], triangle[2], d);
    }
    triplet_count
}

fn main () {
    let new_th_1 = thread::Builder::new().stack_size(32 * 1024 * 1024).spawn (move || {
        let mut i = 100;
        while i <= 100_000_000_000 {
            println!(" Primitive triples below {} : {}", i, f1(3, 4, 5, i) + 1);
            i *= 10;
        }
    }).unwrap();

    let new_th_2 =thread::Builder::new().stack_size(32 * 1024 * 1024).spawn (move || {
        let mut i = 100;
        while i <= 100_000_000_000 {
            println!(" Triples below {} : {}", i, f2(3, 4, 5, i) + i/12);
            i *= 10;
        }
    }).unwrap();

    new_th_1.join().unwrap();
    new_th_2.join().unwrap();
}


object PythagoreanTriples extends App {

  println("               Limit Primatives          All")

  for {e <- 2 to 7
       limit = math.pow(10, e).longValue()
  } {
    var primCount, tripCount = 0

    def parChild(a: BigInt, b: BigInt, c: BigInt): Unit = {
      val perim = a + b + c
      val (a2, b2, c2, c3) = (2 * a, 2 * b, 2 * c, 3 * c)
      if (limit >= perim) {
        primCount += 1
        tripCount += (limit / perim).toInt
        parChild(a - b2 + c2, a2 - b + c2, a2 - b2 + c3)
        parChild(a + b2 + c2, a2 + b + c2, a2 + b2 + c3)
        parChild(-a + b2 + c2, -a2 + b + c2, -a2 + b2 + c3)
      }
    }

    parChild(BigInt(3), BigInt(4), BigInt(5))
    println(f"a + b + c <= ${limit.toFloat}%3.1e  $primCount%9d $tripCount%12d")
  }
}


package Quaternion;
use List::Util 'reduce';
use List::MoreUtils 'pairwise';

sub make {
        my $cls = shift;
        if (@_ == 1)    { return bless [ @_, 0, 0, 0 ] }
        elsif (@_ == 4) { return bless [ @_ ] }
        else            { die "Bad number of components: @_" }
}

sub _abs { sqrt reduce { $a + $b * $b } @{ +shift } }
sub _neg { bless [ map(-$_, @{+shift}) ] }
sub _str { "(@{+shift})" }

sub _add {
        my ($x, $y) = @_;
        $y = [ $y, 0, 0, 0 ] unless ref $y;
        bless [ pairwise { $a + $b } @$x, @$y ]
}

sub _sub {
        my ($x, $y, $swap) = @_;
        $y = [ $y, 0, 0, 0 ] unless ref $y;
        my @x = pairwise { $a - $b } @$x, @$y;
        if ($swap) { $_ = -$_ for @x }
        bless \@x;
}

sub _mul {
        my ($x, $y) = @_;
        if (!ref $y) { return bless [ map($_ * $y, @$x) ] }
        my ($a1, $b1, $c1, $d1) = @$x;
        my ($a2, $b2, $c2, $d2) = @$y;
        bless [ $a1 * $a2 - $b1 * $b2 - $c1 * $c2 - $d1 * $d2,
                $a1 * $b2 + $b1 * $a2 + $c1 * $d2 - $d1 * $c2,
                $a1 * $c2 - $b1 * $d2 + $c1 * $a2 + $d1 * $b2,
                $a1 * $d2 + $b1 * $c2 - $c1 * $b2 + $d1 * $a2]
}

sub conjugate {
        my @a = map { -$_ } @{$_[0]};
        $a[0] = $_[0][0];
        bless \@a
}

use overload (
        '""'    => \&_str,
        '+'     => \&_add,
        '-'     => \&_sub,
        '*'     => \&_mul,
        'neg'   => \&_neg,
        'abs'   => \&_abs,
);

package main;

my $a = Quaternion->make(1, 2, 3, 4);
my $b = Quaternion->make(1, 1, 1, 1);

print "a = $a\n";
print "b = $b\n";
print "|a| = ", abs($a), "\n";
print "-a = ", -$a, "\n";
print "a + 1 = ", $a + 1, "\n";
print "a + b = ", $a + $b, "\n";
print "a - b = ", $a - $b, "\n";
print "a conjugate is ", $a->conjugate, "\n";
print "a * b = ", $a * $b, "\n";
print "b * a = ", $b * $a, "\n";


(use srfi-42)

(define (py perim)
  (define prim 0)
  (values
    (sum-ec
      (: c perim) (: b c) (: a b)
      (if (and (<= (+ a b c) perim)
               (= (square c) (+ (square b) (square a)))))
      (begin (when (= 1 (gcd a b)) (inc! prim)))
      1)
    prim))


$ include "seed7_05.s7i";
  include "bigint.s7i";

var bigInteger: total is 0_;
var bigInteger: prim is 0_;
var bigInteger: max_peri is 10_;

const proc: new_tri (in bigInteger: a, in bigInteger: b, in bigInteger: c) is func
  local
    var bigInteger: p is 0_;
  begin
    p := a + b + c;
    if p <= max_peri then
      incr(prim);
      total +:= max_peri div p;
      new_tri( a - 2_*b + 2_*c,  2_*a - b + 2_*c,  2_*a - 2_*b + 3_*c);
      new_tri( a + 2_*b + 2_*c,  2_*a + b + 2_*c,  2_*a + 2_*b + 3_*c);
      new_tri(-a + 2_*b + 2_*c, -2_*a + b + 2_*c, -2_*a + 2_*b + 3_*c);
    end if;
  end func;

const proc: main is func
  begin
    while max_peri <= 100000000_ do
      total := 0_;
      prim := 0_;
      new_tri(3_, 4_, 5_);
      writeln("Up to " <& max_peri <& ": " <& total <& " triples, " <& prim <& " primitives.");
      max_peri *:= 10_;
    end while;
  end func;


func triples(limit) {
    var primitive = 0
    var civilized = 0

    func oyako(a, b, c) {
        (var perim = a+b+c) > limit || (
            primitive++
            civilized += int(limit / perim)
            oyako( a - 2*b + 2*c,  2*a - b + 2*c,  2*a - 2*b + 3*c)
            oyako( a + 2*b + 2*c,  2*a + b + 2*c,  2*a + 2*b + 3*c)
            oyako(-a + 2*b + 2*c, -2*a + b + 2*c, -2*a + 2*b + 3*c)
        )
    }

    oyako(3,4,5)
    "#{limit} => (#{primitive} #{civilized})"
}

for n (1..Inf) {
    say triples(10**n)
}


with javascript_semantics
function norm(sequence q)
    return sqrt(sum(sq_power(q,2)))
end function

function conjugate(sequence q)
    q = deep_copy(q)
    q[2..4] = sq_uminus(q[2..4])
    return q
end function

function negative(sequence q)
    return sq_uminus(q)
end function

function add(object q1, object q2)
    if atom(q1)!=atom(q2) then
        if atom(q1) then
            q1 = {q1,0,0,0}
        else
            q2 = {q2,0,0,0}
        end if
    end if
    return sq_add(q1,q2)
end function

function mul(object q1, object q2)
    if sequence(q1) and sequence(q2) then
        atom {r1,i1,j1,k1} = q1,
             {r2,i2,j2,k2} = q2
        return { r1*r2 - i1*i2 - j1*j2 - k1*k2,
                 r1*i2 + i1*r2 + j1*k2 - k1*j2,
                 r1*j2 - i1*k2 + j1*r2 + k1*i2,
                 r1*k2 + i1*j2 - j1*i2 + k1*r2 }
    else
        return sq_mul(q1,q2)
    end if
end function

function quats(sequence q)
    return sprintf("%g%+gi%+gj%+gk",q)
end function

constant
    q  = {1, 2, 3, 4},
    q1 = {2, 3, 4, 5},
    q2 = {3, 4, 5, 6}

printf(1, "  q = %s\n", {quats(q)})
printf(1, " q1 = %s\n", {quats(q1)})
printf(1, " q2 = %s\n", {quats(q2)})
printf(1, "\n")
printf(1, "1.  norm(q) = %g\n", norm(q))
printf(1, "2.  negative(q) = %s\n", {quats(negative(q))})
printf(1, "3.  conjugate(q) = %s\n", {quats(conjugate(q))})
printf(1, "\n")
printf(1, "4.a   q + 7  = %s\n", {quats(add(q,7))})
printf(1, " .b   7 + q  = %s\n", {quats(add(7,q))})
printf(1, "\n")
printf(1, "5.a  q1 + q2 = %s\n", {quats(add(q1,q2))})
printf(1, " .b  q2 + q1 = %s\n", {quats(add(q2,q1))})
printf(1, "\n")
printf(1, "6.a   q * 49 = %s\n", {quats(mul(q,49))})
printf(1, " .b  49 * q  = %s\n", {quats(mul(49,q))})
printf(1, "\n")
printf(1, "7.a  q1 * q2 = %s\n", {quats(mul(q1,q2))})
printf(1, " .b  q2 * q1 = %s\n", {quats(mul(q2,q1))})
printf(1, "\n")
printf(1, "8.a  4.a === 4.b: %t\n", {equal(add(q,7),add(7,q))})
printf(1, " .b  5.a === 5.b: %t\n", {equal(add(q1,q2),add(q2,q1))})
printf(1, " .c  6.a === 6.b: %t\n", {equal(mul(q,49),mul(49,q))})
printf(1, " .d  7.a === 7.b: %t\n", {equal(mul(q1,q2),mul(q2,q1))})


var total = 0
var prim = 0
var maxPeri = 100

func newTri(s0:Int, _ s1:Int, _ s2: Int) -> () {

    let p = s0 + s1 + s2
    if p <= maxPeri {
        prim += 1
        total += maxPeri / p
        newTri( s0 + 2*(-s1+s2), 2*( s0+s2) - s1, 2*( s0-s1+s2) + s2)
        newTri( s0 + 2*( s1+s2), 2*( s0+s2) + s1, 2*( s0+s1+s2) + s2)
        newTri(-s0 + 2*( s1+s2), 2*(-s0+s2) + s1, 2*(-s0+s1+s2) + s2)
    }
}

while maxPeri <= 100_000_000 {
    prim = 0
    total = 0
    newTri(3, 4, 5)
    print("Up to \(maxPeri) : \(total) triples \( prim) primitives.")
    maxPeri *= 10
}


proc countPythagoreanTriples {limit} {
    lappend q 3 4 5
    set idx [set count [set prim 0]]
    while {$idx < [llength $q]} {
    set a [lindex $q $idx]
    set b [lindex $q [incr idx]]
    set c [lindex $q [incr idx]]
    incr idx
    if {$a + $b + $c <= $limit} {
        incr prim
        for {set i 1} {$i*$a+$i*$b+$i*$c <= $limit} {incr i} {
        incr count
        }
        lappend q \
        [expr {$a + 2*($c-$b)}] [expr {2*($a+$c) - $b}] [expr {2*($a-$b) + 3*$c}] \
        [expr {$a + 2*($b+$c)}] [expr {2*($a+$c) + $b}] [expr {2*($a+$b) + 3*$c}] \
        [expr {2*($b+$c) - $a}] [expr {2*($c-$a) + $b}] [expr {2*($b-$a) + 3*$c}]
    }
    }
    return [list $count $prim]
}
for {set i 10} {$i <= 10000000} {set i [expr {$i*10}]} {
    lassign [countPythagoreanTriples $i] count primitive
    puts "perimeter limit $i => $count triples, $primitive primitive"
}


go =>
  test,
  nl.

add(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :-
	!, R is R0+R1, I is I0+I1, J is J0+J1, K is K0+K1.
add(qx(R0,I,J,K), F, qx(R,I,J,K)) :-
	number(F), !, R is R0 + F.
add(F, qx(R0,I,J,K), Qx) :-
	add($qx(R0,I,J,K), F, Qx).
mul(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :- !,
	R is R0*R1 - I0*I1 - J0*J1 - K0*K1,
	I is R0*I1 + I0*R1 + J0*K1 - K0*J1,
	J is R0*J1 - I0*K1 + J0*R1 + K0*I1,
	K is R0*K1 + I0*J1 - J0*I1 + K0*R1.
mul(qx(R0,I0,J0,K0), F, qx(R,I,J,K)) :-
	number(F), !, R is R0*F, I is I0*F, J is J0*F, K is K0*F.
mul(F, qx(R0,I0,J0,K0), Qx) :-
	mul($qx(R0,I0,J0,K0),F,Qx).
abs(qx(R,I,J,K), Norm) :-
	Norm is sqrt(R*R+I*I+J*J+K*K).
negate(qx(Ri,Ii,Ji,Ki),qx(R,I,J,K)) :-
	R is -Ri, I is -Ii, J is -Ji, K is -Ki.
conjugate(qx(R,Ii,Ji,Ki),qx(R,I,J,K)) :-
	I is -Ii, J is -Ji, K is -Ki.

data(q,  qx(1,2,3,4)).
data(q1, qx(2,3,4,5)).
data(q2, qx(3,4,5,6)).
data(r, 7).

test :-	data(Name, $qx(A,B,C,D)), abs($qx(A,B,C,D), Norm),
	printf("abs(%w) is %w\n", Name, Norm), fail.
test :- data(q, Qx), negate(Qx, Nqx),
	printf("negate(%w) is %w\n", q, Nqx), fail.
test :- data(q, Qx), conjugate(Qx, Nqx),
	printf("conjugate(%w) is %w\n", q, Nqx), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q1, Q2, Qx),
	printf("q1+q2 is %w\n", Qx), fail.
test :- data(q1, Q1), data(q2, Q2), add(Q2, Q1, Qx),
	printf("q2+q1 is %w\n", Qx), fail.
test :- data(q, Qx), data(r, R), mul(Qx, R, Nqx),
	printf("q*r is %w\n", Nqx), fail.
test :- data(q, Qx), data(r, R), mul(R, Qx, Nqx),
	printf("r*q is %w\n", Nqx), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q1, Q2, Qx),
	printf("q1*q2 is %w\n", Qx), fail.
test :- data(q1, Q1), data(q2, Q2), mul(Q2, Q1, Qx),
	printf("q2*q1 is %w\n", Qx), fail.
test.


(scl 6)

(def 'quatCopy copy)

(de quatNorm (Q)
   (sqrt (sum * Q Q)) )

(de quatNeg (Q)
   (mapcar - Q) )

(de quatConj (Q)
   (cons (car Q) (mapcar - (cdr Q))) )

(de quatAddR (Q R)
   (cons (+ R (car Q)) (cdr Q)) )

(de quatAdd (Q1 Q2)
   (mapcar + Q1 Q2) )

(de quatMulR (Q R)
   (mapcar */ (mapcar * Q (circ R)) (1.0 .)) )

(de quatMul (Q1 Q2)
   (mapcar
      '((Ops I)
         (sum '((Op R I) (Op (*/ R (get Q2 I) 1.0))) Ops Q1 I) )
      '((+ - - -) (+ + + -) (+ - + +) (+ + - +))
      '((1 2 3 4) (2 1 4 3) (3 4 1 2) (4 3 2 1)) ) )

(de quatFmt (Q)
   (mapcar '((R S) (pack (format R *Scl) S))
      Q
      '(" + " "i + " "j + " "k") ) )


Dim total As Variant, prim As Variant, maxPeri As Variant
Private Sub newTri(s0 As Variant, s1 As Variant, s2 As Variant)
    Dim p As Variant
    p = CDec(s0) + CDec(s1) + CDec(s2)
    If p <= maxPeri Then
        prim = prim + 1
        total = total + maxPeri \ p
        newTri s0 + 2 * (-s1 + s2), 2 * (s0 + s2) - s1, 2 * (s0 - s1 + s2) + s2
        newTri s0 + 2 * (s1 + s2), 2 * (s0 + s2) + s1, 2 * (s0 + s1 + s2) + s2
        newTri -s0 + 2 * (s1 + s2), 2 * (-s0 + s2) + s1, 2 * (-s0 + s1 + s2) + s2
      End If
End Sub
Public Sub Program_PythagoreanTriples()
    maxPeri = CDec(100)
    Do While maxPeri <= 10000000#
        prim = CDec(0)
        total = CDec(0)
        newTri 3, 4, 5
        Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
        maxPeri = maxPeri * 10
    Loop
End Sub


For i=1 To 8
	WScript.StdOut.WriteLine triples(10^i)
Next

Function triples(pmax)
	prim=0 : count=0 : nmax=Sqr(pmax)/2 : n=1
	Do While n <= nmax
		m=n+1 : p=2*m*(m+n)
		Do While p <= pmax
			If gcd(m,n)=1 Then
				prim=prim+1
				count=count+Int(pmax/p)
			End If
			m=m+2
			p=2*m*(m+n)
		Loop
		n=n+1
	Loop
	triples = "Max Perimeter: " & pmax &_
				", Total: " & count &_
				", Primitive: " & prim
End Function

Function gcd(a,b)
	c = a : d = b
	Do
		If c Mod d > 0 Then
			e = c Mod d
			c = d
			d = e
		Else
			gcd = d
			Exit Do
		End If
	Loop
End Function


*process source attributes xref or(!);
 qu: Proc Options(main);
 /**********************************************************************
 * 06.09.2013 Walter Pachl translated from REXX
 *            added tasks 9 and A
 **********************************************************************/
 dcl v(4) Char(1) Var Init('','i','j','k');
 define structure 1 quat, 2 x(4) Dec Float(15);
 Dcl q  type quat; Call quat_init(q, 1,2,3,4);
 Dcl q1 type quat; Call quat_init(q1,2,3,4,5);
 Dcl q2 type quat; Call quat_init(q2,3,4,5,6);
 Dcl q3 type quat; Call quat_init(q3,-2,3,-4,-5);
 Dcl r  Dec Float(15)Init(7);

 call showq('       ','q'                    ,q);
 call showq('       ','q1'                   ,q1);
 call showq('       ','q2'                   ,q2);
 call showq('       ','q3'                   ,q3);
 call shows('       ','r'                    ,r);
 Call shows('task 1:','norm q'               ,norm(q));
 Call showq('task 2:','quatneg q'            ,quatneg(q));
 Call showq('task 3:','conjugate q'          ,quatConj(q));
 Call showq('task 4:','addition r+q'         ,quatAddsq(r,q));
 Call showq('task 5:','addition q1+q2'       ,quatAdd(q1,q2));
 Call showq('task 6:','multiplication q*r'   ,quatMulqs(q,r));
 Call showq('task 7:','multiplication q1*q2' ,quatMul(q1,q2));
 Call showq('task 8:','multiplication q2*q1' ,quatMul(q2,q1));
 Call showq('task 9:','quatsub q1-q1'        ,quatAdd(q1,quatneg(q1)));
 Call showq('task A:','addition q1+q3'       ,quatAdd(q1,q3));
 Call showt('task B:','equal'                ,quatEqual(quatMul(q1,q2),
                                                       quatMul(q2,q1)));
 Call showt('task C:','q1=q1'                ,quatEqual(q1,q1));

 quatNeg: procedure(qp) Returns(type quat);
 Dcl (qp,qr) type quat;
 qr.x(*)=-qp.x(*);
 Return (qr);
 End;

 quatAdd: procedure(qp,qq) Returns(type quat);
 Dcl (qp,qq,qr) type quat;
 qr.x(*)=qp.x(*)+qq.x(*);
 Return (qr);
 End;

 quatAddsq: procedure(v,qp) Returns(type quat);
 Dcl v Dec Float(15);
 Dcl (qp,qr) type quat;
 qr.x(*)=qp.x(*);
 qr.x(1)=qp.x(1)+v;
 Return (qr);
 End;

 quatConj: procedure(qp) Returns(type quat);
 Dcl (qp,qr) type quat;
 qr.x(*)=-qp.x(*);
 qr.x(1)= qp.x(1);
 Return (qr);
 End;

 quatMul: procedure(qp,qq) Returns(type quat);
 Dcl (qp,qq,qr) type quat;
 qr.x(1)=
        qp.x(1)*qq.x(1)-qp.x(2)*qq.x(2)-qp.x(3)*qq.x(3)-qp.x(4)*qq.x(4);
 qr.x(2)=
        qp.x(1)*qq.x(2)+qp.x(2)*qq.x(1)+qp.x(3)*qq.x(4)-qp.x(4)*qq.x(3);
 qr.x(3)=
        qp.x(1)*qq.x(3)-qp.x(2)*qq.x(4)+qp.x(3)*qq.x(1)+qp.x(4)*qq.x(2);
 qr.x(4)=
        qp.x(1)*qq.x(4)+qp.x(2)*qq.x(3)-qp.x(3)*qq.x(2)+qp.x(4)*qq.x(1);
 Return (qr);
 End;

 quatMulqs: procedure(qp,v) Returns(type quat);
 Dcl (qp,qr) type quat;
 Dcl v Dec Float(15);
 qr.x(*)=qp.x(*)*v;
 Return (qr);
 End;

 shows: Procedure(t1,t2,v);
 Dcl (t1,t2) Char(*);
 Dcl v Dec Float(15);
 Put Edit(t1,right(t2,24),'  --> ',v)(Skip,a,a,a,f(15,13));
 End;

 showt: Procedure(t1,t2,v);
 Dcl (t1,t2) Char(*);
 Dcl v Char(*) Var);
 Put Edit(t1,right(t2,24),'  --> ',v)(Skip,a,a,a,a);
 End;

 showq: Procedure(t1,t2,qp);
 Dcl qp type quat;
 Dcl (t1,t2) Char(*);
 Dcl (s,s2,p) Char(100) Var Init('');
 Dcl i Bin Fixed(31);
 Put String(s) Edit(t1,right(t2,24),'  --> ')(a,a,a);
 Do i=1 To 4;
   Put String(p) Edit(abs(qp.x(i)))(p'ZZZ9');
   p=trim(p);
   Select;
     When(qp.x(i)<0) p='-'!!p!!v(i);
     When(p=0) p='';
     Otherwise Do
       If s2^='' Then p='+'!!p;
       If i>1 Then p=p!!v(i);
       End;
     End;
   s2=s2!!p
   End;
 If s2='' Then
   s2='0';
 Put Edit(s!!s2)(Skip,a);
 End;

 norm: Procedure(qp) Returns(Dec Float(15));
 Dcl qp type quat;
 Dcl r  Dec Float(15) Init(0);
 Dcl i  Bin Fixed(31);
 Do i=1 To 4;
   r=r+qp.x(i)**2;
   End;
 Return (sqrt(r));
 End;

 quat_init: Proc(qp,x,y,z,u);
 Dcl qp type quat;
 Dcl (x,y,z,u) Dec Float(15);
 qp.x(1)=x;
 qp.x(2)=y;
 qp.x(3)=z;
 qp.x(4)=u;
 End;

 quatEqual: procedure(qp,qq) Returns(Char(12) Var);
 Dcl (qp,qq) type quat;
 Dcl i Bin Fixed(15);
 Do i=1 To 4;
   If qp.x(i)^=qq.x(i) Then
     Return('not equal');
   End;
 Return('equal');
 End;

 End;


Option Explicit

Dim total As Long, prim As Long, maxPeri As Long

Public Sub NewTri(ByVal s0 As Long, ByVal s1 As Long, ByVal s2 As Long)
Dim p As Long, x1 As Long, x2 As Long
    p = s0 + s1 + s2
    If p <= maxPeri Then
        prim = prim + 1
        total = total + maxPeri \ p
        x1 = s0 + s2
        x2 = s1 + s2
        NewTri s0 + 2 * (-s1 + s2), 2 * x1 - s1, 2 * (x1 - s1) + s2
        NewTri s0 + 2 * x2, 2 * x1 + s1, 2 * (x1 + s1) + s2
        NewTri -s0 + 2 * x2, 2 * (-s0 + s2) + s1, 2 * (-s0 + x2) + s2
    End If
End Sub

Public Sub Main()
    maxPeri = 100
    Do While maxPeri <= 10& ^ 8
        prim = 0
        total = 0
        NewTri 3, 4, 5
        Debug.Print "Up to "; maxPeri; ": "; total; " triples, "; prim; " primitives."
        maxPeri = maxPeri * 10
    Loop
End Sub


var sc = System.clock
var total = 0
var prim = 0
var maxPeri = 0

var newTri // recursive function so needs to be declared before it can be called
newTri = Fn.new { |s0, s1, s2|
    var p = s0 + s1 + s2
    if (p <= maxPeri) {
        prim = prim + 1
        total = total + (maxPeri/p).floor
        newTri.call( 1*s0-2*s1+2*s2,  2*s0-1*s1+2*s2,  2*s0-2*s1+3*s2)
        newTri.call( 1*s0+2*s1+2*s2,  2*s0+1*s1+2*s2,  2*s0+2*s1+3*s2)
        newTri.call(-1*s0+2*s1+2*s2, -2*s0+1*s1+2*s2, -2*s0+2*s1+3*s2)
    }
}

maxPeri = 100
while (maxPeri <= 1e10) {
    prim = 0
    total = 0
    newTri.call(3, 4, 5)
    var secs = (System.clock - sc).round
    System.print("Up to %(maxPeri):  %(total) triples, %(prim) primitives, %(secs) seconds")
    maxPeri = 10 * maxPeri
}


class Quaternion {
  [Double]$w
  [Double]$x
  [Double]$y
  [Double]$z
  Quaternion() {
      $this.w = 0
      $this.x = 0
      $this.y = 0
      $this.z = 0
  }
  Quaternion([Double]$a, [Double]$b, [Double]$c, [Double]$d) {
      $this.w = $a
      $this.x = $b
      $this.y = $c
      $this.z = $d
  }
  [Double]abs2() {return $this.w*$this.w + $this.x*$this.x + $this.y*$this.y + $this.z*$this.z}
  [Double]abs() {return [math]::sqrt($this.wbs2())}
  static [Quaternion]real([Double]$r) {return [Quaternion]::new($r, 0, 0, 0)}
  static [Quaternion]add([Quaternion]$m,[Quaternion]$n) {return [Quaternion]::new($m.w+$n.w, $m.x+$n.x, $m.y+$n.y, $m.z+$n.z)}
  [Quaternion]addreal([Double]$r) {return [Quaternion]::add($this,[Quaternion]::real($r))}
  static [Quaternion]mul([Quaternion]$m,[Quaternion]$n) {
    return [Quaternion]::new(
    ($m.w*$n.w) - ($m.x*$n.x) - ($m.y*$n.y) - ($m.z*$n.z),
    ($m.w*$n.x) + ($m.x*$n.w) + ($m.y*$n.z) - ($m.z*$n.y),
    ($m.w*$n.y) - ($m.x*$n.z) + ($m.y*$n.w) + ($m.z*$n.x),
    ($m.w*$n.z) + ($m.x*$n.y) - ($m.y*$n.x) + ($m.z*$n.w))
  }

  [Quaternion]mul([Double]$r) {return [Quaternion]::new($r*$this.w, $r*$this.x, $r*$this.y, $r*$this.z)}
  [Quaternion]negate() {return $this.mul(-1)}
  [Quaternion]conjugate() {return [Quaternion]::new($this.w, -$this.x, -$this.y, -$this.z)}
  static [String]st([Double]$r) {
        if(0 -le $r) {return "+$r"} else {return "$r"}
  }
  [String]show() {return "$($this.w)$([Quaternion]::st($this.x))i$([Quaternion]::st($this.y))j$([Quaternion]::st($this.z))k"}
  static [String]show([Quaternion]$other) {return $other.show()}
}

$q  = [Quaternion]::new(1, 2, 3, 4)
$q1 = [Quaternion]::new(2, 3, 4, 5)
$q2 = [Quaternion]::new(3, 4, 5, 6)
$r = 7
"`$q: $($q.show())"
"`$q1: $($q1.show())"
"`$q2: $($q2.show())"
"`$r: $r"
""
"norm `$q: $($q.wbs())"
"negate `$q: $($q.negate().show())"
"conjugate `$q: $($q.yonjugate().show())"
"`$q + `$r: $($q.wddreal($r).show())"
"`$q1 + `$q2: $([Quaternion]::show([Quaternion]::add($q1,$q2)))"
"`$q * `$r: $($q.mul($r).show())"
"`$q1 * `$q2: $([Quaternion]::show([Quaternion]::mul($q1,$q2)))"
"`$q2 * `$q1: $([Quaternion]::show([Quaternion]::mul($q2,$q1)))"


func GCD(N, D); \Return the greatest common divisor of N and D
int  N, D, R;   \numerator and denominator
[if D > N then
    [R:=D;  D:=N;  N:=R];
while D > 0 do
    [R:= rem(N/D);
    N:= D;
    D:= R;
    ];
return N;
];

int Max, PrimCnt, TripCnt, M, N, A, B, C, K, Prim;
[Max:= 10;
repeat  PrimCnt:= 0;  TripCnt:= 0;
        for M:= 2 to Max do
            for N:= 1 to M do
                [if GCD(M,N) = 1 \coprime\ and
                   ((M&1) = 0 xor (N&1) = 0) \one even\ then
                        [A:= M*M - N*N;
                         B:= 2*M*N;
                         C:= M*M + N*N;
                         Prim:= A+B+C;
                         if Prim <= Max then PrimCnt:= PrimCnt+1;
                         for K:= Max/Prim downto 1 do
                            if K*Prim <= Max then TripCnt:= TripCnt+1;
                        ];
                ];
        Format(6, 0);
        Text(0, "Up to");  RlOut(0, float(Max));
        RlOut(0, float(TripCnt));  Text(0, " triples,");
        RlOut(0, float(PrimCnt));  Text(0, " primitives.^m^j");
        Max:= Max*10;
until   Max > 10_000;
]


   1 LET Y=0: LET X=0: LET Z=0: LET V=0: LET U=0: LET L=10: LET T=0: LET P=0: LET N=4: LET M=0: PRINT "limit   trip.   prim."
   2 FOR U=2 TO INT (SQR (L/2)): LET Y=U-INT (U/2)*2: LET N=N+4: LET M=U*U*2: IF Y=0 THEN LET M=M-U-U
   3 FOR V=1+Y TO U-1 STEP 2: LET M=M+N: LET X=U: LET Y=V
   4 LET Z=Y: LET Y=X-INT (X/Y)*Y: LET X=Z: IF Y<>0 THEN GO TO 4
   5 IF X>1 THEN GO TO 8
   6 IF M>L THEN GO TO 9
   7 LET P=P+1: LET T=T+INT (L/M)
   8 NEXT V
   9 NEXT U
  10 PRINT L;TAB 8;T;TAB 16;P
  11 LET N=4: LET T=0: LET P=0: LET L=L*10: IF L<=100000 THEN GO TO 2


% A quaternion is represented as a complex term qx/4
add(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :-
	!, R is R0+R1, I is I0+I1, J is J0+J1, K is K0+K1.
add(qx(R0,I,J,K), F, qx(R,I,J,K)) :-
	number(F), !, R is R0 + F.
add(F, qx(R0,I,J,K), Qx) :-
	add(qx(R0,I,J,K), F, Qx).
mul(qx(R0,I0,J0,K0), qx(R1,I1,J1,K1), qx(R,I,J,K)) :- !,
	R is R0*R1 - I0*I1 - J0*J1 - K0*K1,
	I is R0*I1 + I0*R1 + J0*K1 - K0*J1,
	J is R0*J1 - I0*K1 + J0*R1 + K0*I1,
	K is R0*K1 + I0*J1 - J0*I1 + K0*R1.
mul(qx(R0,I0,J0,K0), F, qx(R,I,J,K)) :-
	number(F), !, R is R0*F, I is I0*F, J is J0*F, K is K0*F.
mul(F, qx(R0,I0,J0,K0), Qx) :-
	mul(qx(R0,I0,J0,K0),F,Qx).
abs(qx(R,I,J,K), Norm) :-
	Norm is sqrt(R*R+I*I+J*J+K*K).
negate(qx(Ri,Ii,Ji,Ki),qx(R,I,J,K)) :-
	R is -Ri, I is -Ii, J is -Ji, K is -Ki.
conjugate(qx(R,Ii,Ji,Ki),qx(R,I,J,K)) :-
	I is -Ii, J is -Ji, K is -Ki.


Structure Quaternion
  a.f
  b.f
  c.f
  d.f
EndStructure

Procedure.f QNorm(*x.Quaternion)
  ProcedureReturn Sqr(Pow(*x\a, 2) + Pow(*x\b, 2) + Pow(*x\c, 2) + Pow(*x\d, 2))
EndProcedure

;If supplied, the result is returned in the quaternion structure *res,
;otherwise a new quaternion is created.  A pointer to the result is returned.
Procedure QNeg(*x.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
    *res\a = -*x\a
    *res\b = -*x\b
    *res\c = -*x\c
    *res\d = -*x\d
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure QConj(*x.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
    *res\a =  *x\a
    *res\b = -*x\b
    *res\c = -*x\c
    *res\d = -*x\d
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure QAddReal(r.f, *x.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
    *res\a = *x\a + r
    *res\b = *x\b
    *res\c = *x\c
    *res\d = *x\d
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure QAddQuaternion(*x.Quaternion, *y.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
    *res\a = *x\a + *y\a
    *res\b = *x\b + *y\b
    *res\c = *x\c + *y\c
    *res\d = *x\d + *y\d
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure QMulReal_and_Quaternion(r.f, *x.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
    *res\a = *x\a * r
    *res\b = *x\b * r
    *res\c = *x\c * r
    *res\d = *x\d * r
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure QMulQuaternion(*x.Quaternion, *y.Quaternion, *res.Quaternion = 0)
  If *res = 0: *res.Quaternion = AllocateMemory(SizeOf(Quaternion)): EndIf
  If *res
     *res\a = *x\a * *y\a - *x\b * *y\b - *x\c * *y\c - *x\d * *y\d
     *res\b = *x\a * *y\b + *x\b * *y\a + *x\c * *y\d - *x\d * *y\c
     *res\c = *x\a * *y\c - *x\b * *y\d + *x\c * *y\a + *x\d * *y\b
     *res\d = *x\a * *y\d + *x\b * *y\c - *x\c * *y\b + *x\d * *y\a
  EndIf
  ProcedureReturn *res
EndProcedure

Procedure Q_areEqual(*x.Quaternion, *y.Quaternion)
  If (*x\a <> *y\a) Or (*x\b <> *y\b) Or (*x\c <> *y\c) Or (*x\d <> *y\d)
    ProcedureReturn 0 ;false
  EndIf
  ProcedureReturn 1 ;true
EndProcedure


from collections import namedtuple
import math

class Q(namedtuple('Quaternion', 'real, i, j, k')):
    'Quaternion type: Q(real=0.0, i=0.0, j=0.0, k=0.0)'

    __slots__ = ()

    def __new__(_cls, real=0.0, i=0.0, j=0.0, k=0.0):
        'Defaults all parts of quaternion to zero'
        return super().__new__(_cls, float(real), float(i), float(j), float(k))

    def conjugate(self):
        return Q(self.real, -self.i, -self.j, -self.k)

    def _norm2(self):
        return sum( x*x for x in self)

    def norm(self):
        return math.sqrt(self._norm2())

    def reciprocal(self):
        n2 = self._norm2()
        return Q(*(x / n2 for x in self.conjugate()))

    def __str__(self):
        'Shorter form of Quaternion as string'
        return 'Q(%g, %g, %g, %g)' % self

    def __neg__(self):
        return Q(-self.real, -self.i, -self.j, -self.k)

    def __add__(self, other):
        if type(other) == Q:
            return Q( *(s+o for s,o in zip(self, other)) )
        try:
            f = float(other)
        except:
            return NotImplemented
        return Q(self.real + f, self.i, self.j, self.k)

    def __radd__(self, other):
        return Q.__add__(self, other)

    def __mul__(self, other):
        if type(other) == Q:
            a1,b1,c1,d1 = self
            a2,b2,c2,d2 = other
            return Q(
                 a1*a2 - b1*b2 - c1*c2 - d1*d2,
                 a1*b2 + b1*a2 + c1*d2 - d1*c2,
                 a1*c2 - b1*d2 + c1*a2 + d1*b2,
                 a1*d2 + b1*c2 - c1*b2 + d1*a2 )
        try:
            f = float(other)
        except:
            return NotImplemented
        return Q(self.real * f, self.i * f, self.j * f, self.k * f)

    def __rmul__(self, other):
        return Q.__mul__(self, other)

    def __truediv__(self, other):
        if type(other) == Q:
            return self.__mul__(other.reciprocal())
        try:
            f = float(other)
        except:
            return NotImplemented
        return Q(self.real / f, self.i / f, self.j / f, self.k / f)

    def __rtruediv__(self, other):
        return other * self.reciprocal()

    __div__, __rdiv__ = __truediv__, __rtruediv__

Quaternion = Q

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


#lang racket

(struct quaternion (a b c d)
  #:transparent)

(define-match-expander quaternion:
  (λ (stx)
    (syntax-case stx ()
      [(_ a b c d)
       #'(or (quaternion a b c d)
             (and a (app (λ(_) 0) b) (app (λ(_) 0) c) (app (λ(_) 0) d)))])))

(define (norm q)
  (match q
    [(quaternion: a b c d)
     (sqrt (+ (sqr a) (sqr b) (sqr c) (sqr d)))]))

(define (negate q)
  (match q
    [(quaternion: a b c d)
     (quaternion (- a) (- b) (- c) (- d))]))

(define (conjugate q)
  (match q
    [(quaternion: a b c d)
     (quaternion a (- b) (- c) (- d))]))

(define (add q1 q2 . q-rest)
  (let ((ans (match* (q1 q2)
               [((quaternion: a1 b1 c1 d1) (quaternion: a2 b2 c2 d2))
                (quaternion (+ a1 a2) (+ b1 b2) (+ c1 c2) (+ d1 d2))])))
    (if (empty? q-rest)
        ans
        (apply add (cons ans q-rest)))))

(define (multiply q1 q2 . q-rest)
  (let ((ans (match* (q1 q2)
               [((quaternion: a1 b1 c1 d1) (quaternion: a2 b2 c2 d2))
                (quaternion (- (* a1 a2) (* b1 b2) (* c1 c2) (* d1 d2))
                            (+ (* a1 b2) (* b1 a2) (* c1 d2) (- (* d1 c2)))
                            (+ (* a1 c2) (- (* b1 d2)) (* c1 a2) (* d1 b2))
                            (+ (* a1 d2) (* b1 c2) (- (* c1 b2)) (* d1 a2)))])))
    (if (empty? q-rest)
        ans
        (apply multiply (cons ans q-rest)))))

;; Tests
(module+ main
  (define i (quaternion 0 1 0 0))
  (define j (quaternion 0 0 1 0))
  (define k (quaternion 0 0 0 1))
  (displayln (multiply i j k))
  (newline)

  (define q (quaternion 1 2 3 4))
  (define q1 (quaternion 2 3 4 5))
  (define q2 (quaternion 3 4 5 6))
  (define r 7)

  (for ([quat (list q q1 q2)])
    (displayln quat)
    (displayln (norm quat))
    (displayln (negate quat))
    (displayln (conjugate quat))
    (newline))

  (add r q)
  (add q1 q2)
  (multiply r q)

  (newline)
  (multiply q1 q2)
  (multiply q2 q1)
  (equal? (multiply q1 q2)
          (multiply q2 q1)))