with Ada.Containers.Ordered_Maps;
with Ada.Numerics.Big_Numbers.Big_Integers;
with Ada.Text_IO;   use Ada.Text_IO;

procedure Power_Tree is

   Debug_On : constant Boolean := False;

   generic
      type Result_Type is private;
      Base     : Result_Type;
      Identity : Result_Type;
      with function "*" (Left, Right : Result_Type) return Result_Type is <>;
   package Knuth_Power_Tree is
      subtype Exponent is Natural;

      function Power (Exp : Exponent) return Result_Type;
   end Knuth_Power_Tree;

   package body Knuth_Power_Tree is

      package Power_Trees is
        new Ada.Containers.Ordered_Maps (Key_Type     => Exponent,
                                         Element_Type => Result_Type);
      Tree : Power_Trees.Map;

      procedure Debug (Item : String) is
      begin
         if Debug_On then
            Put_Line (Standard_Error, Item);
         end if;
      end Debug;

      function Power (Exp : Exponent) return Result_Type is
         Pow : Result_Type;
      begin
         if Tree.Contains (Exp) then
            return Tree.Element (Exp);
         else
            Debug ("lookup failed of " & Exp'Image);
         end if;

         if Exp mod 2 = 0 then
            Debug ("lookup half " & Exponent'(Exp / 2)'Image);
            Pow := Power (Exp / 2);
            Pow := Pow * Pow;
         else
            Debug ("lookup one less " & Exponent'(Exp - 1)'Image);
            Pow := Power (Exp - 1);
            Pow := Result_Type (Base) * Pow;
         end if;
         Debug ("insert " & Exp'Image);
         Tree.Insert (Key => Exp, New_Item => Pow);
         return Pow;
      end Power;

   begin
      Tree.Insert (Key => 0, New_Item => Identity);
   end Knuth_Power_Tree;

   procedure Part_1
   is
      package Power_2 is new Knuth_Power_Tree (Result_Type => Long_Integer,
                                               Base        => 2,
                                               Identity    => 1);
      R : Long_Integer;
   begin
      Put_Line ("=== Part 1 ===");
      for N in 0 .. 25 loop
         R := Power_2.Power (N);
         Put ("2 **");  Put (N'Image);
         Put (" =");    Put (R'Image);
         New_Line;
      end loop;
   end Part_1;

   procedure Part_2
   is
      use Ada.Numerics.Big_Numbers.Big_Integers;

      package Power_3 is new Knuth_Power_Tree (Result_Type => Big_Integer,
                                               Base        => 3,
                                               Identity    => 1);
      R : Big_Integer;
   begin
      Put_Line ("=== Part 2 ===");
      for E in 190 .. 192 loop
         R := Power_3.Power (E);
         Put ("3 **" & E'Image & " =");  Put (R'Image);  New_Line;
      end loop;
   end Part_2;

   procedure Part_3
   is
      subtype Real is Long_Long_Float;
      package Real_IO is new Ada.Text_IO.Float_IO (Real);
      package Power_1_1 is new Knuth_Power_Tree (Result_Type => Real,
                                                 Base        => 1.1,
                                                 Identity    => 1.0);
      R : Real;
   begin
      Put_Line ("=== Part 3 ===");
      for E in 81 .. 84 loop
         R := Power_1_1.Power (E);
         Put ("1.1 **" & E'Image & " = ");
         Real_IO.Put (R, Exp => 0, Aft => 6);
         New_Line;
      end loop;
   end Part_3;

begin
   Part_1;
   Part_2;
   Part_3;
end Power_Tree;


(lib 'tree)

;; displays a chain hit
(define (power-hit target chain)
	(vector-push chain target)
	(printf "L(%d) = %d - chain:%a "
		target (1- (vector-length chain)) chain)
	(vector-pop chain))

;; build the power-tree : add 1 level of leaf nodes
;; display all chains which lead to target

(define (add-level node chain  target  nums (new))
(vector-push chain (node-datum node))
	(cond
	[(node-leaf? node)
	;; add leaves by summing this node to all nodes in chain
	;; do not add leaf if number already known
			 (for [(prev chain)]
			 		(set! new (+ prev (node-datum node)))
			 		(when (= new target) (power-hit target chain ))
			 		#:continue (vector-search* new nums)
			 		(node-add-leaf node new)
			 		(vector-insert* nums new)
			 		)]
	[else ;; not leaf node -> recurse
	(for [(son  (node-sons node))]
		(add-level son chain target nums )) ])
	(vector-pop chain))

;; add levels in tree until target found
;; return (number of nodes . upper-bound for L(target))
(define (power-tree target)
	(define nums (make-vector 1 1)) ;; known nums =  1
	(define T (make-tree 1)) ;; root node has value 1
	(printf "Looking for %d in %a." target T)
	(while #t
	#:break (vector-search* target nums) =>  (tree-count T)
	(add-level T init-chain: (make-vector 0) target  nums)
	))


let s_of_n_creator n =
  let i = ref 0
  and sample = ref [| |] in
  fun item ->
    incr i;
    if !i <= n then sample := Array.append [| item |] !sample
    else if Random.int !i < n then !sample.(Random.int n) <- item;
    !sample

let test n items_set =
  let s_of_n = s_of_n_creator n in
  Array.fold_left (fun _ v -> s_of_n v) [| |] items_set

let () =
  Random.self_init ();
  let n = 3 in
  let num_items = 10 in
  let items_set = Array.init num_items (fun i -> i) in
  let results = Array.make num_items 0 in
  for i = 1 to 100_000 do
    let res = test n items_set in
    Array.iter (fun j -> results.(j) <- succ results.(j)) res
  done;
  Array.iter (Printf.printf " %d") results;
  print_newline ()


// Integer exponentiation using Knuth power tree. Nigel Galloway: October 29th., 2020
let kT α=let n=Array.zeroCreate<int*int list>((pown 2 (α+1))+1)
         let fN g=let rec fN p=[yield g+p; if p>0 then let g,_=n.[p] in yield! fN g] in (g+g)::(fN (fst n.[g]))|>List.rev
         let fG g=[for α,β in g do for g in β do let p,_=n.[g] in n.[g]<-(p,fN g|>List.filter(fun β->if box n.[β]=null then n.[β]<-(g,[]); true else false)); yield n.[g]]
         let rec kT n g=match g with 0->() |_->let n=fG n in kT n (g-1)
         let fE X g=let α=let rec fE g=[|yield g; if g>1 then yield! fE (fst n.[g])|] in fE g
                    let β=Array.zeroCreate<bigint>α.Length
                    let l=β.Length-1
                    β.[l]<-bigint (X+0)
                    for e in l-1.. -1..0 do β.[e]<-match α.[e]%2 with 0->β.[e+1]*β.[e+1] |_->let l=α.[e+1] in β.[e+1]*β.[α|>Array.findIndex(fun n->l+n=α.[e])]
                    β.[0]
         n.[1]<-(0,[2]); n.[2]<-(1,[]); kT [n.[1]] α; (fun n g->if g=0 then 1I else fE n g)
let xp=kT 11
[0..17]|>List.iter(fun n->printfn "2**%d=%A\n" n (xp 2 n))
printfn "3**191=%A" (xp 3 191)


use strict;

sub s_of_n_creator {
    my $n = shift;
    my @sample;
    my $i = 0;
    sub {
        my $item = shift;
        $i++;
        if ($i <= $n) {
            # Keep first n items
            push @sample, $item;
        } elsif (rand() < $n / $i) {
            # Keep item
            @sample[rand $n] = $item;
        }
        @sample
    }
}

my @items = (0..9);
my @bin;

foreach my $trial (1 .. 100000) {
    my $s_of_n = s_of_n_creator(3);
    my @sample;
    foreach my $item (@items) {
        @sample = $s_of_n->($item);
    }
    foreach my $s (@sample) {
        $bin[$s]++;
    }
}
print "@bin\n";


with javascript_semantics
enum RID, I, SAMPLE

function s_of_n(sequence env, integer item)
    integer i = env[I] + 1,
            n = length(env[SAMPLE])
    env = deep_copy(env)
    env[I] = i
    if i<=n then
        env[SAMPLE][i] = item
    elsif n/i>rnd() then
        env[SAMPLE][rand(n)] = item
    end if
    return env
end function

function s_of_n_creator(int n)
    return {s_of_n,0,repeat(0,n)}
end function

function invoke(sequence env, args)
    env = call_func(env[RID],prepend(deep_copy(args),env))
    return env
end function

function test(integer n, sequence items)
    sequence env = s_of_n_creator(n)
    for i=1 to length(items) do
--      env = s_of_n(env,items[i])
        env = invoke(env, {items[i]})
    end for
    return env[SAMPLE]
end function

procedure main()
    sequence items_set = tagset(9,0)
    sequence frequencies = repeat(0,length(items_set))
    for i=1 to 100000 do
        sequence res = test(3, items_set)
        for j=1 to length(res) do
            integer fdx = res[j]+1
            frequencies[fdx] += 1
        end for
    end for
    ?frequencies
end procedure
main()


package main

import (
    "fmt"
    "math/big"
)

var (
    p   = map[int]int{1: 0}
    lvl = [][]int{[]int{1}}
)

func path(n int) []int {
    if n == 0 {
        return []int{}
    }
    for {
        if _, ok := p[n]; ok {
            break
        }
        var q []int
        for _, x := range lvl[0] {
            for _, y := range path(x) {
                z := x + y
                if _, ok := p[z]; ok {
                    break
                }
                p[z] = x
                q = append(q, z)
            }
        }
        lvl[0] = q
    }
    r := path(p[n])
    r = append(r, n)
    return r
}

func treePow(x float64, n int) *big.Float {
    r := map[int]*big.Float{0: big.NewFloat(1), 1: big.NewFloat(x)}
    p := 0
    for _, i := range path(n) {
        temp := new(big.Float).SetPrec(320)
        temp.Mul(r[i-p], r[p])
        r[i] = temp
        p = i
    }
    return r[n]
}

func showPow(x float64, n int, isIntegral bool) {
    fmt.Printf("%d: %v\n", n, path(n))
    f := "%f"
    if isIntegral {
        f = "%.0f"
    }
    fmt.Printf(f, x)
    fmt.Printf(" ^ %d = ", n)
    fmt.Printf(f+"\n\n", treePow(x, n))
}

func main() {
    for n := 0; n <= 17; n++ {
        showPow(2, n, true)
    }
    showPow(1.1, 81, false)
    showPow(3, 191, true)
}


class PowerTree {
    private static Map<Integer, Integer> p = new HashMap<>()
    private static List<List<Integer>> lvl = new ArrayList<>()

    static {
        p[1] = 0

        List<Integer> temp = new ArrayList<Integer>()
        temp.add 1
        lvl.add temp
    }

    private static List<Integer> path(int n) {
        if (n == 0) return new ArrayList<Integer>()
        while (!p.containsKey(n)) {
            List<Integer> q = new ArrayList<>()
            for (Integer x in lvl.get(0)) {
                for (Integer y in path(x)) {
                    if (p.containsKey(x + y)) break
                    p[x + y] = x
                    q.add x + y
                }
            }
            lvl[0].clear()
            lvl[0].addAll q
        }
        List<Integer> temp = path p[n]
        temp.add n
        temp
    }

    private static BigDecimal treePow(double x, int n) {
        Map<Integer, BigDecimal> r = new HashMap<>()
        r[0] = BigDecimal.ONE
        r[1] = BigDecimal.valueOf(x)

        int p = 0
        for (Integer i in path(n)) {
            r[i] = r[i - p] * r[p]
            p = i
        }
        r[n]
    }

    private static void showPos(double x, int n, boolean isIntegral) {
        printf("%d: %s\n", n, path(n))
        String f = isIntegral ? "%.0f" : "%f"
        printf(f, x)
        printf(" ^ %d = ", n)
        printf(f, treePow(x, n))
        println()
        println()
    }

    static void main(String[] args) {
        for (int n = 0; n <= 17; ++n) {
            showPos 2.0, n, true
        }
        showPos 1.1, 81, false
        showPos 3.0, 191, true
    }
}


<?php
function s_of_n_creator($n) {
    $sample = array();
    $i = 0;
    return function($item) use (&$sample, &$i, $n) {
        $i++;
        if ($i <= $n) {
            // Keep first n items
            $sample[] = $item;
        } else if (rand(0, $i-1) < $n) {
            // Keep item
            $sample[rand(0, $n-1)] = $item;
        }
        return $sample;
    };
}

$items = range(0, 9);

for ($trial = 0; $trial < 100000; $trial++) {
    $s_of_n = s_of_n_creator(3);
    foreach ($items as $item)
        $sample = $s_of_n($item);
    foreach ($sample as $s)
        $bin[$s]++;
}
print_r($bin);
?>


(de s_of_n_creator (@N)
   (curry (@N (I . 0) (Res)) (Item)
      (cond
         ((>= @N (inc 'I)) (push 'Res Item))
         ((>= @N (rand 1 I)) (set (nth Res (rand 1 @N)) Item)) )
      Res ) )

(let Freq (need 10 0)
   (do 100000
      (let S_of_n (s_of_n_creator 3)
         (for I (mapc S_of_n (0 1 2 3 4 5 6 7 8 9))
            (inc (nth Freq (inc I))) ) ) )
   Freq )


from random import randrange

def s_of_n_creator(n):
    sample, i = [], 0
    def s_of_n(item):
        nonlocal i

        i += 1
        if i <= n:
            # Keep first n items
            sample.append(item)
        elif randrange(i) < n:
            # Keep item
            sample[randrange(n)] = item
        return sample
    return s_of_n

if __name__ == '__main__':
    bin = [0]* 10
    items = range(10)
    print("Single run samples for n = 3:")
    s_of_n = s_of_n_creator(3)
    for item in items:
        sample = s_of_n(item)
        print("  Item: %i -> sample: %s" % (item, sample))
    #
    for trial in range(100000):
        s_of_n = s_of_n_creator(3)
        for item in items:
            sample = s_of_n(item)
        for s in sample:
            bin[s] += 1
    print("\nTest item frequencies for 100000 runs:\n ",
          '\n  '.join("%i:%i" % x for x in enumerate(bin)))


{-# LANGUAGE ScopedTypeVariables #-}

module Rosetta.PowerTree
    ( Natural
    , powerTree
    , power
    )  where

import           Data.Foldable (toList)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe)
import           Data.List (foldl')
import           Data.Sequence (Seq (..), (|>))
import qualified Data.Sequence as Seq
import           Numeric.Natural (Natural)

type M = Map Natural S
type S = Seq Natural

levels :: [M]
levels = let s = Seq.singleton 1 in fst <$> iterate step (Map.singleton 1 s, s)

step :: (M, S) -> (M, S)
step (m, xs) = foldl' f (m, Empty) xs
  where
    f :: (M, S) -> Natural -> (M, S)
    f (m', ys) n = foldl' g (m', ys) ns
      where
        ns :: S
        ns = m' Map.! n

        g :: (M, S) -> Natural -> (M, S)
        g (m'', zs) k =
            let l = n + k
            in  case Map.lookup l m'' of
                    Nothing -> (Map.insert l (ns |>  l) m'', zs |> l)
                    Just _  -> (m'', zs)

powerTree :: Natural -> [Natural]
powerTree n
    | n <= 0    = []
    | otherwise = go levels
  where
    go :: [M] -> [Natural]
    go []       = error "impossible branch"
    go (m : ms) = fromMaybe (go ms) $ toList <$> Map.lookup n m

power :: forall a. Num a => a -> Natural -> a
power _ 0 = 1
power a n = go a 1 (Map.singleton 1 a) $ tail $ powerTree n
  where
    go :: a -> Natural -> Map Natural a -> [Natural] -> a
    go b _ _ []       = b
    go b k m (l : ls) =
        let b' = b * m Map.! (l - k)
            m' = Map.insert l b' m
        in  go b' l m' ls


knuth_power_tree=:3 :0
  L=: P=: %(1+y){._ 1
  findpath=: ]
  while. _ e.P do.
    for_n.(/: findpath&>)I.L=>./L-._ do.
      for_a. findpath n do.
         j=. n+a
         l=. 1+n{L
         if. j>y do. break. end.
         if. l>:j{ L do. continue. end.
         L=: l j} L
         P=: n j} P
      end.
      findpath=: [: |. {&P^:a:
    end.
  end.
  P
)

usepath=:4 :0
  path=. findpath y
  exp=. 1,({:path)#x
  for_ex.(,.~2 -~/\"1])2 ,\path  do.
    'ea eb ec'=. ex
    exp=.((ea{exp)*eb{exp) ec} exp
  end.
  {:exp
)


#lang racket/base

(define (s-of-n-creator n)
  (define i 0)
  (define sample (make-vector n)) ; the sample of n items
  (lambda (item)
    (set! i (add1 i))
    (cond [(<= i n)               ; we're not full, so kind of boring
           (vector-set! sample (sub1 i) item)]
          [(< (random i) n)       ; we've already seen n items; swap one?
           (vector-set! sample (random n) item)])
    sample))

(define counts (make-vector 10 0))

(for ([i 100000])
  (define s-of-n (s-of-n-creator 3))
  (define sample (for/last ([digit 10]) (s-of-n digit)))
  (for ([d sample]) (vector-set! counts d (add1 (vector-ref counts d)))))

(for ([d 10]) (printf "~a ~a\n" d (vector-ref counts d)))


sub s_of_n_creator($n) {
    my @sample;
    my $i = 0;
    -> $item {
        if ++$i <= $n {
            push @sample, $item;
        }
        elsif $i.rand < $n {
            @sample[$n.rand] = $item;
        }
        @sample;
    }
}

my @items = 0..9;
my @bin;

for ^100000 {
    my &s_of_n = s_of_n_creator(3);
    my @sample;
    for @items -> $item {
        @sample = s_of_n($item);
    }
    for @sample -> $s {
        @bin[$s]++;
    }
}
say @bin;


/*REXX program  using  Knuth's  algorithm  S  (a random sampling   N   of   M   items). */
parse arg trials size .                          /*obtain optional arguments from the CL*/
if trials=='' | trials==","  then trials= 100000 /*Not specified?  Then use the default.*/
if   size=='' |   size==","  then   size=      3 /* "      "         "   "   "     "    */
#.= 0                                            /*initialize frequency counter array.  */
      do trials                                  /*OK,  now let's light this candle.    */
      call s_of_n_creator    size                /*create an initial list of  N  items. */

          do gen=0  for 10;  call s_of_n gen     /*call s_of_n with a single decimal dig*/
          end   /*gen*/
                                                 /* [↓]  examine what  SofN  generated. */
          do count=1  for size;     _= !.count   /*get a dec. digit from the  Nth item. */
          #._= #._ + 1                           /*bump counter for the decimal digit.  */
          end   /*count*/
      end       /*trials*/
                                                         @= ' trials, and with a size of '
hdr= "  Using Knuth's algorithm  S  for "  commas(trials)  @ || commas(size)":  "
say hdr;         say copies("═", length(hdr) )   /*display the header and its separator.*/

        do dig=0  to 9                           /* [↓]  display the frequency of a dig.*/
        say right("frequency of the", 37)       dig       'digit is: '      commas(#.dig)
        end   /*dig*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _;  do jc=length(_)-3  to 1  by -3; _=insert(',', _, jc); end;  return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
s_of_n: parse arg item;         items= items + 1 /*get  "item",  bump the items counter.*/
        if random(1, items)>size  then return    /*probability isn't good,  so skip it. */
        _= random(1, size);       !._= item      /*now, figure out which previous ···   */
        return                                   /*      ··· item to replace with  ITEM.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
s_of_n_creator: parse arg item 1 items           /*generate    ITEM    number of items. */
                            do k=1  for item     /*traipse through the first  N  items. */
                            !.k= random(0, 9)    /*set the  Kth  item with random digit.*/
                            end   /*k*/
                return                           /*the piddly stuff is done  (for now). */


import java.math.BigDecimal;
import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class PowerTree {
    private static Map<Integer, Integer> p = new HashMap<>();
    private static List<List<Integer>> lvl = new ArrayList<>();

    static {
        p.put(1, 0);

        ArrayList<Integer> temp = new ArrayList<>();
        temp.add(1);
        lvl.add(temp);
    }

    private static List<Integer> path(int n) {
        if (n == 0) return new ArrayList<>();
        while (!p.containsKey(n)) {
            List<Integer> q = new ArrayList<>();
            for (Integer x : lvl.get(0)) {
                for (Integer y : path(x)) {
                    if (p.containsKey(x + y)) break;
                    p.put(x + y, x);
                    q.add(x + y);
                }
            }
            lvl.get(0).clear();
            lvl.get(0).addAll(q);
        }
        List<Integer> temp = path(p.get(n));
        temp.add(n);
        return temp;
    }

    private static BigDecimal treePow(double x, int n) {
        Map<Integer, BigDecimal> r = new HashMap<>();
        r.put(0, BigDecimal.ONE);
        r.put(1, BigDecimal.valueOf(x));

        int p = 0;
        for (Integer i : path(n)) {
            r.put(i, r.get(i - p).multiply(r.get(p)));
            p = i;
        }
        return r.get(n);
    }

    private static void showPow(double x, int n, boolean isIntegral) {
        System.out.printf("%d: %s\n", n, path(n));
        String f = isIntegral ? "%.0f" : "%f";
        System.out.printf(f, x);
        System.out.printf(" ^ %d = ", n);
        System.out.printf(f, treePow(x, n));
        System.out.println("\n");
    }

    public static void main(String[] args) {
        for (int n = 0; n <= 17; ++n) {
            showPow(2.0, n, true);
        }
        showPow(1.1, 81, false);
        showPow(3.0, 191, true);
    }
}


def s_of_n_creator(n)
  sample = []
  i = 0
  Proc.new do |item|
    i += 1
    if i <= n
      sample << item
    elsif rand(i) < n
      sample[rand(n)] = item
    end
    sample
  end
end

frequency = Array.new(10,0)
100_000.times do
  s_of_n = s_of_n_creator(3)
  sample = nil
  (0..9).each {|digit| sample = s_of_n[digit]}
  sample.each {|digit| frequency[digit] += 1}
end

(0..9).each {|digit| puts "#{digit}\t#{frequency[digit]}"}


use rand::{Rng,weak_rng};

struct SofN<R: Rng+Sized, T> {
    rng: R,
    sample: Vec<T>,
    i: usize,
    n: usize,
}

impl<R: Rng, T> SofN<R, T> {
    fn new(rng: R, n: usize) -> Self {
        SofN{rng, sample: Vec::new(), i: 0, n}
    }

    fn add(&mut self, item: T) {
        self.i += 1;
        if self.i <= self.n {
            self.sample.push(item);
        } else if self.rng.gen_range(0, self.i) < self.n {
            self.sample[self.rng.gen_range(0, self.n)] = item;
        }
    }

    fn sample(&self) -> &Vec<T> {
        &self.sample
    }
}

pub fn main() {
    const MAX: usize = 10;
    let mut bin: [i32; MAX] = Default::default();
    for _ in 0..100000 {
        let mut s_of_n = SofN::new(weak_rng(), 3);

        for i in 0..MAX { s_of_n.add(i); }

        for s in s_of_n.sample() {
            bin[*s] += 1;
        }
    }

    for (i, x) in bin.iter().enumerate() {
        println!("frequency of {}: {}", i, x);
    }
}


import java.util
import scala.util.Random

object KnuthsAlgorithmS extends App {

  import scala.collection.JavaConverters._

  val (n, rand, bin) = (3, Random, new Array[Int](10))

  for (_ <- 0 until 100000) {
    val sample = new util.ArrayList[Int](n)
    for (item <- 0 until 10) {
      if (item < n) sample.add(item)
      else if (rand.nextInt(item + 1) < n)
        sample.asScala(rand.nextInt(n)) = item
    }
    for (s <- sample.asScala.toList) bin(s) += 1
  }

  println(bin.mkString("[", ", ", "]"))
}


# Input: {p, lvl, path}
def kpath($n):
  if $n == 0 then .path=[]
  else until( .p[$n|tostring];
        .q = []
        | reduce .lvl[0][] as $x (.;
             kpath($x)
             | label $out
             | foreach (.path[], null) as $y (.;
                if $y == null then .
                else (($x + $y)|tostring) as $xy
                | if .p[$xy] then .
                  else .p[$xy] = $x
                  | .q += [$x + $y]
                  end
                end;
                select($y == null) ) )
        | .lvl[0] = .q )
  | kpath(.p[$n|tostring])
  | .path += [$n]
  end ;

# Input: as for kpath
def treePow($x; $n):
  reduce kpath($n).path[] as $i (
    {r: { "0": 1, "1": $x }, pp: 0 };
    .r[$i|tostring] = .r[($i - .pp)|tostring] * .r[.pp|tostring]
    | .pp = $i )
  | .r[$n|tostring] ;

def showPow($x; $n):
  {  p: {"1": 0},
   lvl: [[1]],
   path: []}
  | "\($n): \(kpath($n).path)",
    "\($x) ^ \($n) = \(treePow($x; $n))";

(range(0;18) as $n | showPow(2; $n)),
showPow(1.1; 81),
showPow(3; 191)


module KnuthPowerTree

const p = Dict(1 => 0)
const lvl = [[1]]

function path(n)
    global p, lvl
    iszero(n) && return Int[]
    while n ∉ keys(p)
        q = Int[]
        for x in lvl[1], y in path(x)
            if (x + y) ∉ keys(p)
                p[x + y] = x
                push!(q, x + y)
            end
        end
        lvl[1] = q
    end
    return push!(path(p[n]), n)
end

function pow(x::Number, n::Integer)
    r = Dict{typeof(n), typeof(x)}(0 => 1, 1 => x)
    p = 0
    for i in path(n)
        r[i] = r[i - p] * r[p]
        p = i
    end
    return r[n]
end

end  # module KnuthPowerTree


// version 1.1.3

import java.math.BigDecimal

var p = mutableMapOf(1 to 0)
var lvl = mutableListOf(listOf(1))

fun path(n: Int): List<Int> {
    if (n == 0) return emptyList<Int>()
    while (n !in p) {
        val q = mutableListOf<Int>()
        for (x in lvl[0]) {
            for (y in path(x)) {
                if ((x + y) in p) break
                p[x + y] = x
                q.add(x + y)
            }
        }
        lvl[0] = q
    }
    return path(p[n]!!) + n
}

fun treePow(x: Double, n: Int): BigDecimal {
    val r = mutableMapOf(0 to BigDecimal.ONE, 1 to BigDecimal(x.toString()))
    var p = 0
    for (i in path(n)) {
        r[i] = r[i - p]!! * r[p]!!
        p = i
    }
    return r[n]!!
}

fun showPow(x: Double, n: Int, isIntegral: Boolean = true) {
    println("$n: ${path(n)}")
    val f = if (isIntegral) "%.0f" else "%f"
    println("${f.format(x)} ^ $n = ${f.format(treePow(x, n))}\n")
}

fun main(args: Array<String>) {
    for (n in 0..17) showPow(2.0, n)
    showPow(1.1, 81, false)
    showPow(3.0, 191)
}


func s_of_n_creator(n) {
    var i = 0
    var sample = []
    { |item|
        if (++i <= n) {
            sample << item;
        }
        elsif (i.rand < n) {
            sample[n.rand] = item;
        }
        sample;
    }
}

var items = 0..9;
var bin = [];

100000.times {
    var s_of_n = s_of_n_creator(3);
    var sample = []
    for item in items {
        sample = s_of_n(item);
    }
    for s in sample {
        bin[s] := 0 ++;
    }
}

say bin;


import Darwin

func s_of_n_creator<T>(n: Int) -> T -> [T]  {
  var sample = [T]()
  var i = 0
  return {(item: T) in
    i++
    if (i <= n) {
      sample.append(item)
    } else if (Int(arc4random_uniform(UInt32(i))) < n) {
      sample[Int(arc4random_uniform(UInt32(n)))] = item
    }
    return sample
  }
}

var bin = [Int](count:10, repeatedValue:0)
for trial in 0..<100000 {
  let s_of_n: Int -> [Int] = s_of_n_creator(3)
  var sample: [Int] = []
  for i in 0..<10 {
    sample = s_of_n(i)
  }
  for s in sample {
    bin[s]++
  }
}
println(bin)


package require Tcl 8.6

oo::class create SofN {
    variable items size count
    constructor {n} {
	set size $n
    }
    method item {item} {
	if {[incr count] <= $size} {
	    lappend items $item
	} elseif {rand()*$count < $size} {
	    lset items [expr {int($size * rand())}] $item
	}
	return $items
    }
}

# Test code
for {set i 0} {$i < 100000} {incr i} {
    set sOf3 [SofN new 3]
    foreach digit {0 1 2 3 4 5 6 7 8 9} {
	set digs [$sOf3 item $digit]
    }
    $sOf3 destroy
    foreach digit $digs {
	incr freq($digit)
    }
}
parray freq


import rand
import rand.seed
fn s_of_ncreator(n int) fn(u8) []u8 {
    mut s := []u8{len: 0, cap:n}
    mut m := n
    return fn[mut s, mut m, n](item u8) []u8 {
        if s.len < n {
            s << item
        } else {
            m++
            if rand.intn(m) or {0} < n {
                s[rand.intn(n) or {0}] = item
            }
        }
        return s
    }
}

fn main() {
    rand.seed(seed.time_seed_array(2))
    mut freq := [10]int{}
    for _ in 0..int(1e5) {
        s_of_n := s_of_ncreator(3)
        for d := '0'[0]; d < '9'[0]; d++ {
            s_of_n(d)
        }
        for d in s_of_n('9'[0]) {
            freq[d-'0'[0]]++
        }
    }
    println(freq)
}


ClearAll[NextStep, TreePow]
NextStep[pows_List] := Module[{maxlen, sel, new, vals, knows},
  maxlen = Max[Length /@ pows[[All, "Path"]]];
  sel = Select[pows, Length[#["Path"]] == maxlen &];
  knows = pows[[All, "P"]];
  new = {};
  Do[
   vals = s["P"] + s["Path"];
   vals = DeleteCases[vals, Alternatives @@ Join[s["Path"], knows]];
   new =
    Join[
     new, <|"Path" -> Append[s["Path"], #], "P" -> #|> & /@ vals];
   ,
   {s, sel}
   ];
  new //= DeleteDuplicatesBy[#["P"] &];
  SortBy[Join[pows, new], #["P"] &]
  ]
TreePow[path_List, base_] := Module[{db, tups},
  db = <|1 -> base|>;
  Do[
   tups = Tuples[Keys[db], 2];
   tups = Select[tups, #[[2]] >= #[[1]] &];
   tups = Select[tups, Total[#] == next &];
   If[Length[tups] < 1, Abort[]];
   tups //= First;
   AssociateTo[db, Total[tups] -> (Times @@ (db /@ tups))]
   ,
   {next, Rest[path]}
   ];
  db[Last[path]]
  ]

pows = {<|"Path" -> {1}, "P" -> 1|>};
steps = Nest[NextStep, pows, 7];
LayeredGraphPlot[DirectedEdge @@@ steps[[2 ;;, "Path", -2 ;;]], VertexLabels -> Automatic]

pows = {<|"Path" -> {1}, "P" -> 1|>};
steps = Nest[NextStep, pows, 5];
assoc = Association[#["P"] -> #["Path"] & /@ steps];
Dataset[assoc]
TreePow[assoc[#], 2] & /@ Range[1, 17]

pows = {<|"Path" -> {1}, "P" -> 1|>};
steps = NestWhile[NextStep, pows, Not[MemberQ[#[[All, "P"]], 191]] &];
SelectFirst[steps, #["P"] == 191 &]["Path"];
TreePow[%, 3]

pows = {<|"Path" -> {1}, "P" -> 1|>};
steps = NestWhile[NextStep, pows, Not[MemberQ[#[[All, "P"]], 81]] &];
SelectFirst[steps, #["P"] == 81 &]["Path"];
TreePow[%, 1.1]


import tables
import bignum

type

  Id = Natural    # Node identifier (= exponent value).

  Tree = object
    parents: Table[Id, Id]  # Mapping node id -> parent node id.
    lastLevel: seq[Id]      # List of node ids in current last level.

func initTree(): Tree =
  ## Return an initialized tree.
  const Root = Id(1)
  Tree(parents: {Root: Id(0)}.toTable, lastLevel: @[Root])

func path(tree: var Tree; id: Id): seq[Id] =
  ## Return the path to node with given id.

  if id == 0: return

  while id notin tree.parents:
    # Node "id" not yet present in the tree: build a new level.
    var newLevel: seq[Id]
    for x in tree.lastLevel:
      for y in tree.path(x):
        let newId = x + y
        if newId in tree.parents: break   # Node already created.
        # Create a new node.
        tree.parents[newId] = x
        newLevel.add newId
    tree.lastLevel = move(newLevel)

  # Node path is the concatenation of parent node path and node id.
  result = tree.path(tree.parents[id]) & id

func treePow[T: SomeNumber | Int](tree: var Tree; x: T; n: Natural): T =
  ## Compute x^n using the power tree.
  let one = when T is Int: newInt(1) else: T(1)
  var results = {0: one, 1: x}.toTable  # Intermediate and last results.
  var k = 0
  for i in tree.path(n):
    results[i] = results[i - k] * results[k]
    k = i
  return results[n]

proc showPow[T: SomeNumber | Int](tree: var Tree; x: T; n: Natural) =
  echo n, " → ", ($tree.path(n))[1..^1]
  let result = tree.treePow(x, n)
  echo x, "^", n, " = ", result

when isMainModule:

  var tree = initTree()
  for n in 0..17: tree.showPow(2, n)
  echo ""
  tree.showPow(1.1, 81)
  echo ""
  tree.showPow(newInt(3), 191)


import "random" for Random

var r = Random.new()

var sOfNCreator = Fn.new { |n|
    var s = List.filled(n, 0)
    var next = 0
    var m = n
    return Fn.new { |item|
        if (next < n) {
            s[next] = item
            next = next + 1
        } else {
            m = m + 1
            if (r.int(m) < n) {
                var t = r.int(n)
                s[t] = item
                if (next <= t) next = t + 1
            }
        }
        return s
    }
}

var freq = List.filled(10, 0)
for (r in 0...1e5) {
    var sOfN = sOfNCreator.call(3)
    for (d in 48...57) sOfN.call(d)
    for (d in sOfN.call(57)) {
        freq[d - 48] = freq[d - 48] + 1
    }
}
System.print(freq)


fcn s_of_n_creator(n){
   fcn(item,ri,N,samples){
      i:=ri.inc(); // 1,2,3,4,...
      if(i<=N) samples.append(item);
      else if ((0).random(i) < N) samples[(0).random(N)] = item;
      samples
   }.fp1(Ref(1),n,L())
}


with javascript_semantics
constant p = new_dict({{1,0}})
sequence lvl = {1}

function path(integer n)
    if n=0 then return {} end if
    while getd_index(n,p)=NULL do
        sequence q = {}
        for i=1 to length(lvl) do
            integer x = lvl[i]
            sequence px = path(x)
            for j=1 to length(px) do
                integer y = x+px[j]
                if getd_index(y,p)!=NULL then exit end if
                setd(y,x,p)
                q &= y
            end for
        end for
        lvl = q
    end while
    return path(getd(n,p))&n
end function

include mpfr.e
mpfr_set_default_precision(500)

function treepow(object x, integer n, sequence pn = {})
-- x can be atom or string (but not mpfr)
-- (asides: sequence r uses out-by-1 indexing, ie r[1] is for 0.
--          sequence c is used to double-check we are not trying
--          to use something which has not yet been calculated.)
    if pn={} then pn=path(n) end if
    sequence r = {mpfr_init(1),mpfr_init(x)},
             c = {1,1}&repeat(0,max(0,n-1))
    for i=1 to max(0,n-1) do r &= mpfr_init() end for
    integer p = 0
    for i=1 to length(pn) do
        integer pi = pn[i]
        if c[pi-p+1]=0 then ?9/0 end if
        if c[p+1]=0 then ?9/0 end if
        mpfr_mul(r[pi+1],r[pi-p+1],r[p+1])
        c[pi+1] = 1
        p = pi
    end for
--  string res = shorten(trim_tail(mpfr_sprintf("%.83Rf",r[n+1]),".0"))
    string res = shorten(trim_tail(mpfr_get_fixed(r[n+1],83),".0"))
    r = mpfr_free(r)
    return res
end function

procedure showpow(object x, integer n)
    sequence pn = path(n)
    string xs = iff(string(x)?x:sprintf("%3g",x))
    printf(1,"%48v : %3s ^ %d = %s\n", {pn,xs,n,treepow(x,n,pn)})
end procedure

for n=0 to 17 do
    showpow(2,n)
end for
showpow("1.1",81)
showpow(3,191)


from __future__ import print_function

# remember the tree generation state and expand on demand
def path(n, p = {1:0}, lvl=[[1]]):
	if not n: return []
	while n not in p:
		q = []
		for x,y in ((x, x+y) for x in lvl[0] for y in path(x) if not x+y in p):
			p[y] = x
			q.append(y)
		lvl[0] = q

	return path(p[n]) + [n]

def tree_pow(x, n):
    r, p = {0:1, 1:x}, 0
    for i in path(n):
        r[i] = r[i-p] * r[p]
        p = i
    return r[n]

def show_pow(x, n):
    fmt = "%d: %s\n" + ["%g^%d = %f", "%d^%d = %d"][x==int(x)] + "\n"
    print(fmt % (n, repr(path(n)), x, n, tree_pow(x, n)))

for x in range(18): show_pow(2, x)
show_pow(3, 191)
show_pow(1.1, 81)


#lang racket

(define pow-path-cache (make-hash '((0 . (0)) (1 . (0 1)))))

(define pow-path-level '(1))

(define (pow-path-extend!)
  (define next-level
    (for*/fold ([next-level '()])
               ([x (in-list pow-path-level)]
                [y (in-list (pow-path x))]
                [s (in-value (+ x y))]
                #:when (not (hash-has-key? pow-path-cache s)))
      (hash-set! pow-path-cache s (append (hash-ref pow-path-cache x) (list s)))
      (cons s next-level)))
  (set! pow-path-level (reverse next-level)))

(define (pow-path n)
  (let loop ()
    (unless (hash-has-key? pow-path-cache n)
      (pow-path-extend!)
      (loop)))
 (hash-ref pow-path-cache n))

(define (pow-tree x n)
  (define pows (make-hash `((0 . 1) (1 . ,x))))
  (for/fold ([prev 0])
            ([i (in-list (pow-path n))])
    (hash-set! pows i (* (hash-ref pows (- i prev)) (hash-ref pows prev)))
    i)
  (hash-ref pows n))

(define (show-pow x n)
  (printf "~a: ~a\n" n (cdr (pow-path n)))
  (printf "~a^~a = ~a\n" x n (pow-tree x n)))

(for ([x (in-range 18)])
  (show-pow 2 x))
(show-pow 3 191)
(show-pow 1.1 81)


use v6;

sub power-path ($n ) {
    state @unused_nodes = (2,);
    state @power-tree = (False,0,1);

    until @power-tree[$n].defined {
        my $node = @unused_nodes.shift;

        for  $node X+ power-path($node).pick(*) {
            next if @power-tree[$_].defined;
            @unused_nodes.push($_);
            @power-tree[$_]= $node;
        }
    }

    ( $n, { @power-tree[$_] } ...^ 0 ).reverse;
}

multi power ( $, 0 ) { 1 };
multi power ( $n, $exponent ) {
    state  %p;
    my     %r =  %p{$n}  // ( 0 => 1, 1 => $n ) ;

    for power-path( $exponent ).rotor( 2 => -1 ) -> ( $p, $c ) {
        %r{ $c } = %r{ $p } * %r{ $c - $p }
    }

    %p{$n} := %r ;
    %r{ $exponent }
}

say 'Power paths: ',      pairs map *.&power-path,    ^18;
say '2 ** key = value: ', pairs map { 2.&power($_) }, ^18;

say 'Path for 191: ', power-path 191;
say '3 ** 191 = ',    power   3, 191;
say 'Path for 81: ',  power-path  81;
say '1.1 ** 81 = ',   power 1.1,  81;


/*REXX program produces & displays a  power tree  for P,  and calculates & displays X^P.*/
numeric digits 1000                              /*be able to handle some large numbers.*/
parse arg XP                                     /*get sets:   X, low power, high power.*/
if XP=''  then XP='2 -4 17   3 191 191   1.1 81' /*Not specified?  Then use the default.*/
          /*────── X LP HP   X  LP  HP    X  LP  ◄── X, low power, high power ··· repeat*/
     do  until XP=''
     parse var XP    x pL pH   XP;    x= x / 1   /*get X, lowP, highP; and normalize X. */
     if pH=''  then pH= pL                       /*No highPower?  Then assume lowPower. */

       do e=pL  to pH;           p= abs(e) / 1   /*use a range of powers;   use  │E│    */
       $= powerTree(p);          w= length(pH)   /*construct the power tree, (pow list).*/
                                                 /* [↑]  W≡length for an aligned display*/
          do i=1  for words($);  @.i= word($, i) /*build a fast Knuth's power tree array*/
          end   /*i*/

       if p==0  then do;  z= 1;  call show;  iterate;  end  /*handle case of zero power.*/
       !.= .;   z= x;     !.1= z;     prv= z     /*define/construct the first power of X*/

           do k=2  to words($);       n= @.k     /*obtain the power (number) to be used.*/
           prev= k - 1;     diff= n - @.prev     /*these are used for the odd powers.   */
           if n//2==0  then z= prv ** 2          /*Even power?   Then square the number.*/
                       else z= z * !.diff        /* Odd   "        "  mult. by pow diff.*/
           !.n= z                                /*remember for other multiplications.  */
           prv= z                                /*remember for squaring the numbers.   */
           end   /*k*/
       call show                                 /*display the expression and its value.*/
       end       /*e*/
     end         /*until XP ···*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
powerTree: arg y 1 oy;   $=                      /*Z is the result; $ is the power tree.*/
           if y=0 | y=1  then return y           /*handle special cases for zero & unity*/
           #.= 0;   @.= 0;    #.0= 1             /*define default & initial array values*/
                                                 /* [↓]  add blank "flag" thingy──►list.*/
                   do  while \(y//2);  $= $ ' '  /*reduce "front" even power #s to odd #*/
                   if y\==oy  then $= y $        /*(only)  ignore the first power number*/
                   y= y % 2                      /*integer divide the power (it's even).*/
                   end   /*while*/

           if $\==''  then $= y $                /*re─introduce the last power number.  */
           $= $ oy                               /*insert last power number 1st in list.*/
           if y>1  then do      while  @.y==0;            n= #.0;        m= 0
                          do    while  n\==0;             q= 0;          s= n
                            do  while  s\==0;             _= n + s
                            if @._==0  then do;  if q==0  then m_= _;
                                                 #._= q;  @._= n;        q= _
                                            end
                            s= @.s
                            end   /*while s¬==0*/
                          if q\==0  then do;   #.m= q;   m= m_;   end
                          n= #.n
                          end     /*while n¬==0*/
                        #.m= 0
                        end       /*while @.y==0*/
           z= @.y
                            do  while z\==0;   $= z $;   z= @.z;  end /*build power list*/
           return space($)                                            /*del extra blanks*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: if e<0  then z=format(1/z, , 40)/1;     _=right(e, w)           /*use reciprocal? */
      say left('power tree for '  _  " is: "  $,60)  '═══'  x"^"_  ' is: '  z;      return


var lvl = [[1]]
var p = Hash(1 => 0)

func path(n) is cached {
    n || return []
    while (n !~ p) {
        var q = []
        for x in lvl[0] {
            for y in path(x) {
                break if (x+y ~~ p)
                y = x+y
                p{y} = x
                q << y
            }
        }
        lvl[0] = q
    }
    path(p{n}) + [n]
}

func tree_pow(x, n) {
    var r = Hash(0 => 1, 1 => x)
    var p = 0
    for i in path(n) {
        r{i} = (r{i-p} * r{p})
        p = i
    }
    r{n}
}

func show_pow(x, n) {
    var fmt = ("%d: %s\n" + ["%g^%s = %f", "%s^%s = %s"][x.is_int] + "\n")
    print(fmt % (n, path(n), x, n, tree_pow(x, n)))
}

for x in ^18 { show_pow(2, x) }
show_pow(1.1, 81)
show_pow(3, 191)


import "/big" for BigRat
import "/fmt" for Fmt

var p = { 1: 0 }
var lvl = [[1]]

var path // recursive
path = Fn.new { |n|
    if (n == 0) return []
    while (!p.containsKey(n)) {
        var q = []
        for (x in lvl[0]) {
            System.write("") // guard against VM recursion bug
            for (y in path.call(x)) {
                if (p.containsKey(x + y)) break
                p[x + y] = x
                q.add(x + y)
            }
        }
        lvl[0] = q
    }
    System.write("") // guard against VM recursion bug
    var l = path.call(p[n])
    l.add(n)
    return l
}

var treePow = Fn.new { |x, n|
    var r = { 0: BigRat.one, 1: BigRat.fromDecimal(x) }
    var p = 0
    for (i in path.call(n)) {
        r[i] = r[i-p] * r[p]
        p = i
    }
    return r[n]
}

var showPow = Fn.new { |x, n|
    System.print("%(n): %(path.call(n))")
    Fmt.print("$s ^ $d = $s\n", x, n, treePow.call(x, n).toDecimal(6))
}

for (n in 0..17) showPow.call(2, n)
showPow.call(1.1, 81)
showPow.call(3, 191)


# remember the tree generation state and expand on demand
fcn path(n,p=Dictionary(1,0),lvl=List(List(1))){
   if(n==0) return(T);
   while(not p.holds(n)){
      q:=List();
      foreach x,y in (lvl[0],path(x,p,lvl)){
         if(p.holds(x+y)) break;  // not this y
	 y=x+y; p[y]=x;
	 q.append(y);
      }
      lvl[0]=q
   }
   path(p[n],p,lvl) + n
}

fcn tree_pow(x,n,path){
   r,p:=Dictionary(0,1, 1,x), 0;
   foreach i in (path){ r[i]=r[i-p]*r[p]; p=i; }
   r[n]
}

fcn show_pow(x,n){
   fmt:="%d: %s\n" + T("%g^%d = %f", "%d^%d = %d")[x==Int(x)] + "\n";
   println(fmt.fmt(n,p:=path(n),x,n,tree_pow(x,n,p)))
}


INCLUDE "H6:REALMATH.ACT"

DEFINE MAXSIZE="20"

INT ARRAY SinTab=[
  0 4 9 13 18 22 27 31 36 40 44 49 53 58 62 66 71 75 79 83
  88 92 96 100 104 108 112 116 120 124 128 132 136 139 143
  147 150 154 158 161 165 168 171 175 178 181 184 187 190
  193 196 199 202 204 207 210 212 215 217 219 222 224 226
  228 230 232 234 236 237 239 241 242 243 245 246 247 248
  249 250 251 252 253 254 254 255 255 255 256 256 256 256]

BYTE ARRAY
  depthStack(MAXSIZE),stageStack(MAXSIZE)
BYTE stacksize=[0]

INT FUNC Sin(INT a)
  WHILE a<0 DO a==+360 OD
  WHILE a>360 DO a==-360 OD
  IF a<=90 THEN
    RETURN (SinTab(a))
  ELSEIF a<=180 THEN
    RETURN (SinTab(180-a))
  ELSEIF a<=270 THEN
    RETURN (-SinTab(a-180))
  ELSE
    RETURN (-SinTab(360-a))
  FI
RETURN (0)

INT FUNC Cos(INT a)
RETURN (Sin(a-90))

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN RETURN (1) FI
RETURN (0)

BYTE FUNC IsFull()
  IF stacksize=MAXSIZE THEN RETURN (1) FI
RETURN (0)

PROC Push(BYTE depth,stage)
  IF IsFull() THEN Break() FI
  depthStack(stacksize)=depth
  stageStack(stackSize)=stage
  stacksize==+1
RETURN

PROC Pop(BYTE POINTER depth,stage)
  IF IsEmpty() THEN Break() FI
  stacksize==-1
  depth^=depthStack(stacksize)
  stage^=stageStack(stacksize)
RETURN

PROC DrawKoch(INT x,y REAL POINTER len BYTE depth)
  BYTE stage
  INT angle=[180],c
  REAL rx,ry,r256,tmp1,tmp2

  IntToReal(x,rx)
  IntToReal(y,ry)
  IntToReal(256,r256)

  Push(depth,0)

  WHILE IsEmpty()=0
  DO
    Pop(@depth,@stage)
    IF depth=0 THEN
      Plot(x,y)
      ;x==+Cos(angle)*len/256
      c=Cos(angle)
      IntToRealForNeg(c,tmp1)
      RealDiv(tmp1,r256,tmp2)
      RealMult(tmp2,len,tmp1)
      RealAdd(rx,tmp1,tmp2)
      RealAssign(tmp2,rx)
      x=RealToInt(rx)
      ;y==-Sin(angle)*len/256
      c=Sin(angle)
      IntToRealForNeg(c,tmp1)
      RealDiv(tmp1,r256,tmp2)
      RealMult(tmp2,len,tmp1)
      RealSub(ry,tmp1,tmp2)
      RealAssign(tmp2,ry)
      y=RealToInt(ry)
      DrawTo(x,y)
    ELSE
      IF stage=1 THEN
        angle==-60
      ELSEIF stage=2 THEN
        angle==+120
      ELSEIF stage=3 THEN
        angle==-60
      FI
      IF stage<=3 THEN
        Push(depth,stage+1)
        Push(depth-1,0)
      FI
    FI
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
  REAL len

  Graphics(8+16)
  Color=1
  COLOR1=$0C
  COLOR2=$02

  ValR("3.7",len)
  DrawKoch(10,140,len,4)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with Ada.Command_Line;
with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO;
with PDF_Out;

procedure Koch_Curve is

   package Real_Math is
     new Ada.Numerics.Generic_Elementary_Functions (PDF_Out.Real);
   use Real_Math, PDF_Out, Ada.Command_Line, Ada.Text_IO;

   subtype Angle_Deg  is Real;
   type    Level_Type is range 0 .. 7;

   Purple : constant Color_Type := (0.7, 0.0, 0.5);
   Length : constant Real       := 400.0;
   Corner : constant Point      := (90.0, 580.0);

   Level     : Level_Type;
   Current   : Point      := (0.0, 0.0);
   Direction : Angle_Deg  := Angle_Deg'(60.0);
   Doc       : PDF_Out_File;

   procedure Koch (Level : Level_Type; Length : Real) is
   begin
      if Level = 0 then
         Current := Current + Length * Point'(Sin (Direction, 360.0),
                                              Cos (Direction, 360.0));
         Doc.Line (Corner + Current);
      else
         Koch (Level - 1, Length / 3.0);  Direction := Direction -  60.0;
         Koch (Level - 1, Length / 3.0);  Direction := Direction + 120.0;
         Koch (Level - 1, Length / 3.0);  Direction := Direction -  60.0;
         Koch (Level - 1, Length / 3.0);
      end if;
   end Koch;

begin
   if Argument_Count /= 1 then
      Put_Line ("koch_curve <level>");
      Put_Line ("  <level>   0 .. 7");
      Put_Line ("open koch.pdf to view ouput");
      return;
   end if;
   Level := Level_Type'Value (Argument (1));

   Doc.Create ("koch.pdf");
   Doc.Page_Setup (A4_Portrait);
   Doc.Margins (Margins_Type'(Left   => Cm_2_5,
                              others => One_cm));
   Doc.Color (Purple);
   Doc.Move (Corner);
   for A in 1 .. 3 loop
      Koch (Level, Length);
      Direction := Direction + 120.0;
   end loop;
   Doc.Finish_Path (Close_Path => True,
                    Rendering  => Fill,
                    Rule       => Even_Odd);
   Doc.Close;
end Koch_Curve;


global RtoD, DtoR
RtoD = 180 / Pi
DtoR = Pi / 180

global posX, posY, angulo
posX = 170 : posY = 100 : angulo = 0

global ancho, alto
ancho = 650 : alto = 650
graphsize ancho, alto

subroutine kochLado(longitud, fondo)
	if fondo = 0 then
		dx = cos(angulo*DtoR) * longitud
		dy = sin(angulo*DtoR) * longitud
		color rgb(5,100,24)
		line (posX, posY, posX+dx, posY+dy)
		posX += dx
		posY += dy
	else
		call kochLado(longitud/3.0, fondo-1)
		angulo += 60
		call kochLado(longitud/3.0, fondo-1)
		angulo -= 120
		call kochLado(longitud/3.0, fondo-1)
		angulo += 60
		call kochLado(longitud/3.0, fondo-1)
	end if
end subroutine

subroutine CopoNieveKoch(longitud, recursionfondo)
	for i = 1 to 6
		call kochLado(longitud,recursionfondo)
		angulo -= 300
	next i
end subroutine

for n = 0 To 7
	clg
	fastgraphics
	text 3,4, "Copo de nieve de Koch"
	text 4,16, "Iteración número: " & n
	call CopoNieveKoch(280, n)
	pause 0.8
	refresh
next n

imgsave "Koch_curve.jpg", "jpg"
end


            hopper src/kock_curve.com > kockcurve.svg
       or
            ./src/kock_curve.com > kockcurve.svg


gdip1()
KochX := 0, KochY := 0
Koch(0, 0, A_ScreenWidth, A_ScreenHeight, 4, Arr:=[])
xmin := xmax := ymin := ymax := 0
for i, point in Arr
{
	xmin := A_Index = 1 ? point.x : xmin < point.x ? xmin : point.x
	xmax := point.x > xmax ? point.x : xmax
	ymin := A_Index = 1 ? point.y : ymin < point.y ? ymin : point.y
	ymax := point.y > ymax ? point.y : ymax
}
for i, point in Arr
	points .= point.x - xmin + KochX "," point.y - ymin + KochY "|"
points := Trim(points, "|")
Gdip_DrawLines(G, pPen, Points)
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
return
; ---------------------------------------------------------------

Koch(x1, y1, x2, y2, iter, Arr) {
	Pi := 3.141592653589793
	angle := Pi / 3 	; 60 degrees
	x3 := (x1*2 + x2) / 3
	y3 := (y1*2 + y2) / 3
	x4 := (x1 + x2*2) / 3
	y4 := (y1 + y2*2) / 3
	x5 := x3 + (x4-x3)*Cos(angle) + (y4-y3)*Sin(angle)
	y5 := y3 - (x4-x3)*Sin(angle) + (y4-y3)*Cos(angle)
	if (iter > 0)
	{
		iter--
		koch(x1, y1, x3, y3, iter, Arr)
		koch(x3, y3, x5, y5, iter, Arr)
		koch(x5, y5, x4, y4, iter, Arr)
		koch(x4, y4, x2, y2, iter, Arr)
	}
	else
	{
		Arr[Arr.count()+1, "x"] := x1, Arr[Arr.count(), "y"] := y1
		Arr[Arr.count()+1, "x"] := x3, Arr[Arr.count(), "y"] := y3
		Arr[Arr.count()+1, "x"] := x5, Arr[Arr.count(), "y"] := y5
		Arr[Arr.count()+1, "x"] := x4, Arr[Arr.count(), "y"] := y4
		Arr[Arr.count()+1, "x"] := x2, Arr[Arr.count(), "y"] := y2
	}
}
; ---------------------------------------------------------------
gdip1(){
	global
	If !pToken := Gdip_Startup()
	{
		MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
		ExitApp
	}
	OnExit, Exit
	Width := A_ScreenWidth, Height := A_ScreenHeight
	Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
	Gui, 1: Show, NA
	hwnd1 := WinExist()
	hbm := CreateDIBSection(Width, Height)
	hdc := CreateCompatibleDC()
	obm := SelectObject(hdc, hbm)
	G := Gdip_GraphicsFromHDC(hdc)
	Gdip_SetSmoothingMode(G, 4)
	pPen := Gdip_CreatePen(0xFFFF0000, 2)
}
; ---------------------------------------------------------------
gdip2(){
	global
	Gdip_DeleteBrush(pBrush)
	Gdip_DeletePen(pPen)
	SelectObject(hdc, obm)
	DeleteObject(hbm)
	DeleteDC(hdc)
	Gdip_DeleteGraphics(G)
}
; ---------------------------------------------------------------
Exit:
gdip2()
Gdip_Shutdown(pToken)
ExitApp
Return


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

#define pi M_PI

typedef struct{
	double x,y;
}point;

void kochCurve(point p1,point p2,int times){
	point p3,p4,p5;
	double theta = pi/3;

	if(times>0){
		p3 = (point){(2*p1.x+p2.x)/3,(2*p1.y+p2.y)/3};
		p5 = (point){(2*p2.x+p1.x)/3,(2*p2.y+p1.y)/3};

		p4 = (point){p3.x + (p5.x - p3.x)*cos(theta) + (p5.y - p3.y)*sin(theta),p3.y - (p5.x - p3.x)*sin(theta) + (p5.y - p3.y)*cos(theta)};

		kochCurve(p1,p3,times-1);
		kochCurve(p3,p4,times-1);
		kochCurve(p4,p5,times-1);
		kochCurve(p5,p2,times-1);
	}

	else{
		line(p1.x,p1.y,p2.x,p2.y);
	}
}

int main(int argC, char** argV)
{
	int w,h,r;
	point p1,p2;

	if(argC!=4){
		printf("Usage : %s <window width> <window height> <recursion level>",argV[0]);
	}

	else{
		w = atoi(argV[1]);
		h = atoi(argV[2]);
		r = atoi(argV[3]);

		initwindow(w,h,"Koch Curve");

		p1 = (point){10,h-10};
		p2 = (point){w-10,h-10};

		kochCurve(p1,p2,r);

		getch();

		closegraph();
	}

	return 0;
}


// See https://en.wikipedia.org/wiki/Koch_snowflake
#include <fstream>
#include <iostream>
#include <vector>

constexpr double sqrt3_2 = 0.86602540378444; // sqrt(3)/2

struct point {
    double x;
    double y;
};

std::vector<point> koch_next(const std::vector<point>& points) {
    size_t size = points.size();
    std::vector<point> output(4*(size - 1) + 1);
    double x0, y0, x1, y1;
    size_t j = 0;
    for (size_t i = 0; i + 1 < size; ++i) {
        x0 = points[i].x;
        y0 = points[i].y;
        x1 = points[i + 1].x;
        y1 = points[i + 1].y;
        double dy = y1 - y0;
        double dx = x1 - x0;
        output[j++] = {x0, y0};
        output[j++] = {x0 + dx/3, y0 + dy/3};
        output[j++] = {x0 + dx/2 - dy * sqrt3_2/3, y0 + dy/2 + dx * sqrt3_2/3};
        output[j++] = {x0 + 2 * dx/3, y0 + 2 * dy/3};
    }
    output[j] = {x1, y1};
    return output;
}

std::vector<point> koch_points(int size, int iterations) {
    double length = size * sqrt3_2 * 0.95;
    double x = (size - length)/2;
    double y = size/2 - length * sqrt3_2/3;
    std::vector<point> points{
        {x, y},
        {x + length/2, y + length * sqrt3_2},
        {x + length, y},
        {x, y}
    };
    for (int i = 0; i < iterations; ++i)
        points = koch_next(points);
    return points;
}

void koch_curve_svg(std::ostream& out, int size, int iterations) {
    out << "<svg xmlns='http://www.w3.org/2000/svg' width='"
        << size << "' height='" << size << "'>\n";
    out << "<rect width='100%' height='100%' fill='black'/>\n";
    out << "<path stroke-width='1' stroke='white' fill='none' d='";
    auto points(koch_points(size, iterations));
    for (size_t i = 0, n = points.size(); i < n; ++i)
        out << (i == 0 ? "M" : "L") << points[i].x << ',' << points[i].y << '\n';
    out << "z'/>\n</svg>\n";
}

int main() {
    std::ofstream out("koch_curve.svg");
    if (!out) {
        std::cerr << "Cannot open output file\n";
        return EXIT_FAILURE;
    }
    koch_curve_svg(out, 600, 5);
    return EXIT_SUCCESS;
}


USING: accessors images images.testing images.viewer kernel
literals math math.constants math.functions sequences ;
IN: rosetta-code.koch-curve

CONSTANT: order 17
CONSTANT: theta 1.047197551196598      ! 60 degrees in radians
CONSTANT: move-distance 0.25
CONSTANT: dim { 600 400 }
CONSTANT: offset-x 500
CONSTANT: offset-y 300

: <koch-image> ( -- image )
    <rgb-image> dim >>dim
    dim product 3 * [ 255 ] B{ } replicate-as >>bitmap ;

: thue-morse ( n -- seq )
    { 0 } swap [ [ ] [ [ 1 bitxor ] map ] bi append ] times ;

TUPLE: turtle
    { heading initial: 0 } { x initial: 0 } { y initial: 0 } ;

: turn ( turtle -- turtle' )
    [ theta + 2pi mod ] change-heading ;

: move ( turtle -- turtle' )
    dup heading>> [ cos move-distance * + ] curry change-x
    dup heading>> [ sin move-distance * + ] curry change-y ;

: step ( turtle elt -- turtle' )
    [ move ] [ drop turn ] if-zero ;

: setup-pixel ( turtle -- pixel x y )
    { 0 0 0 } swap [ x>> ] [ y>> ] bi
    [ >integer ] [email protected] [ offset-x + ] [ offset-y + ] bi* ;

: koch-curve ( -- )
    <koch-image> turtle new over order thue-morse [
        [ dup setup-pixel ] [ set-pixel-at ] [ step drop ] tri*
    ] 2with each image-window ;

MAIN: koch-curve


include lib/graphics.4th
include lib/math.4th
include lib/enter.4th

: (p3&p5) 2* + 3 / ;                   ( n1 n2 -- n2+n2+n1/3)
: (p3) rot (p3&p5) >r swap (p3&p5) r> ;
: (p5) rot swap (p3&p5) >r (p3&p5) r> ;
: (*/10K) * 10K 2 / + 10K / ;          ( n1 n2 -- n1*n2/10000)

: koch                                 ( x1 y1 x2 y2 n --)
  dup 0> if
    1- >r 2over 2over (p5)
    2>r 2over 2over (p3) 2r>           ( x1 y1 x2 y2 x3 y3 x5 y5 )
    PI*10K 3 / >r 2over 2over rot - >r swap - >r ( R: n theta y5-y3 x5-x3)
    2over [email protected] r"@ (sin) (*/10K) - r'@ r"@ (cos) (*/10K) +
    swap  [email protected] r"@ (cos) (*/10K) + r'@ r"@ (sin) (*/10K) +
    rdrop rdrop rdrop swap             ( x1 y1 x2 y2 x3 y3 x5 y5 x4 y4 R: n)

    2rot 2>r 2>r 2rot 2r> 2r> 2rot     ( x2 y2 x5 y5 x4 y4 x3 y3 x1 y1 R: n)
    2over [email protected] recurse                   ( x2 y2 x5 y5 x4 y4 x3 y3 R: n )
    2over [email protected] recurse                   ( x2 y2 x5 y5 x4 y4 R: n )
    2over [email protected] recurse                   ( x2 y2 x5 y5 R: n)
    2swap r> recurse                   ( --)
  ;then drop line
;

600 pic_width ! 600 pic_height !       \ set canvas size
color_image 255 whiteout blue          \ paint blue on white

." Level (0-4): " enter 0 max 4 min >r

450 100 450 500 [email protected] koch                \ paint the snowflake
115 300 450 100 [email protected] koch
450 500 115 300 r> koch

s" gkoch.ppm" save_image               \ save the image


Const Pi = 4 * Atn(1)
Const RtoD = 180 / Pi
Const DtoR = Pi / 180

Dim Shared As Single posX = 260, posY = 90, angulo = 0

Screen 19 : Color 0,15

Sub kochLado(longitud As Integer, fondo As Integer)
    Dim As Single dx, dy
    If fondo = 0 Then
        dx = Cos(angulo*DtoR) * longitud
        dy = Sin(angulo*DtoR) * longitud
        Line (posX, posY)-(posX+dx, posY+dy), 2
        posX += dx
        posY += dy
    Else
        kochLado(longitud/3.0, fondo-1)
        angulo += 60
        kochLado(longitud/3.0, fondo-1)
        angulo -= 120
        kochLado(longitud/3.0, fondo-1)
        angulo += 60
        kochLado(longitud/3.0, fondo-1)
    End If
End Sub

Sub CopoNieveKoch(longitud As Integer, recursionfondo As Integer)
    For i As Integer = 1 To 6
        kochLado(longitud,recursionfondo)
        angulo -= 300
    Next i
End Sub

For n As Integer = 0 To 5
    Cls
    Locate 3,4: Print "Copo de nieve de Koch"
    Locate 4,4: Print "Iteracion numero: " & n
    CopoNieveKoch(280, n)
    Sleep 800
Next n
color 4: Locate 6,4: Print "Pulsa una tecla..."
Bsave "Koch_curve.bmp",0
Sleep
End


package main

import (
    "github.com/fogleman/gg"
    "math"
)

var dc = gg.NewContext(512, 512)

func koch(x1, y1, x2, y2 float64, iter int) {
    angle := math.Pi / 3 // 60 degrees
    x3 := (x1*2 + x2) / 3
    y3 := (y1*2 + y2) / 3
    x4 := (x1 + x2*2) / 3
    y4 := (y1 + y2*2) / 3
    x5 := x3 + (x4-x3)*math.Cos(angle) + (y4-y3)*math.Sin(angle)
    y5 := y3 - (x4-x3)*math.Sin(angle) + (y4-y3)*math.Cos(angle)
    if iter > 0 {
        iter--
        koch(x1, y1, x3, y3, iter)
        koch(x3, y3, x5, y5, iter)
        koch(x5, y5, x4, y4, iter)
        koch(x4, y4, x2, y2, iter)
    } else {
        dc.LineTo(x1, y1)
        dc.LineTo(x3, y3)
        dc.LineTo(x5, y5)
        dc.LineTo(x4, y4)
        dc.LineTo(x2, y2)
    }
}

func main() {
    dc.SetRGB(1, 1, 1) // White background
    dc.Clear()
    koch(100, 100, 400, 400, 4)
    dc.SetRGB(0, 0, 1) // Blue curve
    dc.SetLineWidth(2)
    dc.Stroke()
    dc.SavePNG("koch.png")
}


import Data.Bifunctor (bimap)
import Text.Printf (printf)

------------------------ KOCH CURVE ----------------------
kochSnowflake ::
  Int ->
  (Float, Float) ->
  (Float, Float) ->
  [(Float, Float)]
kochSnowflake n a b =
  concat $
    zipWith (kochCurve n) points (xs <> [x])
  where
    points@(x : xs) = [a, equilateralApex a b, b]

kochCurve ::
  Int ->
  (Float, Float) ->
  (Float, Float) ->
  [(Float, Float)]
kochCurve n ab xy = ab : go n (ab, xy)
  where
    go 0 (_, xy) = [xy]
    go n (ab, xy) =
      let (mp, mq) = midThirdOfLine ab xy
          points@(_ : xs) =
            [ ab,
              mp,
              equilateralApex mp mq,
              mq,
              xy
            ]
       in go (pred n) =<< zip points xs

equilateralApex ::
  (Float, Float) ->
  (Float, Float) ->
  (Float, Float)
equilateralApex = rotatedPoint (pi / 3)

rotatedPoint ::
  Float ->
  (Float, Float) ->
  (Float, Float) ->
  (Float, Float)
rotatedPoint theta (ox, oy) (a, b) = (ox + dx, oy - dy)
  where
    (dx, dy) = rotatedVector theta (a - ox, oy - b)

rotatedVector :: Float -> (Float, Float) -> (Float, Float)
rotatedVector angle (x, y) =
  ( x * cos angle - y * sin angle,
    x * sin angle + y * cos angle
  )

midThirdOfLine ::
  (Float, Float) ->
  (Float, Float) ->
  ((Float, Float), (Float, Float))
midThirdOfLine (a, b) (x, y) = (p, f p)
  where
    (dx, dy) = ((x - a) / 3, (y - b) / 3)
    f = bimap (dx +) (dy +)
    p = f (a, b)

-------------------------- TEST ---------------------------
main :: IO ()
main =
  putStrLn $
    svgFromPoints 1024 $
      kochSnowflake 4 (200, 600) (800, 600)

-------------------------- SVG ----------------------------
svgFromPoints :: Int -> [(Float, Float)] -> String
svgFromPoints w xys =
  unlines
    [ "<svg xmlns=\"http://www.w3.org/2000/svg\"",
      unwords
        [ "width=\"512\" height=\"512\" viewBox=\"5 5",
          sw,
          sw,
          "\"> "
        ],
      "<path d=\"M" <> points <> "\" ",
      unwords [
        "stroke-width=\"2\"",
        "stroke=\"red\"",
        "fill=\"transparent\"/>"
      ],
      "</svg>"
    ]
  where
    sw = show w
    showN = printf "%.2g"
    points =
      ( unwords
          . fmap
            ( ((<>) . showN . fst)
                <*> ((' ' :) . showN . snd)
            )
      )
        xys


100 PROGRAM "Koch.bas"
110 OPTION ANGLE DEGREES
120 SET 22,1:SET 23,0:SET 24,42:SET 25,26
130 OPEN #101:"video:"
140 DISPLAY #101:AT 1 FROM 1 TO 26
150 SET PALETTE 0,252
160 PLOT 300,700;ANGLE 0;
170 FOR I=1 TO 3
180   CALL KOCH(0,800)
190   PLOT RIGHT 120;
200 NEXT
210 DEF KOCH(A,D)
220   IF D>12 THEN
230     LET D=D/3
240     CALL KOCH(A,D)
250     CALL KOCH(60,D)
260     CALL KOCH(-120,D)
270     CALL KOCH(60,D)
280   ELSE
290     PLOT LEFT A;FORWARD D;
300   END IF
310 END DEF


(() => {
    'use strict';

    // kochSnowflake :: Int -> (Float, Float) -> (Float, Float)
    //                      -> [(Float, Float)]
    const kochSnowflake = n => a => b => {
        // List of points on a Koch snowflake of order n, derived
        // from an equilateral triangle with base a b.
        const points = [a, equilateralApex(a)(b), b];
        return concat(
            zipWith(kochCurve(n))(points)(
                points.slice(1).concat([points[0]])
            )
        );
    };

    // koch :: Int -> (Float, Float) -> (Float, Float)
    //             -> [(Float, Float)]
    const kochCurve = n => ab => xy => {
        // A Koch curve of order N, starting at the point
        // (a, b), and ending at the point (x, y).
        const go = n => ([ab, xy]) =>
            0 !== n ? (() => {
                const [mp, mq] = midThirdOfLine(ab)(xy);
                const points = [
                    ab,
                    mp,
                    equilateralApex(mp)(mq),
                    mq,
                    xy
                ];
                return zip(points)(points.slice(1))
                    .flatMap(go(n - 1))
            })() : [xy];
        return [ab].concat(go(n)([ab, xy]));
    };

    // equilateralApex :: (Float, Float) -> (Float, Float) -> (Float, Float)
    const equilateralApex = p => q =>
        rotatedPoint(Math.PI / 3)(p)(q);

    // rotatedPoint :: Float -> (Float, Float) ->
    //        (Float, Float) -> (Float, Float)
    const rotatedPoint = theta => ([ox, oy]) => ([a, b]) => {
        // The point ab rotated theta radians
        // around the origin xy.
        const [dx, dy] = rotatedVector(theta)(
            [a - ox, oy - b]
        );
        return [ox + dx, oy - dy];
    };

    // rotatedVector :: Float -> (Float, Float) -> (Float, Float)
    const rotatedVector = theta => ([x, y]) =>
        // The vector xy rotated by theta radians.
        [
            x * Math.cos(theta) - y * Math.sin(theta),
            x * Math.sin(theta) + y * Math.cos(theta)
        ];

    // midThirdOfLine :: (Float, Float) -> (Float, Float)
    //                 -> ((Float, Float), (Float, Float))
    const midThirdOfLine = ab => xy => {
        // Second of three equal segments of
        // the line between ab and xy.
        const
            vector = zipWith(dx => x => (dx - x) / 3)(xy)(ab),
            f = zipWith(add)(vector),
            p = f(ab);
        return [p, f(p)];
    };

    // TEST -----------------------------------------------
    // main :: IO ()
    const main = () =>
        // SVG showing a Koch snowflake of order 4.
        console.log(
            svgFromPoints(1024)(
                kochSnowflake(5)(
                    [200, 600]
                )([800, 600])
            )
        );

    // SVG ----------------------------------------------

    // svgFromPoints :: Int -> [(Int, Int)] -> String
    const svgFromPoints = w => ps => [
        '<svg xmlns="http://www.w3.org/2000/svg"',
        `width="500" height="500" viewBox="5 5 ${w} ${w}">`,
        `<path d="M${
        ps.flatMap(p => p.map(n => n.toFixed(2))).join(' ')
    }" `,
        'stroke-width="2" stroke="red" fill="transparent"/>',
        '</svg>'
    ].join('\n');

    // GENERIC --------------------------------------------

    // add :: Num -> Num -> Num
    const add = a => b => a + b;

    // concat :: [[a]] -> [a]
    const concat = xs => [].concat.apply([], xs);

    // zip :: [a] -> [b] -> [(a, b)]
    const zip = xs => ys =>
        xs.slice(
            0, Math.min(xs.length, ys.length)
        ).map((x, i) => [x, ys[i]]);

    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
    const zipWith = f => xs => ys =>
        xs.slice(
            0, Math.min(xs.length, ys.length)
        ).map((x, i) => f(x)(ys[i]));

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


include "turtle" {search: "."};

def rules:
   { F:  "F+F--F+F",
     "": "F--F--F"  };

def koch($count):
  rules as $rules
  | def repeat($count):
      if $count <= 0 then .
      else gsub("F"; $rules["F"])
      | repeat($count-1)
      end;
  $rules[""] | repeat($count) ;

def interpret($x):
  if   $x == "+" then turtleRotate(60)
  elif $x == "-" then turtleRotate(-60)
  elif $x == "F" then turtleForward(4)
  else .
  end;

def koch_curve($n):
  koch($n)
  | split("")
  | reduce .[] as $action (turtle([0,300]) | turtleDown;
      interpret($action) ) ;

koch_curve(5)
| draw(1200)


using Plots

function pointskoch(points, maxk, α = sqrt(3)/2)
  Q = [0 -1; 1 0]
  for k = 1:maxk
    n = length(points)
    new_points = Vector{Float64}[]
    for i = 1:n-1
      p1, p2 = points[i], points[i+1]
      v = (p2 - p1) / 3
      q1 = p1 + v
      q2 = p1 + 1.5v + α * Q * v
      q3 = q1 + v
      append!(new_points, [p1, q1, q2, q3])
    end
    push!(new_points, points[end])
    points = new_points
  end
  return points
end

function plot_koch(points; c=:red, kwargs...)
  n = length(points)
  plot(leg=false, axis=false, grid=false, background=:white)
  px = [p[1] for p in points]
  py = [p[2] for p in points]
  plot!(px, py, c=c; kwargs...)
end

function plot_koch!(points; c=:red, kwargs...)
  n = length(points)
  px = [p[1] for p in points]
  py = [p[2] for p in points]
  plot!(px, py, c=c; kwargs...)
end

function main()
  pyplot(size=(600,300))
  points = [[0.0; 0.0], [1.0; 0.0]]
  for k = 0:7
    new_points = pointskoch(points, k)
    plot_koch(new_points)
    ylims!(-0.1, 0.4)
    png("line-koch-$k")
  end

  pyplot(size=(200,200))
  for N = 2:8
    points = [[sin(2π*i/N), cos(2π*i/N)] for i = 0:N]
    plot_koch(points, c=:blue)
    points = pointskoch(points, 6)
    plot_koch!(points)
    xlims!(-1.5, 1.5)
    ylims!(-1.5, 1.5)
    png("polygon-$N")

    points = [[sin(2π*i/N), cos(2π*i/N)] for i = N:-1:0]
    plot_koch(points, c=:blue)
    points = pointskoch(points, 6)
    plot_koch!(points)
    xlims!(-1.5, 1.5)
    ylims!(-1.5, 1.5)
    png("polygon-reverse-$N")

    if N > 2
      points = [[sin(2π*i/N), cos(2π*i/N)] for i = N:-1:0]
      α = 0.85 / tan(π / N)
      α = 3 * sqrt(N) / 5
      points = pointskoch(points, 5, α)
      plot_koch(points)
      xlims!(-1.5, 1.5)
      ylims!(-1.5, 1.5)
      png("stargon-$N")
    end
  end

  # [1.5,  1.2,  0.96, 0.85
  # [√3/2, 1.2,  1.32, 1.47

  maxk = 5
  points = [[sin(2π*i/3), cos(2π*i/3)] for i = 3:-1:0]
  points = pointskoch(points, maxk)
  plot_koch(points)
  xlims!(-1.1, 1.1)
  ylims!(-0.9, 1.3)
  png("reverse-koch")

  N = 4
  points = [[cos(2π*i/N), sin(2π*i/N)] for i = 0:N]
  points = pointskoch(points, maxk, 1.25)
  plot_koch(points)
  png("star")

  points = [[0.0; 0.0], [1.0; 0.0], [1.0; 1.0], [0.0; 1.0], [0.0; 0.0]]
  points = pointskoch(points, maxk, 1.2)
  plot_koch(points)
  png("reverse-star")

  for N = 3:5
    points = [[cos(2π*i/N), sin(2π*i/N)] for i = 1:N]
    points = [i % 2 == 0 ? zeros(2) : points[div(i, 2) + 1] for i = 0:2N]
    points = pointskoch(points, 5, 1.0)
    plot_koch(points)
    xlims!(-1.2, 1.2)
    ylims!(-1.2, 1.2)
    png("tri-$N")
  end

  N = 3
  points = [[sin(2π*i/N), cos(2π*i/N)] for i = 0:N]
  points = pointskoch(points, maxk)
  plot_koch(points)
  α = 0.6
  plot_koch!(α^2 * points)
  plot_koch!(α^4 * points)
  points = [[y,x] for (x,y) in points]
  plot_koch!(α * points, c=:green)
  plot_koch!(α^3 * points, c=:green)
  png("koch")

  run(`montage tri-3.png koch.png tri-4.png tri-5.png reverse-star.png star.png -geometry +2+2 background.jpg`)
end

function large_koch()
  pyplot(size=(2000,2000))
  N = 3
  points = [[sin(2π*i/N), cos(2π*i/N)] for i = 0:N]
  points = pointskoch(points, 1)
  plot_koch(points)
  α = 3/sqrt(3)
  maxp = 11
  for p = 1:maxp
    points = α * [[-y;x] for (x,y) in points]
    if p < 7
      points = pointskoch(points, 1)
    end
    plot_koch!(points, c=p%2==1 ? :green : :red)
    xlims!(-1.1α^p, 1.1α^p)
    ylims!(-1.1α^p, 1.1α^p)
    png("koch-large-sub-$p")
  end
  xlims!(-1.1α^maxp, 1.1α^maxp)
  ylims!(-1.1α^maxp, 1.1α^maxp)
  png("koch-large")
end

function koch_julia()
  colors = [RGB(0.584, 0.345, 0.698)  RGB(0.667, 0.475, 0.757);
            RGB(0.220, 0.596, 0.149)  RGB(0.376, 0.678, 0.318);
            RGB(0.796, 0.235, 0.200)  RGB(0.835, 0.388, 0.361)]
  plot()
  plot_koch([])
  α = sqrt(3)/3
  for (i,θ) in enumerate([2π*i/3 for i = 0:2])
    points = [[sin(2π*i/3), cos(2π*i/3)] for i = 0:3]
    points = pointskoch(points, 6)
    plot_koch!([[sin(θ) + x; cos(θ) + y] for (x,y) in points], c=colors[i,1], lw=2)
    for p = 1:8
      points = α * [[-y; x] for (x,y) in points]
      plot_koch!([[sin(θ) + x; cos(θ) + y] for (x,y) in points], c=colors[i,p%2+1], lw=2)
    end
  end
  xlims!(-2.1, 2.1)
  ylims!(-1.9, 2.3)
  png("koch-julia")
end

#main()
#large_koch()
koch_julia()


// Version 1.2.41

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import kotlin.math.*
import java.io.File
import javax.imageio.ImageIO

val Double.asI get() = this.toInt()

class Point(var x: Int, var y: Int)

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))

    fun drawLine(x0: Int, y0: Int, x1: Int, y1: Int, c: Color) {
        val dx = abs(x1 - x0)
        val dy = abs(y1 - y0)
        val sx = if (x0 < x1) 1 else -1
        val sy = if (y0 < y1) 1 else -1
        var xx = x0
        var yy = y0
        var e1 = (if (dx > dy) dx else -dy) / 2
        var e2: Int
        while (true) {
            setPixel(xx, yy, c)
            if (xx == x1 && yy == y1) break
            e2 = e1
            if (e2 > -dx) { e1 -= dy; xx += sx }
            if (e2 <  dy) { e1 += dx; yy += sy }
        }
    }

    fun koch(x1: Double, y1: Double, x2: Double, y2: Double, it: Int) {
        val angle = PI / 3.0  // 60 degrees
        val clr = Color.blue
        var iter = it
        val x3 = (x1 * 2.0 + x2) / 3.0
        val y3 = (y1 * 2.0 + y2) / 3.0
        val x4 = (x1 + x2 * 2.0) / 3.0
        val y4 = (y1 + y2 * 2.0) / 3.0
        val x5 = x3 + (x4 - x3) * cos(angle) + (y4 - y3) * sin(angle)
        val y5 = y3 - (x4 - x3) * sin(angle) + (y4 - y3) * cos(angle)

        if (iter > 0) {
            iter--
            koch(x1, y1, x3, y3, iter)
            koch(x3, y3, x5, y5, iter)
            koch(x5, y5, x4, y4, iter)
            koch(x4, y4, x2, y2, iter)
         }
         else {
            drawLine(x1.asI, y1.asI, x3.asI, y3.asI, clr)
            drawLine(x3.asI, y3.asI, x5.asI, y5.asI, clr)
            drawLine(x5.asI, y5.asI, x4.asI, y4.asI, clr)
            drawLine(x4.asI, y4.asI, x2.asI, y2.asI, clr)
         }
    }
}

fun main(args: Array<String>) {
    val width = 512
    val height = 512
    val bbs = BasicBitmapStorage(width, height)
    with (bbs) {
        fill(Color.white)
        koch(100.0, 100.0, 400.0, 400.0, 4)
        val kFile = File("koch_curve.jpg")
        ImageIO.write(image, "jpg", kFile)
    }
}


{def koch
 {lambda {:d :n}
  {if {< :n 1}
   then M:d
   else {koch {/ :d 3} {- :n 1}} T-60
        {koch {/ :d 3} {- :n 1}} T120
        {koch {/ :d 3} {- :n 1}} T-60
        {koch {/ :d 3} {- :n 1}} }}}
-> koch

{def K {koch 300 4}}
-> K

{svg {@ width="580" height="580" style="box-shadow:0 0 8px #000;"}
 {polyline  {@ points="{turtle 140 140 0 {K}}"
               stroke="#f00" fill="transparent"}}
 {polyline  {@ points="{turtle 140 440 90 {K}}"
               stroke="#0f0" fill="transparent"}}
 {polyline  {@ points="{turtle 440 440 180 {K}}"
               stroke="#00f" fill="transparent"}}
 {polyline  {@ points="{turtle 440 140 270 {K}}"
               stroke="#ff0" fill="transparent"}}
}

The output is a "square of Koch" which can be seen in
http://lambdaway.free.fr/lambdawalks/?view=koch


to ff :l :i
cs
right 90
pd
pr [lenght] show form :l  4 0
pr [iterations] show form  :i 4 0
koch :l :i
end

to koch :len :iterations
ifelse :iterations = 1 [fd :len] [
koch :len :iterations - 1
left 60
koch :len :iterations - 1
right 120
koch :len :iterations - 1
left 60
koch :len :iterations - 1]
end

to zzz
ifelse YesNoBox [Welcome] [YES=run it, NO=show me the code] [ff 22 3] [edall]
end

Make "startup [zzz]


local cos, sin, floor, pi = math.cos, math.sin, math.floor, math.pi

function Bitmap:render()
  for y = 1, self.height do
    print(table.concat(self.pixels[y]))
  end
end

function Bitmap:drawKochPath(path, x, y, angle, speed, color)
  local rules = {
    ["+"] = function() angle = angle + pi/3 end,
    ["-"] = function() angle = angle - pi/3 end,
    ["F"] = function()
      local nx, ny = x+speed*cos(angle), y+speed*sin(angle)
      self:line(floor(x*2+0.5), floor(y+0.5), floor(nx*2+0.5), floor(ny+0.5), color)
      x, y = nx, ny
    end
  }
  path:gsub("(.)", function(c) rules[c]() end)
end

function LSystem(axiom, rules, reps)
  for i = 1, reps do
    axiom = axiom:gsub("(.)", function(c) return rules[c] or c end)
  end
  return axiom
end
function KochPath(reps) return LSystem("F--F--F--", { F = "F+F--F+F" }, reps) end

demos = {
  { n=0, w= 11, h= 6, x=1, y= 4 },
  { n=1, w= 22, h=14, x=1, y= 9 },
  { n=2, w= 60, h=34, x=1, y=24 },
  { n=3, w=168, h=96, x=1, y=71 }
}
for _,d in ipairs(demos) do
  bitmap = Bitmap(d.w, d.h)
  bitmap:clear(".")
  bitmap:drawKochPath(KochPath(d.n), d.x, d.y, 0, 3, "@")
  bitmap:render()
  print()
end


Graphics[{GeometricTransformation[KochCurve[5], RotationTransform[Pi, {0.5, 0}]],
  GeometricTransformation[KochCurve[5], RotationTransform[-Pi/3, {1, 0}]],
  GeometricTransformation[KochCurve[5], RotationTransform[Pi/3, {0, 0}]]}]


from math import sin, cos, PI
import libgd

const
  width = 512
  height = 512
  iterations = 4

proc kochCurve(img: gdImagePtr, x1, y1, x2, y2: float, iter: int): void  =
  let angle = PI / 3 # 60 degrees
  let x3 = (x1 * 2 + x2) / 3
  let y3 = (y1 * 2 + y2) / 3
  let x4 = (x1 + x2 * 2) / 3
  let y4 = (y1 + y2 * 2) / 3
  let x5 = x3 + (x4 - x3) * cos(angle) + (y4 - y3) * sin(angle)
  let y5 = y3 - (x4 - x3) * sin(angle) + (y4 - y3) * cos(angle)

  if iter > 0:
    img.kochCurve(x1, y1, x3, y3, iter - 1)
    img.kochCurve(x3, y3, x5, y5, iter - 1)
    img.kochCurve(x5, y5, x4, y4, iter - 1)
    img.kochCurve(x4, y4, x2, y2, iter - 1)
  else:
    img.drawLine(startPoint=[x1.int, y1.int], endPoint=[x3.int, y3.int])
    img.drawLine(startPoint=[x3.int, y3.int], endPoint=[x5.int, y5.int])
    img.drawLine(startPoint=[x5.int, y5.int], endPoint=[x4.int, y4.int])
    img.drawLine(startPoint=[x4.int, y4.int], endPoint=[x2.int, y2.int])

proc main() =

  withGd imageCreate(width, height) as img:
    let white = img.backgroundColor(0xffffff)
    let red = img.foregroundColor(0xff0000)

    img.kochCurve(100, 100, 400, 400, iterations)

    let png_out = open("koch_curve.png", fmWrite)
    img.writePng(png_out)
    png_out.close()

main()


use SVG;
use List::Util qw(max min);

use constant pi => 2 * atan2(1, 0);

# Compute the curve with a Lindemayer-system
my $koch = 'F--F--F';
$koch =~ s/F/F+F--F+F/g for 1..5;

# Draw the curve in SVG
($x, $y) = (0, 0);
$theta   = pi/3;
$r       = 2;

for (split //, $koch) {
    if (/F/) {
        push @X, sprintf "%.0f", $x;
        push @Y, sprintf "%.0f", $y;
        $x += $r * cos($theta);
        $y += $r * sin($theta);
    }
    elsif (/\+/) { $theta += pi/3; }
    elsif (/\-/) { $theta -= pi/3; }
}

$xrng =  max(@X) - min(@X);
$yrng =  max(@Y) - min(@Y);
$xt   = -min(@X)+10;
$yt   = -min(@Y)+10;
$svg = SVG->new(width=>$xrng+20, height=>$yrng+20);
$points = $svg->get_path(x=>\@X, y=>\@Y, -type=>'polyline');
$svg->rect(width=>"100%", height=>"100%", style=>{'fill'=>'black'});
$svg->polyline(%$points, style=>{'stroke'=>'orange', 'stroke-width'=>1}, transform=>"translate($xt,$yt)");

open  $fh, '>', 'koch_curve.svg';
print $fh  $svg->xmlify(-namespace=>'svg');
close $fh;


--
-- demo\rosetta\Koch_curve.exw
-- ===========================
--
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

integer ox = 0, oy = 0

procedure koch(atom x1, y1, x2, y2, integer iter)
    atom angle = -PI/3, -- -60 degrees
         x3 := (x1*2 + x2) / 3,
         y3 := (y1*2 + y2) / 3,
         x4 := (x1 + x2*2) / 3,
         y4 := (y1 + y2*2) / 3,
         x5 := x3 + (x4-x3)*cos(angle) + (y4-y3)*sin(angle),
         y5 := y3 - (x4-x3)*sin(angle) + (y4-y3)*cos(angle)
    if iter>0  then
        iter -= 1
        koch(x1, y1, x3, y3, iter)
        koch(x3, y3, x5, y5, iter)
        koch(x5, y5, x4, y4, iter)
        koch(x4, y4, x2, y2, iter)
    else
        cdCanvasVertex(cddbuffer, x1+ox, y1+oy)
        cdCanvasVertex(cddbuffer, x3+ox, y3+oy)
        cdCanvasVertex(cddbuffer, x5+ox, y5+oy)
        cdCanvasVertex(cddbuffer, x4+ox, y4+oy)
        cdCanvasVertex(cddbuffer, x2+ox, y2+oy)
    end if
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    atom {w,h} = IupGetIntInt(canvas, "DRAWSIZE")
    if w>h then ox = floor((w-h)/2); w=h
           else oy = floor((h-w)/2); h=w end if
    atom {x,y} = {w*0.05+w/6,h*0.05+h/4}
    {w,h} = {w*0.6,h*0.6}
    cdCanvasActivate(cddbuffer)
    cdCanvasBegin(cddbuffer, CD_OPEN_LINES)
    koch(x,y,x+w/2,y+h,4)
    koch(x+w/2,y+h,x+w,y,4)
    koch(x+w,y,x,y,4)
    cdCanvasEnd(cddbuffer)
    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_BLUE)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()

    canvas = IupCanvas("RASTERSIZE=512x512")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})

    dlg = IupDialog(canvas,`TITLE="Koch curve"`)

    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


int l = 300;

void setup() {
  size(400, 400);
  background(0, 0, 255);
  stroke(255);
  // draw from center of screen
  translate(width/2.0, height/2.0);
  // center curve from lower-left corner of base equilateral triangle
  translate(-l/2.0, l*sqrt(3)/6.0);
  for (int i = 1; i <= 3; i++) {
    kcurve(0, l);
    rotate(radians(120));
    translate(-l, 0);
  }
}

void kcurve(float x1, float x2) {
  float s = (x2-x1)/3;
  if (s < 5) {
    pushMatrix();
    translate(x1, 0);
    line(0, 0, s, 0);
    line(2*s, 0, 3*s, 0);
    translate(s, 0);
    rotate(radians(60));
    line(0, 0, s, 0);
    translate(s, 0);
    rotate(radians(-120));
    line(0, 0, s, 0);
    popMatrix();
    return;
  }
  pushMatrix();
  translate(x1, 0);
  kcurve(0, s);
  kcurve(2*s, 3*s);
  translate(s, 0);
  rotate(radians(60));
  kcurve(0, s);
  translate(s, 0);
  rotate(radians(-120));
  kcurve(0, s);
  popMatrix();
}


main:-
    write_koch_snowflake('koch_snowflake.svg').

write_koch_snowflake(File):-
    open(File, write, Stream),
    koch_snowflake(Stream, 600, 5),
    close(Stream).

koch_snowflake(Stream, Size, N):-
    format(Stream, "<svg xmlns='http://www.w3.org/2000/svg' width='~d' height='~d'>\n",
           [Size, Size]),
    write(Stream, "<rect width='100%' height='100%' fill='black'/>\n"),
    write(Stream, "<path stroke-width='1' stroke='white' fill='none' d='"),
    Sqrt3_2 = 0.86602540378444,
    Length is Size * Sqrt3_2 * 0.95,
    X0 is (Size - Length)/2,
    Y0 is Size/2 - Length * Sqrt3_2/3,
    X1 is X0 + Length/2,
    Y1 is Y0 + Length * Sqrt3_2,
    X2 is X0 + Length,
    format(Stream, 'M ~g,~g ', [X0, Y0]),
    koch_curve(Stream, X0, Y0, X1, Y1, N),
    koch_curve(Stream, X1, Y1, X2, Y0, N),
    koch_curve(Stream, X2, Y0, X0, Y0, N),
    write(Stream, "z'/>\n</svg>\n").

koch_curve(Stream, _, _, X1, Y1, 0):-
    !,
    format(Stream, 'L ~g,~g\n', [X1, Y1]).
koch_curve(Stream, X0, Y0, X1, Y1, N):-
    N > 0,
    Sqrt3_2 = 0.86602540378444,
    N1 is N - 1,
    Dx is X1 - X0,
    Dy is Y1 - Y0,
    X2 is X0 + Dx/3,
    Y2 is Y0 + Dy/3,
    X3 is X0 + Dx/2 - Dy * Sqrt3_2/3,
    Y3 is Y0 + Dy/2 + Dx * Sqrt3_2/3,
    X4 is X0 + 2 * Dx/3,
    Y4 is Y0 + 2 * Dy/3,
    koch_curve(Stream, X0, Y0, X2, Y2, N1),
    koch_curve(Stream, X2, Y2, X3, Y3, N1),
    koch_curve(Stream, X3, Y3, X4, Y4, N1),
    koch_curve(Stream, X4, Y4, X1, Y1, N1).


'''Koch curve'''

from math import cos, pi, sin
from operator import add, sub
from itertools import chain

# kochSnowflake :: Int -> (Float, Float) -> (Float, Float) -> [(Float, Float)]
def kochSnowflake(n, a, b):
    '''List of points on a Koch snowflake of order n, derived
       from an equilateral triangle with base a b.
    '''
    points = [a, equilateralApex(a, b), b]
    return chain.from_iterable(map(
        kochCurve(n),
        points,
        points[1:] + [points[0]]
    ))

# kochCurve :: Int -> (Float, Float) -> (Float, Float)
#                  -> [(Float, Float)]
def kochCurve(n):
    '''List of points on a Koch curve of order n,
       starting at point ab, and ending at point xy.
    '''
    def koch(n):
        def goTuple(abxy):
            ab, xy = abxy
            if 0 == n:
                return [xy]
            else:
                mp, mq = midThirdOfLine(ab, xy)
                points = [
                    ab,
                    mp,
                    equilateralApex(mp, mq),
                    mq,
                    xy
                ]
                return list(
                    chain.from_iterable(map(
                        koch(n - 1),
                        zip(points, points[1:])
                    ))
                )
        return goTuple

    def go(ab, xy):
        return [ab] + koch(n)((ab, xy))
    return go

# equilateralApex :: (Float, Float) -> (Float, Float) -> (Float, Float)
def equilateralApex(p, q):
    '''Apex of triangle with base p q.
    '''
    return rotatedPoint(pi / 3)(p, q)

# rotatedPoint :: Float -> (Float, Float) ->
#                (Float, Float) -> (Float, Float)
def rotatedPoint(theta):
    '''The point ab rotated theta radians
        around the origin xy.
    '''
    def go(xy, ab):
        ox, oy = xy
        a, b = ab
        dx, dy = rotatedVector(theta, (a - ox, oy - b))
        return ox + dx, oy - dy
    return go

# rotatedVector :: Float -> (Float, Float) -> (Float, Float)
def rotatedVector(theta, xy):
    '''The vector xy rotated by theta radians.
    '''
    x, y = xy
    return (
        x * cos(theta) - y * sin(theta),
        x * sin(theta) + y * cos(theta)
    )

# midThirdOfLine :: (Float, Float) -> (Float, Float)
#                -> ((Float, Float), (Float, Float))
def midThirdOfLine(ab, xy):
    '''Second of three equal segments of
       the line between ab and xy.
    '''
    vector = [x / 3 for x in map(sub, xy, ab)]

    def f(p):
        return tuple(map(add, vector, p))
    p = f(ab)
    return (p, f(p))

# -------------------------- TEST --------------------------
# main :: IO ()
def main():
    '''SVG for Koch snowflake of order 4.
    '''
    print(
        svgFromPoints(1024)(
            kochSnowflake(
                4, (200, 600), (800, 600)
            )
        )
    )

# -------------------------- SVG ---------------------------

# svgFromPoints :: Int -> [(Float, Float)] -> SVG String
def svgFromPoints(w):
    '''Width of square canvas -> Point list -> SVG string.
    '''
    def go(xys):
        xs = ' '.join(map(
            lambda xy: str(round(xy[0], 2)) + ' ' + str(round(xy[1], 2)),
            xys
        ))
        return '\n'.join([
            '<svg xmlns="http://www.w3.org/2000/svg"',
            f'width="512" height="512" viewBox="5 5 {w} {w}">',
            f'<path d="M{xs}" ',
            'stroke-width="2" stroke="red" fill="transparent"/>',
            '</svg>'
        ])
    return go

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


    ' Chaos:  start at any point,  this program uses the middle of the screen  (or universe.  One of six
    ' degrees of freedom (a direction)  is chosen at random  (by throwing a six-sided die),  and a line
    ' is drawn from the old point to the new point in the direction indicated by the pip on the die.
    '
    ' The traverse distance is always a fraction of the last distance drawn;  the fraction (here) uses:
    '
    '                                       +-                                -+
    '                                       |                                  |
    '       distance  <===  old_distance *  |  1/2 - 1/8 - 1/32 - 1/128 - ...  |
    '                                       |                                  |
    '                                       +-                                -+
    '            ---or---
    '                                       +-                                -+
    '                                       |   1     1     1      1           |
    '       distance  <===  old_distance *  |  --- - --- - ---- - ----- - ...  |
    '                                       |  2**1  2**3  2**5   2**7         |
    '                                       +-                                -+
    '
    ' (The series above has a limit of  1/3.)
    '
    ' The six degrees of freedom:                      1         6
    '
    '                                                    \     /
    '                                                     \   /
    '                                                      \ /
    '                                            2  <------ X ------>  5
    '                                                      / \
    '                                                     /   \
    '                                                    /     \
    '
    '                                                  3         4
    '
    ' When the amount to be moved is too small to show on the terminal screen,  the chaos curve is
    ' starting again  (from the initial point,  the middle of the screen/universe).
    '
    ' All subsequent chaos curves are superimposed on the first curve.
    '
    ' The envelope of this chaos curve is defined as the snowflake curve.
    '
    ' If any cursor key (one of the "arrow" keys) is pressed,  program execution is halted.
    '
    ' If any function key is pressed during execution, the random chaos curve is stopped, the screen
    ' cleared, and the snowflake curve is drawn by a non-random method (brute force).
    '
    ' Once the random snowflake (chaos) curve is being drawn, the pressing of function keys 1-->9 will
    ' force the randomness to move in a particular direction, the direction (the degree of freedom) is
    ' the direction indicated by the number of times that function key is pressed for that curve point.
    ' That is, function key 1 is used for the first point (part of the chaos curve),  function key 2 is
    ' used for the second point, function key 3 for the third point,  etc.

    DEFINT A-Y                    ' define variables that begin with   A-->Y   as integers.
    DEFSNG Z                      ' define variables that begin with     Z     as single precision.
    DIM XP(16,6),YP(16,6),KY(16)  ' define some (integer) arrays.
    MP= 16                        ' set the maximum number of points (1st dimension) that can be plotted.
    CLS                           ' clear the screen for visual fidelity.
    SCREEN 2                      ' make the screen high-res graphics.
    GOTO 230                      ' branch around a  RETURN  statement that  ON KEY(i) uses.

220 RETURN
230 FK= 0                         ' set FK  (used to indicate that a function key was pressed).

      FOR I=1  TO 10              ' allow the use of function keys to stop the deliberate snowflake
                                  ' curve and start drawing it randomly.
      KY(I)= 0
      ON KEY(I)  GOSUB 220        ' allow the trapping of function keys,  but don't process it as yet.
      KEY(I)  ON
      KEY(I) STOP
      NEXT I

    CLS                           ' clear the screen for visual fidelity.
    ZZ= 2 + TIMER                 ' on some PCs, a pause of at least one second prevents scrolling.

240 IF TIMER<ZZ  THEN GOTO 240
    RANDOMIZE TIMER               ' randomize the RND function from the timer.
    XM= 640 - 1                   ' define the number of points on the screen (for plotting).
    YM= 200 - 1
    XO= XM \ 2                    ' define the origin of the chaos curve.
    YO= YM \ 2
    ZT= 1 / 3                     ' define the traverse distance,  it's this distance that each part of
                                  ' the chaos curve "breaks",  when the distance that the next part of
                                  ' the chaos curve is moved to.
    ZA= 1                         ' define the aspect ratio for the terminal screen.
    ZX= XM * ZA                   ' define the initial distance to be plotted (for a line).
    ZY= YM                        '    "    "     "        "     "  "    "      "  "   "
           FOR I=1  TO MP         ' compute (once) all the  x & y  distances for each part of the curve.
           ZX= ZX * ZT * ZA
           ZY= ZY * ZT
           XP(I, 1) = -ZX / 2
           XP(I, 2) = -ZX
           XP(I, 3) = -ZX / 2
           XP(I, 4) =  ZX / 2
           XP(I, 5) =  ZX
           XP(I, 6) =  ZX / 2
           YP(I, 1) = -ZY
           YP(I, 2) =   0
           YP(I, 3) =  ZY
           YP(I, 4) =  ZY
           YP(I, 5) =   0
           YP(I, 6) = -ZY
           NEXT I
    N0=0
           FOR II=1  TO MP        ' find the maximum number of points that can be plotted.
             FOR I=1  TO 6
             IF XP(II, I) <> 0  THEN N0= II
             IF YP(II, I) <> 0  THEN N0= II
             NEXT I
           NEXT II

           FOR I=11  TO 14        ' quit if any cursor key is pressed.
           ON KEY(I)  GOSUB 598
           KEY(I)  ON
           NEXT I

           FOR I=1  TO 10         ' If any function key is pressed during execution, the deliberate
           ON KEY(I)  GOSUB 400   ' curve is stopped,  the screen is cleared, and the snowflake curve is
           KEY(I)  ON             ' drawn by a random process  (AKA,  the chaos curve).
           NEXT I

    GOTO 500

400 FK= 1                         ' come here when any function or cursor key is pressed,  and set  FK
                                  ' that is checked by the deliberate snowflake curve generator.
    RETURN

500 CLS                           ' clear the screen before starting  (for visual fidelity).
                  FOR I1=1  TO 6  ' plot the curve via non-random (deliberate calculation) points.
                  X1= XO  +  XP(1, I1)
                  Y1= YO  +  YP(1, I1)
                  IF FK  THEN GOTO 600
                  LINE (XO, YO)  -  (X1, Y1)
                    FOR I2=1  TO 6
                    X2= X1  +  XP(2,I2)
                    Y2= Y1  +  YP(2,I2)
                    IF FK  THEN GOTO 600
                    LINE (X1, Y1)  -  (X2, Y2)
                      FOR I3=1  TO 6
                      X3= X2  +  XP(3, I3)
                      Y3= Y2  +  YP(3, I3)
                      IF FK  THEN GOTO 600
                      LINE (X2, Y2)  -  (X3, Y3)
                        FOR I4=1  TO 6
                        X4= X3  +  XP(4, I4)
                        Y4= Y3  +  YP(4, I4)
                        IF FK  THEN GOTO 600
                        LINE (X3, Y3)  -  (X4, Y4)
                          FOR I5=1  TO 6
                          X5= X4  +  XP(5, I5)
                          Y5= Y4  +  YP(5, I5)
                          IF FK  THEN GOTO 600
                          LINE (X4, Y4)  -  (X5, Y5)
                          NEXT I5
                        NEXT I4
                      NEXT I3
                    NEXT I2
                  NEXT I1
    ZZ= 10+TIMER                  ' The snowflake curve is now complete.

555 IF TIMER<ZZ  THEN GOTO 555    ' loop for ten seconds.
598 SYSTEM                        ' stick a fork in it, we're all done.

600 ON  KEY(1)   GOSUB 710        ' trap all function keys for toggling.
    ON  KEY(2)   GOSUB 720
    ON  KEY(3)   GOSUB 730
    ON  KEY(4)   GOSUB 740
    ON  KEY(5)   GOSUB 750
    ON  KEY(6)   GOSUB 760
    ON  KEY(7)   GOSUB 770
    ON  KEY(8)   GOSUB 780
    ON  KEY(9)   GOSUB 790
    ON  KEY(10)  GOSUB 700

              FOR I=1  TO MP      ' re-active trapping all the function keys.
              KEY(I)  ON
              NEXT I
    CLS                           ' clear the screen before starting.
    GOTO 900                      ' go and start drawing the chaos curve.

700           FOR I0=1  TO MP     ' reset all toggle settings for all points.
              KY(I0)= 0
              NEXT I0
    RETURN

710 KI= 1                         ' toggle setting for point #1 (bypass).
              GOTO 800
720 KI= 2                         ' toggle setting for point #2 (bypass).
              GOTO 800
730 KI= 3                         ' toggle setting for point #3 (bypass).
              GOTO 800
740 KI= 4                         ' toggle setting for point #4 (bypass).
              GOTO 800
750 KI= 5                         ' toggle setting for point #5 (bypass).
              GOTO 800
760 KI= 6                         ' toggle setting for point #6 (bypass).
              GOTO 800
770 KI= 7                         ' toggle setting for point #7 (bypass).
              GOTO 800
780 KI= 8                         ' toggle setting for point #8 (bypass).
              GOTO 800
790 KI= 9                         ' toggle setting for point #9 (bypass).

800 KY(KI)= (1 + KY(KI) )  MOD 7  ' reset toggle settings for all higher points.

              FOR IK=KI+1  TO MP
              KY(IK)= 0
              NEXT IK
    RETURN

900 N= 0                          ' initialize the number of points in this particular chaos curve.
    X= XO                         ' move the start-of-the-chaos-curve to the origin.
    Y= YO
    LINE (X, Y)  -  (X, Y)
    N= N + 1                      ' bump number of points drawn so far.
    IF N>N0   THEN GOTO 900       ' # points drawn exceeds possible?  Start another chaos curve.
                                  ' start of diminishing loop to create an envelope for the chaos curve.
    IF KY(N)  THEN R= KY(N)   ELSE R= 1 + INT(RND*6)
    X= X  +  XP(N, R)             ' exercise a degree of freedom (one of six).
    Y= Y  +  YP(N, R)
    LINE -(X, Y)                  ' depending on the "die",  draw the next part of the chaos curve.
                   GOTO 900       ' now, go and do another point.


  [ $ "turtleduck.qky" loadfile ] now!

  [ $ "" swap witheach
      [ nested quackery join ] ]    is expand ( $ --> $ )

  [ $ "FRFLLFRF" ]                  is F      ( $ --> $ )

  [ $ "L" ]                         is L      ( $ --> $ )

  [ $ "R" ]                         is R      ( $ --> $ )

  $ "FLLFLLF"

  4 times expand

  turtle
  witheach
    [ dup char F = iff
        [ drop 3 1 walk ] done
      char L = iff
        [ -1 6 turn ] done
       1 6 turn ]


#lang racket

(require metapict)

; rot: rotate d degrees around point p, where c is a point or curve
(def (rot d p c)
  (rotated-aboutd d p c))

(define (koch a b n)
  (match n
    [0 (draw (curve a -- b))]
    [_ (def 1/3ab (med 1/3 a b))
       (def 2/3ab (med 2/3 a b))
       (draw (koch a 1/3ab                      (- n 1))
             (koch 1/3ab (rot 60 1/3ab 2/3ab)   (- n 1))
             (koch (rot 60 1/3ab 2/3ab) 2/3ab   (- n 1))
             (koch 2/3ab b                      (- n 1)))]))

(define (snow n)
  (def a (pt 0 0))
  (def b (pt 1 0))
  (def c (rot 60 a b))
  (draw (koch b a n)
        (koch c b n)
        (koch a c n)))

(scale 4 (snow 2))


use SVG;

role Lindenmayer {
    has %.rules;
    method succ {
        self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
    }
}

my $flake = 'F--F--F' but Lindenmayer( { F => 'F+F--F+F' } );

$flake++ xx 5;
my @points = (50, 440);

for $flake.comb -> $v {
    state ($x, $y) = @points[0,1];
    state $d = 2 + 0i;
    with $v {
        when 'F' { @points.append: ($x += $d.re).round(.01), ($y += $d.im).round(.01) }
        when '+' { $d *= .5 + .8660254i }
        when '-' { $d *= .5 - .8660254i }
    }
}

say SVG.serialize(
    svg => [
        width => 600, height => 600, style => 'stroke:rgb(0,0,255)',
        :rect[:width<100%>, :height<100%>, :fill<white>],
        :polyline[ points => @points.join(','), :fill<white> ],
    ],
);