class Quaternion
  property a, b, c, d

  def initialize(@a : Int64, @b : Int64, @c : Int64, @d : Int64) end

  def norm; Math.sqrt(a**2 + b**2 + c**2 + d**2) end
  def conj; Quaternion.new(a, -b, -c, -d)        end
  def +(n)  Quaternion.new(a + n, b, c, d)       end
  def -(n)  Quaternion.new(a - n, b, c, d)       end
  def -()   Quaternion.new(-a, -b, -c, -d)       end
  def *(n)  Quaternion.new(a * n, b * n, c * n, d * n) end
  def ==(rhs : Quaternion) self.to_s == rhs.to_s end
  def +(rhs : Quaternion)
    Quaternion.new(a + rhs.a, b + rhs.b, c + rhs.c, d + rhs.d)
  end

  def -(rhs : Quaternion)
    Quaternion.new(a - rhs.a, b - rhs.b, c - rhs.c, d - rhs.d)
  end

  def *(rhs : Quaternion)
    Quaternion.new(
      a * rhs.a - b * rhs.b - c * rhs.c - d * rhs.d,
      a * rhs.b + b * rhs.a + c * rhs.d - d * rhs.c,
      a * rhs.c - b * rhs.d + c * rhs.a + d * rhs.b,
      a * rhs.d + b * rhs.c - c * rhs.b + d * rhs.a)
  end

  def to_s(io : IO) io << "(#{a} #{sgn(b)}i #{sgn(c)}j #{sgn(d)}k)\n" end
  private def sgn(n)  n.sign|1 == 1 ? "+ #{n}" : "- #{n.abs}"  end
end

struct Number
  def +(rhs : Quaternion)
    Quaternion.new(rhs.a + self, rhs.b, rhs.c, rhs.d)
  end

  def -(rhs : Quaternion)
    Quaternion.new(-rhs.a + self, -rhs.b, -rhs.c, -rhs.d)
  end

  def *(rhs : Quaternion)
    Quaternion.new(rhs.a * self, rhs.b * self, rhs.c * self, rhs.d * self)
  end
end

q0 = Quaternion.new(a: 1, b: 2, c: 3, d: 4)
q1 = Quaternion.new(2, 3, 4, 5)
q2 = Quaternion.new(3, 4, 5, 6)
r  = 7

puts "q0 = #{q0}"
puts "q1 = #{q1}"
puts "q2 = #{q2}"
puts "r  = #{r}"
puts
puts "normal of q0 = #{q0.norm}"
puts "-q0 = #{-q0}"
puts "conjugate of q0 = #{q0.conj}"
puts "q0 * (conjugate of q0) = #{q0 * q0.conj}"
puts "(conjugate of q0) * q0 = #{q0.conj * q0}"
puts
puts "r + q0 = #{r + q0}"
puts "q0 + r = #{q0 + r}"
puts
puts " q0 - r = #{q0 - r}"
puts "-q0 - r = #{-q0 - r}"
puts " r - q0 = #{r - q0}"
puts "-q0 + r = #{-q0 + r}"
puts
puts "r * q0 = #{r * q0}"
puts "q0 * r = #{q0 * r}"
puts
puts "q0 + q1 = #{q0 + q1}"
puts "q0 - q1 = #{q2 - q1}"
puts "q0 * q1 = #{q0 * q1}"
puts
puts " q0 + q1 * q2  = #{q0 + q1 * q2}"
puts "(q0 + q1) * q2 = #{(q0 + q1) * q2}"
puts
puts " q0 *  q1  * q2 = #{q0 * q1 * q2}"
puts "(q0 *  q1) * q2 = #{(q0 * q1) * q2}"
puts " q0 * (q1 * q2) = #{q0 * (q1 * q2)}"
puts
puts "q1 * q2 = #{q1 * q2}"
puts "q2 * q1 = #{q2 * q1}"
puts
puts "q1 * q2 != q2 * q1 => #{(q1 * q2) != (q2 * q1)}"
puts "q1 * q2 == q2 * q1 => #{(q1 * q2) == (q2 * q1)}"


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

let rec gcd a b =
    let t = a % b
    if t = 0 then b else gcd b t

let coprime a b = gcd a b = 1

let num_to ms =
    let mutable ctr = 0
    let mutable prim_ctr = 0
    let max_m = isqrt (ms/2)
    for m = 2 to max_m do
        for j = 0 to (m/2) - 1 do
            let n = m-(2*j+1)
            if coprime m n then
                let s = 2*m*(m+n)
                if s <= ms then
                    ctr <- ctr + (ms/s)
                    prim_ctr <- prim_ctr + 1
    (ctr, prim_ctr)

let show i =
    let s, p = num_to i in
    printfn "For perimeters up to %d there are %d total and %d primitive" i s p;;

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


' version 03-12-2016
' compile with: fbc -s gui
' or fbc -s console

Sub pythagoras_tree(x1 As Double, y1 As Double, x2 As Double, y2 As Double, depth As ULong)

    If depth > 10 Then Return

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

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

End Sub

' ------=< MAIN >=------
' max for w is about max screensize - 500
Dim As ULong w = 800, h = w * 11 \ 16
Dim As ULong w2 = w \ 2, diff = w \ 12

ScreenRes w, h, 8
pythagoras_tree(w2 - diff, h -10 , w2 + diff , h -10 , 0)
' BSave "pythagoras_tree.bmp",0

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


package main

import (
	"image"
	"image/color"
	"image/draw"
	"image/png"
	"log"
	"os"
)

const (
	width, height = 800, 600
	maxDepth      = 11                    // how far to recurse, between 1 and 20 is reasonable
	colFactor     = uint8(255 / maxDepth) // adjusts the colour so leaves get greener further out
	fileName      = "pythagorasTree.png"
)

func main() {
	img := image.NewNRGBA(image.Rect(0, 0, width, height)) // create new image
	bg := image.NewUniform(color.RGBA{255, 255, 255, 255}) // prepare white for background
	draw.Draw(img, img.Bounds(), bg, image.ZP, draw.Src)   // fill the background

	drawSquares(340, 550, 460, 550, img, 0) // start off near the bottom of the image

	imgFile, err := os.Create(fileName)
	if err != nil {
		log.Fatal(err)
	}
	defer imgFile.Close()
	if err := png.Encode(imgFile, img); err != nil {
		imgFile.Close()
		log.Fatal(err)
	}
}

func drawSquares(ax, ay, bx, by int, img *image.NRGBA, depth int) {
	if depth > maxDepth {
		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
	col := color.RGBA{0, uint8(depth) * colFactor, 0, 255}
	drawLine(ax, ay, bx, by, img, col)
	drawLine(bx, by, x3, y3, img, col)
	drawLine(x3, y3, x4, y4, img, col)
	drawLine(x4, y4, ax, ay, img, col)
	drawSquares(x4, y4, x5, y5, img, depth+1)
	drawSquares(x5, y5, x3, y3, img, depth+1)
}

func drawLine(x0, y0, x1, y1 int, img *image.NRGBA, col color.RGBA) {
	dx := abs(x1 - x0)
	dy := abs(y1 - y0)
	var sx, sy int = -1, -1
	if x0 < x1 {
		sx = 1
	}
	if y0 < y1 {
		sy = 1
	}
	err := dx - dy
	for {
		img.Set(x0, y0, col)
		if x0 == x1 && y0 == y1 {
			break
		}
		e2 := 2 * err
		if e2 > -dy {
			err -= dy
			x0 += sx
		}
		if e2 < dx {
			err += dx
			y0 += sy
		}
	}
}
func abs(x int) int {
	if x < 0 {
		return -x
	}
	return x
}


import std.math, std.numeric, std.traits, std.conv, std.complex;

struct Quat(T) if (isFloatingPoint!T) {
    alias CT = Complex!T;

    union {
        struct { T re, i, j, k; } // Default init to NaN.
        struct { CT x, y; }
        struct { T[4] vector; }
    }

    string toString() const pure /*nothrow*/ @safe {
        return vector.text;
    }

    @property T norm2() const pure nothrow @safe @nogc { /// Norm squared.
        return re ^^ 2 + i ^^ 2 + j ^^ 2 + k ^^ 2;
    }

    @property T abs() const pure nothrow @safe @nogc { /// Norm.
        return sqrt(norm2);
    }

    @property T arg() const pure nothrow @safe @nogc { /// Theta.
        return acos(re / abs); // this may be incorrect...
    }

    @property Quat!T conj() const pure nothrow @safe @nogc { /// Conjugate.
        return Quat!T(re, -i, -j, -k);
    }

    @property Quat!T recip() const pure nothrow @safe @nogc {  /// Reciprocal.
        return Quat!T(re / norm2, -i / norm2, -j / norm2, -k / norm2);
    }

    @property Quat!T pureim() const pure nothrow @safe @nogc { /// Pure imagery.
        return Quat!T(0, i, j, k);
    }

    @property Quat!T versor() const pure nothrow @safe @nogc { /// Unit versor.
        return this / abs;
    }

    /// Unit versor of imagery part.
    @property Quat!T iversor() const pure nothrow @safe @nogc {
        return pureim / pureim.abs;
    }

    /// Assignment.
    Quat!T opAssign(U : T)(Quat!U z) pure nothrow @safe @nogc {
        x = z.x;  y = z.y;
        return this;
    }

    Quat!T opAssign(U : T)(Complex!U c) pure nothrow @safe @nogc {
        x = c;  y = 0;
        return this;
    }

    Quat!T opAssign(U : T)(U r) pure nothrow @safe @nogc
    if (isNumeric!U) {
        re = r; i = 0; y = 0;
        return this;
    }

    /// Test for equal, not ordered so no opCmp.
    bool opEquals(U : T)(Quat!U z) const pure nothrow @safe @nogc {
        return re == z.re && i == z.i && j == z.j && k == z.k;
    }

    bool opEquals(U : T)(Complex!U c) const pure nothrow @safe @nogc {
        return re == c.re && i == c.im && j == 0 && k == 0;
    }

    bool opEquals(U : T)(U r) const pure nothrow @safe @nogc
    if (isNumeric!U) {
        return re == r && i == 0 && j == 0 && k == 0;
    }

    /// Unary op.
    Quat!T opUnary(string op)() const pure nothrow @safe @nogc
    if (op == "+") {
        return this;
    }

    Quat!T opUnary(string op)() const pure nothrow @safe @nogc
    if (op == "-") {
        return Quat!T(-re, -i, -j, -k);
    }

    /// Binary op, Quaternion on left of op.
    Quat!(CommonType!(T,U)) opBinary(string op, U)(Quat!U z)
    const pure nothrow @safe @nogc {
        alias typeof(return) C;

        static if (op == "+" ) {
            return C(re + z.re, i + z.i, j + z.j, k + z.k);
        } else static if (op == "-") {
            return C(re - z.re, i - z.i, j - z.j, k - z.k);
        } else static if (op == "*") {
            return C(re * z.re - i * z.i  - j * z.j  - k * z.k,
                     re * z.i  + i * z.re + j * z.k  - k * z.j,
                     re * z.j  - i * z.k  + j * z.re + k * z.i,
                     re * z.k  + i * z.j  - j * z.i  + k * z.re);
        } else static if (op == "/") {
            return this * z.recip;
        }
    }

    /// Extend complex to quaternion.
    Quat!(CommonType!(T,U)) opBinary(string op, U)(Complex!U c)
    const pure nothrow @safe @nogc {
        return opBinary!op(typeof(return)(c.re, c.im, 0, 0));
    }

    /// For scalar.
    Quat!(CommonType!(T,U)) opBinary(string op, U)(U r)
    const pure nothrow @safe @nogc
    if (isNumeric!U) {
        alias typeof(return) C;

        static if (op == "+" ) {
            return C(re + r, i, j, k);
        } else static if (op == "-") {
            return C(re - r, i, j, k);
        } else static if (op == "*") {
            return C(re * r, i * r, j * r, k * r);
        } else static if (op == "/") {
            return C(re / r, i / r, j / r, k / r);
        } else static if (op == "^^") {
            return pow(r);
        }
    }

    /// Power function.
    Quat!(CommonType!(T,U)) pow(U)(U r)
    const pure nothrow @safe @nogc
    if (isNumeric!U) {
        return (abs^^r) * exp(r * iversor * arg);
    }

    /// Handle binary op if Quaternion on right of op and left is
    /// not quaternion.
    Quat!(CommonType!(T,U)) opBinaryRight(string op, U)(Complex!U c)
    const pure nothrow @safe @nogc {
        alias typeof(return) C;
        auto w = C(c.re, c.im, 0, 0);
        return w.opBinary!(op)(this);
    }

    Quat!(CommonType!(T,U)) opBinaryRight(string op, U)(U r)
    const pure nothrow @safe @nogc
    if (isNumeric!U) {
        alias typeof(return) C;

        static if (op == "+" || op == "*") {
            return opBinary!op(r);
        } else static if (op == "-") {
            return C(r - re , -i, -j, -k);
        } else static if (op == "/") {
            auto w = C(re, i, j, k);
            return w.recip * r;
        }
    }
}

HT exp(HT)(HT z) pure nothrow @safe @nogc
if (is(HT T == Quat!T)) {
    immutable inorm = z.pureim.abs;
    return std.math.exp(z.re) * (cos(inorm) + z.iversor * sin(inorm));
}

HT log(HT)(HT z) pure nothrow @safe @nogc
if (is(HT T == Quat!T)) {
    return std.math.log(z.abs) + z.iversor * acos(z.re / z.abs);
}

void main() @safe { // Demo code.
    import std.stdio;

    alias QR = Quat!real;
    enum real r = 7.0;

    immutable QR q  = QR(2, 3, 4, 5),
                 q1 = QR(2, 3, 4, 5),
                 q2 = QR(3, 4, 5, 6);

    writeln("1.             q - norm: ", q.abs);
    writeln("2.         q - negative: ", -q);
    writeln("3.        q - conjugate: ", q.conj);
    writeln("4.                r + q: ", r + q);
    writeln("                  q + r: ", q + r);
    writeln("5.              q1 + q2: ", q1 + q2);
    writeln("6.                r * q: ", r * q);
    writeln("                  q * r: ", q * r);
    writeln("7.              q1 * q2: ", q1 * q2);
    writeln("                q2 * q1: ", q2 * q1);
    writeln("8.  q1 * q2 != q2 * Q1 ? ", q1 * q2 != q2 * q1);

    immutable QR i = QR(0, 1, 0, 0),
                 j = QR(0, 0, 1, 0),
                 k = QR(0, 0, 0, 1);
    writeln("9.1               i * i: ", i * i);
    writeln("                  J * j: ", j * j);
    writeln("                  k * k: ", k * k);
    writeln("              i * j * k: ", i * j * k);
    writeln("9.2             q1 / q2: ", q1 / q2);
    writeln("9.3        q1 / q2 * q2: ", q1 / q2 * q2);
    writeln("           q2 * q1 / q2: ", q2 * q1 / q2);
    writeln("9.4         exp(pi * i): ", exp(PI * i));
    writeln("            exp(pi * j): ", exp(PI * j));
    writeln("            exp(pi * k): ", exp(PI * k));
    writeln("                 exp(q): ", exp(q));
    writeln("                 log(q): ", log(q));
    writeln("            exp(log(q)): ", exp(log(q)));
    writeln("            log(exp(q)): ", log(exp(q)));
    immutable s = q.exp.log;
    writeln("9.5 let s = log(exp(q)): ", s);
    writeln("                 exp(s): ", exp(s));
    writeln("                 log(s): ", log(s));
    writeln("            exp(log(s)): ", exp(log(s)));
    writeln("            log(exp(s)): ", log(exp(s)));
}


USING: accessors arrays formatting kernel literals math
math.functions math.matrices math.ranges sequences ;
IN: rosettacode.pyth

CONSTANT: T1 {
  {  1  2  2 }
  { -2 -1 -2 }
  {  2  2  3 }
}
CONSTANT: T2 {
  {  1  2  2 }
  {  2  1  2 }
  {  2  2  3 }
}
CONSTANT: T3 {
  { -1 -2 -2 }
  {  2  1  2 }
  {  2  2  3 }
}

CONSTANT: base { 3 4 5 }

TUPLE: triplets-count primitives total ;
: <0-triplets-count> ( -- a ) 0 0 \ triplets-count boa ;
: next-triplet ( triplet T -- triplet' ) [ 1array ] [ m. ] bi* first ;
: candidates-triplets ( seed -- candidates )
  ${ T1 T2 T3 } [ next-triplet ] with map ;
: add-triplets ( current-triples limit triplet -- stop )
  sum 2dup > [
   /i [ + ] curry change-total
   [ 1 + ] change-primitives drop t
  ] [ 3drop f ] if ;
: all-triplets ( current-triples limit seed -- triplets )
  3dup add-triplets [
    candidates-triplets [ all-triplets ] with swapd reduce
  ] [ 2drop ] if ;
: count-triplets ( limit -- count )
  <0-triplets-count> swap base all-triplets ;
: pprint-triplet-count ( limit count -- )
  [ total>> ] [ primitives>> ] bi
  "Up to %d: %d triples, %d primitives.\n" printf ;
: pyth ( -- )
  8 [1,b] [ 10^ dup count-triplets pprint-triplet-count ] each ;


\ Two methods to create Pythagorean Triples
\ this code has been tested using Win32Forth and gforth

: pythag_fibo ( f1 f0 -- )
     \ Create Pythagorean Triples from 4 element Fibonacci series
     \ this is called with the first two members of a 4 element Fibonacci series
     \ Price and Burkhart have two good articles about this method
     \ "Pythagorean Tree: A New Species" and
     \ "Heron's Formula, Descartes Circles, and Pythagorean Triangles"
     \ Horadam found out how to compute Pythagorean Triples from Fibonacci series

     \ compute the two other members of the Fibonacci series and put them in
     \ local variables.  I was unable to do this with out using locals
     2DUP + 2DUP + 2OVER 2DUP + 2DUP +
     LOCALS| f3 f2 f1 f0 |

     wk_level @  9 .r f0 8 .r  f1 8 .r  f2 8 .r  f3 8 .r

     \ this block calculates the sides of the Pythagorean Triangle using single precision
     \ f0 f3 * 14 .r                 \ side a  (always odd)
     \ 2 f1 * f2 * 10 .r             \ side b  (a multiple of 4)
     \ f0 f2 * f1 f3 * + 10 .r       \ side c, the hyponenuse, (always odd)

     \ this block calculates double precision values
     f0 f3 um* 15 d.r                    \ side a  (always odd)
     2 f1 * f2 um* 15 d.r                \ side b  (a multiple of 4)
     f0 f2 um* f1 f3 um* d+ 17 d.r  cr   \ side c, the hypotenuse, (always odd)

     MAX_LEVEL @ wk_LEVEL @ U> IF   \ TRUE if MAX_LEVEL > WK_LEVEL
     wk_level @ 1+ wk_level !

     \ this creates a teranary tree of Pythagorean triples
     \ use a two of the members of the Fibonacci series as seeds for the
     \ next level
     \ It's the same tree created by Barning or Hall using matrix multiplication
     f3 f1 recurse
     f3 f2 recurse
     f0 f2 recurse

     wk_level @ 1- wk_level !

     else
     then

     drop drop drop drop ;

\ implements the Fibonacci series -- Pythagorean triple
\ the stack contents sets how many iteration levels there will be
: pf_test
     \ the stack contents set up the maximum level
     max_level !
     0 wk_level !
     cr

     \ call the function with the first two elements of the base Fibonacci series
     1 1 pythag_fibo  ;

: gcd ( a b -- gcd )
  begin ?dup while tuck mod repeat ;

\ this is the classical algorithm, known to Euclid, it is explained in many
\ books on Number Theory
\ this generates all primitive Pythagorean triples

\ i -- inner loop index or current loop index
\ j -- outer loop index
\ stack contents is the upper limit for j
\ i and j can not both be odd
\ the gcd( i, j ) must be 1
\ j is greater than i
\ the stack contains the upper limit of the j variable
: pythag_ancn  ( limit -- )
     cr
     1 + 2 do
        i 1 and if 2 else 1 then
        \ this sets the start value of the inner loop so that
        \ if the outer loop index is odd only even inner loop indices happen
        \ if the outer loop index is even only odd inner loop indices happen
        i swap do
             i j gcd 1 - 0> if else  \ do this if gcd( i, j ) is 1
             j 5 .r i 5 .r

             \ j j * i i * - 12 .r   \ a side of Pythagorean triangle (always odd)
             \ i j * 2 * 9 .r        \ b side of Pythagorean triangle (multiple of 4)
             \ i i * j j * + 9 .r    \ hypotenuse of Pythagorean triangle (always odd)

             \ this block calculates double precision Pythagorean triple values
             j j um* i i um* d- 15 d.r    \ a side of Pythagorean triangle (always odd)
             i j um* d2* 15 d.r           \ b side of Pythagorean triangle (multiple of 4)
             i i um* j j um* d+ 17 d.r    \ hypotenuse of Pythagorean triangle (always odd)

             cr then 2 +loop       \ keep i being all odd or all even
     loop ;

Current directory: C:\Forth ok
FLOAD 'C:\Forth\ancien_fibo_pythag.F'  ok
  ok

  ok
  ok
3 pf_test
        0       1       1       2       3              3              4                5
        1       3       1       4       5             15              8               17
        2       5       1       6       7             35             12               37
        3       7       1       8       9             63             16               65
        3       7       6      13      19            133            156              205
        3       5       6      11      17             85            132              157
        2       5       4       9      13             65             72               97
        3      13       4      17      21            273            136              305
        3      13       9      22      31            403            396              565
        3       5       9      14      23            115            252              277
        2       3       4       7      11             33             56               65
        3      11       4      15      19            209            120              241
        3      11       7      18      25            275            252              373
        3       3       7      10      17             51            140              149
        1       3       2       5       7             21             20               29
        2       7       2       9      11             77             36               85
        3      11       2      13      15            165             52              173
        3      11       9      20      29            319            360              481
        3       7       9      16      25            175            288              337
        2       7       5      12      17            119            120              169
        3      17       5      22      27            459            220              509
        3      17      12      29      41            697            696              985
        3       7      12      19      31            217            456              505
        2       3       5       8      13             39             80               89
        3      13       5      18      23            299            180              349
        3      13       8      21      29            377            336              505
        3       3       8      11      19             57            176              185
        1       1       2       3       5              5             12               13
        2       5       2       7       9             45             28               53
        3       9       2      11      13            117             44              125
        3       9       7      16      23            207            224              305
        3       5       7      12      19             95            168              193
        2       5       3       8      11             55             48               73
        3      11       3      14      17            187             84              205
        3      11       8      19      27            297            304              425
        3       5       8      13      21            105            208              233
        2       1       3       4       7              7             24               25
        3       7       3      10      13             91             60              109
        3       7       4      11      15            105             88              137
        3       1       4       5       9              9             40               41
 ok
  ok
10 pythag_ancn
    2    1              3              4                5
    3    2              5             12               13
    4    1             15              8               17
    4    3              7             24               25
    5    2             21             20               29
    5    4              9             40               41
    6    1             35             12               37
    6    5             11             60               61
    7    2             45             28               53
    7    4             33             56               65
    7    6             13             84               85
    8    1             63             16               65
    8    3             55             48               73
    8    5             39             80               89
    8    7             15            112              113
    9    2             77             36               85
    9    4             65             72               97
    9    8             17            144              145
   10    1             99             20              101
   10    3             91             60              109
   10    7             51            140              149
   10    9             19            180              181
 ok


100 PROGRAM "Pythagor.bas"
110 OPTION ANGLE DEGREES
120 LET SQ2=SQR(2)
130 SET VIDEO MODE 1:SET VIDEO COLOUR 0:SET VIDEO X 42:SET VIDEO Y 25
140 OPEN #101:"video:"
150 SET PALETTE 0,141
160 DISPLAY #101:AT 1 FROM 1 TO 25
170 PLOT 580,20;ANGLE 90;
180 CALL BROCCOLI(225,10)
190 DO
200 LOOP WHILE INKEY$=""
210 TEXT
220 DEF BROCCOLI(X,Y)
230   IF X<Y THEN EXIT DEF
240   CALL SQUARE(X)
250   PLOT FORWARD X,LEFT 45,
260   CALL BROCCOLI(X/SQ2,Y)
270   PLOT RIGHT 90,FORWARD X/SQ2,
280   CALL BROCCOLI(X/SQ2,Y)
290   PLOT BACK X/SQ2,LEFT 45,BACK X,
300 END DEF
310 DEF SQUARE(X)
320   FOR I=1 TO 4
330     PLOT FORWARD X;RIGHT 90;
340   NEXT
350 END DEF


gnuplot --persist -e 'plot"<ijconsole /tmp/pt.ijs"w l'


unit Quaternions;

interface

type

  TQuaternion = record
    A, B, C, D: double;

    function  Init          (aA, aB, aC, aD : double): TQuaternion;
    function  Norm          : double;
    function  Conjugate     : TQuaternion;
    function  ToString      : string;

    class operator Negative (Left : TQuaternion): TQuaternion;
    class operator Positive (Left : TQuaternion): TQuaternion;
    class operator Add      (Left, Right : TQuaternion): TQuaternion;
    class operator Add      (Left : TQuaternion; Right : double): TQuaternion; overload;
    class operator Add      (Left : double; Right : TQuaternion): TQuaternion; overload;
    class operator Subtract (Left, Right : TQuaternion): TQuaternion;
    class operator Multiply (Left, Right : TQuaternion): TQuaternion;
    class operator Multiply (Left : TQuaternion; Right : double): TQuaternion; overload;
    class operator Multiply (Left : double; Right : TQuaternion): TQuaternion; overload;
  end;

implementation

uses
  SysUtils;

{ TQuaternion }

function TQuaternion.Init(aA, aB, aC, aD: double): TQuaternion;
begin
  A := aA;
  B := aB;
  C := aC;
  D := aD;

  result := Self;
end;

function TQuaternion.Norm: double;
begin
  result := sqrt(sqr(A) + sqr(B) + sqr(C) + sqr(D));
end;

function TQuaternion.Conjugate: TQuaternion;
begin
  result.B := -B;
  result.C := -C;
  result.D := -D;
end;

class operator TQuaternion.Negative(Left: TQuaternion): TQuaternion;
begin
  result.A := -Left.A;
  result.B := -Left.B;
  result.C := -Left.C;
  result.D := -Left.D;
end;

class operator TQuaternion.Positive(Left: TQuaternion): TQuaternion;
begin
  result := Left;
end;

class operator TQuaternion.Add(Left, Right: TQuaternion): TQuaternion;
begin
  result.A := Left.A + Right.A;
  result.B := Left.B + Right.B;
  result.C := Left.C + Right.C;
  result.D := Left.D + Right.D;
end;

class operator TQuaternion.Add(Left: TQuaternion; Right: double): TQuaternion;
begin
  result.A := Left.A + Right;
  result.B := Left.B;
  result.C := Left.C;
  result.D := Left.D;
end;

class operator TQuaternion.Add(Left: double; Right: TQuaternion): TQuaternion;
begin
  result.A := Left + Right.A;
  result.B := Right.B;
  result.C := Right.C;
  result.D := Right.D;
end;

class operator TQuaternion.Subtract(Left, Right: TQuaternion): TQuaternion;
begin
  result.A := Left.A - Right.A;
  result.B := Left.B - Right.B;
  result.C := Left.C - Right.C;
  result.D := Left.D - Right.D;
end;

class operator TQuaternion.Multiply(Left, Right: TQuaternion): TQuaternion;
begin
  result.A := Left.A * Right.A - Left.B * Right.B - Left.C * Right.C - Left.D * Right.D;
  result.B := Left.A * Right.B + Left.B * Right.A + Left.C * Right.D - Left.D * Right.C;
  result.C := Left.A * Right.C - Left.B * Right.D + Left.C * Right.A + Left.D * Right.B;
  result.D := Left.A * Right.D + Left.B * Right.C - Left.C * Right.B + Left.D * Right.A;
end;

class operator TQuaternion.Multiply(Left: double; Right: TQuaternion): TQuaternion;
begin
  result.A := Left * Right.A;
  result.B := Left * Right.B;
  result.C := Left * Right.C;
  result.D := Left * Right.D;
end;

class operator TQuaternion.Multiply(Left: TQuaternion; Right: double): TQuaternion;
begin
  result.A := Left.A * Right;
  result.B := Left.B * Right;
  result.C := Left.C * Right;
  result.D := Left.D * Right;
end;

function TQuaternion.ToString: string;
begin
  result := Format('%f + %fi + %fj + %fk', [A, B, C, D]);
end;

end.


module triples
  implicit none

  integer :: max_peri, prim, total
  integer :: u(9,3) = reshape((/ 1, -2, 2,  2, -1, 2,  2, -2, 3, &
                                 1,  2, 2,  2,  1, 2,  2,  2, 3, &
                                -1,  2, 2, -2,  1, 2, -2,  2, 3 /), &
                                (/ 9, 3 /))

contains

recursive subroutine new_tri(in)
  integer, intent(in) :: in(:)
  integer :: i
  integer :: t(3), p

  p = sum(in)
  if (p > max_peri) return

  prim = prim + 1
  total = total + max_peri / p
  do i = 1, 3
    t(1) = sum(u(1:3, i) * in)
    t(2) = sum(u(4:6, i) * in)
    t(3) = sum(u(7:9, i) * in)
    call new_tri(t);
  end do
end subroutine new_tri
end module triples

program Pythagorean
  use triples
  implicit none

  integer :: seed(3) = (/ 3, 4, 5 /)

  max_peri = 10
  do
    total = 0
    prim = 0
    call new_tri(seed)
    write(*, "(a, i10, 2(i10, a))") "Up to", max_peri, total, " triples",  prim, " primitives"
    if(max_peri == 100000000) exit
    max_peri = max_peri * 10
  end do
end program Pythagorean


import java.awt.*;
import java.awt.geom.Path2D;
import javax.swing.*;

public class PythagorasTree extends JPanel {
    final int depthLimit = 7;
    float hue = 0.15f;

    public PythagorasTree() {
        setPreferredSize(new Dimension(640, 640));
        setBackground(Color.white);
    }

    private void drawTree(Graphics2D g, float x1, float y1, float x2, float y2,
            int depth) {

        if (depth == depthLimit)
            return;

        float dx = x2 - x1;
        float dy = y1 - y2;

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

        Path2D square = new Path2D.Float();
        square.moveTo(x1, y1);
        square.lineTo(x2, y2);
        square.lineTo(x3, y3);
        square.lineTo(x4, y4);
        square.closePath();

        g.setColor(Color.getHSBColor(hue + depth * 0.02f, 1, 1));
        g.fill(square);
        g.setColor(Color.lightGray);
        g.draw(square);

        Path2D triangle = new Path2D.Float();
        triangle.moveTo(x3, y3);
        triangle.lineTo(x4, y4);
        triangle.lineTo(x5, y5);
        triangle.closePath();

        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);
    }

    @Override
    public void paintComponent(Graphics g) {
        super.paintComponent(g);
        drawTree((Graphics2D) g, 275, 500, 375, 500, 0);
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("Pythagoras Tree");
            f.setResizable(false);
            f.add(new PythagorasTree(), BorderLayout.CENTER);
            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}


interface Quaternion guards QS {}
def makeQuaternion(a, b, c, d) {
    return def quaternion implements QS {

        to __printOn(out) {
            out.print("(", a, " + ", b, "i + ")
            out.print(c, "j + ", d, "k)")
        }

        # Task requirement 1
        to norm() {
            return (a**2 + b**2 + c**2 + d**2).sqrt()
        }

        # Task requirement 2
        to negate() {
            return makeQuaternion(-a, -b, -c, -d)
        }

        # Task requirement 3
        to conjugate() {
            return makeQuaternion(a, -b, -c, -d)
        }

        # Task requirement 4, 5
        # This implements q + r; r + q is deliberately prohibited by E
        to add(other :any[Quaternion, int, float64]) {
            switch (other) {
              match q :Quaternion {
                return makeQuaternion(
                    a+q.a(), b+q.b(), c+q.c(), d+q.d())
              }
              match real {
                return makeQuaternion(a+real, b, c, d)
              }
            }
        }

        # Task requirement 6, 7
        # This implements q * r; r * q is deliberately prohibited by E
        to multiply(other :any[Quaternion, int, float64]) {
            switch (other) {
                match q :Quaternion {
                    return makeQuaternion(
                        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())
                    }
                match real {
                    return makeQuaternion(real*a, real*b, real*c, real*d)
                }
            }
        }

        to a() { return a }
        to b() { return b }
        to c() { return c }
        to d() { return d }
    }
}


' version 30-05-2016
' compile with: fbc -s console

' primitive pythagoras triples
' a = m^2 - n^2, b = 2mn, c = m^2 + n^2
' m, n are positive integers and m > n
' m - n = odd and GCD(m, n) = 1
' p = a + b + c

' max m for give perimeter
' p = m^2 - n^2 + 2mn + m^2 + n^2
' p = 2mn + m^2 + m^2 + n^2 - n^2 = 2mn + 2m^2
' m >> n and n = 1 ==> p = 2m + 2m^2 = 2m(1 + m)
' m >> 1 ==> p = 2m(m) = 2m^2
' max m for given perimeter = sqr(p / 2)

Function gcd(x As UInteger, y As UInteger) As UInteger

    Dim As UInteger t

    While y
        t = y
        y = x Mod y
        x = t
    Wend
    Return x

End Function

Sub pyth_trip(limit As ULongInt, ByRef trip As ULongInt, ByRef prim As ULongInt)

    Dim As ULongInt perimeter, lby2 = limit Shr 1
    Dim As UInteger m, n
    Dim As ULongInt a, b, c

    For m = 2 To Sqr(limit / 2)
        For n = 1 + (m And 1) To (m - 1) Step 2
            ' common divisor, try next n
            If (gcd(m, n) > 1) Then Continue For
            a = CULngInt(m) * m - n * n
            b = CULngInt(m) * n * 2
            c = CULngInt(m) * m + n * n
            perimeter = a + b + c
            ' perimeter > limit, since n goes up try next m
            If perimeter >= limit Then Continue For, For
            prim += 1
            If perimeter < lby2 Then
                trip += limit \ perimeter
            Else
                trip += 1
            End If
        Next n
    Next m

End Sub

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

Dim As String str1, buffer = Space(14)
Dim As ULongInt limit, trip, prim
Dim As Double t, t1 = Timer

Print "below           triples   primitive            time"
Print

For x As UInteger = 1 To 12
    t = Timer
    limit = 10 ^ x : trip = 0 : prim = 0
    pyth_trip(limit, trip, prim)
    LSet buffer, Str(prim) : str1 = buffer
    Print Using "10^##  ################   "; x; trip;
    If x > 7 Then
        Print str1;
        Print Using "  ######.## sec."; Timer - t
    Else
        Print str1
    End If
Next x

Print : Print
Print Using "Total time needed #######.## sec."; Timer - t1

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


<!DOCTYPE html>
<html lang="en">

<head>
    <meta charset="UTF-8">
    <style>
        canvas {
            position: absolute;
            top: 45%;
            left: 50%;
            width: 640px;
            height: 640px;
            margin: -320px 0 0 -320px;
        }
    </style>
</head>

<body>
    <canvas></canvas>
    <script>
        'use strict';
        var canvas = document.querySelector('canvas');
        canvas.width = 640;
        canvas.height = 640;

        var g = canvas.getContext('2d');

        var depthLimit = 7;
        var hue = 0.15;

        function 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);

            g.beginPath();
            g.moveTo(x1, y1);
            g.lineTo(x2, y2);
            g.lineTo(x3, y3);
            g.lineTo(x4, y4);
            g.closePath();

            g.fillStyle = HSVtoRGB(hue + depth * 0.02, 1, 1);
            g.fill();
            g.strokeStyle = "lightGray";
            g.stroke();

            g.beginPath();
            g.moveTo(x3, y3);
            g.lineTo(x4, y4);
            g.lineTo(x5, y5);
            g.closePath();

            g.fillStyle = HSVtoRGB(hue + depth * 0.035, 1, 1);
            g.fill();
            g.strokeStyle = "lightGray";
            g.stroke();

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

        /* copied from stackoverflow */
        function HSVtoRGB(h, s, v) {
            var r, g, b, i, f, p, q, t;

            i = Math.floor(h * 6);
            f = h * 6 - i;
            p = v * (1 - s);
            q = v * (1 - f * s);
            t = v * (1 - (1 - f) * s);
            switch (i % 6) {
                case 0: r = v, g = t, b = p; break;
                case 1: r = q, g = v, b = p; break;
                case 2: r = p, g = v, b = t; break;
                case 3: r = p, g = q, b = v; break;
                case 4: r = t, g = p, b = v; break;
                case 5: r = v, g = p, b = q; break;
            }
            return "rgb("
                + Math.round(r * 255) + ","
                + Math.round(g * 255) + ","
                + Math.round(b * 255) + ")";
        }

        function draw() {
            g.clearRect(0, 0, canvas.width, canvas.height);
            drawTree(275, 500, 375, 500, 0);
        }
        draw();
    </script>

</body>

</html>


#import <Foundation/Foundation.h>

interface Quaternion : Number
  // Properties -- note that this is an immutable class.
  double real, i, j, k {readonly}
end

implementation Quaternion

  initWithReal: double, i: double, j: double, k: double, return instancetype
    self = super.init
    if self
      _real = real; _i = i; _j = j; _k = k
    return self

  +new: double real, ..., return instancetype
    va_list args
    va_start(args, real)
    object := Quaternion.alloc.initWithReal: real,
                                          i: va_arg(args, double),
                                          j: va_arg(args, double),
                                          k: va_arg(args, double)
    va_end(args)
    return object

  descriptionWithLocale: id, return String = String.stringWithFormat:
      '(%.1f, %.1f, %.1f, %.1f)', self.real, self.i, self.j, self.k

  norm, return double =
      sqrt(self.real * self.real +
           self.i * self.i + self.j * self.j + self.k * self.k)

  negative, return Quaternion =
      Quaternion.new: -self.real, -self.i, -self.j, -self.k

  conjugate, return Quaternion =
      Quaternion.new: self.real, -self.i, -self.j, -self.k

  // Overload "+" operator (left operand is Quaternion)
  plus: Number operand, return Quaternion
    real := self.real, i = self.i, j = self.j, k = self.k
    if operand.isKindOfClass: Quaternion.class
      q := (Quaternion)operand
      real += q.real; i += q.i; j += q.j; k += q.k
    else
      real += (double)operand
    return Quaternion.new: real, i, j, k

  // Overload "*" operator (left operand is Quaternion)
  multipliedBy: Number operand, return Quaternion
    real := self.real, i = self.i, j = self.j, k = self.k
    if operand.isKindOfClass: Quaternion.class
      q := (Quaternion)operand
      real = self.real * q.real - self.i* q.i - self.j * q.j - self.k * q.k
      i = self.real * q.i + self.i * q.real + self.j * q.k - self.k * q.j
      j = self.real * q.j - self.i * q.k + self.j * q.real + self.k * q.i
      k = self.real * q.k + self.i * q.j - self.j * q.i + self.k * q.real
    else
      real *= (double)operand
      i *= (double)operand; j *= (double)operand; k *= (double)operand
    return Quaternion.new: real, i, j, k

end

implementation Number (QuaternionOperators)

  // Overload "+" operator (left operand is Number)
  plus: Quaternion operand, return Quaternion
    real := (double)self + operand.real
    return Quaternion.new: real, operand.i, operand.j, operand.k

  // Overload "*" operator (left operand is Number)
  multipliedBy: Quaternion operand, return Quaternion
    r := (double)self
    return Quaternion.new: r * operand.real, r * operand.i,
                           r * operand.j, r * operand.k

end

int main()
  autoreleasepool

    q  := Quaternion.new: 1.0, 2.0, 3.0, 4.0
    q1 := Quaternion.new: 2.0, 3.0, 4.0, 5.0
    q2 := Quaternion.new: 3.0, 4.0, 5.0, 6.0

    Log( 'q  = %@', q )
    Log( 'q1 = %@', q1 )
    Log( 'q2 = %@\n\n', q2 )

    Log( 'q norm = %.3f',  q.norm )
    Log( 'q negative = %@',  q.negative )
    Log( 'q conjugate = %@',  q.conjugate )
    Log( '7 + q = %@', 7.0 + q )
    Log( 'q + 7 = %@', q + 7.0 )
    Log( 'q1 + q2 = %@',  q1 + q2 )
    Log( '7 * q = %@', 7 * q)
    Log( 'q * 7 = %@', q * 7.0 )
    Log( 'q1 * q2 = %@',  q1 * q2 )
    Log( 'q2 * q1 = %@',  q2 * q1 )

  return 0


package main

import "fmt"

var total, prim, maxPeri int64

func newTri(s0, s1, s2 int64) {
    if p := s0 + s1 + s2; p <= maxPeri {
        prim++
        total += maxPeri / p
        newTri(+1*s0-2*s1+2*s2, +2*s0-1*s1+2*s2, +2*s0-2*s1+3*s2)
        newTri(+1*s0+2*s1+2*s2, +2*s0+1*s1+2*s2, +2*s0+2*s1+3*s2)
        newTri(-1*s0+2*s1+2*s2, -2*s0+1*s1+2*s2, -2*s0+2*s1+3*s2)
    }
}

func main() {
    for maxPeri = 100; maxPeri <= 1e11; maxPeri *= 10 {
        prim = 0
        total = 0
        newTri(3, 4, 5)
        fmt.Printf("Up to %d:  %d triples, %d primitives\n",
            maxPeri, total, prim)
    }
}


# viewBox = <min-x> <min-y> <width> <height>
# Input: {svg, minx, miny, maxx, maxy}
def svg:
  "<svg viewBox='\(.minx - 4|floor) \(.miny - 4 |floor) \(6 + .maxx - .minx|ceil) \(6 + .maxy - .miny|ceil)'",
  "     preserveAspectRatio='xMinYmin meet'",
  "     xmlns='http://www.w3.org/2000/svg' >",
  .svg,
  "</svg>";

def minmax($xy):
    .minx = ([.minx, $xy[0]]|min)
  | .miny = ([.miny, $xy[1]]|min)
  | .maxx = ([.maxx, $xy[0]]|max)
  | .maxy = ([.maxy, $xy[1]]|max) ;

# default values for $fill and $stroke are provided
def Polygon( $ary; $fill; $stroke):
  def rnd: 1000*.|round/1000;
  ($fill // "none") as $fill
  | ($stroke // "black") as $stroke
  | ($ary | map(rnd) | join(" ")) as $a
  | .svg += "\n<polygon points='\($a)' fill='\($fill)' stroke='\($stroke)' />"
  | minmax($ary | [ ([ .[ range(0;length;2)]] |min),  ([ .[range(1;length;2)]]|min) ] )
  | minmax($ary | [ ([ .[ range(0;length;2)]] |max),  ([ .[range(1;length;2)]]|max) ] ) ;

def Square($A; $B; $C; $D; $fill; $stroke):
  Polygon( $A + $B + $C + $D; $fill; $stroke);

def Triangle($A; $B; $C; $fill; $stroke):
  Polygon( $A + $B + $C; $fill; $stroke);

def PythagorasTree:

  def drawTree($x1; $y1; $x2; $y2; $depth):
    if $depth <= 0 then .
    else ($x2 - $x1) as $dx
         | ($y1 - $y2) as $dy
         | ($x2 - $dy) as $x3
	 | ($y2 - $dx) as $y3
         | ($x1 - $dy) as $x4
         | ($y1 - $dx)  as $y4
	 | ($x4 + 0.5 * ($dx - $dy)) as $x5
         | ($y4 - 0.5 * ($dx + $dy)) as $y5

         # draw a square
	 | "rgb(\(256 - $depth * 20), 0, 0)" as $col
         | Square([$x1, $y1]; [$x2, $y2]; [$x3, $y3] ;  [$x4, $y4] ; $col; "lightgray")

         # draw a triangle
         | "rgb( 128, \(256 - $depth * 20), 128)" as $col
         | Triangle([$x3, $y3]; [$x4, $y4];  [$x5, $y5];  $col; "lightgray")
         | drawTree($x4; $y4; $x5; $y5; $depth - 1)
         | drawTree($x5; $y5; $x3; $y3; $depth - 1)
    end ;

  {svg: "", minx: infinite, miny: infinite, maxx: -infinite, maxy: -infinite}
  | drawTree(275; 500; 375; 500; 7);

PythagorasTree | svg


using Gadfly
using DataFrames

const xarray = zeros(Float64, 80000)
const yarray = zeros(Float64, 80000)
const arraypos = ones(Int32,1)
const maxdepth = zeros(Int32, 1)

function addpoints(x1, y1, x2, y2)
    xarray[arraypos[1]] = x1
    xarray[arraypos[1]+1] = x2
    yarray[arraypos[1]] = y1
    yarray[arraypos[1]+1] = y2
    arraypos[1] += 2
end

function pythtree(ax, ay, bx, by, depth)
    if(depth > maxdepth[1])
        return
    end
    dx=bx-ax; dy=ay-by;
    x3=bx-dy; y3=by-dx;
    x4=ax-dy; y4=ay-dx;
    x5=x4+(dx-dy)/2; y5=y4-(dx+dy)/2;
    addpoints(ax, ay, bx, by)
    addpoints(bx, by, x3, y3)
    addpoints(x3, y3, x4, y4)
    addpoints(x4, y4, ax, ay)
    pythtree(x4, y4, x5, y5, depth + 1)
    pythtree(x5, y5, x3, y3, depth + 1)
end

function pythagorastree(x1, y1, x2, y2, size, maxdep)
    maxdepth[1] = maxdep
    println("Pythagoras Tree, depth $(maxdepth[1]), size $size, starts at ($x1, $y1, $x2, $y2)");
    pythtree(x1, y1, x2, y2, 0);
    df = DataFrame(x=xarray[1:arraypos[1]-1], y=-yarray[1:arraypos[1]-1])
    plot(df, x=:x, y=:y, Geom.path(), Theme(default_color="green", point_size=0.4mm))
end

pythagorastree(275.,500.,375.,500.,640., 9)


// version 1.1.2

import java.awt.*
import java.awt.geom.Path2D
import javax.swing.*

class PythagorasTree : JPanel() {
    val depthLimit = 7
    val hue = 0.15f

    init {
        preferredSize = Dimension(640, 640)
        background = Color.white
    }

    private fun drawTree(g: Graphics2D, x1: Float, y1: Float,
                                        x2: Float, y2: Float, depth: Int) {
        if (depth == depthLimit) return

        val dx = x2 - x1
        val dy = y1 - y2

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

        val square = Path2D.Float()
        with (square) {
            moveTo(x1, y1)
            lineTo(x2, y2)
            lineTo(x3, y3)
            lineTo(x4, y4)
            closePath()
        }

        g.color = Color.getHSBColor(hue + depth * 0.02f, 1.0f, 1.0f)
        g.fill(square)
        g.color = Color.lightGray
        g.draw(square)

        val triangle = Path2D.Float()
        with (triangle) {
            moveTo(x3, y3)
            lineTo(x4, y4)
            lineTo(x5, y5)
            closePath()
        }

        g.color = Color.getHSBColor(hue + depth * 0.035f, 1.0f, 1.0f)
        g.fill(triangle)
        g.color = Color.lightGray
        g.draw(triangle)

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

    override fun paintComponent(g: Graphics) {
        super.paintComponent(g)
        drawTree(g as Graphics2D, 275.0f, 500.0f, 375.0f, 500.0f, 0)
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        with (f) {
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            title = "Pythagoras Tree"
            isResizable = false
            add(PythagorasTree(), BorderLayout.CENTER)
            pack()
            setLocationRelativeTo(null);
            setVisible(true)
        }
    }
}


import system'math;
import extensions;
import extensions'text;

struct Quaternion
{
    rprop real A;
    rprop real B;
    rprop real C;
    rprop real D;

    constructor new(a, b, c, d)
        <= new(cast real(a), cast real(b), cast real(c), cast real(d));

    constructor new(real a, real b, real c, real d)
    {
        A := a;
        B := b;
        C := c;
        D := d
    }

    constructor(real r)
    {
        A := r;
        B := 0.0r;
        C := 0.0r;
        D := 0.0r
    }

    real Norm = (A*A + B*B + C*C + D*D).sqrt();

    Quaternion Negative = Quaternion.new(A.Negative,B.Negative,C.Negative,D.Negative);

    Quaternion Conjugate = Quaternion.new(A,B.Negative,C.Negative,D.Negative);

    Quaternion add(Quaternion q)
        = Quaternion.new(A + q.A, B + q.B, C + q.C, D + q.D);

    Quaternion multiply(Quaternion q)
        = Quaternion.new(
            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);

    Quaternion add(real r)
        <= add(Quaternion.new(r,0,0,0));

    Quaternion multiply(real r)
        <= multiply(Quaternion.new(r,0,0,0));

    bool equal(Quaternion q)
        = (A == q.A) && (B == q.B) && (C == q.C) && (D == q.D);

    string toPrintable()
        = new StringWriter().printFormatted("Q({0}, {1}, {2}, {3})",A,B,C,D);
}

public program()
{
    auto q := Quaternion.new(1,2,3,4);
    auto q1 := Quaternion.new(2,3,4,5);
    auto q2 := Quaternion.new(3,4,5,6);
    real r := 7;

    console.printLine("q = ", q);
    console.printLine("q1 = ", q1);
    console.printLine("q2 = ", q2);
    console.printLine("r = ", r);

    console.printLine("q.Norm() = ", q.Norm);
    console.printLine("q1.Norm() = ", q1.Norm);
    console.printLine("q2.Norm() = ", q2.Norm);

    console.printLine("-q = ", q.Negative);
    console.printLine("q.Conjugate() = ", q.Conjugate);

    console.printLine("q + r = ", q + r);
    console.printLine("q1 + q2 = ", q1 + q2);
    console.printLine("q2 + q1 = ", q2 + q1);

    console.printLine("q * r = ", q * r);
    console.printLine("q1 * q2 = ", q1 * q2);
    console.printLine("q2 * q1 = ", q2 * q1);

    console.printLineFormatted("q1*q2 {0} q2*q1", ((q1 * q2) == (q2 * q1)).iif("==","!="))
}


PROGRAM QUATERNION

!$DOUBLE

TYPE QUATERNION=(A,B,C,D)

DIM Q:QUATERNION,Q1:QUATERNION,Q2:QUATERNION

DIM R:QUATERNION,S:QUATERNION,T:QUATERNION

PROCEDURE NORM(T.->NORM)
   NORM=SQR(T.A*T.A+T.B*T.B+T.C*T.C+T.D*T.D)
END PROCEDURE

PROCEDURE NEGATIVE(T.->T.)
    T.A=-T.A
    T.B=-T.B
    T.C=-T.C
    T.D=-T.D
END PROCEDURE

PROCEDURE CONJUGATE(T.->T.)
    T.A=T.A
    T.B=-T.B
    T.C=-T.C
    T.D=-T.D
END PROCEDURE

PROCEDURE ADD_REAL(T.,REAL->T.)
    T.A=T.A+REAL
    T.B=T.B
    T.C=T.C
    T.D=T.D
END PROCEDURE

PROCEDURE ADD(T.,S.->T.)
    T.A=T.A+S.A
    T.B=T.B+S.B
    T.C=T.C+S.C
    T.D=T.D+S.D
END PROCEDURE

PROCEDURE MULT_REAL(T.,REAL->T.)
    T.A=T.A*REAL
    T.B=T.B*REAL
    T.C=T.C*REAL
    T.D=T.D*REAL
END PROCEDURE

PROCEDURE MULT(T.,S.->R.)
    R.A=T.A*S.A-T.B*S.B-T.C*S.C-T.D*S.D
    R.B=T.A*S.B+T.B*S.A+T.C*S.D-T.D*S.C
    R.C=T.A*S.C-T.B*S.D+T.C*S.A+T.D*S.B
    R.D=T.A*S.D+T.B*S.C-T.C*S.B+T.D*S.A
END PROCEDURE

PROCEDURE PRINTQ(T.)
    PRINT("(";T.A;",";T.B;",";T.C;",";T.D;")")
END PROCEDURE

BEGIN
    Q.A=1  Q.B=2  Q.C=3  Q.D=4
    Q1.A=2 Q1.B=3 Q1.C=4 Q1.D=5
    Q2.A=3 Q2.B=4 Q2.C=5 Q2.D=6
    REAL=7

    NORM(Q.->NORM)
    PRINT("Norm(q)=";NORM)

    NEGATIVE(Q.->T.)
    PRINT("Negative(q) =";)
    PRINTQ(T.)

    CONJUGATE(Q.->T.)
    PRINT("Conjugate(q) =";)
    PRINTQ(T.)

    ADD_REAL(Q.,REAL->T.)
    PRINT("q + real =";)
    PRINTQ(T.)

! addition is commutative
    ADD(Q1.,Q2.->T.)
    PRINT("q1 + q2 =";)
    PRINTQ(T.)

    ADD(Q2.,Q1.->T.)
    PRINT("q2 + q1 = ";)
    PRINTQ(T.)

    MULT_REAL(Q.,REAL->T.)
    PRINT("q * real =";)
    PRINTQ(T.)

! multiplication is not commutative
    MULT(Q1.,Q2.->R.)
    PRINT("q1 * q2=";)
    PRINTQ(R.)

    MULT(Q2.,Q1.->R.)
    PRINT("q2 * q1=";)
    PRINTQ(R.)
END PROGRAM


class Triple {
    BigInteger a, b, c
    def getPerimeter() { this.with { a + b + c } }
    boolean isValid() { this.with { a*a + b*b == c*c } }
}

def initCounts (def n = 10) {
    (n..1).collect { 10g**it }.inject ([:]) { Map map, BigInteger perimeterLimit ->
        map << [(perimeterLimit): [primative: 0g, total: 0g]]
    }
}

def findPythagTriples, findChildTriples

findPythagTriples = {Triple t = new Triple(a:3, b:4, c:5), Map counts = initCounts() ->
    def p = t.perimeter
    def currentCounts = counts.findAll { pLimit, tripleCounts -> p <= pLimit }
    if (! currentCounts || ! t.valid) { return }
    currentCounts.each { pLimit, tripleCounts ->
        tripleCounts.with { primative ++; total += pLimit.intdiv(p) }
    }
    findChildTriples(t, currentCounts)
    counts
}

findChildTriples = { Triple t, Map counts ->
    t.with {
        [
            [ 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],
            [-a + 2*b + 2*c, -2*a + b + 2*c, -2*a + 2*b + 3*c]
        ]*.sort().each { aa, bb, cc ->
            findPythagTriples(new Triple(a:aa, b:bb, c:cc), counts)
        }
    }
}


MODULE Pythagoras_tree {
	CLS 5, 0  ' MAGENTA, NO SPLIT SCREEN
	PEN 14   ' YELLOW
	\\ code from zkl/Free Basic
	LET w = scale.x, h = w * 11 div 16
	LET w2 = w div 2, diff = w div 12
	LET TreeOrder = 6
	pythagoras_tree(w2 - diff, h -10, w2 + diff, h -10, 0)

	SUB pythagoras_tree(x1, y1, x2, y2, depth)

	    IF depth > TreeOrder THEN EXIT SUB

	    LOCAL dx = x2 - x1, dy = y1 - y2
	    LOCAL x3 = x2 - dy, y3 = y2 - dx
	    LOCAL x4 = x1 - dy, y4 = y1 - dx
	    LOCAL x5 = x4 + (dx - dy) / 2
	    LOCAL y5 = y4 - (dx + dy) / 2
	    MOVE x1, y1
	    DRAW TO x2, y2
	    DRAW TO x3, y3
	    DRAW TO x4, y4
	    DRAW TO x1, y1
	    pythagoras_tree(x4, y4, x5, y5, depth +1)
	    pythagoras_tree(x5, y5, x3, y3, depth +1)

	END SUB
}
Pythagoras_tree


n = 7;
colors = Blend[{Orange, Yellow, Green}, #] & /@ Subdivide[n - 1];
ClearAll[NextConfigs, NewConfig]
NewConfig[b1_List, b2_List] := Module[{diff, perp},
  diff = b2 - b1;
  perp = Cross[b2 - b1];
  <|"quad" -> Polygon[{b1, b2, b2 + perp, b1 + perp}], "triang" -> Polygon[{b1 + 1.5 perp + diff/2, b1 + perp, b2 + perp}]|>
  ]
NextConfigs[config_Association] := Module[{tr},
  tr = config["triangs"][[All, 1]];
  tr = Join[NewConfig @@@ tr[[All, {2, 1}]], NewConfig @@@ tr[[All, {1, 3}]]];
  <|"quads" -> tr[[All, "quad"]], "triangs" -> tr[[All, "triang"]]|>
  ]
nc = NewConfig[{-0.5, 0.0}, {0.5, 0.0}];
config = <|"quads" -> {nc["quad"]}, "triangs" -> {nc["triang"]}|>;
config = NestList[NextConfigs, config, n - 1];
Graphics[MapThread[{EdgeForm[Black], FaceForm[#2], #1["quads"], #1["triangs"]} &, {config, colors}]]


import imageman

const
  Width = 1920
  Height = 1080
  MaxDepth = 10
  Color = ColorRGBU([byte 0, 255, 0])

proc drawTree(img: var Image; x1, y1, x2, y2: int; depth: Natural) =

  if depth == 0: return

  let
    dx = x2 - x1
    dy = y1 - y2
    x3 = x2 - dy
    y3 = y2 - dx
    x4 = x1 - dy
    y4 = y1 - dx
    x5 = x4 + (dx - dy) div 2
    y5 = y4 - (dx + dy) div 2

  # Draw square.
  img.drawPolyline(true, Color, (x1, y1), (x2, y2), (x3, y3), (x4, y4))

  # Draw triangle.
  img.drawPolyline(true, Color, (x3, y3), (x4, y4), (x5, y5))

  # Next level.
  img.drawTree(x4, y4, x5, y5, depth - 1)
  img.drawTree(x5, y5, x3, y3, depth - 1)

var image = initImage[ColorRGBU](Width, Height)
image.drawTree(int(Width / 2.3), Height - 1, int(Width / 1.8), Height - 1, MaxDepth)
image.savePNG("pythagoras_tree.png", compression = 9)


(import (lib gl))
(import (OpenGL version-1-0))
(gl:set-window-size 700 600)
(gl:set-window-title "http://rosettacode.org/wiki/Pythagoras_tree")

(glLineWidth 2)
(gl:set-renderer (lambda (mouse)
   (glClear GL_COLOR_BUFFER_BIT)
   (glLoadIdentity)
   (glOrtho -3 4 -1 5 0 1)

   (let loop ((a '(0 . 0)) (b '(1 . 0)) (n 7))
      (unless (zero? n)
         (define dx (- (car b) (car a)))
         (define dy (- (cdr b) (cdr a)))
         (define c (cons
            (- (car b) dy)
            (+ (cdr b) dx)))
         (define d (cons
            (- (car a) dy)
            (+ (cdr a) dx)))
         (define e (cons
            (- (/ (+ (car c) (car d)) 2) (/ dy 2))
            (+ (/ (+ (cdr c) (cdr d)) 2) (/ dx 2))))

         (glColor3f 0 (+ 1/3 (/ 2/3 n)) 0)
         (glBegin GL_QUADS)
            (glVertex2f (car a) (cdr a))
            (glVertex2f (car b) (cdr b))
            (glVertex2f (car c) (cdr c))
            (glVertex2f (car d) (cdr d))
         (glEnd)
         (glColor3f 1 0 0)
         (glBegin GL_TRIANGLES)
            (glVertex2f (car c) (cdr c))
            (glVertex2f (car e) (cdr e))
            (glVertex2f (car d) (cdr d))
         (glEnd)
         (loop d e (- n 1))
         (loop e c (- n 1))
      ))
))


function norm(sequence q)
    return sqrt(power(q[1],2)+power(q[2],2)+power(q[3],2)+power(q[4],2))
end function

function conj(sequence q)
    q[2..4] = -q[2..4]
    return 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 q1+q2
end function

function mul(object q1, object q2)
    if sequence(q1) and sequence(q2) then
        return { q1[1]*q2[1] - q1[2]*q2[2] - q1[3]*q2[3] - q1[4]*q2[4],
                 q1[1]*q2[2] + q1[2]*q2[1] + q1[3]*q2[4] - q1[4]*q2[3],
                 q1[1]*q2[3] - q1[2]*q2[4] + q1[3]*q2[1] + q1[4]*q2[2],
                 q1[1]*q2[4] + q1[2]*q2[3] - q1[3]*q2[2] + q1[4]*q2[1] }
    else
        return 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 = {5, 6, 7, 8},
    r  = 7

printf(1, "norm(q) = %g\n", norm(q))
printf(1, "-q = %s\n", {quats(-q)})
printf(1, "conj(q) = %s\n", {quats(conj(q))})
printf(1, "q + r = %s\n", {quats(add(q,r))})
printf(1, "q1 + q2 = %s\n", {quats(add(q1,q2))})
printf(1, "q1 * q2 = %s\n", {quats(mul(q1,q2))})
printf(1, "q2 * q1 = %s\n", {quats(mul(q2,q1))})


pytr :: Int -> [(Bool, Int, Int, Int)]
pytr n =
  filter
    (\(_, a, b, c) -> a + b + c <= n)
    [ (prim a b c, a, b, c)
      | a <- xs,
        b <- drop a xs,
        c <- drop b xs,
        a ^ 2 + b ^ 2 == c ^ 2
    ]
  where
    xs = [1 .. n]
    prim a b _ = gcd a b == 1

main :: IO ()
main =
  putStrLn $
    "Up to 100 there are "
      <> show (length xs)
      <> " triples, of which "
      <> show (length $ filter (\(x, _, _, _) -> x) xs)
      <> " are primitive."
  where
    xs = pytr 100


\\ Pythagoras Tree (w/recursion)
\\ 4/11/16 aev
plotline(x1,y1,x2,y2)={plotmove(0, x1,y1);plotrline(0,x2-x1,y2-y1);}

pythtree(ax,ay,bx,by,d=0)={
my(dx,dy,x3,y3,x4,y4,x5,y5);
if(d>10, return());
dx=bx-ax; dy=ay-by;
x3=bx-dy; y3=by-dx;
x4=ax-dy; y4=ay-dx;
x5=x4+(dx-dy)\2; y5=y4-(dx+dy)\2;
plotline(ax,ay,bx,by);
plotline(bx,by,x3,y3);
plotline(x3,y3,x4,y4);
plotline(x4,y4,ax,ay);
pythtree(x4,y4,x5,y5,d+1);
pythtree(x5,y5,x3,y3,d+1);
}

PythagorTree(x1,y1,x2,y2,depth=9,size)={
my(dx=1,dy=0,ttlb="Pythagoras Tree, depth ",ttl=Str(ttlb,depth));
print1(" *** ",ttl); print(", size ",size);
print(" *** Start: ",x1,",",y1,",",x2,",",y2);
plotinit(0);
plotcolor(0,6); \\green
plotscale(0, -size,size, size,0 );
plotmove(0, 0,0);
pythtree(x1,y1, x2,y2);
plotdraw([0,size,size]);
}

{\\ Executing:
PythagorTree(275,500,375,500,9,640);    \\PythTree1.png
}


open System

[<Struct; StructuralEquality; NoComparison>]
type Quaternion(r : float, i : float, j : float, k : float) =
    member this.A = r
    member this.B = i
    member this.C = j
    member this.D = k

    new (f : float) = Quaternion(f, 0., 0., 0.)

    static member (~-) (q : Quaternion) = Quaternion(-q.A, -q.B, -q.C, -q.D)

    static member (+) (q1 : Quaternion, q2 : Quaternion) =
        Quaternion(q1.A + q2.A, q1.B + q2.B, q1.C + q2.C, q1.D + q2.D)
    static member (+) (q : Quaternion, r : float) = q + Quaternion(r)
    static member (+) (r : float, q: Quaternion) = Quaternion(r) + q

    static member (*) (q1 : Quaternion, q2 : Quaternion) =
        Quaternion(
            q1.A * q2.A - q1.B * q2.B - q1.C * q2.C - q1.D * q2.D,
            q1.A * q2.B + q1.B * q2.A + q1.C * q2.D - q1.D * q2.C,
            q1.A * q2.C - q1.B * q2.D + q1.C * q2.A + q1.D * q2.B,
            q1.A * q2.D + q1.B * q2.C - q1.C * q2.B + q1.D * q2.A)
    static member (*) (q : Quaternion, r : float) = q * Quaternion(r)
    static member (*) (r : float, q: Quaternion) = Quaternion(r) * q

    member this.Norm = Math.Sqrt(r * r + i * i + j * j + k * k)

    member this.Conjugate = Quaternion(r, -i, -j, -k)

    override this.ToString() = sprintf "Q(%f, %f, %f, %f)" r i j k

[<EntryPoint>]
let main argv =
    let q = Quaternion(1., 2., 3., 4.)
    let q1 = Quaternion(2., 3., 4., 5.)
    let q2 = Quaternion(3., 4., 5., 6.)
    let r = 7.

    printfn "q = %A" q
    printfn "q1 = %A" q1
    printfn "q2 = %A" q2
    printfn "r = %A" r

    printfn "q.Norm = %A" q.Norm
    printfn "q1.Norm = %A" q1.Norm
    printfn "q2.Norm = %A" q2.Norm

    printfn "-q = %A" -q
    printfn "q.Conjugate = %A" q.Conjugate

    printfn "q + r = %A" (q + (Quaternion r))
    printfn "q1 + q2 = %A" (q1 + q2)
    printfn "q2 + q1 = %A" (q2 + q1)

    printfn "q * r = %A" (q * r)
    printfn "q1 * q2 = %A" (q1 * q2)
    printfn "q2 * q1 = %A" (q2 * q1)

    printfn "q1*q2 %s q2*q1" (if (q1 * q2) = (q2 * q1) then "=" else "<>")
    printfn "q %s Q(1.,2.,3.,4.)" (if q = Quaternion(1., 2., 3., 4.) then "=" else "<>")
    0


link numbers
link printf

procedure main(A)  # P-triples

   plimit := (0 < integer(\A[1])) | 100 # get perimiter limit

   nonprimitiveS := set()  # record unique non-primitives triples
   primitiveS := set()     # record unique primitive triples

   u :=  0
   while (g := (u +:= 1)^2) + 3 * u + 2 < plimit / 2 do {
      every v := seq(1) do {
         a := g + (i := 2*u*v)
         b := (h := 2*v^2) + i
         c := g + h + i
         if (p := a + b + c) > plimit then break

         insert( (gcd(u,v)=1 & u%2=1, primitiveS) | nonprimitiveS, memo(a,b,c))
         every k := seq(2) do {      # k is for larger non-primitives
            if k*p > plimit then break
            insert(nonprimitiveS,memo(a*k,b*k,c*k) )
            }
         }
      }

printf("Under perimiter=%d: Pythagorean Triples=%d including primitives=%d\n",
       plimit,*nonprimitiveS+*primitiveS,*primitiveS)

every put(gcol := []  , &collections)
printf("Time=%d, Collections: total=%d string=%d block=%d",&time,gcol[1],gcol[3],gcol[4])
end

procedure memo(x[]) #: return a csv string of arguments in sorted order
every (s := "") ||:= !sort(x) do s ||:= ","
return s[1:-1]
end


USING: generalizations io kernel locals math.quaternions
math.vectors prettyprint sequences ;
IN: rosetta-code.quaternion-type

: show ( quot -- )
    [ unparse 2 tail but-last "= " append write ] [ call . ] bi
    ; inline

: 2show ( quots -- )
    [ 2curry show ] map-compose [ call ] each ; inline

: q+n ( q n -- q+n ) n>q q+ ;

[let
    { 1 2 3 4 } 7 { 2 3 4 5 } { 3 4 5 6 } :> ( q r q1 q2 )
    q [ norm ]
    q [ vneg ]
    q [ qconjugate ]
    [ curry show ] [email protected]
    {
        [ q  r  [ q+n ] ]
        [ q  r  [ q*n ] ]
        [ q1 q2 [ q+  ] ]
        [ q1 q2 [ q*  ] ]
        [ q2 q1 [ q*  ] ]
    } 2show
]


: quaternions  4 * floats ;

: qvariable create 1 quaternions allot ;

: q! ( a b c d q -- )
  dup 3 floats + f!  dup 2 floats + f!  dup float+ f!  f! ;

: qcopy ( src dest -- ) 1 quaternions move ;

: qnorm  ( q -- f )
  0e 4 0 do  dup [email protected] fdup f* f+  float+ loop drop fsqrt ;

: qf* ( q f -- )
  4 0 do dup [email protected] fover f* dup f!  float+ loop fdrop drop ;

: qnegate ( q -- )  -1e qf* ;

: qconj ( q -- )
  float+ 3 0 do dup [email protected] fnegate dup f!  float+ loop drop ;

: qf+ ( q f -- ) dup [email protected] f+ f! ;

: q+ ( q1 q2 -- )
  4 0 do over [email protected] dup [email protected] f+ dup f!  float+ swap float+ swap loop 2drop ;

\ access
: q.a             [email protected] ;
: q.b      float+ [email protected] ;
: q.c  2 floats + [email protected] ;
: q.d  3 floats + [email protected] ;

: q* ( dest q1 q2 -- )
  over q.a dup q.d f*  over q.b dup q.c f* f+  over q.c dup q.b f* f-  over q.d dup q.a f* f+
  over q.a dup q.c f*  over q.b dup q.d f* f-  over q.c dup q.a f* f+  over q.d dup q.b f* f+
  over q.a dup q.b f*  over q.b dup q.a f* f+  over q.c dup q.d f* f+  over q.d dup q.c f* f-
  over q.a dup q.a f*  over q.b dup q.b f* f-  over q.c dup q.c f* f-  over q.d dup q.d f* f-
  2drop  4 0 do dup f!  float+ loop  drop ;

: q= ( q1 q2 -- ? )
  4 0 do
    over [email protected] dup [email protected] f<> if 2drop false unloop exit then
    float+ swap float+
  loop
  2drop true ;

\ testing

: q. ( q -- )
  [char] ( emit space
  4 0 do dup [email protected] f.  float+ loop drop
  [char] ) emit space ;

qvariable q   1e 2e 3e 4e q  q!
qvariable q1  2e 3e 4e 5e q1 q!
create q2     3e f, 4e f, 5e f, 6e f,	\ by hand

qvariable tmp
qvariable m1
qvariable m2

q qnorm f.				\ 5.47722557505166
q tmp qcopy  tmp qnegate  tmp q.	\ ( -1. -2. -3. -4. )
q tmp qcopy  tmp qconj    tmp q.	\ ( 1. -2. -3. -4. )

q m1 qcopy  m1 7e qf+   m1 q.		\ ( 8. 2. 3. 4. )
q m2 qcopy  7e m2 qf+   m2 q.		\ ( 8. 2. 3. 4. )
m1 m2 q= .				\ -1  (true)

q2 tmp qcopy  q1 tmp q+   tmp q.	\ ( 5. 7. 9. 11. )

q m1 qcopy  m1 7e qf*     m1 q.		\ ( 7. 14. 21. 28. )
q m2 qcopy  7e m2 qf*     m2 q.		\ ( 7. 14. 21. 28. )
m1 m2 q= .				\ -1  (true)

m1 q1 q2 q*  m1 q.			\ ( -56. 16. 24. 26. )
m2 q2 q1 q*  m2 q.			\ ( -56. 18. 20. 28. )
m1 m2 q= .				\ 0  (false)


import java.math.BigInteger;
import static java.math.BigInteger.ONE;

public class PythTrip{

    public static void main(String[] args){
        long tripCount = 0, primCount = 0;

        //change this to whatever perimeter limit you want;the RAM's the limit
        BigInteger periLimit = BigInteger.valueOf(100),
                peri2 = periLimit.divide(BigInteger.valueOf(2)),
                peri3 = periLimit.divide(BigInteger.valueOf(3));

        for(BigInteger a = ONE; a.compareTo(peri3) < 0; a = a.add(ONE)){
            BigInteger aa = a.multiply(a);

            for(BigInteger b = a.add(ONE);
                    b.compareTo(peri2) < 0; b = b.add(ONE)){
                BigInteger bb = b.multiply(b);
                BigInteger ab = a.add(b);
                BigInteger aabb = aa.add(bb);

                for(BigInteger c = b.add(ONE);
                        c.compareTo(peri2) < 0; c = c.add(ONE)){

                    int compare = aabb.compareTo(c.multiply(c));
                    //if a+b+c > periLimit
                    if(ab.add(c).compareTo(periLimit) > 0){
                        break;
                    }
                    //if a^2 + b^2 != c^2
                    if(compare < 0){
                        break;
                    }else if (compare == 0){
                        tripCount++;
                        System.out.print(a + ", " + b + ", " + c);

                        //does binary GCD under the hood
                        if(a.gcd(b).equals(ONE)){
                            System.out.print(" primitive");
                            primCount++;
                        }
                        System.out.println();
                    }
                }
            }
        }
        System.out.println("Up to a perimeter of " + periLimit + ", there are "
                + tripCount + " triples, of which " + primCount + " are primitive.");
    }
}


-- demo\rosetta\PythagorasTree.exw
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

enum FILL, BORDER

procedure drawTree(atom x1, y1, x2, y2, integer depth, dd)
    atom dx = x2 - x1,
         dy = y1 - y2,
         x3 = x2 - dy,
         y3 = y2 - dx,
         x4 = x1 - dy,
         y4 = y1 - dx,
         x5 = x4 + 0.5 * (dx - dy),
         y5 = y4 - 0.5 * (dx + dy)

    if depth=dd then
        integer r = 250-depth*20

        for draw=FILL to BORDER do
            -- one square...
            cdCanvasSetForeground(cddbuffer, iff(draw=FILL?rgb(r,#FF,0):CD_GRAY))
            integer mode = iff(draw=FILL?CD_FILL:CD_CLOSED_LINES)
            cdCanvasBegin(cddbuffer,mode)
            cdCanvasVertex(cddbuffer, x1, 640-y1)
            cdCanvasVertex(cddbuffer, x2, 640-y2)
            cdCanvasVertex(cddbuffer, x3, 640-y3)
            cdCanvasVertex(cddbuffer, x4, 640-y4)
            cdCanvasEnd(cddbuffer)
            -- ...and the attached triangle
            if draw=FILL then
                cdCanvasSetForeground(cddbuffer, rgb(r-depth*10,#FF,0))
            end if
            cdCanvasBegin(cddbuffer,mode)
            cdCanvasVertex(cddbuffer, x3, 640-y3)
            cdCanvasVertex(cddbuffer, x4, 640-y4)
            cdCanvasVertex(cddbuffer, x5, 640-y5)
            cdCanvasEnd(cddbuffer)
        end for
    elsif depth<dd then
        drawTree(x4, y4, x5, y5, depth + 1, dd)
        drawTree(x5, y5, x3, y3, depth + 1, dd)
    end if
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    cdCanvasActivate(cddbuffer)
    for i=0 to 7 do -- (draw leaves last)
        drawTree(275, 500, 375, 500, 0, i)
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_WHITE)
    cdCanvasSetForeground(cddbuffer, CD_RED)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()

    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "640x640")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

    dlg = IupDialog(canvas,"RESIZE=NO")
    IupSetAttribute(dlg, "TITLE", "Pythagoras Tree")

    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


module Q_mod
  implicit none

  type quaternion
    real :: a, b, c, d
  end type

  public :: norm, neg, conj
  public :: operator (+)
  public :: operator (*)

  private ::  q_plus_q, q_plus_r, r_plus_q, &
              q_mult_q, q_mult_r, r_mult_q, &
              norm_q, neg_q, conj_q

  interface norm
    module procedure norm_q
  end interface

  interface neg
    module procedure neg_q
  end interface

  interface conj
    module procedure conj_q
  end interface

  interface operator (+)
    module procedure q_plus_q, q_plus_r, r_plus_q
  end interface

  interface operator (*)
    module procedure q_mult_q, q_mult_r, r_mult_q
  end interface

contains

function norm_q(x) result(res)
  real :: res
  type (quaternion), intent (in) :: x

  res = sqrt(x%a*x%a + x%b*x%b + x%c*x%c + x%d*x%d)

end function norm_q

function neg_q(x) result(res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x

  res%a = -x%a
  res%b = -x%b
  res%c = -x%c
  res%d = -x%d

end function neg_q

function conj_q(x) result(res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x

  res%a = x%a
  res%b = -x%b
  res%c = -x%c
  res%d = -x%d

end function conj_q

function q_plus_q(x, y) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x, y

  res%a = x%a + y%a
  res%b = x%b + y%b
  res%c = x%c + y%c
  res%d = x%d + y%d

end function q_plus_q

function q_plus_r(x, r) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x
  real, intent(in) :: r

   res = x
   res%a = x%a + r

end function q_plus_r

function r_plus_q(r, x) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x
  real, intent(in) :: r

   res = x
   res%a = x%a + r

end function r_plus_q

function q_mult_q(x, y) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x, y

   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

end function q_mult_q

function q_mult_r(x, r) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x
  real, intent(in) ::  r

   res%a = x%a*r
   res%b = x%b*r
   res%c = x%c*r
   res%d = x%d*r

end function q_mult_r

function r_mult_q(r, x) result (res)
  type (quaternion) :: res
  type (quaternion), intent (in) :: x
  real, intent(in) ::  r

   res%a = x%a*r
   res%b = x%b*r
   res%c = x%c*r
   res%d = x%d*r

end function r_mult_q
end module Q_mod

program Quaternions
  use Q_mod
  implicit none

  real :: r = 7.0
  type(quaternion) :: q, q1, q2

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

  write(*, "(a, 4f8.3)") "             q = ", q
  write(*, "(a, 4f8.3)") "            q1 = ", q1
  write(*, "(a, 4f8.3)") "            q2 = ", q2
  write(*, "(a, f8.3)")  "             r = ", r
  write(*, "(a, f8.3)")  "     Norm of q = ", norm(q)
  write(*, "(a, 4f8.3)") " Negative of q = ", neg(q)
  write(*, "(a, 4f8.3)") "Conjugate of q = ", conj(q)
  write(*, "(a, 4f8.3)") "         q + r = ", q + r
  write(*, "(a, 4f8.3)") "         r + q = ", r + q
  write(*, "(a, 4f8.3)") "       q1 + q2 = ", q1 + q2
  write(*, "(a, 4f8.3)") "         q * r = ", q * r
  write(*, "(a, 4f8.3)") "         r * q = ", r * q
  write(*, "(a, 4f8.3)") "       q1 * q2 = ", q1 * q2
  write(*, "(a, 4f8.3)") "       q2 * q1 = ", q2 * q1

end program


(() => {
    "use strict";

    // Arguments: predicate, maximum perimeter
    // pythTripleCount :: ((Int, Int, Int) -> Bool) -> Int -> Int
    const pythTripleCount = p =>
        maxPerim => {
            const
                xs = enumFromTo(1)(
                    Math.floor(maxPerim / 2)
                );

            return xs.flatMap(
                x => xs.slice(x).flatMap(
                    y => xs.slice(y).flatMap(
                        z => ((x + y + z <= maxPerim) &&
                            ((x * x) + (y * y) === z * z) &&
                            p(x, y, z)) ? [
                            [x, y, z]
                        ] : []
                    )
                )
            ).length;
        };

    // ---------------------- TEST -----------------------
    const main = () => [10, 100, 1000]
        .map(n => ({
            maxPerimeter: n,
            triples: pythTripleCount(() => true)(n),
            primitives: pythTripleCount(
                (x, y) => gcd(x)(y) === 1
            )(n)
        }));

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

    // abs :: Num -> Num
    const abs =
        // Absolute value of a given number
        // without the sign.
        x => 0 > x ? (
            -x
        ) : x;

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

    // gcd :: Integral a => a -> a -> a
    const gcd = x =>
        y => {
            const zero = x.constructor(0);
            const go = (a, b) =>
                zero === b ? (
                    a
                ) : go(b, a % b);

            return go(abs(x), abs(y));
        };

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


void tree(float x1, float y1, float x2, float y2, int depth) {

  if (depth <= 0) {
    return;
  }

  float dx = (x2 - x1);
  float dy = (y1 - y2);

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

  // square
  beginShape();
  fill(0.0, 255.0/depth, 0.0);
  vertex(x1, y1);
  vertex(x2, y2);
  vertex(x3, y3);
  vertex(x4, y4);
  vertex(x1, y1);
  endShape();

  // triangle
  beginShape();
  fill(0.0, 255.0/depth, 0.0);
  vertex(x3, y3);
  vertex(x4, y4);
  vertex(x5, y5);
  vertex(x3, y3);
  endShape();

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

void setup() {
  size(1920, 1080);
  background(255);
  stroke(0, 255, 0);
  tree(width/2.3, height, width/1.8, height, 10);
}


EnableExplicit
DisableDebugger

Procedure.d maxXY(a.d,b.d,c.d,d.d)
  If a<b : Swap a,b : EndIf
  If a<c : Swap a,c : EndIf
  If a<d : Swap a,d : EndIf
  ProcedureReturn a
EndProcedure

Procedure.d minXY(a.d,b.d,c.d,d.d)
  If a>b : Swap a,b : EndIf
  If a>c : Swap a,c : EndIf
  If a>d : Swap a,d : EndIf
  ProcedureReturn a
EndProcedure

Procedure Ptree(x1.d, y1.d, x2.d, y2.d, d.i=0)
  If d>10 : ProcedureReturn : EndIf

  Define dx.d=x2-x1,
         dy.d=y1-y2,
         x3.d=x2-dy,
         y3.d=y2-dx,
         x4.d=x1-dy,
         y4.d=y1-dx,
         x5.d=x4+(dx-dy)/2.0,
         y5.d=y4-(dx+dy)/2.0,
         p1.d=(maxXY(x1,x2,x3,x4)+minXY(x1,x2,x3,x4))/2.0,
         p2.d=(maxXY(y1,y2,y3,y4)+minXY(y1,y2,y3,y4))/2.0,
         p3.d=(maxXY(x1,x2,x3,x4)-minXY(x1,x2,x3,x4))

  FrontColor(RGB(Random(125,1),Random(255,125),Random(125,1)))
  LineXY(x1,y1,x2,y2)
  LineXY(x2,y2,x3,y3)
  LineXY(x3,y3,x4,y4)
  LineXY(x4,y4,x1,y1)
  BoxedGradient(minXY(x1,x2,x3,x4),minXY(y1,y2,y3,y4),p3,p3)
  FillArea(p1,p2,-1)

  Ptree(x4,y4,x5,y5,d+1)
  Ptree(x5,y5,x3,y3,d+1)

EndProcedure

Define w1.i=800,
       h1.i=w1*11/16,
       w2.i=w1/2,
       di.i=w1/12

If OpenWindow(0,#PB_Ignore,#PB_Ignore,w1,h1,"Pythagoras tree")
  If CreateImage(0,w1,h1,24,0) And StartDrawing(ImageOutput(0))
    DrawingMode(#PB_2DDrawing_Gradient)
    BackColor($000000)
    Ptree(w2-di,h1-10,w2+di,h1-10)
    StopDrawing()
  EndIf
  ImageGadget(0,0,0,0,0,ImageID(0))
  Repeat : Until WaitWindowEvent(50)=#PB_Event_CloseWindow
EndIf
End


Dim Shared As Integer q(3)  = {1, 2, 3, 4}
Dim Shared As Integer q1(3) = {2, 3, 4, 5}
Dim Shared As Integer q2(3) = {3, 4, 5, 6}
Dim Shared As Integer i, r = 7, t(3)

Function q_norm(q() As Integer) As Double
    ' medida o valor absoluto de un cuaternión
    Dim As Double a = 0
    For i = 0 To 3
        a += q(i)^2
    Next i
    Return Sqr(a)
End Function

Sub q_neg(q() As Integer)
    For i = 0 To 3
        q(i) *= -1
    Next i
End Sub

Sub q_conj(q() As Integer)
    ' conjugado de un cuaternión
    For i = 1 To 3
        q(i) *= -1
    Next i
End Sub

Sub q_addreal(q() As Integer, r As Integer)
    q(0) += r
End Sub

Sub q_add(q() As Integer, r() As Integer)
    ' adición entre cuaternios
    For i = 0 To 3
        q(i) += r(i)
    Next i
End Sub

Sub q_mulreal(q() As Integer, r As Integer)
    For i = 0 To 3
        q(i) *= r
    Next i
End Sub

Sub q_mul(q() As Integer, r() As Integer)
    ' producto entre cuaternios
    Dim As Integer m(3)
    m(0) = q(0)*r(0) - q(1)*r(1) - q(2)*r(2) - q(3)*r(3)
    m(1) = q(0)*r(1) + q(1)*r(0) + q(2)*r(3) - q(3)*r(2)
    m(2) = q(0)*r(2) - q(1)*r(3) + q(2)*r(0) + q(3)*r(1)
    m(3) = q(0)*r(3) + q(1)*r(2) - q(2)*r(1) + q(3)*r(0)
    For i = 0 To 3 : q(i) = m(i) : Next i
End Sub

Function q_show(q() As Integer) As String
    Dim As String a = "("
    For i = 0 To 3
        a += Str(q(i)) + ", "
    Next i
    Return Mid(a,1,Len(a)-2) + ")"
End Function

'--- Programa Principal ---
Print " q = "; q_show(q())
Print "q1 = "; q_show(q1())
Print "q2 = "; q_show(q2())
Print " r = "; r
Print "norm(q) ="; q_norm(q())
For i = 0 To 3 : t(i) = q(i) : Next i : q_neg(t())  : Print " neg(q) = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_conj(t()) : Print "conj(q) = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_addreal(t(),r) : Print " r + q  = "; q_show(t())
For i = 0 To 3 : t(i) = q1(i) : Next i : q_add(t(),q2()) : Print "q1 + q2 = "; q_show(t())
For i = 0 To 3 : t(i) = q2(i) : Next i : q_add(t(),q1()) : Print "q2 + q1 = "; q_show(t())
For i = 0 To 3 : t(i) = q(i) : Next i : q_mulreal(t(),r) : Print " r * q  = "; q_show(t())
For i = 0 To 3 : t(i) = q1(i) : Next i : q_mul(t(),q2()) : Print "q1 * q2 = "; q_show(t())
For i = 0 To 3 : t(i) = q2(i) : Next i : q_mul(t(),q1()) : Print "q2 * q1 = "; q_show(t())
End


def gcd(a; b):
  def _gcd:
    if .[1] == 0 then .[0]
    else [.[1], .[0] % .[1]] | _gcd
    end;
  [a,b] | _gcd ;

# Return: [total, primitives] for pythagorean triangles having
# perimeter no larger than peri.
# The following uses Euclid's formula with the convention: m > n.
def count(peri):

  # The inner function can be used to count for a given value of m:
  def _count:
    # state [n,m,p, [total, primitives]]
    .[0] as $n | .[1] as $m | .[2] as $p
    | if $n < $m and $p <= peri then
        if (gcd($m;$n) == 1)
        then .[3] | [ (.[0] + ((peri/$p)|floor) ),  (.[1] + 1)]
        else .[3]
        end
        | [$n+2, $m, $p+4*$m, .] | _count
      else .
      end;

  # m^2 < m*(m+1) <= m*(m+n) = perimeter/2
  reduce range(2;  (peri/2) | sqrt + 1) as $m
    ( [1, 2, 12, [0,0]];
      (($m % 2) + 1) as $n
      | (2 * $m * ($m + $n) ) as $p   # a+b+c for this (m,n)
      | [$n, $m, $p, .[3]] | _count
    ) | .[3] ;

# '''Example''':
def pow(i): . as $in | reduce range(0; i) as $j (1; . * $in);

range(1; 9) | . as $i | 10|pow($i) as $i | "\($i):  \(count($i) )"


function primitiven{T<:Integer}(m::T)
    1 < m || return T[]
    m != 2 || return T[1]
    !isprime(m) || return T[2:2:m-1]
    rp = trues(m-1)
    if isodd(m)
        rp[1:2:m-1] = false
    end
    for p in keys(factor(m))
        rp[p:p:m-1] = false
    end
    T[1:m-1][rp]
end

function pythagoreantripcount{T<:Integer}(plim::T)
    primcnt = 0
    fullcnt = 0
    11 < plim || return (primcnt, fullcnt)
    for m in 2:plim
        p = 2m^2
        p+2m <= plim || break
        for n in primitiven(m)
            q = p + 2m*n
            q <= plim || break
            primcnt += 1
            fullcnt += div(plim, q)
        end
    end
    return (primcnt, fullcnt)
end

println("Counting Pythagorian Triplets within perimeter limits:")
println("    Limit          All   Primitive")
for om in 1:10
    (pcnt, fcnt) = pythagoreantripcount(10^om)
    println(@sprintf "    10^%02d  %11d   %9d" om fcnt pcnt)
end


// version 1.1.2

var total = 0L
var prim = 0L
var maxPeri = 0L

fun newTri(s0: Long, s1: Long, s2: Long) {
    val p = s0 + s1 + s2
    if (p <= maxPeri) {
        prim++
        total += maxPeri / p
        newTri( s0 - 2 * s1 + 2 * s2,  2 * s0 - s1 + 2 * s2,  2 * s0 - 2 * s1 + 3 * s2)
        newTri( s0 + 2 * s1 + 2 * s2,  2 * s0 + s1 + 2 * s2,  2 * s0 + 2 * s1 + 3 * s2)
        newTri(-s0 + 2 * s1 + 2 * s2, -2 * s0 + s1 + 2 * s2, -2 * s0 + 2 * s1 + 3 * s2)
    }
}

fun main(args: Array<String>) {
    maxPeri = 100
    while (maxPeri <= 10_000_000_000L) {
        prim = 0
        total = 0
        newTri(3, 4, 5)
        println("Up to $maxPeri: $total triples, $prim primatives")
        maxPeri *= 10
    }
}


from turtle import goto, pu, pd, color, done

def level(ax, ay, bx, by, depth=0):
    if depth > 0:
        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
        goto(ax, ay), pd()
        for x, y in ((bx, by), (x3, y3), (x4, y4), (ax, ay)):
            goto(x, y)
        pu()
        level(x4,y4, x5,y5, depth - 1)
        level(x5,y5, x3,y3, depth - 1)

if __name__ == '__main__':
    color('red', 'yellow')
    pu()
    level(-100, 500, 100, 500, depth=8)
    done()


## Recursive PT plotting
pythtree <- function(ax,ay,bx,by,d) {
  if(d<0) {return()}; clr="darkgreen";
  dx=bx-ax; dy=ay-by;
  x3=bx-dy; y3=by-dx;
  x4=ax-dy; y4=ay-dx;
  x5=x4+(dx-dy)/2; y5=y4-(dx+dy)/2;
  segments(ax,-ay,bx,-by, col=clr);
  segments(bx,-by,x3,-y3, col=clr);
  segments(x3,-y3,x4,-y4, col=clr);
  segments(x4,-y4,ax,-ay, col=clr);
  pythtree(x4,y4,x5,y5,d-1);
  pythtree(x5,y5,x3,y3,d-1);
}
## Plotting Pythagoras Tree. aev 3/27/17
## x1,y1,x2,y2 - starting position
## ord - order/depth, fn - file name, ttl - plot title.
pPythagorasT <- function(x1, y1,x2, y2, ord, fn="", ttl="") {
  cat(" *** START PYTHT:", date(), "\n");
  m=640; i=j=k=m1=m-2; x=y=d=dm=0;
  if(fn=="") {pf=paste0("PYTHTR", ord, ".png")} else {pf=paste0(fn, ".png")};
  if(ttl=="") {ttl=paste0("Pythagoras tree, order - ", ord)};
  cat(" *** Plot file -", pf, "title:", ttl, "\n");
  plot(NA, xlim=c(0,m), ylim=c(-m,0), xlab="", ylab="", main=ttl);
  pythtree(x1,y1, x2,y2, ord);
  dev.copy(png, filename=pf, width=m, height=m);
  dev.off(); graphics.off();
  cat(" *** END PYTHT:",date(),"\n");
}
## Executing:
pPythagorasT(275,500,375,500,9)
pPythagorasT(275,500,375,500,7)


# GAP has built-in support for quaternions

A := QuaternionAlgebra(Rationals);
# <algebra-with-one of dimension 4 over Rationals>

b := BasisVectors(Basis(A));
# [ e, i, j, k ]

q := [1, 2, 3, 4]*b;
# e+(2)*i+(3)*j+(4)*k

# Conjugate
ComplexConjugate(q);
# e+(-2)*i+(-3)*j+(-4)*k

# Division
1/q;
# (1/30)*e+(-1/15)*i+(-1/10)*j+(-2/15)*k

# Computing norm may be difficult, since the result would be in a quadratic field.
# Sqrt exists in GAP, but it is quite unusual: see ?E in GAP documentation, and the following example
Sqrt(5/3);
# 1/3*E(60)^7+1/3*E(60)^11-1/3*E(60)^19-1/3*E(60)^23-1/3*E(60)^31+1/3*E(60)^43-1/3*E(60)^47+1/3*E(60)^59

# However, the square of the norm is easy to compute
q*ComplexConjugate(q);
# (30)*e

q1 := [2, 3, 4, 5]*b;
# (2)*e+(3)*i+(4)*j+(5)*k

q2 := [3, 4, 5, 6]*b;
# (3)*e+(4)*i+(5)*j+(6)*k

q1*q2 - q2*q1;
# (-2)*i+(4)*j+(-2)*k

# Can't add directly to a rational, one must make a quaternion of it
r := 5/3*b[1];
# (5/3)*e
r + q;
# (8/3)*e+(2)*i+(3)*j+(4)*k

# For multiplication, no problem (we are in an algebra over rationals !)
r*q;
# (5/3)*e+(10/3)*i+(5)*j+(20/3)*k
5/3*q;
# (5/3)*e+(10/3)*i+(5)*j+(20/3)*k

# Negative
-q;
(-1)*e+(-2)*i+(-3)*j+(-4)*k

# While quaternions are built-in, you can define an algebra in GAP by specifying it's multiplication table.
# See tutorial, p. 60, and reference of the functions used below.

# A multiplication table of dimension 4.

T := EmptySCTable(4, 0);
SetEntrySCTable(T, 1, 1, [1, 1]);
SetEntrySCTable(T, 1, 2, [1, 2]);
SetEntrySCTable(T, 1, 3, [1, 3]);
SetEntrySCTable(T, 1, 4, [1, 4]);
SetEntrySCTable(T, 2, 1, [1, 2]);
SetEntrySCTable(T, 2, 2, [-1, 1]);
SetEntrySCTable(T, 2, 3, [1, 4]);
SetEntrySCTable(T, 2, 4, [-1, 3]);
SetEntrySCTable(T, 3, 1, [1, 3]);
SetEntrySCTable(T, 3, 2, [-1, 4]);
SetEntrySCTable(T, 3, 3, [-1, 1]);
SetEntrySCTable(T, 3, 4, [1, 2]);
SetEntrySCTable(T, 4, 1, [1, 4]);
SetEntrySCTable(T, 4, 2, [1, 3]);
SetEntrySCTable(T, 4, 3, [-1, 2]);
SetEntrySCTable(T, 4, 4, [-1, 1]);

A := AlgebraByStructureConstants(Rationals, T, ["e", "i", "j", "k"]);
b := GeneratorsOfAlgebra(A);

IsAssociative(A);
# true

IsCommutative(A);
# false

# Then, like above

q := [1, 2, 3, 4]*b;
# e+(2)*i+(3)*j+(4)*k

# However, as is, GAP does not know division or conjugate on this algebra.
# QuaternionAlgebra is useful as well for extensions of rationals,
# and this one _has_ conjugate and division, as seen previously.

# Try this on Q[z] where z is the square root of 5 (in GAP it's ER(5))
F := FieldByGenerators([ER(5)]);
A := QuaternionAlgebra(F);
b := GeneratorsOfAlgebra(A);

q := [1, 2, 3, 4]*b;
# e+(2)*i+(3)*j+(4)*k

# Conjugate and division

ComplexConjugate(q);
# e+(-2)*i+(-3)*j+(-4)*k

1/q;
# (1/30)*e+(-1/15)*i+(-1/10)*j+(-2/15)*k


package main

import (
    "fmt"
    "math"
)

type qtn struct {
    r, i, j, k float64
}

var (
    q  = &qtn{1, 2, 3, 4}
    q1 = &qtn{2, 3, 4, 5}
    q2 = &qtn{3, 4, 5, 6}

    r  float64 = 7
)

func main() {
    fmt.Println("Inputs")
    fmt.Println("q:", q)
    fmt.Println("q1:", q1)
    fmt.Println("q2:", q2)
    fmt.Println("r:", r)

    var qr qtn
    fmt.Println("\nFunctions")
    fmt.Println("q.norm():", q.norm())
    fmt.Println("neg(q):", qr.neg(q))
    fmt.Println("conj(q):", qr.conj(q))
    fmt.Println("addF(q, r):", qr.addF(q, r))
    fmt.Println("addQ(q1, q2):", qr.addQ(q1, q2))
    fmt.Println("mulF(q, r):", qr.mulF(q, r))
    fmt.Println("mulQ(q1, q2):", qr.mulQ(q1, q2))
    fmt.Println("mulQ(q2, q1):", qr.mulQ(q2, q1))
}

func (q *qtn) String() string {
    return fmt.Sprintf("(%g, %g, %g, %g)", q.r, q.i, q.j, q.k)
}

func (q *qtn) norm() float64 {
    return math.Sqrt(q.r*q.r + q.i*q.i + q.j*q.j + q.k*q.k)
}

func (z *qtn) neg(q *qtn) *qtn {
    z.r, z.i, z.j, z.k = -q.r, -q.i, -q.j, -q.k
    return z
}

func (z *qtn) conj(q *qtn) *qtn {
    z.r, z.i, z.j, z.k = q.r, -q.i, -q.j, -q.k
    return z
}

func (z *qtn) addF(q *qtn, r float64) *qtn {
    z.r, z.i, z.j, z.k = q.r+r, q.i, q.j, q.k
    return z
}

func (z *qtn) addQ(q1, q2 *qtn) *qtn {
    z.r, z.i, z.j, z.k = q1.r+q2.r, q1.i+q2.i, q1.j+q2.j, q1.k+q2.k
    return z
}

func (z *qtn) mulF(q *qtn, r float64) *qtn {
    z.r, z.i, z.j, z.k = q.r*r, q.i*r, q.j*r, q.k*r
    return z
}

func (z *qtn) mulQ(q1, q2 *qtn) *qtn {
    z.r, z.i, z.j, z.k =
        q1.r*q2.r-q1.i*q2.i-q1.j*q2.j-q1.k*q2.k,
        q1.r*q2.i+q1.i*q2.r+q1.j*q2.k-q1.k*q2.j,
        q1.r*q2.j-q1.i*q2.k+q1.j*q2.r+q1.k*q2.i,
        q1.r*q2.k+q1.i*q2.j-q1.j*q2.i+q1.k*q2.r
    return z
}


// Brute Force: Too slow for large numbers
define num_pythagorean_triples(max_perimeter::integer) => {
   local(max_b) = (#max_perimeter / 3)*2

   return (
      with a in 1 to (#max_b - 1)
      sum integer(
         with b in (#a + 1) to #max_b
         let c = math_sqrt(#a*#a + #b*#b)
         where #c == integer(#c)
         where #c > #b
         where (#a+#b+#c) <= #max_perimeter
         sum 1
      )
   )
}
stdout(`Number of Pythagorean Triples in a Perimeter of 100: `)
stdoutnl(num_pythagorean_triples(100))


print time$()

for power =1 to 6
    perimeterLimit =10^power
    upperBound     =int( 1 +perimeterLimit^0.5)
    primitives     =0
    triples        =0
    extras         =0   '   will count the in-range multiples of any primitive

    for m =2 to upperBound
        for n =1 +( m mod 2 =1) to m -1 step 2
            term1      =2 *m *n
            term2      =m *m -n *n
            term3      =m *m +n *n
            perimeter  =term1 +term2 +term3

            if perimeter <=perimeterLimit then triples =triples +1

            a     =term1
            b     =term2

            do
                r = a mod b
                a =b
                b =r
            loop until r <=0

            if ( a =1) and ( perimeter <=perimeterLimit) then                       'we've found a primitive triple if a =1, since hcf =1. And it is inside perimeter range. Save it in an array
                primitives =primitives +1
                if term1 >term2 then temp =term1: term1 =term2: term2 =temp         'swap so in increasing order of side length
                nEx =int( perimeterLimit /perimeter)                     'We have the primitive & removed any multiples. Now calculate ALL the multiples in range.
                extras =extras +nEx
            end if

            scan
        next n
    next m

    print "  Number of primitives having perimeter below "; 10^power, " was "; primitives, " & "; extras, " non-primitive triples."
    print time$()
next power

print "End"
end


_Title "Pythagoras Tree"

Dim As Integer sw, sh
sw = 640
sh = 480

Screen _NewImage(sw, sh, 32)

Call pythTree(sw / 2 - sw / 12, sh - 30, sw / 2 + sw / 12, sh - 30, 0)

Sleep
System

Sub pythTree (ax As Integer, ay As Integer, bx As Integer, by As Integer, depth As Integer)
    Dim As Single cx, cy, dx, dy, ex, ey
    Dim As Integer c

    cx = ax - ay + by
    cy = ax + ay - bx
    dx = bx + by - ay
    dy = ax - bx + by
    ex = (cx - cy + dx + dy) * 0.5
    ey = (cx + cy - dx + dy) * 0.5
    c = depth * 15
    Color _RGB(c Mod 256, Abs((255 - c)) Mod 256, (144 + c) Mod 256)
    Line (cx, cy)-(ax, ay)
    Line (ax, ay)-(bx, by)
    Line (bx, by)-(dx, dy)
    Line (dx, dy)-(cx, cy)
    Line (cx, cy)-(ex, ey)
    Line (ex, ey)-(dx, dy)
    If depth < 12 Then
        Call pythTree(cx, cy, ex, ey, depth + 1)
        Call pythTree(ex, ey, dx, dy, depth + 1)
    End If
End Sub


#lang racket
(require racket/draw pict)

(define (draw-pythagoras-tree order x0 y0 x1 y1)
  (λ (the-dc dx dy)
    (define (inr order x0 y0 x1 y1)
      (when (positive? order)
        (let* ((y0-1 (- y0 y1))
               (x1-0 (- x1 x0))
               (x2 (+ x1 y0-1))
               (y2 (+ y1 x1-0))
               (x3 (+ x0 y0-1))
               (y3 (+ y0 x1-0))
               (x4 (+ x2 x3 (/ (+ x0 x2) -2)))
               (y4 (+ y2 y3 (/ (+ y0 y2) -2)))
               (path (new dc-path%)))
          (send* path [move-to x0 y0]
            [line-to x1 y1] [line-to x2 y2] [line-to x3 y3]
            [close])
          (send the-dc draw-path path dx dy)
          (inr (sub1 order) x3 y3 x4 y4)
          (inr (sub1 order) x4 y4 x2 y2))))

    (define old-brush (send the-dc get-brush))
    (define old-pen (send the-dc get-pen))
    (send the-dc set-pen (new pen% [width 1] [color "black"]))
    (inr (add1 order) x0 y0 x1 y1)
    (send the-dc set-brush old-brush)
    (send the-dc set-pen old-pen)))

(dc (draw-pythagoras-tree 7 (+ 200 32) 255 (- 200 32) 255) 400 256)


class Square {
    has Complex ($.position, $.edge);
    method size { $!edge.abs }
    method svg-polygon {
	qq[<polygon points="{join ' ', map
	{ ($!position + $_ * $!edge).reals.join(',') },
	0, 1, 1+1i, 1i}" style="fill:lime;stroke=black" />]
    }
    method left-child {
	self.new:
	position => $!position + i*$!edge,
	edge => sqrt(2)/2*cis(pi/4)*$!edge;
    }
    method right-child {
	self.new:
	position => $!position + i*$!edge + self.left-child.edge,
	edge => sqrt(2)/2*cis(-pi/4)*$!edge;
    }
}

BEGIN say '<svg width="500" height="500">';
END   say '</svg>';

sub tree(Square $s, $level = 0) {
    return if $level > 8;
    say $s.svg-polygon;
    tree($s.left-child, $level+1);
    tree($s.right-child, $level+1);
}

tree Square.new: :position(250+0i), :edge(60+0i);


import Control.Monad (join)

data Quaternion a =
  Q a a a a
  deriving (Show, Eq)

realQ :: Quaternion a -> a
realQ (Q r _ _ _) = r

imagQ :: Quaternion a -> [a]
imagQ (Q _ i j k) = [i, j, k]

quaternionFromScalar :: (Num a) => a -> Quaternion a
quaternionFromScalar s = Q s 0 0 0

listFromQ :: Quaternion a -> [a]
listFromQ (Q a b c d) = [a, b, c, d]

quaternionFromList :: [a] -> Quaternion a
quaternionFromList [a, b, c, d] = Q a b c d

normQ :: (RealFloat a) => Quaternion a -> a
normQ = sqrt . sum . join (zipWith (*)) . listFromQ

conjQ :: (Num a) => Quaternion a -> Quaternion a
conjQ (Q a b c d) = Q a (-b) (-c) (-d)

instance (RealFloat a) => Num (Quaternion a) where
  (Q a b c d) + (Q p q r s) = Q (a + p) (b + q) (c + r) (d + s)
  (Q a b c d) - (Q p q r s) = Q (a - p) (b - q) (c - r) (d - s)
  (Q a b c d) * (Q p q r s) =
    Q
    (a * p - b * q - c * r - d * s)
    (a * q + b * p + c * s - d * r)
    (a * r - b * s + c * p + d * q)
    (a * s + b * r - c * q + d * p)
  negate (Q a b c d)        = Q (-a) (-b) (-c) (-d)
  abs q                     = quaternionFromScalar (normQ q)
  signum (Q 0 0 0 0)        = 0
  signum q@(Q a b c d)      = Q (a/n) (b/n) (c/n) (d/n) where n = normQ q
  fromInteger n             = quaternionFromScalar (fromInteger n)

main :: IO ()
main = do
  let q, q1, q2 :: Quaternion Double
      q  = Q 1 2 3 4
      q1 = Q 2 3 4 5
      q2 = Q 3 4 5 6
  print $ (Q 0 1 0 0) * (Q 0 0 1 0) * (Q 0 0 0 1) -- i*j*k; prints "Q (-1.0) 0.0 0.0 0.0"
  print $ q1 * q2                                 -- prints "Q (-56.0) 16.0 24.0 26.0"
  print $ q2 * q1                                 -- prints "Q (-56.0) 18.0 20.0 28.0"
  print $ q1 * q2 == q2 * q1                      -- prints "False"
  print $ imagQ q                                 -- prints "[2.0,3.0,4.0]"


N=  100;
  a = 1:N;
  b = a(ones(N,1),:).^2;
  b = b+b';
  b = sqrt(b);  [y,x]=find(b==fix(b)); % test
  % here some alternative tests
  % b = b.^(1/k); [y,x]=find(b==fix(b)); % test 2
  % [y,x]=find(b==(fix(b.^(1/k)).^k));  % test 3
  % b=b.^(1/k); [y,x]=find(abs(b - round(b)) <= 4*eps*b);

  z  = sqrt(x.^2+y.^2);
  ix = (z+x+y<100) & (x < y) & (y < z);
  p  = find(gcd(x(ix),y(ix))==1);   % find primitive triples

  printf('There are %i Pythagorean Triples and %i primitive triples with a perimeter smaller than %i.\n',...
         sum(ix), length(p), N);


# Project : Pythagoras tree

load "guilib.ring"

paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Pythagoras tree")
                  setgeometry(100,100,800,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,800,600)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,100,30)
                          settext("draw")
                          setclickevent("draw()")
                  }
                  show()
        }
        exec()
        }

func draw
        p1 = new qpicture()
               color = new qcolor() {
               setrgb(0,0,255,255)
        }
        pen = new qpen() {
                 setcolor(color)
                 setwidth(1)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

        w = 800
        h = floor(w*11/16)
        w2 = floor(w/2)
        diff = floor(w/12)

        pythagorastree(w2 - diff,h -10,w2 + diff ,h -10 ,0)

        endpaint()
        }
        label1 { setpicture(p1) show() }
        return

func pythagorastree(x1,y1,x2,y2,depth)
        if depth > 10
           return
        ok
        dx = x2 - x1
        dy = y1 - y2
        x3 = x2 - dy
        y3 = y2 - dx
        x4 = x1 - dy
        y4 = y1 - dx
        x5 = x4 + floor((dx - dy) / 2)
        y5 = y4 - floor((dx + dy) / 2)
        paint.drawline(x1,y1,x2,y2)
        paint.drawline(x2,y2,x3,y3)
        paint.drawline(x4,y4,x1,y1)
        pythagorastree(x4, y4, x5, y5, depth +1)
        pythagorastree(x5, y5, x3, y3, depth +1)


# frozen_string_literal: true

def setup
  sketch_title 'Pythagoras Tree'
  background(255)
  stroke(0, 255, 0)
  tree(width / 2.3, height, width / 1.8, height, 10)
end

def tree(x1, y1, x2, y2, depth)
  return if depth <= 0

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

  x3 = (x2 - dy)
  y3 = (y2 - dx)
  x4 = (x1 - dy)
  y4 = (y1 - dx)
  x5 = (x4 + 0.5 * (dx - dy))
  y5 = (y4 - 0.5 * (dx + dy))
  # square
  begin_shape
  fill(0.0, 255.0 / depth, 0.0)
  vertex(x1, y1)
  vertex(x2, y2)
  vertex(x3, y3)
  vertex(x4, y4)
  vertex(x1, y1)
  end_shape
  # triangle
  begin_shape
  fill(0.0, 255.0 / depth, 0.0)
  vertex(x3, y3)
  vertex(x4, y4)
  vertex(x5, y5)
  vertex(x3, y3)
  end_shape
  tree(x4, y4, x5, y5, depth - 1)
  tree(x5, y5, x3, y3, depth - 1)
end

def settings
  size(800, 400)
end


/* add to file Cargo.toml:
[dependencies]
svg = "0.10.0"
*/

use svg::node::element::{Group, Polygon};

fn main() {
    let mut doc = svg::Document::new().set("stroke", "white");
    let mut base: Vec<[(f64, f64); 2]> = vec![[(-200.0, 0.0), (200.0, 0.0)]];
    for lvl in 0..12u8 {
        let rg = |step| lvl.wrapping_mul(step).wrapping_add(80 - step * 2);
        let mut group = Group::new().set("fill", format!("#{:02X}{:02X}18", rg(20), rg(30))); // level color
        let mut next_base = Vec::new();
        for [a, b] in base {
            let v = (b.0 - a.0, b.1 - a.1);
            let c = (a.0 + v.1, a.1 - v.0);
            let d = (c.0 + v.0, c.1 + v.1);
            let e = (c.0 + 0.5 * (v.0 + v.1), c.1 + 0.5 * (v.1 - v.0));
            group = group.add(Polygon::new().set("points", vec![a, c, e, d, c, d, b]));
            next_base.extend([[c, e], [e, d]]);
        }
        base = next_base;
        doc = doc.add(group);
    }
    let (x0, y0) = (base.iter()).fold((0.0, 0.0), |(x0, y0), [(x, y), _]| (x.min(x0), y.min(y0)));
    let file = "pythagoras_tree.svg";
    match svg::save(file, &doc.set("viewBox", (x0, y0, -x0 * 2.0, -y0))) {
        Ok(_) => println!("{file} file written successfully!"),
        Err(e) => println!("failed to write {file}: {e}"),
    }
}


class Quaternion(a, b, c, d)

  method norm ()
    return sqrt (a*a + b*b + c*c + d*d)
  end

  method negative ()
    return Quaternion(-a, -b, -c, -d)
  end

  method conjugate ()
    return Quaternion(a, -b, -c, -d)
  end

  method add (n)
    if type(n) == "Quaternion__state"
      then return Quaternion(a+n.a, b+n.b, c+n.c, d+n.d)
      else return Quaternion(a+n, b, c, d)
  end

  method multiply (n)
    if type(n) == "Quaternion__state"
      then return Quaternion(a*n.a - b*n.b - c*n.c - d*n.d,
                             a*n.b + b*n.a + c*n.d - d*n.c,
                             a*n.c - b*n.d + c*n.a + d*n.b,
                             a*n.d + b*n.c - c*n.b + d*n.a)
      else return Quaternion(a*n, b*n, c*n, d*n)
  end

  method sign (n)
    return if n >= 0 then "+" else "-"
  end

  method string ()
    return ("" || a || sign(b) || abs(b) || "i" || sign(c) || abs(c) || "j" || sign(d) || abs(d) || "k");
  end

  initially(a, b, c, d)
    self.a := if /a then 0 else a
    self.b := if /b then 0 else b
    self.c := if /c then 0 else c
    self.d := if /d then 0 else d
end