(* 
 * 15-317 Constructive Logic
 * Fall 2017
 * Frank Pfenning
 *)

(* naive integer square root *)
fun isqrt 0 = 0
  | isqrt x = (* x > 0 *)
    let val a = isqrt (x-1)
     in if x < (a+1)*(a+1)
        then a
        else a+1
    end

(* naive exponential *)
fun exp b 0 = 1
  | exp b n = (* n > 0 *)
    let val a = exp b (n-1)
    in b * a end

(* tail-recursive exponential *)
fun exp2_aux b 0 c = c
  | exp2_aux b n c = (* n > 0 *)
    exp2_aux b (n-1) (c*b)

fun exp2 b n = exp2_aux b n 1

(* more efficient tail-recursive exponential *)
fun exp3_aux b 0 c = c
  | exp3_aux b n c = (* n > 0 *)
    if n mod 2 = 0
    then exp3_aux (b*b) (n div 2) c
    else exp3_aux (b*b) ((n-1) div 2) (c*b)

fun exp3 b n = exp3_aux b n 1

(* "Warshall's algorithm" for graph reachability *)
fun warshall edge (nil) x y = edge x y
  | warshall edge (z::W) x y =
    warshall edge W x y orelse
    (warshall edge W x z andalso warshall edge W z y)

(* some minimal testing on a small graph *)
fun edge 0 1 = true
  | edge 1 2 = true
  | edge 3 2 = true
  | edge 2 4 = true
  | edge 4 2 = true
  | edge _ _ = false

val true = warshall edge [0,1,2,3,4] 0 4
val true = warshall edge [4,3,2,1,0] 0 4
val false = warshall edge [0,1,2,3,4] 2 1
val false = warshall edge [4,3,2,1,0] 2 1

(* "Warshall's algorithm", computing a path if there is one *)
fun warshall2 edge (nil) x y =
    if edge x y then SOME [x,y] else NONE
  | warshall2 edge (z::W) x y =
    case warshall2 edge W x y
     of SOME p => SOME p
      | NONE => (case warshall2 edge W x z
                  of SOME q => (case warshall2 edge W z y
                                 of SOME r => SOME (q @ tl r)
                                  | NONE => NONE)
                   | NONE => NONE)

val SOME p1 = warshall2 edge [0,1,2,3,4] 0 4
val SOME p2 = warshall2 edge [4,3,2,1,0] 0 4
val NONE = warshall2 edge [0,1,2,3,4] 2 1
val NONE = warshall2 edge [4,3,2,1,0] 2 1

(* tail-recursive integer square root *)
fun isqrt2_aux x c = (* c*c <= x *)
    if x < (c+1)*(c+1)
    then c
    else (* (c+1)*(c+1) <= x *)
        isqrt2_aux x (c+1)

fun isqrt2 x = isqrt2_aux x 0

(* multiplication-avoiding, tail-recursive integer square root *)
fun isqrt3_aux x d c = (* c*c <= x, d = x-c*c *)
    if d < 2*c+1
    then c
    else (* (c+1)*(c+1) <= x, d-2*c-1 = x-(c+1)*(c+1) *)
        isqrt3_aux x (d-2*c-1) (c+1)

fun isqrt3 x = isqrt3_aux x x 0