#lang typed/racket
(define-type Point (Pair Real Real))
(define-type Points (Listof Point))

(: ⊗ (Point Point Point -> Real))
(define/match (⊗ o a b)
  [((cons o.x o.y) (cons a.x a.y) (cons b.x b.y))
   (- (* (- a.x o.x) (- b.y o.y)) (* (- a.y o.y) (- b.x o.x)))])

(: Point<? (Point Point -> Boolean))
(define (Point<? a b)
  (cond [(< (car a) (car b)) #t] [(> (car a) (car b)) #f] [else (< (cdr a) (cdr b))]))

;; Input: a list P of points in the plane.
(define (convex-hull [P:unsorted : Points])
  ;; Sort the points of P by x-coordinate (in case of a tie, sort by y-coordinate).
  (define P (sort P:unsorted Point<?))
  ;; for i = 1, 2, ..., n:
  ;;     while L contains at least two points and the sequence of last two points
  ;;             of L and the point P[i] does not make a counter-clockwise turn:
  ;;        remove the last point from L
  ;;     append P[i] to L
  ;; TB: U is identical with (reverse P)
  (define (upper/lower-hull [P : Points])
    (reverse
     (for/fold ((rev : Points null))
       ((P.i (in-list P)))
       (let u/l : Points ((rev rev))
         (match rev
           [(list p-2 p-1 ps ...) #:when (not (positive? (⊗ p-2 P.i p-1))) (u/l (list* p-1 ps))]
           [(list ps ...) (cons P.i ps)])))))

  ;; Initialize U and L as empty lists.
  ;; The lists will hold the vertices of upper and lower hulls respectively.
  (let ((U (upper/lower-hull (reverse P)))
        (L (upper/lower-hull P)))
    ;; Remove the last point of each list (it's the same as the first point of the other list).
    ;; Concatenate L and U to obtain the convex hull of P.
    (append (drop-right L 1) (drop-right U 1)))) ; Points in the result will be listed in CCW order.)

(module+ test
  (require typed/rackunit)
  (check-equal?
   (convex-hull
    (list '(16 . 3) '(12 . 17) '(0 . 6) '(-4 . -6) '(16 . 6) '(16 . -7) '(16 . -3) '(17 . -4)
          '(5 . 19) '(19 . -8) '(3 . 16) '(12 . 13) '(3 . -4) '(17 . 5) '(-3 . 15) '(-3 . -9)
          '(0 . 11) '(-9 . -3) '(-4 . -2) '(12 . 10)))
   (list '(-9 . -3) '(-3 . -9) '(19 . -8) '(17 . 5) '(12 . 17) '(5 . 19) '(-3 . 15))))


class Point {
    has Real $.x is rw;
    has Real $.y is rw;
    method gist { [~] '(', self.x,', ', self.y, ')' };
}

sub ccw (Point $a, Point $b, Point $c) {
    ($b.x - $a.x)*($c.y - $a.y) - ($b.y - $a.y)*($c.x - $a.x);
}

sub tangent (Point $a, Point $b) {
    my $opp = $b.x - $a.x;
    my $adj = $b.y - $a.y;
    $adj != 0 ?? $opp / $adj !! Inf
}

sub graham-scan (**@coords) {
    # sort points by y, secondary sort on x
    my @sp = @coords.map( { Point.new( :x($_[0]), :y($_[1]) ) } )
                    .sort: {.y, .x};

    # need at least 3 points to make a hull
    return @sp if +@sp < 3;

    # first point on hull is minimum y point
    my @h  = @sp.shift;

    # re-sort the points by angle, secondary on x
    @sp    = @sp.map( { $++ => [tangent(@h[0], $_), $_.x] } )
                .sort( {-$_.value[0], $_.value[1] } )
                .map: { @sp[$_.key] };

    # first point of re-sorted list is guaranteed to be on hull
    @h.push:  @sp.shift;

    # check through the remaining list making sure that
    # there is always a positive angle
    for @sp -> $point {
        if ccw( |@h.tail(2), $point ) > 0 {
            @h.push: $point;
        } else {
            @h.pop;
            @h.push: $point and next if +@h < 2;
            redo;
        }
    }
    @h
}

my @hull = graham-scan(
    (16, 3), (12,17), ( 0, 6), (-4,-6), (16, 6), (16,-7), (16,-3),
    (17,-4), ( 5,19), (19,-8), ( 3,16), (12,13), ( 3,-4), (17, 5),
    (-3,15), (-3,-9), ( 0,11), (-9,-3), (-4,-2), (12,10)
  );

say "Convex Hull ({[email protected]} points): ", @hull;

@hull = graham-scan(
    (16, 3), (12,17), ( 0, 6), (-4,-6), (16, 6), (16,-7), (16,-3),
    (17,-4), ( 5,19), (19,-8), ( 3,16), (12,13), ( 3,-4), (17, 5),
    (-3,15), (-3,-9), ( 0,11), (-9,-3), (-4,-2), (12,10), (20,-9), (1,-9)
  );

say "Convex Hull ({[email protected]} points): ", @hull;


#
# Convex hulls by Andrew's monotone chain algorithm.
#
# For a description of the algorithm, see
# https://en.wikibooks.org/w/index.php?title=Algorithm_Implementation/Geometry/Convex_hull/Monotone_chain&stableid=40169
#
# As in the Fortran 2018 version upon which this code is based, I
# shall use the built-in "complex" type to represent "points" in the
# plane. This is merely for convenience, rather than to express a
# mathematical equivalence.
#

define(point, complex)

function x (u)

  # Return the x-coordinate of "point" u.

  implicit none

  point u
  real x

  x = real (u)
end

function y (u)

  # Return the y-coordinate of "point" u.

  implicit none

  point u
  real y

  y = aimag (u)
end

function cross (u, v)

  # Return, as a signed scalar, the cross product of "points" u and v
  # (regarded as "vectors" or multivectors).

  implicit none

  point u, v
  real cross, x, y

  cross = (x (u) * y (v)) - (y (u) * x (v))
end

subroutine sortpt (numpt, pt)

  # Sort "points" in ascending order, first by the x-coordinates and
  # then by the y-coordinates. Any decent sort algorithm will suffice;
  # for the sake of interest, here is the Shell sort of
  # https://en.wikipedia.org/w/index.php?title=Shellsort&oldid=1084744510

  implicit none

  integer numpt
  point pt(0:*)

  real x, y
  integer i, j, k, gap, offset
  point temp
  logical done

  integer gaps(1:8)
  data gaps / 701, 301, 132, 57, 23, 10, 4, 1 /

  for (k = 1; k <= 8; k = k + 1)
    {
      gap = gaps(k)
      for (offset = 0; offset <= gap - 1; offset = offset + 1)
        for (i = offset; i <= numpt - 1; i = i + gap)
          {
            temp = pt(i)
            j = i
            done = .false.
            while (!done)
              {
                if (j < gap)
                  done = .true.
                else if (x (pt(j - gap)) < x (temp))
                  done = .true.
                else if (x (pt(j - gap)) == x (temp)      _
                          && (y (pt(j - gap)) <= y (temp)))
                  done = .true.
                else
                  {
                    pt(j) = pt(j - gap)
                    j = j - gap
                  }
              }
            pt(j) = temp
          }
    }
end

subroutine deltrd (n, pt)

  # Delete trailing neighbor duplicates.

  implicit none

  integer n
  point pt(0:*)

  integer i
  logical done

  i = n - 1
  done = .false.
  while (!done)
    {
      if (i == 0)
        {
          n = 1
          done = .true.
        }
      else if (pt(i - 1) != pt(i))
        {
          n = i + 1
          done = .true.
        }
      else
        i = i - 1
    }
end

subroutine delntd (n, pt)

  # Delete non-trailing neighbor duplicates.

  implicit none

  integer n
  point pt(0:*)

  integer i, j, numdel
  logical done

  i = 0
  while (i < n - 1)
    {
      j = i + 1
      done = .false.
      while (!done)
        {
          if (j == n)
            done = .true.
          else if (pt(j) != pt(i))
            done = .true.
          else
            j = j + 1
        }
      if (j != i + 1)
        {
          numdel = j - i - 1
          while (j != n)
            {
              pt(j - numdel) = pt(j)
              j = j + 1
            }
          n = n - numdel
        }
      i = i + 1
    }
end

subroutine deldup (n, pt)

  # Delete neighbor duplicates.

  implicit none

  integer n
  point pt(0:*)

  call deltrd (n, pt)
  call delntd (n, pt)
end

subroutine cxlhul (n, pt, hullsz, hull)

  # Construct the lower hull.

  implicit none

  integer n                     # Number of points.
  point pt(0:*)
  integer hullsz                # Output.
  point hull(0:*)               # Output.

  real cross
  integer i, j
  logical done

  j = 1
  hull(0) = pt(0)
  hull(1) = pt(1)
  for (i = 2; i <= n - 1; i = i + 1)
    {
      done = .false.
      while (!done)
        {
          if (j == 0)
            {
              j = j + 1
              hull(j) = pt(i)
              done = .true.
            }
          else if (0.0 < cross (hull(j) - hull(j - 1), _
                                pt(i) - hull(j - 1)))
            {
              j = j + 1
              hull(j) = pt(i)
              done = .true.
            }
          else
            j = j - 1
        }
    }
  hullsz = j + 1
end

subroutine cxuhul (n, pt, hullsz, hull)

  # Construct the upper hull.

  implicit none

  integer n                     # Number of points.
  point pt(0:*)
  integer hullsz                # Output.
  point hull(0:*)               # Output.

  real cross
  integer i, j
  logical done

  j = 1
  hull(0) = pt(n - 1)
  hull(1) = pt(n - 2)
  for (i = n - 3; 0 <= i; i = i - 1)
    {
      done = .false.
      while (!done)
        {
          if (j == 0)
            {
              j = j + 1
              hull(j) = pt(i)
              done = .true.
            }
          else if (0.0 < cross (hull(j) - hull(j - 1), _
                                pt(i) - hull(j - 1)))
            {
              j = j + 1
              hull(j) = pt(i)
              done = .true.
            }
          else
            j = j - 1
        }
    }
  hullsz = j + 1
end

subroutine cxhull (n, pt, hullsz, lhull, uhull)

  # Construct the hull.

  implicit none

  integer n                     # Number of points.
  point pt(0:*)                 # Overwritten with hull.
  integer hullsz                # Output.
  point lhull(0:*)              # Workspace.
  point uhull(0:*)              # Workspace

  integer lhulsz, uhulsz, i

  # A side note: the calls to construct_lower_hull and
  # construct_upper_hull could be done in parallel.
  call cxlhul (n, pt, lhulsz, lhull)
  call cxuhul (n, pt, uhulsz, uhull)

  hullsz = lhulsz + uhulsz - 2

  for (i = 0; i <= lhulsz - 2; i = i + 1)
    pt(i) = lhull(i)
  for (i = 0; i <= uhulsz - 2; i = i + 1)
    pt(lhulsz - 1 + i) = uhull(i)
end

subroutine cvxhul (n, pt, hullsz, lhull, uhull)

  # Find a convex hull.

  implicit none

  integer n            # Number of points.
  point pt(0:*)        # The contents of pt is replaced with the hull.
  integer hullsz       # Output.
  point lhull(0:*)     # Workspace.
  point uhull(0:*)     # Workspace

  integer numpt

  numpt = n

  call sortpt (numpt, pt)
  call deldup (numpt, pt)

  if (numpt == 0)
    hullsz = 0
  else if (numpt <= 2)
    hullsz = numpt
  else
    call cxhull (numpt, pt, hullsz, lhull, uhull)
end

program cvxtsk

  # The Rosetta Code convex hull task.

  implicit none

  integer n, i
  point points(0:100)
  point lhull(0:100)
  point uhull(0:100)
  character*100 fmt

  point exampl(0:19)
  data exampl / (16, 3), (12, 17), (0, 6), (-4, -6), (16, 6),    _
                (16, -7), (16, -3), (17, -4), (5, 19), (19, -8), _
                (3, 16), (12, 13), (3, -4), (17, 5), (-3, 15),   _
                (-3, -9), (0, 11), (-9, -3), (-4, -2), (12, 10) /

  n = 20
  for (i = 0; i <= n - 1; i = i + 1)
    points(i) = exampl(i)
  call cvxhul (n, points, n, lhull, uhull)

  write (fmt, '("(", I20, ''("(", F3.0, 1X, F3.0, ") ")'', ")")') n
  write (*, fmt) (points(i), i = 0, n - 1)
end


/* REXX ---------------------------------------------------------------
* Compute the Convex Hull for a set of points
* Format of the input file:
* (16,3) (12,17) (0,6) (-4,-6) (16,6) (16,-7) (16,-3) (17,-4) (5,19)
* (19,-8) (3,16) (12,13) (3,-4) (17,5) (-3,15) (-3,-9) (0,11) (-9,-3)
* (-4,-2)
*--------------------------------------------------------------------*/
  Signal On Novalue
  Signal On Syntax
Parse Arg fid
If fid='' Then Do
  fid='chullmin.in'                 /* miscellaneous test data       */
  fid='chullx.in'
  fid='chullt.in'
  fid='chulla.in'
  fid='chullxx.in'
  fid='sq.in'
  fid='tri.in'
  fid='line.in'
  fid='point.in'
  fid='chull.in'                    /* data from task description    */
  End
g.0debug=''
g.0oid=fn(fid)'.txt'; 'erase' g.0oid
x.=0
yl.=''
Parse Value '1000 -1000' With g.0xmin g.0xmax
Parse Value '1000 -1000' With g.0ymin g.0ymax
/*---------------------------------------------------------------------
* First read the input and store the points' coordinates
* x.0 contains the number of points, x.i contains the x.coordinate
* yl.x contains the y.coordinate(s) of points (x/y)
*--------------------------------------------------------------------*/
Do while lines(fid)>0
  l=linein(fid)
  Do While l<>''
    Parse Var l '(' x ',' y ')' l
    Call store x,y
    End
  End
Call lineout fid
Do i=1 To x.0                       /* loop over points              */
  x=x.i
  yl.x=sortv(yl.x)                  /* sort y-coordinates            */
  End
Call sho

/*---------------------------------------------------------------------
* Now we look for special border points:
* lefthigh and leftlow: leftmost points with higheste and lowest y
* ritehigh and ritelow: rightmost points with higheste and lowest y
* yl.x contains the y.coordinate(s) of points (x/y)
*--------------------------------------------------------------------*/
leftlow=0
lefthigh=0
Do i=1 To x.0
  x=x.i
  If maxv(yl.x)=g.0ymax Then Do
    If lefthigh=0 Then lefthigh=x'/'g.0ymax
    ritehigh=x'/'g.0ymax
    End
  If minv(yl.x)=g.0ymin Then Do
    ritelow=x'/'g.0ymin
    If leftlow=0 Then leftlow=x'/'g.0ymin
    End
  End
Call o 'lefthigh='lefthigh
Call o 'ritehigh='ritehigh
Call o 'ritelow ='ritelow
Call o 'leftlow ='leftlow
/*---------------------------------------------------------------------
* Now we look for special border points:
* leftmost_n and leftmost_s: points with lowest x and highest/lowest y
* ritemost_n and ritemost_s: points with largest x and highest/lowest y
* n and s stand foNorth and South, respectively
*--------------------------------------------------------------------*/
x=g.0xmi; leftmost_n=x'/'maxv(yl.x)
x=g.0xmi; leftmost_s=x'/'minv(yl.x)
x=g.0xma; ritemost_n=x'/'maxv(yl.x)
x=g.0xma; ritemost_s=x'/'minv(yl.x)

/*---------------------------------------------------------------------
* Now we compute the paths from ritehigh to ritelow (n_end)
* and leftlow to lefthigh (s_end), respectively
*--------------------------------------------------------------------*/
x=g.0xma
n_end=''
Do i=words(yl.x) To 1 By -1
  n_end=n_end x'/'word(yl.x,i)
  End
Call o 'n_end='n_end
x=g.0xmi
s_end=''
Do i=1 To words(yl.x)
  s_end=s_end x'/'word(yl.x,i)
  End
Call o 's_end='s_end

n_high=''
s_low=''
/*---------------------------------------------------------------------
* Now we compute the upper part of the convex hull (nhull)
*--------------------------------------------------------------------*/
Call o 'leftmost_n='leftmost_n
Call o 'lefthigh  ='lefthigh
nhull=leftmost_n
res=mk_nhull(leftmost_n,lefthigh);
nhull=nhull res
Call o 'A nhull='nhull
Do While res<>lefthigh
  res=mk_nhull(res,lefthigh); nhull=nhull res
  Call o 'B nhull='nhull
  End
res=mk_nhull(lefthigh,ritemost_n); nhull=nhull res
Call o 'C nhull='nhull
Do While res<>ritemost_n
  res=mk_nhull(res,ritemost_n); nhull=nhull res
  Call o 'D nhull='nhull
  End

nhull=nhull n_end                /* attach the right vertical border */

/*---------------------------------------------------------------------
* Now we compute the lower part of the convex hull (shull)
*--------------------------------------------------------------------*/
res=mk_shull(ritemost_s,ritelow);
shull=ritemost_s res
Call o 'A shull='shull
Do While res<>ritelow
  res=mk_shull(res,ritelow)
  shull=shull res
  Call o 'B shull='shull
  End
res=mk_shull(ritelow,leftmost_s)
shull=shull res
Call o 'C shull='shull
Do While res<>leftmost_s
  res=mk_shull(res,leftmost_s);
  shull=shull res
  Call o 'D shull='shull
  End

shull=shull s_end

chull=nhull shull                 /* concatenate upper and lower part */
                                  /* eliminate duplicates             */
                                  /* too lazy to take care before :-) */
Parse Var chull chullx chull
have.=0
have.chullx=1
Do i=1 By 1 While chull>''
  Parse Var chull xy chull
  If have.xy=0 Then Do
    chullx=chullx xy
    have.xy=1
    End
  End
                                   /* show the result                */
Say 'Points of convex hull in clockwise order:'
Say    chullx
/**********************************************************************
* steps that were necessary in previous attempts
/*---------------------------------------------------------------------
* Final polish: Insert points that are not yet in chullx but should be
* First on the upper hull going from left to right
*--------------------------------------------------------------------*/
i=1
Do While i<words(chullx)
  xya=word(chullx,i)  ; Parse Var xya xa '/' ya
  If xa=g.0xmax Then Leave
  xyb=word(chullx,i+1); Parse Var xyb xb '/' yb
  Do j=1 To x.0
    If x.j>xa Then Do
      If x.j<xb Then Do
        xx=x.j
        parse Value kdx(xya,xyb) With k d x
        If (k*xx+d)=maxv(yl.xx) Then Do
          chullx=subword(chullx,1,i) xx'/'maxv(yl.xx),
                                                    subword(chullx,i+1)
          i=i+1
          End
        End
      End
    Else
      i=i+1
    End
  End

Say    chullx

/*---------------------------------------------------------------------
* Final polish: Insert points that are not yet in chullx but should be
* Then on the lower hull going from right to left
*--------------------------------------------------------------------*/
i=wordpos(ritemost_s,chullx)
Do While i<words(chullx)
  xya=word(chullx,i)  ; Parse Var xya xa '/' ya
  If xa=g.0xmin Then Leave
  xyb=word(chullx,i+1); Parse Var xyb xb '/' yb
  Do j=x.0 To 1 By -1
    If x.j<xa Then Do
      If x.j>xb Then Do
        xx=x.j
        parse Value kdx(xya,xyb) With k d x
        If (k*xx+d)=minv(yl.xx) Then Do
          chullx=subword(chullx,1,i) xx'/'minv(yl.xx),
                                                    subword(chullx,i+1)
          i=i+1
          End
        End
      End
    Else
      i=i+1
    End
  End
Say chullx
**********************************************************************/
Call lineout g.0oid

Exit

store: Procedure Expose x. yl. g.
/*---------------------------------------------------------------------
* arrange the points in ascending order of x (in x.) and,
* for each x in ascending order of y (in yl.x)
* g.0xmin is the smallest x-value, etc.
* g.0xmi  is the x-coordinate
* g.0ymin is the smallest y-value, etc.
* g.0ymi  is the x-coordinate of such a point
*--------------------------------------------------------------------*/
  Parse Arg x,y
  Call o 'store' x y
  If x<g.0xmin Then Do; g.0xmin=x; g.0xmi=x; End
  If x>g.0xmax Then Do; g.0xmax=x; g.0xma=x; End
  If y<g.0ymin Then Do; g.0ymin=y; g.0ymi=x; End
  If y>g.0ymax Then Do; g.0ymax=y; g.0yma=x; End
  Do i=1 To x.0
    Select
      When x.i>x Then
        Leave
      When x.i=x Then Do
        yl.x=yl.x y
        Return
        End
      Otherwise
        Nop
      End
    End
  Do j=x.0 To i By -1
    ja=j+1
    x.ja=x.j
    End
  x.i=x
  yl.x=y
  x.0=x.0+1
  Return

sho: Procedure Expose x. yl. g.
  Do i=1 To x.0
    x=x.i
    say  format(i,2) 'x='format(x,3) 'yl='yl.x
    End
  Say ''
  Return

maxv: Procedure Expose g.
  Call trace 'O'
  Parse Arg l
  res=-1000
  Do While l<>''
    Parse Var l v l
    If v>res Then res=v
    End
  Return res

minv: Procedure Expose g.
  Call trace 'O'
  Parse Arg l
  res=1000
  Do While l<>''
    Parse Var l v l
    If v<res Then res=v
    End
  Return res

sortv: Procedure Expose g.
  Call trace 'O'
  Parse Arg l
  res=''
  Do Until l=''
    v=minv(l)
    res=res v
    l=remove(v,l)
    End
  Return space(res)

lastword: return word(arg(1),words(arg(1)))

kdx: Procedure  Expose xy. g.
/*---------------------------------------------------------------------
* Compute slope and y-displacement of a straight line
* that is defined by two points:  y=k*x+d
* Specialty; k='*' x=xa if xb=xa
*--------------------------------------------------------------------*/
  Call trace 'O'
  Parse Arg xya,xyb
  Parse Var xya xa '/' ya
  Parse Var xyb xb '/' yb
  If xa=xb Then
    Parse Value '*' '-' xa With k d x
  Else Do
    k=(yb-ya)/(xb-xa)
    d=yb-k*xb
    x='*'
    End
  Return k d x

remove:
/*---------------------------------------------------------------------
* Remove a specified element (e) from a given string (s)
*--------------------------------------------------------------------*/
  Parse Arg e,s
  Parse Var s sa (e) sb
  Return space(sa sb)

o: Procedure Expose g.
/*---------------------------------------------------------------------
* Write a line to the debug file
*--------------------------------------------------------------------*/
  If arg(2)=1 Then say arg(1)
  Return lineout(g.0oid,arg(1))

is_ok: Procedure Expose x. yl. g. sigl
/*---------------------------------------------------------------------
* Test if a given point (b) is above/on/or below a straight line
* defined by two points (a and c)
*--------------------------------------------------------------------*/
  Parse Arg a,b,c,op
  Call o    'is_ok' a b c op
  Parse Value kdx(a,c) With k d x
  Parse Var b x'/'y
  If op='U' Then y=maxv(yl.x)
            Else y=minv(yl.x)
  Call o    y x (k*x+d)
  If (abs(y-(k*x+d))<1.e-8) Then Return 0
  If op='U' Then res=(y<=(k*x+d))
            Else res=(y>=(k*x+d))
  Return res

mk_nhull: Procedure Expose x. yl. g.
/*---------------------------------------------------------------------
* Compute the upper (north) hull between two points (xya and xyb)
* Move x from xyb back to xya until all points within the current
* range (x and xyb) are BELOW the straight line defined xya and x
* Then make x the new starting point
*--------------------------------------------------------------------*/
  Parse Arg xya,xyb
  Call o 'mk_nhull' xya xyb
  If xya=xyb Then Return xya
  Parse Var xya xa '/' ya
  Parse Var xyb xb '/' yb
  iu=0
  iv=0
  Do xi=1 To x.0
    if x.xi>=xa & iu=0 Then iu=xi
    if x.xi<=xb Then iv=xi
    If x.xi>xb Then Leave
    End
  Call o    iu iv
  xu=x.iu
  xyu=xu'/'maxv(yl.xu)
  Do h=iv To iu+1 By -1 Until good
    Call o 'iv='iv,g.0debug
    Call o ' h='h,g.0debug
    xh=x.h
    xyh=xh'/'maxv(yl.xh)
    Call o    'Testing' xyu xyh,g.0debug
    good=1
    Do hh=h-1 To iu+1 By -1 While good
      xhh=x.hh
      xyhh=xhh'/'maxv(yl.xhh)
      Call o 'iu hh iv=' iu hh h,g.0debug
      If is_ok(xyu,xyhh,xyh,'U') Then Do
        Call o    xyhh 'is under' xyu xyh,g.0debug
        Nop
        End
      Else Do
        good=0
        Call o    xyhh 'is above' xyu xyh '-' xyh 'ist nicht gut'
        End
      End
    End
  Call o xyh 'is the one'

  Return xyh

p: Return
Say arg(1)
Pull  .
Return

mk_shull: Procedure Expose x. yl. g.
/*---------------------------------------------------------------------
* Compute the lower (south) hull between two points (xya and xyb)
* Move x from xyb back to xya until all points within the current
* range (x and xyb) are ABOVE the straight line defined xya and x
* Then make x the new starting point
*-----
---------------------------------------------------------------*/
  Parse Arg xya,xyb
  Call o 'mk_shull' xya xyb
  If xya=xyb Then Return xya
  Parse Var xya xa '/' ya
  Parse Var xyb xb '/' yb
  iu=0
  iv=0
  Do xi=x.0 To 1 By -1
    if x.xi<=xa & iu=0 Then iu=xi
    if x.xi>=xb Then iv=xi
    If x.xi<xb Then Leave
    End
  Call o iu iv '_' x.iu x.iv
  Call o 'mk_shull iv iu' iv iu
  xu=x.iu
  xyu=xu'/'minv(yl.xu)
  good=0
  Do h=iv To iu-1 Until good
    xh=x.h
    xyh=xh'/'minv(yl.xh)
    Call o    'Testing' xyu xyh   h iu
    good=1
    Do hh=h+1 To iu-1 While good
      Call o 'iu hh h=' iu hh h
      xhh=x.hh
      xyhh=xhh'/'minv(yl.xhh)
      If is_ok(xyu,xyhh,xyh,'O') Then Do
        Call o xyhh 'is above' xyu xyh
        Nop
        End
      Else Do
        Call o xyhh 'is under' xyu xyh '-' xyh 'ist nicht gut'
        good=0
        End
      End
    End
  Call o xyh 'is the one'
  Return xyh

Novalue:
  Say 'Novalue raised in line' sigl
  Say sourceline(sigl)
  Say 'Variable' condition('D')
  Signal lookaround

Syntax:
  Say 'Syntax raised in line' sigl
  Say sourceline(sigl)
  Say 'rc='rc '('errortext(rc)')'

halt:
lookaround:
  Say 'You can look around now.'
  Trace ?R
  Nop
  Exit 12


class Point
    include Comparable
    attr :x, :y

    def initialize(x, y)
        @x = x
        @y = y
    end

    def <=>(other)
        x <=> other.x
    end

    def to_s
        "(%d, %d)" % [@x, @y]
    end

    def to_str
        to_s()
    end
end

def ccw(a, b, c)
    ((b.x - a.x) * (c.y - a.y)) > ((b.y - a.y) * (c.x - a.x))
end

def convexHull(p)
    if p.length == 0 then
        return []
    end

    p = p.sort
    h = []

    # Lower hull
    p.each { |pt|
        while h.length >= 2 and not ccw(h[-2], h[-1], pt)
            h.pop()
        end
        h << pt
    }

    # upper hull
    t = h.length + 1
    p.reverse.each { |pt|
        while h.length >= t and not ccw(h[-2], h[-1], pt)
            h.pop()
        end
        h << pt
    }

    h.pop()
    h
end

def main
    points = [
        Point.new(16,  3), Point.new(12, 17), Point.new( 0,  6), Point.new(-4, -6), Point.new(16,  6),
        Point.new(16, -7), Point.new(16, -3), Point.new(17, -4), Point.new( 5, 19), Point.new(19, -8),
        Point.new( 3, 16), Point.new(12, 13), Point.new( 3, -4), Point.new(17,  5), Point.new(-3, 15),
        Point.new(-3, -9), Point.new( 0, 11), Point.new(-9, -3), Point.new(-4, -2), Point.new(12, 10)
    ]
    hull = convexHull(points)
    print "Convex Hull: [", hull.join(", "), "]\n"
end

main()


#[derive(Debug, Clone)]
struct Point {
    x: f32,
    y: f32
}

fn calculate_convex_hull(points: &Vec<Point>) -> Vec<Point> {
    //There must be at least 3 points
    if points.len() < 3 { return points.clone(); }

    let mut hull = vec![];

    //Find the left most point in the polygon
    let (left_most_idx, _) = points.iter()
        .enumerate()
        .min_by(|lhs, rhs| lhs.1.x.partial_cmp(&rhs.1.x).unwrap())
        .expect("No left most point");

    let mut p = left_most_idx;
    let mut q = 0_usize;

    loop {
        //The left most point must be part of the hull
        hull.push(points[p].clone());

        q = (p + 1) % points.len();

        for i in 0..points.len() {
            if orientation(&points[p], &points[i], &points[q]) == 2 {
                q = i;
            }
        }

        p = q;

        //Break from loop once we reach the first point again
        if p == left_most_idx { break; }
    }

    return hull;
}

//Calculate orientation for 3 points
//0 -> Straight line
//1 -> Clockwise
//2 -> Counterclockwise
fn orientation(p: &Point, q: &Point, r: &Point) -> usize {
    let val = (q.y - p.y) * (r.x - q.x) -
        (q.x - p.x) * (r.y - q.y);

    if val == 0. { return 0 };
    if val > 0. { return 1; } else { return 2; }
}

fn main(){
    let points = vec![pt(16,3), pt(12,17), pt(0,6), pt(-4,-6), pt(16,6), pt(16,-7), pt(16,-3), pt(17,-4), pt(5,19), pt(19,-8), pt(3,16), pt(12,13), pt(3,-4), pt(17,5), pt(-3,15), pt(-3,-9), pt(0,11), pt(-9,-3), pt(-4,-2), pt(12,10)];
    let hull = calculate_convex_hull(&points);

    hull.iter()
        .for_each(|pt| println!("{:?}", pt));
}

fn pt(x: i32, y: i32) -> Point {
    return Point {x:x as f32, y:y as f32};
}


object convex_hull{
    def get_hull(points:List[(Double,Double)], hull:List[(Double,Double)]):List[(Double,Double)] = points match{
        case Nil  =>            join_tail(hull,hull.size -1)
        case head :: tail =>    get_hull(tail,reduce(head::hull))
    }
    def reduce(hull:List[(Double,Double)]):List[(Double,Double)] = hull match{
        case p1::p2::p3::rest => {
            if(check_point(p1,p2,p3))      hull
            else                           reduce(p1::p3::rest)
        }
        case _ =>                          hull
    }
    def check_point(pnt:(Double,Double), p2:(Double,Double),p1:(Double,Double)): Boolean = {
        val (x,y) = (pnt._1,pnt._2)
        val (x1,y1) = (p1._1,p1._2)
        val (x2,y2) = (p2._1,p2._2)
        ((x-x1)*(y2-y1) - (x2-x1)*(y-y1)) <= 0
    }
    def m(p1:(Double,Double), p2:(Double,Double)):Double = {
        if(p2._1 == p1._1 && p1._2>p2._2)       90
        else if(p2._1 == p1._1 && p1._2<p2._2)  -90
        else if(p1._1<p2._1)                    180 - Math.toDegrees(Math.atan(-(p1._2 - p2._2)/(p1._1 - p2._1)))
        else                                    Math.toDegrees(Math.atan((p1._2 - p2._2)/(p1._1 - p2._1)))
    }
    def join_tail(hull:List[(Double,Double)],len:Int):List[(Double,Double)] = {
        if(m(hull(len),hull(0)) > m(hull(len-1),hull(0)))   join_tail(hull.slice(0,len),len-1)
        else                                                hull
    }
    def main(args:Array[String]){
        val points = List[(Double,Double)]((16,3), (12,17), (0,6), (-4,-6), (16,6), (16,-7), (16,-3), (17,-4), (5,19), (19,-8), (3,16), (12,13), (3,-4), (17,5), (-3,15), (-3,-9), (0,11), (-9,-3), (-4,-2), (12,10))
        val sorted_points = points.sortWith(m(_,(0.0,0.0)) < m(_,(0.0,0.0)))
        println(f"Points:\n" + points + f"\n\nConvex Hull :\n" +get_hull(sorted_points,List[(Double,Double)]()))
    }
}


(define-library (convex-hulls)

  (export vector-convex-hull)
  (export list-convex-hull)

  (import (scheme base))
  (import (srfi 132))                   ; Sorting.

  (begin

    ;;
    ;; The implementation is based on Andrew's monotone chain
    ;; algorithm, and is adapted from a Fortran implementation I wrote
    ;; myself in 2011.
    ;;
    ;; For a description of the algorithm, see
    ;; https://en.wikibooks.org/w/index.php?title=Algorithm_Implementation/Geometry/Convex_hull/Monotone_chain&stableid=4016938
    ;;

    (define [email protected] car)
    (define [email protected] cadr)

    (define (cross u v)
      ;; Cross product (as a signed scalar).
      (- (* ([email protected] u) ([email protected] v)) (* ([email protected] u) ([email protected] v))))

    (define (point- u v)
      (list (- ([email protected] u) ([email protected] v)) (- ([email protected] u) ([email protected] v))))

    (define (sort-points-vector points-vector)
      ;; Ascending sort on x-coordinates, followed by ascending sort
      ;; on y-coordinates.
      (vector-sort (lambda (u v)
                     (or (< ([email protected] u) ([email protected] v))
                         (and (= ([email protected] u) ([email protected] v))
                              (< ([email protected] u) ([email protected] v)))))
                   points-vector))

    (define (construct-lower-hull sorted-points-vector)
      (let* ((pt sorted-points-vector)
             (n (vector-length pt))
             (hull (make-vector n))
             (j 1))
        (vector-set! hull 0 (vector-ref pt 0))
        (vector-set! hull 1 (vector-ref pt 1))
        (do ((i 2 (+ i 1)))
            ((= i n))
          (let inner-loop ()
            (if (or (zero? j)
                    (positive?
                     (cross (point- (vector-ref hull j)
                                    (vector-ref hull (- j 1)))
                            (point- (vector-ref pt i)
                                    (vector-ref hull (- j 1))))))
                (begin
                  (set! j (+ j 1))
                  (vector-set! hull j (vector-ref pt i)))
                (begin
                  (set! j (- j 1))
                  (inner-loop)))))
        (values (+ j 1) hull)))         ; Hull size, hull points.

    (define (construct-upper-hull sorted-points-vector)
      (let* ((pt sorted-points-vector)
             (n (vector-length pt))
             (hull (make-vector n))
             (j 1))
        (vector-set! hull 0 (vector-ref pt (- n 1)))
        (vector-set! hull 1 (vector-ref pt (- n 2)))
        (do ((i (- n 3) (- i 1)))
            ((= i -1))
          (let inner-loop ()
            (if (or (zero? j)
                    (positive?
                     (cross (point- (vector-ref hull j)
                                    (vector-ref hull (- j 1)))
                            (point- (vector-ref pt i)
                                    (vector-ref hull (- j 1))))))
                (begin
                  (set! j (+ j 1))
                  (vector-set! hull j (vector-ref pt i)))
                (begin
                  (set! j (- j 1))
                  (inner-loop)))))
        (values (+ j 1) hull)))         ; Hull size, hull points.

    (define (construct-hull sorted-points-vector)
      ;; Notice that the lower and upper hulls could be constructed in
      ;; parallel.
      (let-values (((lower-hull-size lower-hull)
                    (construct-lower-hull sorted-points-vector))
                   ((upper-hull-size upper-hull)
                    (construct-upper-hull sorted-points-vector)))
        (let* ((hull-size (+ lower-hull-size upper-hull-size -2))
               (hull (make-vector hull-size)))
          (vector-copy! hull 0 lower-hull 0 (- lower-hull-size 1))
          (vector-copy! hull (- lower-hull-size 1) upper-hull
                        0 (- upper-hull-size 1))
          hull)))

    (define (vector-convex-hull points)
      (let* ((points-vector (if (vector? points)
                                points
                                (list->vector points)))
             (sorted-points-vector
              (vector-delete-neighbor-dups
               equal?
               (sort-points-vector points-vector))))
        (if (<= (vector-length sorted-points-vector) 2)
            sorted-points-vector
            (construct-hull sorted-points-vector))))

    (define (list-convex-hull points)
      (vector->list (vector-convex-hull points)))

    )) ;; end of library convex-hulls.

;;
;; A demonstration.
;;

(import (scheme base))
(import (scheme write))
(import (convex-hulls))

(define example-points
  '((16 3) (12 17) (0 6) (-4 -6) (16 6)
    (16 -7) (16 -3) (17 -4) (5 19) (19 -8)
    (3 16) (12 13) (3 -4) (17 5) (-3 15)
    (-3 -9) (0 11) (-9 -3) (-4 -2) (12 10)))

(write (list-convex-hull example-points))
(newline)


class Point(Number x, Number y) {
    method to_s {
        "(#{x}, #{y})"
    }
}

func ccw (Point a, Point b, Point c) {
    (b.x - a.x)*(c.y - a.y) - (b.y - a.y)*(c.x - a.x)
}

func tangent (Point a, Point b) {
    (b.x - a.x) / (b.y - a.y)
}

func graham_scan (*coords) {

    ## sort points by y, secondary sort on x
    var sp = coords.map { |a|
        Point(a...)
    }.sort { |a,b|
        (a.y <=> b.y) ||
        (a.x <=> b.x)
    }

    # need at least 3 points to make a hull
    if (sp.len < 3) {
        return sp
    }

    # first point on hull is minimum y point
    var h = [sp.shift]

    # re-sort the points by angle, secondary on x
    sp = sp.map_kv { |k,v|
        Pair(k, [tangent(h[0], v), v.x])
    }.sort { |a,b|
        (b.value[0] <=> a.value[0]) ||
        (a.value[1] <=> b.value[1])
    }.map { |a|
        sp[a.key]
    }

    # first point of re-sorted list is guaranteed to be on hull
    h << sp.shift

    # check through the remaining list making sure that
    # there is always a positive angle
    sp.each { |point|
        loop {
            if (ccw(h.last(2)..., point) >= 0) {
                h << point
                break
            } else {
                h.pop
            }
        }
    }

    return h
}

var hull = graham_scan(
    [16, 3], [12,17], [ 0, 6], [-4,-6], [16, 6], [16,-7], [16,-3],
    [17,-4], [ 5,19], [19,-8], [ 3,16], [12,13], [ 3,-4], [17, 5],
    [-3,15], [-3,-9], [ 0,11], [-9,-3], [-4,-2], [12,10])

say("Convex Hull (#{hull.len} points): ", hull.join(" "))

hull = graham_scan(
    [16, 3], [12,17], [ 0, 6], [-4,-6], [16, 6], [16,-7], [16,-3],
    [17,-4], [ 5,19], [19,-8], [ 3,16], [12,13], [ 3,-4], [17, 5],
    [-3,15], [-3,-9], [ 0,11], [-9,-3], [-4,-2], [12,10], [14,-9], [1,-9])

say("Convex Hull (#{hull.len} points): ", hull.join(" "))


(*
 * Convex hulls by Andrew's monotone chain algorithm.
 *
 * For a description of the algorithm, see
 * https://en.wikibooks.org/w/index.php?title=Algorithm_Implementation/Geometry/Convex_hull/Monotone_chain&stableid=40169
 *)

(*------------------------------------------------------------------*)
(*
 * Just enough plane geometry for our purpose.
 *)

signature PLANE_POINT =
sig
  type planePoint
  val planePoint : real * real -> planePoint
  val toTuple : planePoint -> real * real
  val x : planePoint -> real
  val y : planePoint -> real
  val == : planePoint * planePoint -> bool

  (* Impose a total order on points, making it one that will work for
     Andrew's monotone chain algorithm. *)
  val order : planePoint * planePoint -> bool

  (* Subtraction is really a vector or multivector operation. *)
  val subtract : planePoint * planePoint -> planePoint

  (* Cross product is really a multivector operation. *)
  val cross : planePoint * planePoint -> real

  val toString : planePoint -> string
end

structure PlanePoint : PLANE_POINT =
struct
type planePoint = real * real

fun planePoint xy = xy
fun toTuple (x, y) = (x, y)
fun x (x, _) = x
fun y (_, y) = y

fun == ((a : real, b : real), (c : real, d : real)) =
    Real.== (a, c) andalso Real.== (b, d)

fun order ((a : real, b : real), (c : real, d : real)) =
    Real.< (a, c) orelse (Real.== (a, c) andalso Real.< (b, d))

fun subtract ((a : real, b : real), (c : real, d : real)) =
    (a - c, b - d)

fun cross ((a : real, b : real), (c : real, d : real)) =
    (a * d) - (b * c)

fun toString (x, y) =
    "(" ^ Real.toString x ^ " " ^ Real.toString y ^ ")"
end

(*------------------------------------------------------------------*)
(*
 * Rather than rely on compiler extensions for sorting, let us write
 * our own.
 *
 * For no special reason, let us use the Shell sort of
 * https://en.wikipedia.org/w/index.php?title=Shellsort&oldid=1084744510
 *)

val ciura_gaps = Array.fromList [701, 301, 132, 57, 23, 10, 4, 1]

fun sort_in_place less arr =
    let
      open Array

      fun span_gap gap =
          let
            fun iloop i =
                if length arr <= i then
                  ()
                else
                  let
                    val temp = sub (arr, i)
                    fun jloop j =
                        if j < gap orelse
                           less (sub (arr, j - gap), temp) then
                          update (arr, j, temp)
                        else
                          (update (arr, j, sub (arr, j - gap));
                           jloop (j - gap))
                  in
                    jloop i;
                    iloop (i + gap)
                  end
          in
            iloop 0
          end
    in
      app span_gap ciura_gaps
    end

(*------------------------------------------------------------------*)
(*
 * To go with our sort routine, we want something akin to
 * array_delete_neighbor_dups of Scheme's SRFI-132.
 *)

fun array_delete_neighbor_dups equal arr =
    let
      open Array

      fun loop i lst =
          (* Cons a list of non-duplicates, going backwards through
             the array so the list will be in forwards order. *)
          if i = 0 then
            sub (arr, i) :: lst
          else if equal (sub (arr, i - 1), sub (arr, i)) then
            loop (i - 1) lst
          else
            loop (i - 1) (sub (arr, i) :: lst)

      val n = length arr
    in
      fromList (if n = 0 then [] else loop (n - 1) [])
    end

(*------------------------------------------------------------------*)
(*
 * The convex hull algorithm.
 *)

fun cross_test (pt_i, hull, j) =
    let
      open PlanePoint
      val hull_j = Array.sub (hull, j)
      val hull_j1 = Array.sub (hull, j - 1)
    in
      0.0 < cross (subtract (hull_j, hull_j1),
                   subtract (pt_i, hull_j1))
    end

fun construct_lower_hull (n, pt) =
    let
      open PlanePoint

      val hull = Array.array (n, planePoint (0.0, 0.0))
      val () = Array.update (hull, 0, Array.sub (pt, 0))
      val () = Array.update (hull, 1, Array.sub (pt, 1))

      fun outer_loop i j =
          if i = n then
            j + 1
          else
            let
              val pt_i = Array.sub (pt, i)

              fun inner_loop j =
                  if j = 0 orelse cross_test (pt_i, hull, j) then
                    (Array.update (hull, j + 1, pt_i);
                     j + 1)
                  else
                    inner_loop (j - 1)
            in
              outer_loop (i + 1) (inner_loop j)
            end

      val hull_size = outer_loop 2 1
    in
      (hull_size, hull)
    end

fun construct_upper_hull (n, pt) =
    let
      open PlanePoint

      val hull = Array.array (n, planePoint (0.0, 0.0))
      val () = Array.update (hull, 0, Array.sub (pt, n - 1))
      val () = Array.update (hull, 1, Array.sub (pt, n - 2))

      fun outer_loop i j =
          if i = ~1 then
            j + 1
          else
            let
              val pt_i = Array.sub (pt, i)

              fun inner_loop j =
                  if j = 0 orelse cross_test (pt_i, hull, j) then
                    (Array.update (hull, j + 1, pt_i);
                     j + 1)
                  else
                    inner_loop (j - 1)
            in
              outer_loop (i - 1) (inner_loop j)
            end

      val hull_size = outer_loop (n - 3) 1
    in
      (hull_size, hull)
    end

fun construct_hull (n, pt) =
    let
      (* Side note: Construction of the lower and upper hulls can be
         done in parallel. *)
      val (lower_hull_size, lower_hull) = construct_lower_hull (n, pt)
      and (upper_hull_size, upper_hull) = construct_upper_hull (n, pt)

      val hull_size = lower_hull_size + upper_hull_size - 2
      val hull =
          Array.array (hull_size, PlanePoint.planePoint (0.0, 0.0))

      fun copy_lower i =
          if i = lower_hull_size - 1 then
            ()
          else
            (Array.update (hull, i, Array.sub (lower_hull, i));
             copy_lower (i + 1))

      fun copy_upper i =
          if i = upper_hull_size - 1 then
            ()
          else
            (Array.update (hull, i + lower_hull_size - 1,
                           Array.sub (upper_hull, i));
             copy_upper (i + 1))
    in
      copy_lower 0;
      copy_upper 0;
      hull
    end

fun plane_convex_hull points_lst =
    (* Takes an arbitrary list of points, which may be in any order
       and may contain duplicates. Returns an ordered array of points
       that make up the convex hull. If the list of points is empty,
       the returned array is empty. *)
    let
      val pt = Array.fromList points_lst
      val () = sort_in_place PlanePoint.order pt
      val pt = array_delete_neighbor_dups (PlanePoint.==) pt
      val n = Array.length pt
    in
      if n <= 2 then
        pt
      else
        construct_hull (n, pt)
    end

(*------------------------------------------------------------------*)

fun main () =
    let
      open PlanePoint

      val example_points =
          [planePoint (16.0, 3.0),
           planePoint (12.0, 17.0),
           planePoint (0.0, 6.0),
           planePoint (~4.0, ~6.0),
           planePoint (16.0, 6.0),
           planePoint (16.0, ~7.0),
           planePoint (16.0, ~3.0),
           planePoint (17.0, ~4.0),
           planePoint (5.0, 19.0),
           planePoint (19.0, ~8.0),
           planePoint (3.0, 16.0),
           planePoint (12.0, 13.0),
           planePoint (3.0, ~4.0),
           planePoint (17.0, 5.0),
           planePoint (~3.0, 15.0),
           planePoint (~3.0, ~9.0),
           planePoint (0.0, 11.0),
           planePoint (~9.0, ~3.0),
           planePoint (~4.0, ~2.0),
           planePoint (12.0, 10.0)]

      val hull = plane_convex_hull example_points
    in
      Array.app (fn p => (print (toString p);
                          print " "))
                hull;
      print "\n"
    end;

main ();

(*------------------------------------------------------------------*)
(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)


public struct Point: Equatable, Hashable {
  public var x: Double
  public var y: Double

  public init(fromTuple t: (Double, Double)) {
    self.x = t.0
    self.y = t.1
  }
}

public func calculateConvexHull(fromPoints points: [Point]) -> [Point] {
  guard points.count >= 3 else {
    return points
  }

  var hull = [Point]()
  let (leftPointIdx, _) = points.enumerated().min(by: { $0.element.x < $1.element.x })!

  var p = leftPointIdx
  var q = 0

  repeat {
    hull.append(points[p])

    q = (p + 1) % points.count

    for i in 0..<points.count where calculateOrientation(points[p], points[i], points[q]) == .counterClockwise {
      q = i
    }

    p = q
  } while p != leftPointIdx

  return hull
}

private func calculateOrientation(_ p: Point, _ q: Point, _ r: Point) -> Orientation {
  let val = (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y)

  if val == 0 {
    return .straight
  } else if val > 0 {
    return .clockwise
  } else {
    return .counterClockwise
  }
}

private enum Orientation {
  case straight, clockwise, counterClockwise
}

let points = [
  (16,3),
  (12,17),
  (0,6),
  (-4,-6),
  (16,6),
  (16,-7),
  (16,-3),
  (17,-4),
  (5,19),
  (19,-8),
  (3,16),
  (12,13),
  (3,-4),
  (17,5),
  (-3,15),
  (-3,-9),
  (0,11),
  (-9,-3),
  (-4,-2),
  (12,10)
].map(Point.init(fromTuple:))

print("Input: \(points)")
print("Output: \(calculateConvexHull(fromPoints: points))")


catch {namespace delete test_convex_hull} ;# Start with a clean namespace

namespace eval test_convex_hull {
    package require Tcl 8.5 ;# maybe earlier?
    interp alias {} @ {} lindex;# An essential readability helper for list indexing

    proc cross {o a b} {
        ### 2D cross product of OA and OB vectors ###
        return [expr {([@ $a 0] - [@ $o 0]) * ([@ $b 1] - [@ $o 1]) - ([@ $a 1] - [@ $o 1]) * ([@ $b 0] - [@ $o 0]) }]
    }

    proc calc_hull_edge {points} {
        ### Build up hull edge ###
        set edge [list]
        foreach p $points {
            while {[llength $edge ] >= 2 && [cross [@ $edge end-1] [@ $edge end] $p] <= 0} {
                set edge [lreplace $edge end end] ;# pop
            }
            lappend edge $p
        }
        return $edge
    }

    proc convex_hull {points} {
        ### Convex hull of a set of 2D points ###

        # Unique points
        set points [lsort -unique $points]

        # Sorted points
        set points [lsort -real -index 0 [lsort -real -index 1 $points]]

        # No calculation necessary
        if {[llength $points] <= 1} {
            return $points
        }

        set lower [calc_hull_edge $points]
        set upper [calc_hull_edge [lreverse $points]]

        return [concat [lrange $lower 0 end-1] [lrange $upper 0 end-1]]
    }

    # Testing
    set tpoints {{16 3} {12 17} {0 6} {-4 -6} {16 6}  {16 -7} {16 -3} {17 -4} {5 19}  {19 -8}
                 {3 16} {12 13} {3 -4} {17 5} {-3 15} {-3 -9} {0 11}  {-9 -3} {-4 -2} {12 10}}

    puts "Test points:"
    puts [lrange $tpoints 0 end] ;# prettier
    puts "Convex Hull:"
    puts [convex_hull $tpoints]
}


Imports ConvexHull

Module Module1

    Class Point : Implements IComparable(Of Point)
        Public Property X As Integer
        Public Property Y As Integer

        Public Sub New(x As Integer, y As Integer)
            Me.X = x
            Me.Y = y
        End Sub

        Public Function CompareTo(other As Point) As Integer Implements IComparable(Of Point).CompareTo
            Return X.CompareTo(other.X)
        End Function

        Public Overrides Function ToString() As String
            Return String.Format("({0}, {1})", X, Y)
        End Function
    End Class

    Function ConvexHull(p As List(Of Point)) As List(Of Point)
        If p.Count = 0 Then
            Return New List(Of Point)
        End If
        p.Sort()
        Dim h As New List(Of Point)

        ' Lower hull
        For Each pt In p
            While h.Count >= 2 AndAlso Not Ccw(h(h.Count - 2), h(h.Count - 1), pt)
                h.RemoveAt(h.Count - 1)
            End While
            h.Add(pt)
        Next

        ' Upper hull
        Dim t = h.Count + 1
        For i = p.Count - 1 To 0 Step -1
            Dim pt = p(i)
            While h.Count >= t AndAlso Not Ccw(h(h.Count - 2), h(h.Count - 1), pt)
                h.RemoveAt(h.Count - 1)
            End While
            h.Add(pt)
        Next

        h.RemoveAt(h.Count - 1)
        Return h
    End Function

    Function Ccw(a As Point, b As Point, c As Point) As Boolean
        Return ((b.X - a.X) * (c.Y - a.Y)) > ((b.Y - a.Y) * (c.X - a.X))
    End Function

    Sub Main()
        Dim points As New List(Of Point) From {
            New Point(16, 3),
            New Point(12, 17),
            New Point(0, 6),
            New Point(-4, -6),
            New Point(16, 6),
            New Point(16, -7),
            New Point(16, -3),
            New Point(17, -4),
            New Point(5, 19),
            New Point(19, -8),
            New Point(3, 16),
            New Point(12, 13),
            New Point(3, -4),
            New Point(17, 5),
            New Point(-3, 15),
            New Point(-3, -9),
            New Point(0, 11),
            New Point(-9, -3),
            New Point(-4, -2),
            New Point(12, 10)
        }

        Dim hull = ConvexHull(points)
        Dim it = hull.GetEnumerator()
        Console.Write("Convex Hull: [")
        If it.MoveNext() Then
            Console.Write(it.Current)
        End If
        While it.MoveNext()
            Console.Write(", {0}", it.Current)
        End While
        Console.WriteLine("]")
    End Sub

End Module


import "/sort" for Sort
import "/trait" for Comparable, Stepped

class Point is Comparable {
    construct new(x, y) {
        _x = x
        _y = y
    }

    x { _x }
    y { _y }

    compare(other) { (_x != other.x) ? (_x - other.x).sign : (_y - other.y).sign }

    toString { "(%(_x), %(_y))" }
}

/* ccw returns true if the three points make a counter-clockwise turn */
var ccw = Fn.new { |a, b, c| ((b.x - a.x) * (c.y - a.y)) > ((b.y - a.y) * (c.x - a.x)) }

var convexHull = Fn.new { |pts|
    if (pts.isEmpty) return []
    Sort.quick(pts)
    var h = []

    // lower hull
    for (pt in pts) {
        while (h.count >= 2 && !ccw.call(h[-2], h[-1], pt)) h.removeAt(-1)
        h.add(pt)
    }

    // upper hull
    var t = h.count + 1
    for (i in Stepped.descend(pts.count-2..0, 1)) {
        var pt = pts[i]
        while (h.count >= t && !ccw.call(h[-2], h[-1], pt)) h.removeAt(-1)
        h.add(pt)
    }

    h.removeAt(-1)
    return h
}

var pts = [
    Point.new(16,  3), Point.new(12, 17), Point.new( 0,  6), Point.new(-4, -6), Point.new(16,  6),
    Point.new(16, -7), Point.new(16, -3), Point.new(17, -4), Point.new( 5, 19), Point.new(19, -8),
    Point.new( 3, 16), Point.new(12, 13), Point.new( 3, -4), Point.new(17,  5), Point.new(-3, 15),
    Point.new(-3, -9), Point.new( 0, 11), Point.new(-9, -3), Point.new(-4, -2), Point.new(12, 10)
]
System.print("Convex Hull: %(convexHull.call(pts))")


// Use Graham Scan to sort points into a convex hull
// https://en.wikipedia.org/wiki/Graham_scan, O(n log n)
// http://www.geeksforgeeks.org/convex-hull-set-2-graham-scan/
// http://geomalgorithms.com/a10-_hull-1.html
fcn grahamScan(points){
   N:=points.len();
   # find the point with the lowest y-coordinate, x is tie breaker
   p0:=points.reduce(fcn([(a,b)]ab,[(x,y)]xy){
	if(b<y)ab else if(b==y and a<x)ab else xy });
   #sort points by polar angle with p0, ie ccw from p0
   points.sort('wrap(p1,p2){ ccw(p0,p1,p2)>0 });

   # We want points[0] to be a sentinel point that will stop the loop.
   points.insert(0,points[-1]);
   M:=1; # M will denote the number of points on the convex hull.
   foreach i in ([2..N]){
      # Find next valid point on convex hull.
      while(ccw(points[M-1], points[M], points[i])<=0){
	 if(M>1) M-=1;
	 else if(i==N) break;  # All points are collinear
	 else i+=1;
      }
      points.swap(M+=1,i); # Update M and swap points[i] to the correct place.
   }
   points[0,M]
}
# Three points are a counter-clockwise turn if ccw > 0, clockwise if
# ccw < 0, and collinear if ccw = 0 because ccw is a determinant that
# gives twice the signed  area of the triangle formed by p1, p2 and p3.
fcn ccw(a,b,c){  // a,b,c are points: (x,y)
   ((b[0] - a[0])*(c[1] - a[1])) - ((b[1] - a[1])*(c[0] - a[0]))
}


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

DEFINE PTR="CARD"
DEFINE JSR="$20"
DEFINE RTS="$60"

PROC CoeffA=*(INT n REAL POINTER res)
  [JSR $00 $00 ;JSR to address set by SetCoeffA
   RTS]

PROC CoeffB=*(INT n REAL POINTER res)
  [JSR $00 $00 ;JSR to address set by SetCoeffB
   RTS]

PROC SetCoeffA(PTR p)
  PTR addr

  addr=CoeffA+1 ;location of address of JSR
  PokeC(addr,p)
RETURN

PROC SetCoeffB(PTR p)
  PTR addr

  addr=CoeffB+1 ;location of address of JSR
  PokeC(addr,p)
RETURN

PROC Calc(PTR funA,funB INT count REAL POINTER res)
  INT i
  REAL a,b,tmp

  SetCoeffA(funA)
  SetCoeffB(funB)

  IntToReal(0,res)
  i=count
  WHILE i>0
  DO
    CoeffA(i,a)
    CoeffB(i,b)
    RealAdd(a,res,tmp)
    RealDiv(b,tmp,res)
    i==-1
  OD
  CoeffA(0,a)
  RealAdd(a,res,tmp)
  RealAssign(tmp,res)
RETURN

PROC sqrtA(INT n REAL POINTER res)
  IF n>0 THEN
    IntToReal(2,res)
  ELSE
    IntToReal(1,res)
  FI
RETURN

PROC sqrtB(INT n REAL POINTER res)
  IntToReal(1,res)
RETURN

PROC napierA(INT n REAL POINTER res)
  IF n>0 THEN
    IntToReal(n,res)
  ELSE
    IntToReal(2,res)
  FI
RETURN

PROC napierB(INT n REAL POINTER res)
  IF n>1 THEN
    IntToReal(n-1,res)
  ELSE
    IntToReal(1,res)
  FI
RETURN

PROC piA(INT n REAL POINTER res)
  IF n>0 THEN
    IntToReal(6,res)
  ELSE
    IntToReal(3,res)
  FI
RETURN

PROC piB(INT n REAL POINTER res)
  REAL tmp

  IntToReal(2*n-1,tmp)
  RealMult(tmp,tmp,res)
RETURN

PROC Main()
  REAL res

  Put(125) PutE() ;clear the screen

  Calc(sqrtA,sqrtB,50,res)
  Print(" Sqrt2=") PrintRE(res)

  Calc(napierA,napierB,50,res)
  Print("Napier=") PrintRE(res)

  Calc(piA,piB,500,res)
  Print("    Pi=") PrintRE(res)
RETURN


generic
   type Scalar is digits <>;

   with function A (N : in Natural)  return Natural;
   with function B (N : in Positive) return Natural;
function Continued_Fraction (Steps : in Natural) return Scalar;


PROC cf = (INT steps, PROC (INT) INT a, PROC (INT) INT b) REAL:
BEGIN
  REAL result;
  result := 0;
  FOR n FROM steps BY -1 TO 1 DO
      result := b(n) / (a(n) + result)
  OD;
  a(0) + result
END;

PROC asqr2 = (INT n) INT: (n = 0 | 1 | 2);
PROC bsqr2 = (INT n) INT: 1;

PROC anap = (INT n) INT: (n = 0 | 2 | n);
PROC bnap = (INT n) INT: (n = 1 | 1 | n - 1);

PROC api = (INT n) INT: (n = 0 | 3 | 6);
PROC bpi = (INT n) INT: (n = 1 | 1 | (2 * n - 1) ** 2);

INT precision = 10000;

print (("Precision: ", precision, newline));
print (("Sqr(2):    ", cf(precision, asqr2, bsqr2), newline));
print (("Napier:    ", cf(precision, anap, bnap), newline));
print (("Pi:        ", cf(precision, api, bpi)))


calc: function [f, n][
    [a, b, temp]: 0.0

    loop n..1 'i [
        [a, b]: call f @[i]
        temp: b // a + temp
    ]
    [a, b]: call f @[0]
    return a + temp
]

sqrt2: function [n][
    (n > 0)? -> [2.0, 1.0] -> [1.0, 1.0]
]

napier: function [n][
    a: (n > 0)? -> to :floating n -> 2.0
    b: (n > 1)? -> to :floating n-1 -> 1.0
    @[a, b]
]

Pi: function [n][
    a: (n > 0)? -> 6.0 -> 3.0
    b: ((2 * to :floating n)-1) ^ 2
    @[a, b]
]

print calc 'sqrt2 20
print calc 'napier 15
print calc 'Pi 10000


#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
(*
** a coefficient function creates double values from in paramters
*)
typedef coeff_f = int -> double
//
(*
** a continued fraction is described by a record of two coefficent
** functions a and b
*)
typedef frac = @{a= coeff_f, b= coeff_f}
//
(* ****** ****** *)

fun calc
(
  f: frac, n: int
) : double = let
//
(*
** recursive definition of the approximation
*)
fun loop
(
  n: int, r: double
) : double =
(
if n = 0
  then f.a(0) + r
  else loop (n - 1, f.b(n) / (f.a(n) + r))
// end of [if]
)
//
in
  loop (n, 0.0)
end // end of [calc]

(* ****** ****** *)

val sqrt2 = @{
  a= lam (n: int): double => if n = 0 then 1.0 else 2.0
,
  b= lam (n: int): double => 1.0
} (* end of [val] *)

val napier = @{
  a= lam (n: int): double => if n = 0 then 2.0 else 1.0 * n
,
  b= lam (n: int): double => if n = 1 then 1.0 else n - 1.0
} (* end of [val] *)

val pi = @{
  a= lam (n: int): double => if n = 0 then 3.0 else 6.0
,
  b= lam (n: int): double => let val x = 2.0 * n - 1 in x * x end
}

(* ****** ****** *)

implement
main0 () =
(
  println! ("sqrt2  = ", calc(sqrt2,  100));
  println! ("napier = ", calc(napier, 100));
  println! ("  pi   = ", calc(  pi  , 100));
) (* end of [main0] *)


sqrt2_a(n) ; function definition is as simple as that
{
return n?2.0:1.0
}

sqrt2_b(n)
{
return 1.0
}

napier_a(n)
{
return n?n:2.0
}

napier_b(n)
{
return n>1.0?n-1.0:1.0
}

pi_a(n)
{
return n?6.0:3.0
}

pi_b(n)
{
return (2.0*n-1.0)**2.0 ; exponentiation operator
}

calc(f,expansions)
{
r:=0,i:=expansions
; A nasty trick: the names of the two coefficient functions are generated dynamically
; a dot surrounded by spaces means string concatenation
f_a:=f . "_a",f_b:=f . "_b"

while i>0 {
; You can see two dynamic function calls here
r:=%f_b%(i)/(%f_a%(i)+r)
i--
}

return %f_a%(0)+r
}

Msgbox, % "sqrt 2 = " . calc("sqrt2", 1000) . "`ne = " . calc("napier", 1000) . "`npi = " . calc("pi", 1000)


get(obj) == convergents(obj).1000 -- utility to extract the 1000th value
get continuedFraction(1, repeating [1], repeating [2]) :: Float
get continuedFraction(2, cons(1,[i for i in 1..]), [i for i in 1..]) :: Float
get continuedFraction(3, [i^2 for i in 1.. by 2], repeating [6]) :: Float


      *FLOAT64
      @% = &1001010

      PRINT "SQR(2) = " ; FNcontfrac(1, 1, "2", "1")
      PRINT "     e = " ; FNcontfrac(2, 1, "N", "N")
      PRINT "    PI = " ; FNcontfrac(3, 1, "6", "(2*N+1)^2")
      END

      REM a$ and b$ are functions of N
      DEF FNcontfrac(a0, b1, a$, b$)
      LOCAL N, expr$
      REPEAT
        N += 1
        expr$ += STR$(EVAL(a$)) + "+" + STR$(EVAL(b$)) + "/("
      UNTIL LEN(expr$) > (65500 - N)
      = a0 + b1 / EVAL (expr$ + "1" + STRING$(N, ")"))


/* calculate approximations for continued fractions */
#include <stdio.h>

/* kind of function that returns a series of coefficients */
typedef double (*coeff_func)(unsigned n);

/* calculates the specified number of expansions of the continued fraction
 * described by the coefficient series f_a and f_b */
double calc(coeff_func f_a, coeff_func f_b, unsigned expansions)
{
	double a, b, r;
	a = b = r = 0.0;

	unsigned i;
	for (i = expansions; i > 0; i--) {
		a = f_a(i);
		b = f_b(i);
		r = b / (a + r);
	}
	a = f_a(0);

	return a + r;
}

/* series for sqrt(2) */
double sqrt2_a(unsigned n)
{
	return n ? 2.0 : 1.0;
}

double sqrt2_b(unsigned n)
{
	return 1.0;
}

/* series for the napier constant */
double napier_a(unsigned n)
{
	return n ? n : 2.0;
}

double napier_b(unsigned n)
{
	return n > 1.0 ? n - 1.0 : 1.0;
}

/* series for pi */
double pi_a(unsigned n)
{
	return n ? 6.0 : 3.0;
}

double pi_b(unsigned n)
{
	double c = 2.0 * n - 1.0;

	return c * c;
}

int main(void)
{
	double sqrt2, napier, pi;

	sqrt2  = calc(sqrt2_a,  sqrt2_b,  1000);
	napier = calc(napier_a, napier_b, 1000);
	pi     = calc(pi_a,     pi_b,     1000);

	printf("%12.10g\n%12.10g\n%12.10g\n", sqrt2, napier, pi);

	return 0;
}


using System;
using System.Collections.Generic;

namespace ContinuedFraction {
    class Program {
        static double Calc(Func<int, int[]> f, int n) {
            double temp = 0.0;
            for (int ni = n; ni >= 1; ni--) {
                int[] p = f(ni);
                temp = p[1] / (p[0] + temp);
            }
            return f(0)[0] + temp;
        }

        static void Main(string[] args) {
            List<Func<int, int[]>> fList = new List<Func<int, int[]>>();
            fList.Add(n => new int[] { n > 0 ? 2 : 1, 1 });
            fList.Add(n => new int[] { n > 0 ? n : 2, n > 1 ? (n - 1) : 1 });
            fList.Add(n => new int[] { n > 0 ? 6 : 3, (int) Math.Pow(2 * n - 1, 2) });

            foreach (var f in fList) {
                Console.WriteLine(Calc(f, 200));
            }
        }
    }
}


#include <iomanip>
#include <iostream>
#include <tuple>

typedef std::tuple<double,double> coeff_t; // coefficients type
typedef coeff_t (*func_t)(int); // callback function type

double calc(func_t func, int n)
{
    double a, b, temp = 0;
    for (; n > 0; --n) {
        std::tie(a, b) = func(n);
        temp = b / (a + temp);
    }
    std::tie(a, b) = func(0);
    return a + temp;
}

coeff_t sqrt2(int n)
{
    return coeff_t(n > 0 ? 2 : 1, 1);
}

coeff_t napier(int n)
{
    return coeff_t(n > 0 ? n : 2, n > 1 ? n - 1 : 1);
}

coeff_t pi(int n)
{
    return coeff_t(n > 0 ? 6 : 3, (2 * n - 1) * (2 * n - 1));
}

int main()
{
    std::streamsize old_prec = std::cout.precision(15); // set output digits
    std::cout
        << calc(sqrt2, 20) << '\n'
        << calc(napier, 15) << '\n'
        << calc(pi, 10000) << '\n'
        << std::setprecision(old_prec); // reset precision
}


proc calc(f, n) {
        var r = 0.0;

        for k in 1..n by -1 {
                var v = f.pair(k);
                r = v(2) / (v(1) + r);
        }

        return f.pair(0)(1) + r;
}

record Sqrt2 {
        proc pair(n) {
                return (if n == 0 then 1 else 2,
                        1);
        }
}

record Napier {
        proc pair(n) {
                return (if n == 0 then 2 else n,
                        if n == 1 then 1 else n - 1);
        }
}
record Pi {
        proc pair(n) {
                return (if n == 0 then 3 else 6,
                        (2*n - 1)**2);
        }
}

config const n = 200;
writeln(calc(new Sqrt2(), n));
writeln(calc(new Napier(), n));
writeln(calc(new Pi(), n));


       identification division.
       program-id. show-continued-fractions.

       environment division.
       configuration section.
       repository.
           function continued-fractions
           function all intrinsic.

       procedure division.
       fractions-main.

       display "Square root 2 approximately   : "
               continued-fractions("sqrt-2-alpha", "sqrt-2-beta", 100)
       display "Napier constant approximately : "
               continued-fractions("napier-alpha", "napier-beta", 40)
       display "Pi approximately              : "
               continued-fractions("pi-alpha", "pi-beta", 10000)

       goback.
       end program show-continued-fractions.

      *> **************************************************************
       identification division.
       function-id. continued-fractions.

       data division.
       working-storage section.
       01 alpha-function       usage program-pointer.
       01 beta-function        usage program-pointer.
       01 alpha                usage float-long.
       01 beta                 usage float-long.
       01 running              usage float-long.
       01 i                    usage binary-long.

       linkage section.
       01 alpha-name           pic x any length.
       01 beta-name            pic x any length.
       01 iterations           pic 9 any length.
       01 approximation        usage float-long.

       procedure division using
           alpha-name beta-name iterations
           returning approximation.

       set alpha-function to entry alpha-name
       if alpha-function = null then
           display "error: no " alpha-name " function" upon syserr
           goback
       end-if
       set beta-function to entry beta-name
       if beta-function = null then
           display "error: no " beta-name " function" upon syserr
           goback
       end-if

       move 0 to alpha beta running
       perform varying i from iterations by -1 until i = 0
           call alpha-function using i returning alpha
           call beta-function using i returning beta
           compute running = beta / (alpha + running)
       end-perform
       call alpha-function using 0 returning alpha
       compute approximation = alpha + running

       goback.
       end function continued-fractions.

      *> ******************************
       identification division.
       program-id. sqrt-2-alpha.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       if iteration equal 0 then
           move 1.0 to result
       else
           move 2.0 to result
       end-if

       goback.
       end program sqrt-2-alpha.

      *> ******************************
       identification division.
       program-id. sqrt-2-beta.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       move 1.0 to result

       goback.
       end program sqrt-2-beta.

      *> ******************************
       identification division.
       program-id. napier-alpha.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       if iteration equal 0 then
           move 2.0 to result
       else
           move iteration to result
       end-if

       goback.
       end program napier-alpha.

      *> ******************************
       identification division.
       program-id. napier-beta.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       if iteration = 1 then
           move 1.0 to result
       else
           compute result = iteration - 1.0
       end-if

       goback.
       end program napier-beta.

      *> ******************************
       identification division.
       program-id. pi-alpha.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       if iteration equal 0 then
           move 3.0 to result
       else
           move 6.0 to result
       end-if

       goback.
       end program pi-alpha.

      *> ******************************
       identification division.
       program-id. pi-beta.

       data division.
       working-storage section.
       01 result               usage float-long.

       linkage section.
       01 iteration            usage binary-long unsigned.

       procedure division using iteration returning result.
       compute result = (2 * iteration - 1) ** 2

       goback.
       end program pi-beta.


# Compute a continuous fraction of the form
# a0 + b1 / (a1 + b2 / (a2 + b3 / ...
continuous_fraction = (f) ->
  a = f.a
  b = f.b
  c = 1
  for n in [100000..1]
    c = b(n) / (a(n) + c)
  a(0) + c

# A little helper.
p = (a, b) ->
  console.log a
  console.log b
  console.log "---"

do ->
  fsqrt2 =
    a: (n) -> if n is 0 then 1 else 2
    b: (n) -> 1
  p Math.sqrt(2), continuous_fraction(fsqrt2)

  fnapier =
    a: (n) -> if n is 0 then 2 else n
    b: (n) -> if n is 1 then 1 else n - 1
  p Math.E, continuous_fraction(fnapier)

  fpi =
    a: (n) ->
      return 3 if n is 0
      6
    b: (n) ->
      x = 2*n - 1
      x * x
  p Math.PI, continuous_fraction(fpi)


(defun estimate-continued-fraction (generator n)
  (let ((temp 0))
    (loop for n1 from n downto 1
       do (multiple-value-bind (a b)
	      (funcall generator n1)
	    (setf temp (/ b (+ a temp)))))
    (+ (funcall generator 0) temp)))

(format t "sqrt(2) = ~a~%" (coerce (estimate-continued-fraction
				    (lambda (n)
				      (values (if (> n 0) 2 1) 1)) 20)
				   'double-float))
(format t "napier's = ~a~%" (coerce (estimate-continued-fraction
				     (lambda (n)
				       (values (if (> n 0) n 2)
					       (if (> n 1) (1- n) 1))) 15)
				    'double-float))

(format t "pi = ~a~%" (coerce (estimate-continued-fraction
			       (lambda (n)
				 (values (if (> n 0) 6 3)
					 (* (1- (* 2 n))
					    (1- (* 2 n))))) 10000)
			      'double-float))


import std.stdio, std.functional, std.traits;

FP calc(FP, F)(in F fun, in int n) pure nothrow if (isCallable!F) {
    FP temp = 0;

    foreach_reverse (immutable ni; 1 .. n + 1) {
        immutable p = fun(ni);
        temp = p[1] / (FP(p[0]) + temp);
    }
    return fun(0)[0] + temp;
}

int[2] fSqrt2(in int n) pure nothrow {
    return [n > 0 ? 2 : 1,   1];
}

int[2] fNapier(in int n) pure nothrow {
    return [n > 0 ? n : 2,   n > 1 ? (n - 1) : 1];
}

int[2] fPi(in int n) pure nothrow {
    return [n > 0 ? 6 : 3,   (2 * n - 1) ^^ 2];
}

alias print = curry!(writefln, "%.19f");

void main() {
    calc!real(&fSqrt2, 200).print;
    calc!real(&fNapier, 200).print;
    calc!real(&fPi, 200).print;
}


-module(continued).
-compile([export_all]).

pi_a (0) -> 3;
pi_a (_N) -> 6.

pi_b (N) ->
    (2*N-1)*(2*N-1).

sqrt2_a (0) ->
    1;
sqrt2_a (_N) ->
    2.

sqrt2_b (_N) ->
    1.

nappier_a (0) ->
    2;
nappier_a (N) ->
    N.

nappier_b (1) ->
    1;
nappier_b (N) ->
    N-1.

continued_fraction(FA,_FB,0) -> FA(0);
continued_fraction(FA,FB,N) ->
    continued_fraction(FA,FB,N-1,FB(N)/FA(N)).

continued_fraction(FA,_FB,0,Acc) -> FA(0) + Acc;
continued_fraction(FA,FB,N,Acc) ->
    continued_fraction(FA,FB,N-1,FB(N)/ (FA(N) + Acc)).

test_pi (N) ->
    continued_fraction(fun pi_a/1,fun pi_b/1,N).

test_sqrt2 (N) ->
    continued_fraction(fun sqrt2_a/1,fun sqrt2_b/1,N).

test_nappier (N) ->
    continued_fraction(fun nappier_a/1,fun nappier_b/1,N).


// I provide four functions:-
// cf2S general purpose continued fraction to sequence of float approximations
// cN2S Normal continued fractions (a-series always 1)
// cfSqRt uses cf2S to calculate sqrt of float
// π takes a sequence of b values returning the next until the list is exhausted after which  it injects infinity
// Nigel Galloway: December 19th., 2018
let cf2S α β=let n0,g1,n1,g2=β(),α(),β(),β()
             seq{let (Π:decimal)=g1/n1 in yield n0+Π; yield! Seq.unfold(fun(n,g,Π)->let a,b=α(),β() in let Π=Π*g/n in Some(n0+Π,(b+a/n,b+a/g,Π)))(g2+α()/n1,g2,Π)}
let cN2S = cf2S (fun()->1M)
let cfSqRt n=(cf2S (fun()->n-1M) (let mutable n=false in fun()->if n then 2M else (n<-true; 1M)))
let π n=let mutable π=n in (fun ()->match π with h::t->π<-t; h |_->9999999999999999999999999999M)


USING: arrays combinators io kernel locals math math.functions
  math.ranges prettyprint sequences ;
IN: rosetta.cfrac

! Every continued fraction must implement these two words.
GENERIC: cfrac-a ( n cfrac -- a )
GENERIC: cfrac-b ( n cfrac -- b )

! square root of 2
SINGLETON: sqrt2
M: sqrt2 cfrac-a
    ! If n is 1, then a_n is 1, else a_n is 2.
    drop { { 1 [ 1 ] } [ drop 2 ] } case ;
M: sqrt2 cfrac-b
    ! Always b_n is 1.
    2drop 1 ;

! Napier's constant
SINGLETON: napier
M: napier cfrac-a
    ! If n is 1, then a_n is 2, else a_n is n - 1.
    drop { { 1 [ 2 ] } [ 1 - ] } case ;
M: napier cfrac-b
    ! If n is 1, then b_n is 1, else b_n is n - 1.
    drop { { 1 [ 1 ] } [ 1 - ] } case ;

SINGLETON: pi
M: pi cfrac-a
    ! If n is 1, then a_n is 3, else a_n is 6.
    drop { { 1 [ 3 ] } [ drop 6 ] } case ;
M: pi cfrac-b
    ! Always b_n is (n * 2 - 1)^2.
    drop 2 * 1 - 2 ^ ;

:: cfrac-estimate ( cfrac terms -- number )
    terms cfrac cfrac-a             ! top = last a_n
    terms 1 - 1 [a,b] [ :> n
        n cfrac cfrac-b swap /      ! top = b_n / top
        n cfrac cfrac-a +           ! top = top + a_n
    ] each ;

:: decimalize ( rational prec -- string )
    rational 1 /mod             ! split whole, fractional parts
    prec 10^ *                  ! multiply fraction by 10 ^ prec
    [ >integer unparse ] [email protected]    ! convert digits to strings
    :> fraction
    "."                         ! push decimal point
    prec fraction length -
    dup 0 < [ drop 0 ] when
    "0" <repetition> concat     ! push padding zeros
    fraction 4array concat ;

<PRIVATE
: main ( -- )
    " Square root of 2: " write
    sqrt2 50 cfrac-estimate 30 decimalize print
    "Napier's constant: " write
    napier 50 cfrac-estimate 30 decimalize print
    "               Pi: " write
    pi 950 cfrac-estimate 10 decimalize print ;
PRIVATE>

MAIN: main


fun pi (n:int) : (double*double) =>
    let a = match n with | 0 => 3.0 | _ => 6.0 endmatch in
    let b = pow(2.0 * n.double - 1.0, 2.0) in
    (a,b);

fun sqrt_2 (n:int) : (double*double) =>
    let a = match n with | 0 => 1.0 | _ => 2.0 endmatch in
    let b = 1.0 in
    (a,b);

fun napier (n:int) : (double*double) =>
    let a = match n with | 0 => 2.0 | _ => n.double endmatch in
    let b = match n with | 1 => 1.0 | _ => (n.double - 1.0) endmatch in
    (a,b);

fun cf_iter (steps:int) (f:int -> double*double)  = {
    var acc = 0.0;
    for var n in steps downto 0 do
        var a, b = f(n);
        acc = if (n > 0) then (b / (a + acc)) else (acc + a);
    done
    return acc;
}

println$ cf_iter 200 sqrt_2; // => 1.41421
println$ cf_iter 200 napier; // => 2.71818
println$ cf_iter 1000 pi; // => 3.14159


: fsqrt2 1 s>f 0> if 2 s>f else fdup then ;
: fnapier dup dup 1 > if 1- else drop 1 then s>f dup 1 < if drop 2 then s>f ;
: fpi dup 2* 1- dup * s>f 0> if 6 else 3 then s>f ;
                                       ( n -- f1 f2)
: cont.fraction                        ( xt n -- f)
  1 swap 1+ 0 s>f                      \ calculate for 1 .. n
  do i over execute frot f+ f/ -1 +loop
  0 swap execute fnip f+               \ calcucate for 0
;


module continued_fractions
  implicit none

  integer, parameter :: long = selected_real_kind(7,99)

  type continued_fraction
    integer                            :: a0, b1
    procedure(series), pointer, nopass :: a, b
  end type

  interface
    pure function series (n)
      integer, intent(in) :: n
      integer             :: series
    end function
  end interface

contains

  pure function define_cf (a0,a,b1,b) result(x)
    integer, intent(in)           :: a0
    procedure(series)             :: a
    integer, intent(in), optional :: b1
    procedure(series),   optional :: b
    type(continued_fraction)      :: x
    x%a0 = a0
    x%a => a
    if ( present(b1) ) then
       x%b1 = b1
    else
       x%b1 = 1
    end if
    if ( present(b) ) then
       x%b => b
    else
       x%b => const_1
    end if
  end function define_cf

  pure integer function const_1(n)
    integer,intent(in) :: n
    const_1 = 1
  end function

  pure real(kind=long) function output(x,iterations)
    type(continued_fraction), intent(in) :: x
    integer,                  intent(in) :: iterations
    integer                              :: i
    output = x%a(iterations)
    do i = iterations-1,1,-1
      output = x%a(i) + (x%b(i+1) / output)
    end do
    output = x%a0 + (x%b1 / output)
  end function output

end module continued_fractions

program examples
  use continued_fractions

  type(continued_fraction) :: sqr2,napier,pi

  sqr2   = define_cf(1,a_sqr2)
  napier = define_cf(2,a_napier,1,b_napier)
  pi     = define_cf(3,a=a_pi,b=b_pi)

  write (*,*) output(sqr2,10000)
  write (*,*) output(napier,10000)
  write (*,*) output(pi,10000)

contains

  pure integer function a_sqr2(n)
    integer,intent(in) :: n
    a_sqr2 = 2
  end function

  pure integer function a_napier(n)
    integer,intent(in) :: n
    a_napier = n
  end function

  pure integer function b_napier(n)
    integer,intent(in) :: n
    b_napier = n-1
  end function

  pure integer function a_pi(n)
    integer,intent(in) :: n
    a_pi = 6
  end function

  pure integer function b_pi(n)
    integer,intent(in) :: n
    b_pi = (2*n-1)*(2*n-1)
  end function

end program examples


#define MAX 70000

function sqrt2_a( n as uinteger ) as uinteger
    return iif(n,2,1)
end function

function sqrt2_b( n as uinteger ) as uinteger
    return 1
end function

function napi_a( n as uinteger ) as uinteger
   return iif(n,n,2)
end function

function napi_b( n as uinteger ) as uinteger
   return iif(n>1,n-1,1)
end function

function pi_a( n as uinteger ) as uinteger
    return iif(n,6,3)
end function

function pi_b( n as uinteger ) as uinteger
    return (2*n-1)^2
end function

function calc_contfrac( an as function (as uinteger) as uinteger, bn as function (as uinteger) as uinteger, byval iter as uinteger ) as double
    dim as double r
    dim as integer i
    for i = iter to 1 step -1
        r = bn(i)/(an(i)+r)
    next i
    return an(0)+r
end function

print calc_contfrac( @sqrt2_a, @sqrt2_b, MAX )
print calc_contfrac( @napi_a, @napi_b, MAX )
print calc_contfrac( @pi_a, @pi_b, MAX )


package main

import "fmt"

type cfTerm struct {
    a, b int
}

// follows subscript convention of mathworld and WP where there is no b(0).
// cf[0].b is unused in this representation.
type cf []cfTerm

func cfSqrt2(nTerms int) cf {
    f := make(cf, nTerms)
    for n := range f {
        f[n] = cfTerm{2, 1}
    }
    f[0].a = 1
    return f
}

func cfNap(nTerms int) cf {
    f := make(cf, nTerms)
    for n := range f {
        f[n] = cfTerm{n, n - 1}
    }
    f[0].a = 2
    f[1].b = 1
    return f
}

func cfPi(nTerms int) cf {
    f := make(cf, nTerms)
    for n := range f {
        g := 2*n - 1
        f[n] = cfTerm{6, g * g}
    }
    f[0].a = 3
    return f
}

func (f cf) real() (r float64) {
    for n := len(f) - 1; n > 0; n-- {
        r = float64(f[n].b) / (float64(f[n].a) + r)
    }
    return r + float64(f[0].a)
}

func main() {
    fmt.Println("sqrt2:", cfSqrt2(20).real())
    fmt.Println("nap:  ", cfNap(20).real())
    fmt.Println("pi:   ", cfPi(20).real())
}


import java.util.function.Function

import static java.lang.Math.pow

class Test {
    static double calc(Function<Integer, Integer[]> f, int n) {
        double temp = 0

        for (int ni = n; ni >= 1; ni--) {
            Integer[] p = f.apply(ni)
            temp = p[1] / (double) (p[0] + temp)
        }
        return f.apply(0)[0] + temp
    }

    static void main(String[] args) {
        List<Function<Integer, Integer[]>> fList = new ArrayList<>()
        fList.add({ n -> [n > 0 ? 2 : 1, 1] })
        fList.add({ n -> [n > 0 ? n : 2, n > 1 ? (n - 1) : 1] })
        fList.add({ n -> [n > 0 ? 6 : 3, (int) pow(2 * n - 1, 2)] })

        for (Function<Integer, Integer[]> f : fList)
            System.out.println(calc(f, 200))
    }
}


import Data.List (unfoldr)
import Data.Char (intToDigit)

-- continued fraction represented as a (possibly infinite) list of pairs
sqrt2, napier, myPi :: [(Integer, Integer)]
sqrt2 = zip (1 : [2,2 ..]) [1,1 ..]

napier = zip (2 : [1 ..]) (1 : [1 ..])

myPi = zip (3 : [6,6 ..]) ((^ 2) <$> [1,3 ..])

-- approximate a continued fraction after certain number of iterations
approxCF
  :: (Integral a, Fractional b)
  => Int -> [(a, a)] -> b
approxCF t = foldr (\(a, b) z -> fromIntegral a + fromIntegral b / z) 1 . take t

-- infinite decimal representation of a real number
decString
  :: RealFrac a
  => a -> String
decString frac = show i ++ '.' : decString_ f
  where
    (i, f) = properFraction frac
    decString_ = map intToDigit . unfoldr (Just . properFraction . (10 *))

main :: IO ()
main =
  mapM_
    (putStrLn .
     take 200 . decString . (approxCF 950 :: [(Integer, Integer)] -> Rational))
    [sqrt2, napier, myPi]


import static java.lang.Math.pow;
import java.util.*;
import java.util.function.Function;

public class Test {
    static double calc(Function<Integer, Integer[]> f, int n) {
        double temp = 0;

        for (int ni = n; ni >= 1; ni--) {
            Integer[] p = f.apply(ni);
            temp = p[1] / (double) (p[0] + temp);
        }
        return f.apply(0)[0] + temp;
    }

    public static void main(String[] args) {
        List<Function<Integer, Integer[]>> fList = new ArrayList<>();
        fList.add(n -> new Integer[]{n > 0 ? 2 : 1, 1});
        fList.add(n -> new Integer[]{n > 0 ? n : 2, n > 1 ? (n - 1) : 1});
        fList.add(n -> new Integer[]{n > 0 ? 6 : 3, (int) pow(2 * n - 1, 2)});

        for (Function<Integer, Integer[]> f : fList)
            System.out.println(calc(f, 200));
    }
}


# "first" is the first triple,
# e.g. [1,a,b]; count specifies the number of terms to use.
def continued_fraction( first; next; count ):
  # input: [i, a, b]]
  def cf:
      if .[0] == count then 0
      else next as $ab
      | .[1] + (.[2] / ($ab | cf))
      end ;
  first | cf;

# "first" and "next" are as above;
# if delta is 0 then continue until there is no detectable change.
def continued_fraction_delta(first; next; delta):
  def abs: if . < 0 then -. else . end;
  def cf:
    # state: [n, prev]
    .[0] as $n | .[1] as $prev
    |  continued_fraction(first; next; $n+1) as $this
    | if $prev == null then [$n+1, $this] | cf
      elif delta <= 0 and ($prev == $this) then $this
      elif (($prev - $this)|abs) <= delta then $this
      else [$n+1, $this] | cf
      end;
  [2,null] | cf;


function _sqrt(a::Bool, n)
    if a
        return n > 0 ? 2.0 : 1.0
    else
        return 1.0
    end
end

function _napier(a::Bool, n)
    if a
        return n > 0 ? Float64(n) : 2.0
    else
        return n > 1 ? n - 1.0 : 1.0
    end
end

function _pi(a::Bool, n)
    if a
        return n > 0 ? 6.0 : 3.0
    else
        return (2.0 * n - 1.0) ^ 2.0 # exponentiation operator
    end
end

function calc(f::Function, expansions::Integer)
    a, b = true, false
    r = 0.0
    for i in expansions:-1:1
        r = f(b, i) / (f(a, i) + r)
    end
    return f(a, 0) + r
end

for (v, f) in (("√2", _sqrt), ("e", _napier), ("π", _pi))
    @printf("%3s = %f\n", v, calc(f, 1000))
end


// version 1.1.2

typealias Func = (Int) -> IntArray

fun calc(f: Func, n: Int): Double {
    var temp = 0.0
    for (i in n downTo 1) {
        val p = f(i)
        temp = p[1] / (p[0] + temp)
    }
    return f(0)[0] + temp
}

fun main(args: Array<String>) {
    val pList = listOf<Pair<String, Func>>(
        "sqrt(2)" to { n -> intArrayOf(if (n > 0) 2 else 1, 1) },
        "e      " to { n -> intArrayOf(if (n > 0) n else 2, if (n > 1) n - 1 else 1) },
        "pi     " to { n -> intArrayOf(if (n > 0) 6 else 3, (2 * n - 1) * (2 * n - 1)) }
    )
    for (pair in pList) println("${pair.first} = ${calc(pair.second, 200)}")
}


{def gcf
 {def gcf.rec
  {lambda {:f :n :r}
   {if {< :n 1}
    then {+ {car {:f 0}} :r}
    else {gcf.rec :f
                   {- :n 1}
                   {let { {:r :r}
                          {:ab {:f :n}}
                        } {/ {cdr :ab}
                             {+ {car :ab} :r}} }}}}}
 {lambda {:f :n}
  {gcf.rec :f :n 0}}}

{def phi
 {lambda {:n}
  {cons 1 1}}}

{gcf phi 50}
-> 1.618033988749895

{def sqrt2
 {lambda {:n}
  {cons {if {> :n 0} then 2 else 1} 1}}}

{gcf sqrt2 25}
-> 1.4142135623730951

{def napier
 {lambda {:n}
  {cons {if {> :n 0} then :n else 2} {if {> :n 1} then {- :n 1} else 1} }}}

{gcf napier 20}
-> 2.7182818284590455

{def fpi
 {lambda {:n}
  {cons {if {> :n 0} then 6 else 3} {pow {- {* 2 :n} 1} 2} }}}

{gcf fpi 500}
-> 3.1415926 516017554
// only 8 exact decimals for 500 iterations
// A very very slow convergence.
// Here is a quicker version without any obvious pattern

{def pi
 {lambda {:n}
  {cons {A.get :n {A.new 3 7 15 1 292 1 1 1 2 1 3 1 14 2 1 1}} 1}}}

{gcf pi 15}
-> 3.1415926 53589793

// Much quicker, 15 exact decimals after 15 iterations


function calc(fa, fb, expansions)
    local a = 0.0
    local b = 0.0
    local r = 0.0
    local i = expansions
    while i > 0 do
        a = fa(i)
        b = fb(i)
        r = b / (a + r)
        i = i - 1
    end
    a = fa(0)
    return a + r
end

function sqrt2a(n)
    if n ~= 0 then
        return 2.0
    else
        return 1.0
    end
end

function sqrt2b(n)
    return 1.0
end

function napiera(n)
    if n ~= 0 then
        return n
    else
        return 2.0
    end
end

function napierb(n)
    if n > 1.0 then
        return n - 1.0
    else
        return 1.0
    end
end

function pia(n)
    if n ~= 0 then
        return 6.0
    else
        return 3.0
    end
end

function pib(n)
    local c = 2.0 * n - 1.0
    return c * c
end

function main()
    local sqrt2  = calc(sqrt2a,  sqrt2b,  1000)
    local napier = calc(napiera, napierb, 1000)
    local pi     = calc(pia,     pib,     1000)
    print(sqrt2)
    print(napier)
    print(pi)
end

main()


contfrac:=n->evalf(Value(NumberTheory:-ContinuedFraction(n)));
contfrac(2^(0.5));
contfrac(Pi);
contfrac(exp(1));


/* REXX ***************************************************************
* Derived from REXX ... Derived from PL/I with a little "massage"
* SQRT2=  1.41421356237309505              <- PL/I Result
*         1.41421356237309504880168872421  <- NetRexx Result 30 digits
* NAPIER= 2.71828182845904524
*         2.71828182845904523536028747135
* PI=     3.14159262280484695
*         3.14159262280484694855146925223
* 07.09.2012 Walter Pachl
* 08.09.2012 Walter Pachl simplified (with the help of a friend)
**********************************************************************/
options replace format comments java crossref savelog symbols
  class CFB public

properties static
  Numeric Digits 30
  Sqrt2 =1
  napier=2
  pi    =3
  a     =0
  b     =0

method main(args = String[]) public static
  Say 'SQRT2='.left(7)  calc(sqrt2,  200)
  Say 'NAPIER='.left(7) calc(napier, 200)
  Say 'PI='.left(7)     calc(pi,     200)
  Return

method get_Coeffs(form,n) public static
  select
    when form=Sqrt2 Then do
      if n > 0 then a = 2; else a = 1
      b = 1
      end
    when form=Napier Then do
      if n > 0 then a = n; else a = 2
      if n > 1 then b = n - 1; else b = 1
      end
    when form=pi Then do
      if n > 0 then a = 6; else a = 3
      b = (2*n - 1)**2
      end
    end
  Return

method calc(form,n)  public static
  temp=0
  loop ni = n to 1 by -1
    Get_Coeffs(form,ni)
    temp = b/(a + temp)
    end
  Get_Coeffs(form,0)
  return (a + temp)


proc calc(f: proc(n: int): tuple[a, b: float], n: int): float =
  var a, b, temp = 0.0
  for i in countdown(n, 1):
    (a, b) = f(i)
    temp = b / (a + temp)
  (a, b) = f(0)
  a + temp

proc sqrt2(n: int): tuple[a, b: float] =
  if n > 0:
    (2.0, 1.0)
  else:
    (1.0, 1.0)

proc napier(n: int): tuple[a, b: float] =
  let a = if n > 0: float(n) else: 2.0
  let b = if n > 1: float(n - 1) else: 1.0
  (a, b)

proc pi(n: int): tuple[a, b: float] =
  let a = if n > 0: 6.0 else: 3.0
  let b = (2 * float(n) - 1) * (2 * float(n) - 1)
  (a, b)

echo calc(sqrt2, 20)
echo calc(napier, 15)
echo calc(pi, 10000)


let pi = 3, fun n -> ((2*n-1)*(2*n-1), 6)
and nap = 2, fun n -> (max 1 (n-1), n)
and root2 = 1, fun n -> (1, 2) in

let eval (i,f) k =
  let rec frac n =
    let a, b = f n in
    float a /. (float b +.
      if n >= k then 0.0 else frac (n+1)) in
  float i +. frac 1 in

Printf.printf "sqrt(2)\t= %.15f\n" (eval root2 1000);
Printf.printf "e\t= %.15f\n" (eval nap 1000);
Printf.printf "pi\t= %.15f\n" (eval pi 1000);


use strict;
use warnings;
no warnings 'recursion';
use experimental 'signatures';

sub continued_fraction ($a, $b, $n = 100) {
    $a->() + ($n and $b->() / continued_fraction($a, $b, $n-1));
}

printf "√2  ≈ %.9f\n", continued_fraction do { my $n; sub { $n++ ? 2 : 1  } },              sub { 1                 };
printf "e   ≈ %.9f\n", continued_fraction do { my $n; sub { $n++ or 2     } },  do { my $n; sub { $n++ or 1       } };
printf "π   ≈ %.9f\n", continued_fraction do { my $n; sub { $n++ ? 6 : 3  } },  do { my $n; sub { (2*$n++ + 1)**2 } }, 1000;
printf "π/2 ≈ %.9f\n", continued_fraction do { my $n; sub { 1/($n++ or 1) } },              sub { 1                 }, 1000;


with javascript_semantics
constant precision = 10000

function continued_fraction(integer f, steps=precision)
    atom a, b, res = 0
    for n=steps to 1 by -1 do
        {a, b} = f(n)
        res := b / (a + res)
    end for
    {a} = f(0)
    return a + res
end function

function sqr2(integer n) return {iff(n=0?1:2),1} end function

function nap(integer n) return {iff(n=0?2:n),iff(n=1?1:n-1)} end function

function pi(integer n) return {iff(n=0?3:6),power(2*n-1,2)} end function

printf(1,"Precision: %d\n", {precision})
printf(1,"Sqr(2):    %.10g\n", {continued_fraction(sqr2)})
printf(1,"Napier:    %.10g\n", {continued_fraction(nap)})
printf(1,"Pi:        %.10g\n", {continued_fraction(pi)})


go =>

  % square root 2
  continued_fraction(200, sqrt_2_ab, V1),
  printf("sqrt(2) = %w (diff: %0.15f)\n", V1, V1-sqrt(2)),

  % napier
  continued_fraction(200, napier_ab, V2),
  printf("e       = %w (diff: %0.15f)\n", V2, V2-math.e),

  % pi
  continued_fraction(200, pi_ab, V3),
  printf("pi      = %w (diff: %0.15f)\n", V3, V3-math.pi),
  % get a better precision
  continued_fraction(20000, pi_ab, V3b),
  printf("pi      = %w (diff: %0.15f)\n", V3b, V3b-math.pi),
  nl.

continued_fraction(N, Compute_ab, V) ?=>
  continued_fraction(N,  Compute_ab, 0, V).

continued_fraction(0,  Compute_ab, Temp, V) ?=>
  call(Compute_ab, 0, A, _),
  V = A + Temp.

continued_fraction(N, Compute_ab, Tmp, V) =>
  call(Compute_ab, N, A, B),
  Tmp1 = B / (A + Tmp),
  N1 = N - 1,
  continued_fraction(N1, Compute_ab, Tmp1, V).

% definitions for square root of 2
sqrt_2_ab(0, 1, 1).
sqrt_2_ab(_, 2, 1).

% definitions for napier
napier_ab(0, 2, _).
napier_ab(1, 1, 1).
napier_ab(N, N, V) :-
	V is N - 1.

% definitions for pi
pi_ab(0, 3, _).
pi_ab(N, 6, V) :-
	V is (2 * N - 1)*(2 * N - 1).


/* Version for SQRT(2) */
test: proc options (main);
   declare n fixed;

denom: procedure (n) recursive returns (float (18));
   declare n fixed;
   n = n + 1;
   if n > 100 then return (2);
   return (2 + 1/denom(n));
end denom;

   put (1 + 1/denom(2));

end test;


continued_fraction :-
	% square root 2
	continued_fraction(200, sqrt_2_ab, V1),
	format('sqrt(2) = ~w~n', [V1]),

	% napier
	continued_fraction(200, napier_ab, V2),
	format('e       = ~w~n', [V2]),

	% pi
	continued_fraction(200, pi_ab, V3),
	format('pi      = ~w~n', [V3]).

% code for continued fractions
continued_fraction(N, Compute_ab, V) :-
	continued_fraction(N,  Compute_ab, 0, V).

continued_fraction(0,  Compute_ab, Temp, V) :-
	call(Compute_ab, 0, A, _),
	V is A + Temp.

continued_fraction(N, Compute_ab, Tmp, V) :-
	call(Compute_ab, N, A, B),
	Tmp1 is B / (A + Tmp),
	N1 is N - 1,
	continued_fraction(N1, Compute_ab, Tmp1, V).

% specific codes for examples
% definitions for square root of 2
sqrt_2_ab(0, 1, 1).
sqrt_2_ab(_, 2, 1).

% definitions for napier
napier_ab(0, 2, _).
napier_ab(1, 1, 1).
napier_ab(N, N, V) :-
	V is N - 1.

% definitions for pi
pi_ab(0, 3, _).
pi_ab(N, 6, V) :-
	V is (2 * N - 1)*(2 * N - 1).


from fractions import Fraction
import itertools
try: zip = itertools.izip
except: pass

# The Continued Fraction
def CF(a, b, t):
  terms = list(itertools.islice(zip(a, b), t))
  z = Fraction(1,1)
  for a, b in reversed(terms):
    z = a + b / z
  return z

# Approximates a fraction to a string
def pRes(x, d):
  q, x = divmod(x, 1)
  res = str(q)
  res += "."
  for i in range(d):
    x *= 10
    q, x = divmod(x, 1)
    res += str(q)
  return res

# Test the Continued Fraction for sqrt2
def sqrt2_a():
  yield 1
  for x in itertools.repeat(2):
    yield x

def sqrt2_b():
  for x in itertools.repeat(1):
    yield x

cf = CF(sqrt2_a(), sqrt2_b(), 950)
print(pRes(cf, 200))
#1.41421356237309504880168872420969807856967187537694807317667973799073247846210703885038753432764157273501384623091229702492483605585073721264412149709993583141322266592750559275579995050115278206057147

# Test the Continued Fraction for Napier's Constant
def Napier_a():
  yield 2
  for x in itertools.count(1):
    yield x

def Napier_b():
  yield 1
  for x in itertools.count(1):
    yield x

cf = CF(Napier_a(), Napier_b(), 950)
print(pRes(cf, 200))
#2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642742746639193200305992181741359662904357290033429526059563073813232862794349076323382988075319525101901

# Test the Continued Fraction for Pi
def Pi_a():
  yield 3
  for x in itertools.repeat(6):
    yield x

def Pi_b():
  for x in itertools.count(1,2):
    yield x*x

cf = CF(Pi_a(), Pi_b(), 950)
print(pRes(cf, 10))
#3.1415926532


  [ $ "bigrat.qky" loadfile ] now!

  [ 1 min
    [ table
      [ 1 1 ]
      [ 2 1 ] ] do ]     is sqrt2  ( n --> n/d )

  [ dup 2 min
    [ table
      [ drop 2 1 ]
      [ 1 ]
      [ dup 1 - ] ] do ] is napier ( n --> n/d )

    [ dup 1 min
    [ table
      [ drop 3 1 ]
      [ 2 * 1 - dup *
        6 swap ] ]  do ] is pi     ( n --> n/d )

  [ ]'[ temp put
    0 1
    rot times
      [ i 1+
        temp share do
        v+ 1/v ]
    0 temp take do v+ ]  is cf     ( n --> n/d )

  1000 cf sqrt2   10 point$ echo$ cr
  1000 cf napier  10 point$ echo$ cr
  1000 cf pi      10 point$ echo$ cr


#lang racket
(define (calc cf n)
  (match/values (cf 0)
    [(a0 b0)
     (+ a0
        (for/fold ([t 0.0]) ([i (in-range (+ n 1) 0 -1)])
          (match/values (cf i)
                        [(a b) (/ b (+ a t))])))]))

(define (cf-sqrt i)   (values  (if (> i 0) 2 1)  1))
(define (cf-napier i) (values  (if (> i 0) i 2)  (if (> i 1) (- i 1) 1)))
(define (cf-pi i)     (values  (if (> i 0) 6 3)  (sqr (- (* 2 i) 1))))

(calc cf-sqrt   200)
(calc cf-napier 200)
(calc cf-pi     200)


/*REXX program  calculates and displays  values of  various  continued fractions.       */
parse arg terms digs .
if terms=='' | terms==","  then terms=500
if  digs=='' |  digs==","  then  digs=100
numeric digits digs                              /*use  100  decimal digits for display.*/
b.=1                                             /*omitted ß terms are assumed to be  1.*/
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=2;                                                           call tell '√2',      cf(1)
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=1;  do N=2  by  2  to terms; a.N=2; end;                     call tell '√3',      cf(1)     /*also:  2∙sin(π/3) */
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=2                  /*              ___ */
      do N=2  to 17   /*generalized  √ N  */
      b.=N-1;                          NN=right(N, 2);          call tell 'gen √'NN, cf(1)
      end   /*N*/
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=2;   b.=-1/2;                                                call tell 'gen √ ½', cf(1)
/*══════════════════════════════════════════════════════════════════════════════════════*/
  do j=1 for terms; a.j=j;  if j>1   then b.j=a.p; p=j; end;    call tell 'e',       cf(2)
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=1;                                                           call tell 'φ, phi',  cf(1)
/*══════════════════════════════════════════════════════════════════════════════════════*/
a.=1;    do j=1 for terms;  if j//2  then a.j=j;        end;    call tell 'tan(1)',  cf(1)
/*══════════════════════════════════════════════════════════════════════════════════════*/
         do j=1 for terms;                a.j=2*j+1;    end;    call tell 'coth(1)', cf(1)
/*══════════════════════════════════════════════════════════════════════════════════════*/
         do j=1 for terms;                a.j=4*j+2;    end;    call tell 'coth(½)', cf(2)    /*also:  [e+1]÷[e-1] */
/*══════════════════════════════════════════════════════════════════════════════════════*/
                     terms=100000
a.=6;    do j=1  for terms;  b.j=(2*j-1)**2;            end;    call tell 'π, pi',   cf(3)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
cf:      procedure expose a. b. terms;  parse arg C;     !=0;    numeric digits 9+digits()
                                          do k=terms  by -1  for terms;  d=a.k+!;  !=b.k/d
                                          end   /*k*/
         return !+C
/*──────────────────────────────────────────────────────────────────────────────────────*/
tell:    parse arg ?,v;   $=left(format(v)/1,1+digits());    w=50    /*50 bytes of terms*/
         aT=;     do k=1;  _=space(aT a.k);  if length(_)>w  then leave;  aT=_;  end /*k*/
         bT=;     do k=1;  _=space(bT b.k);  if length(_)>w  then leave;  bT=_;  end /*k*/
                          say right(?,8)   "="    $     '  α terms='aT  ...
         if b.1\==1  then say right("",12+digits())     '  ß terms='bT  ...
         a=;   b.=1;  return       /*only 50 bytes of  α & ß terms  ↑   are displayed.  */


# Project : Continued fraction

see "SQR(2) = " + contfrac(1, 1, "2", "1") + nl
see "        e = " + contfrac(2, 1, "n", "n") + nl
see "       PI = " + contfrac(3, 1, "6", "(2*n+1)^2") + nl

func contfrac(a0, b1, a, b)
        expr = ""
        n = 0
        while len(expr) < (700 - n)
                 n = n + 1
                 eval("temp1=" + a)
                 eval("temp2=" + b)
                 expr = expr + string(temp1) + char(43) + string(temp2) + "/("
        end
        str = copy(")",n)
        eval("temp3=" + expr + "1" + str)
        return a0 + b1 / temp3


require 'bigdecimal'

# square root of 2
sqrt2 = Object.new
def sqrt2.a(n); n == 1 ? 1 : 2; end
def sqrt2.b(n); 1; end

# Napier's constant
napier = Object.new
def napier.a(n); n == 1 ? 2 : n - 1; end
def napier.b(n); n == 1 ? 1 : n - 1; end

pi = Object.new
def pi.a(n); n == 1 ? 3 : 6; end
def pi.b(n); (2*n - 1)**2; end

# Estimates the value of a continued fraction _cfrac_, to _prec_
# decimal digits of precision. Returns a BigDecimal. _cfrac_ must
# respond to _cfrac.a(n)_ and _cfrac.b(n)_ for integer _n_ >= 1.
def estimate(cfrac, prec)
  last_result = nil
  terms = prec

  loop do
    # Estimate continued fraction for _n_ from 1 to _terms_.
    result = cfrac.a(terms)
    (terms - 1).downto(1) do |n|
      a = BigDecimal cfrac.a(n)
      b = BigDecimal cfrac.b(n)
      digits = [b.div(result, 1).exponent + prec, 1].max
      result = a + b.div(result, digits)
    end
    result = result.round(prec)

    if result == last_result
      return result
    else
      # Double _terms_ and try again.
      last_result = result
      terms *= 2
    end
  end
end

puts estimate(sqrt2, 50).to_s('F')
puts estimate(napier, 50).to_s('F')
puts estimate(pi, 10).to_s('F')