;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   MDH 2006 (updated 071118) based on
;;;   $Id: IntegerRoot.scm,v 1.3 2008/03/03 14:20:13 logik Exp $
;;;   We prove the existence of integer square roots.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load "~/minlog/init.scm")
(set! COMMENT-FLAG #f)
(libload "nat.scm")

(add-var-name "f" "g" (py "nat=>nat"))

(set-goal (pf "all f,g,n.(allnc n.n<f 0 -> bot) -> 
                         allnc n n<f(g n) -> 
                         excl m.(n<f m -> bot) ! n<f(m+1)"))
(assume "f" "g" "n" 1 2 3)
(cut (pf "all m.n<f m -> bot"))
(search)
(ind)
(search)
(search)
(define RootPrf (current-proof))

(mload "../modules/diatup.scm")
(set! COMMENT-FLAG #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; First we extract exact realizers, best by Light Dialectica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define vatmp (time (DIA-extract 'light RootPrf)))
(define FY-untup (tmpair-to-tuple (vatmpair-to-tmpair vatmp)))
(define FY-tmlst (tmtuple-to-tmlist FY-untup))
(length FY-tmlst)
(define tk (car FY-tmlst))
;;; (define tk (caddr FY-tmlst)) when Pure Dialectica used - ugly
(pp tk)
(set-flag 'UNFOLDING-FLAG #t)
(define et (time (nt tk)))
(pp et)

(define sqr (pt "[n]n*n"))
(pp (time (nt (mk-term-in-app-form et sqr (pt "Succ") (pt "27"))))) ; "5" in 0.2 sec
(pp (time (nt (mk-term-in-app-form et sqr (pt "Succ") (pt "127"))))) ; "11" in 4 sec

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Here we extract upper bounds, by Light Monotone Dialectica
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define vatmp (time (DIA-extract 'monot RootPrf)))
(define FY-untup (tmpair-to-tuple (vatmpair-to-tmpair vatmp)))
(define FY-tmlst (tmtuple-to-tmlist FY-untup))
(length FY-tmlst)
(define tk (car FY-tmlst))
(pp tk)
(set-flag 'UNFOLDING-FLAG #t)
(define et (time (nt tk)))
(pp et)

(define sqr (pt "[n]n*n"))
(pp (time (nt (mk-term-in-app-form et sqr (pt "Succ") (pt "27"))))) ; "27" in 0.02 sec
(pp (time (nt (mk-term-in-app-form et sqr (pt "Succ") (pt "127"))))) ; "127" in 0.5 sec
