(** * Basics: Programacion Funcional en Coq *)

(* This library definition is included here temporarily
   for backward compatibility with Coq 8.3.
   Please ignore. *)
Definition admit {T: Type} : T.  Admitted.

(* ###################################################################### *)
(** * Introduccion *)

(** El estilo de programacion funcional acerca la progamacion a las
    matematicas: Si un procedimiento o metodo no tiene efectos
    colaterales, entonces casi todo lo que se necesita entender acerca
    del procedimiento es como relaciona entradas con salidas -- es
    decir, uno puede pensar su comportamiento como computar una
    funcion matematica.  Esta es una razon para la palabra "funcional"
    en "programacion funcional".  Esta conexion directa entre
    programas y objetos matematicos permite razonar informalmente,
    tanto como formalmente, acerca del comportamiento de los
    programas.

    El otro sentido en que la programacion funcional es "funcional" es
    que pone enfasis en el uso de funciones (o metodos) como valores
    _de primera clase_ -- es decir, valores que pueden ser pasados
    como argumentos de otras funciones, retornados como resultados,
    almacenados en estructuras de datos, etc.  El reconocimiento de
    que funciones pueden ser tratadas como datos en esta forma
    habilita una cantidad de expresiones utiles, como vamos a ver.

    Otras caracteristicas comunes a los lenguajes funcionales incluye
    _tipos de datos algebraicos_ y _"pattern matching"_, que facilita
    la construccion y manipulacion de estructuras de datos expresivas,
    junto con sofisticados _sistemas de tipos polimorficos_ que
    permiten abstraccion y reutilizacion de codigo.  Coq incluye todas
    estas caracteristicas.  *)

(* ###################################################################### *)
(** * Tipos Enumerados *)

(** Un aspecto poco usual de Coq es que esta conformado por un
    conjunto _extremadamente_ pequenio de elementos.  Por ejemplo, en
    vez de proveer la usual paleta de tipos de datos atomicos
    (booleanos, enteros, strings, etc.), Coq ofrece un mechanismo
    poderoso para definir nuevos tipos de datos desde cero -- tan
    poderoso que todos estos tipos familiares son reproducidos dentro
    de Coq mismo.

    Naturalmente, la distribucion oficial de Coq viene con una
    libreria estandard extensiva, que ya provee definiciones para los
    tipos de datos mencionados y muchos otros, como listas, tablas de
    hash, etc.  Pero no hay nada magico o primitivo acerca de estas
    definiciones de libreria: son codigo ordinario que cualquier
    usuario de Coq puede escribir.

    Para ver como funciona este mechanismo, empecemos por un ejemplo
    muy sencillo. *)

(* ###################################################################### *)
(** ** Dias de la Semana *)

(** La siguiente declaracion le dice a Coq que estamos definiendo un nuevo
    conjunto de valores -- un _tipo_ de datos. *)

Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

(** El tipo es llamado [day] (dia), y sus miembros son [monday]
    (lunes), [tuesday] (martes), etc.  Desde la segunda hasta la
    octava linea de la definicion se pueden leer como "[monday] es un
    [day], [tuesday] es un [day], etc."

    Habiendo definido [day], podemos escribir funciones que operan
    sobre dias. *)

Definition next_weekday (d:day) : day :=
  match d with
  | monday    => tuesday
  | tuesday   => wednesday
  | wednesday => thursday
  | thursday  => friday
  | friday    => monday
  | saturday  => monday
  | sunday    => monday
  end.

(** Noten que el tipo del argumento y de retorno estan declarados
    explicitamente.  Como muchos lenguajes de programacion funcionales,
    Coq ofrece la posibilidad de descubrir estos tipos si no son
    declarados explicitamente -- es decir, realiza _inferencia de tipos_
    -- pero vamos a escribirlos explicitamente de cualquier forma para
    facilitar la lectura. *)

(** Habiendo definido una funcion, vamos a verificar que funciona en
    algunos ejemplos.  Hay tres formas distintas de hacer esto en Coq.
    Primero, podemos usar el comando [Eval compute] para evaluar una
    expresion incluyendo [next_weekday].  *)

Eval compute in (next_weekday friday).
   (* ==> monday : day *)
Eval compute in (next_weekday (next_weekday saturday)).
   (* ==> tuesday : day *)

(** Si tienes una computadora a mano, este es un momento excelente
    para utilizar tu IDE favorito -- ya sea CoqIde o Proof General --
    y probarlo por ti mismo.  Carga este archivo ([Basics.v]) desde el
    codigo Coq acompaniando a este libro, busca el ejemplo anterior,
    ejecutalo en Coq, y observa el resultado. *)

(** La palabra clave [compute] le dice a Coq precisamente como evaluar
    la expresion que le dimos.  Por el momento, [compute] es lo unico
    que vamos a necesitar; mas tarde veremos otras alternativas que
    son a veces utiles. *)

(** Segundo, vamos a registrar que _esperamos_ que el resultado sea en
    la forma de un ejemplo de Coq: *)

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

(** Esta declaracion hace dos cosas: crea una asercion (que el
    segundo dia de la semana luego de [saturday] es [tuesday]), y
    provee un nombre a tal afirmacion para que nos podamos referir a
    ella mas tarde. *)
(** Habiendo hecho esta asercion, podemos pedirle a Coq que la
    verifique de la siguiente manera: *)

Proof. simpl. reflexivity.  Qed.

(** Los detalles no son importantes de momento (volveremos a ellos en
    un segundo), pero esencialmente esto se puede leer como "La
    asercion que hicimos puede ser probada observando que ambos
    lados de la igualdad son iguales, luego de simplificar (en este
    caso, evaluar) la expresion". *)

(** Podemos pedirle a Coq que "extraiga" un programa, desde una
    [Definition], a un lenguaje de programacion mas convencional
    (OCaml, Scheme, o Haskell) con un compilador de alta performance.
    Esta facilidad es muy interesante, puesto que nos permite una
    forma de construir programas _totalmente certificados_ en
    lenguajes conocidos.  De hecho, este es uno de los usos
    principales por los cuales Coq fue desarrollado.  Volveremos a
    este tema en capitulos posteriores.  Para mas informacion,
    referimos al lector al libro "Coq'Art" de Bertot y Casteran, asi
    como tambien al manual de referencia de Coq. *)

(* ###################################################################### *)
(** ** Booleanos *)

(** De forma similar, podemos definir el tipo [bool] de valores booleanos,
    con miembros [true] y [false]. *)

Inductive bool : Type :=
  | true : bool
  | false : bool.

(** Aunque estamos escribiendo nuestros propios booleanos para
    ilustrar que se puede construir todo desde cero, Coq incluye, por
    supuesto, una implementacion "default" de los booleanos en su
    libreria estandard, junto a una multitud de funciones utiles y
    lemmas.  (Mirar a [Coq.Init.Datatypes] en la documentacion de la
    libreria estandard de Coq para mas datos.)  Cuando sea posible,
    vamos a nombrar las definiciones y teoremas con los mismos nombres
    que los utilizados en las librerias de Coq. *)

(** Podemos definir funciones sobre booleanos de la misma forma como
    hicimos antes: *)

(** Negacion: *)
Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.

(** Conjuncion: *)
Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

(** Disyuncion: *)
Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

(** Los ultimos dos ilustran la sintaxis utilizada para definiciones
    de funciones con varios argumentos. *)

(** Los siguientes "unit tests" (tests de un unidad) constituyen una
    especificacion completa -- una tabla de verdad -- para la funcion
    [orb]: *)

Example test_orb1:  (orb true  false) = true.
Proof. reflexivity.  Qed.
Example test_orb2:  (orb false false) = false.
Proof. reflexivity.  Qed.
Example test_orb3:  (orb false true)  = true.
Proof. reflexivity.  Qed.
Example test_orb4:  (orb true  true)  = true.
Proof. reflexivity.  Qed.

(** (Notar que omitimos el [simpl] en las pruebas.  No es necesario
    porque [reflexivity] de hecho realiza la simplificacion
    automaticamente.) *)

(** _Una nota sobre la notacion_: Usamos corchetes para delimitar
    fragmentos de codigo Coq en los comentarios de los archivos .v;
    esta convecion, que es tambien utilizada por la herramienta de
    documentacion [coqdoc], separa el codigo visualemente del texto
    alrededor del codigo.  En la version html, estos pedazos de texto
    aparecen con [fuente diferente]. *)

(** Los valores [Admitted] y [admit] puede ser utilizados para llenar
    un agujero en una definicion o prueba incompleta.  Los usamos aqui
    en los siguientes ejercicios.  En general, tu trabajo en los
    ejercicios es reemplazar [admit] o [Admitted] con una definicion o
    prueba concreta. *)

(** **** Ejercicio: 1 star (nandb) *)
(** Complete la definicion de la siguiente funcion.  Luego asegurese
    de que los ejemplos a continuacion pueden ser verificados
    correctamente por Coq.  *)

(** Esta funcion debe retornar [true] si ambos o uno de los inputs es
    [false]. *)

Definition nandb (b1:bool) (b2:bool) : bool :=
  (* FILL IN HERE *) admit.

(** Remover "[Admitted.]" y llenar cada prueba con
    "[Proof. reflexivity. Qed.]" *)

Example test_nandb1:               (nandb true false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb2:               (nandb false false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb3:               (nandb false true) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb4:               (nandb true true) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Ejercicio: 1 star (andb3) *)
(** Repita la misma idea para la funcion [andb3] de abajo.  Esta
    funcion retorna [true] cuando todos sus input son [true], y
    [false] en cualquier otro caso. *)

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  (* FILL IN HERE *) admit.

Example test_andb31:                 (andb3 true true true) = true.
(* FILL IN HERE *) Admitted.
Example test_andb32:                 (andb3 false true true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb33:                 (andb3 true false true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb34:                 (andb3 true true false) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** ** Tipos de Funcion *)

(** El comando [Check] hace que Coq imprima el tipo de una expresion.
    Por ejemplo, el tipo de [negb true] es [bool]. *)

Check true.
(* ===> true : bool *)
Check (negb true).
(* ===> negb true : bool *)

(** Funciones como [negb] son tambien valores, como [true] y [false].
    Sus tipos son llamados _tipos de funcion_, y se escriben con
    flechas. *)

Check negb.
(* ===> negb : bool -> bool *)

(** El tipo de [negb], escrito [bool -> bool] y pronunciado "[bool]
    flecha [bool]," puede leerse como, "Dado una entrada (argumento)
    de tipo [bool], esta funcion produce una salida de tipo [bool]."
    Similarmente, el tipo de [andb], escrito [bool -> bool -> bool],
    puede leerse como, "Dado dos argumentos, ambos de tipo [bool],
    esta funcion produce un resultado de tipo [bool]." *)

(* ###################################################################### *)
(** ** Numeros *)

(** _Digresion tecnica_: Coq provee un _sistema de modulos_ bastante
    sofisticado, para ayudar a organizar grandes desarrollos.  En este
    curso no vamos a utilizar muchas de sus caracteristicas, pero hay
    una que es partiuclarmente util: Si encerramos una coleccion de
    declaraciones entre [Module X] y [End X], entonces, en el resto
    del archivo luego del [End] estas definiciones van a ser referidas
    con [X.foo] en vez de [foo].  Aqui, utilizamos esta caracteristica
    para introducir definiciones de tipo [nat] en un modulo interno,
    de forma que no sobreescriba la que viene por default en la
    libreria estandard. *)

Module Playground1.

(** Los tipos que definimos hasta ahora son ejemplos de "tipos
    enumerados": Su definicion explicitamente enumera un a serie de
    elementos.  Una forma mas interesante de definir un tipo es
    proveyendo una serie de "reglas inductivas" describiendo sus
    elementos.  Por ejemplo, podemos definir a los numeros naturales como: *)

Inductive nat : Type :=
  | O : nat
  | S : nat -> nat.

(** Las clausulas de esta definicion se pueden leer como:
      - [O] es un numero natural (Notar que es la letra "[O]," no el numeral
        "[0]").
      - [S] es el "constructor" que toma un numero natural y retorna otro
        -- eso es, si [n] es un numero natural, entonces [S n] lo es tambien.

    Veamoslo con mayor detalle.

    Cada conjunto definido inductivamente ([day], [nat], [bool], etc.)
    es en realidad un conjunto de _expresiones_.  La definicion de
    [nat] dice como estas expresiones en el conjunto [nat] pueden ser
    construidas:

    - la expresion [O] pertence al conjunto [nat];
    - si [n] es una expresion perteneciente al conjunto [nat], entonces [S n]
      tambien es una expresion perteneciente al conjunto [nat]; y
    - expresiones formadas de estas dos formas son las unicas pertenecientes
      al conjunto [nat].

    Las mismas reglas se aplican a las definiciones de [day] y
    [bool]. Las anotaciones que usamos para sus constructores son
    analogos a las el constructor [O], e indican que cada uno de estos
    constructores no toma ningun argumento. *)

(** Estas tres condiciones son la fortaleza de la declaracion
    [Inductive].  Implican que la expresion [O], la expresion [S O],
    la expresion [S (S O)], la expresion [S (S (S O))], etc, todas
    pertenecen al conjunto [nat], mientras que otras como [true],
    [andb true false], y [S (S false)] no.

    Podemos escribir funciones que "pattern matchean" numeros
    naturales como hicimos antes -- por ejemplo, la funcion
    predecesor: *)

Definition pred (n : nat) : nat :=
  match n with
    | O => O
    | S n' => n'
  end.

(** La segunda clausula puede leerse como: "si [n] tiene la forma [S n']
    para algun [n'], entonces retornar [n']."  *)

End Playground1.

Definition minustwo (n : nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

(** Como los numeros naturales son tan importantes, Coq provee
    funcionalidad para imprimirlos y "parsearlos": se puede utilizar un
    numeral arabico ordinario como alternativa a la representacion
    "unaria" definida con los constructores [S] y [O].  Coq imprime el
    numero en forma arabica tambien como default: *)

Check (S (S (S (S O)))).
Eval simpl in (minustwo 4).

(** El constructor [S] tiene tipo [nat -> nat], igual que las
    funciones [minustwo] y [pred]: *)

Check S.
Check pred.
Check minustwo.

(** Estas son todas cosas que pueden ser aplicadas a un numero para
    retornar otro numero.  Sin embargo, hay una diferencia
    fundamental: las funciones como [pred] y [minustwo] vienen con
    _reglas computacionales_ -- es decir, la definicion de [pred] dice
    que [pred 2] puede simplificarse a [1] -- mientras que la
    definicion de [S] no tiene ningun comportamiento.  Aunque es como
    una funcion en el sentido de que puede ser aplicada a un
    argumento, _no hace_ nada en absoluto!  *)

(** Para casi todas las funciones sobre numeros, pattern matching no
    es suficiente: necesitamos tambien recursion.  Por ejemplo, para
    ver que un numero [n] es par (even en ingles), debemos
    recusivamente ver que [n-2] es par.  Para escribir tal funcion
    necesitamos la palabra clave [Fixpoint] (punto fijo). *)

Fixpoint evenb (n:nat) : bool :=
  match n with
  | O        => true
  | S O      => false
  | S (S n') => evenb n'
  end.

(** Podemos definir [oddb] (impar) de forma similar, con la
    declaracion [Fixpoint], pero hay una forma mejor: *)

Definition oddb (n:nat) : bool   :=   negb (evenb n).

Example test_oddb1:    (oddb (S O)) = true.
Proof. reflexivity.  Qed.
Example test_oddb2:    (oddb (S (S (S (S O))))) = false.
Proof. reflexivity.  Qed.

(** Naturalmente, podemos tambien definir funciones recursivas con
    multiples argumentos.  (De nuevo, usamos un modulo para evitar
    conflictos de nomenclatura.) *)

Module Playground2.

Fixpoint plus (n : nat) (m : nat) : nat :=
  match n with
    | O => m
    | S n' => S (plus n' m)
  end.

(** Sumar 3 a 2 nos da 5, como esperamos. *)

Eval simpl in (plus (S (S (S O))) (S (S O))).

(** La simplificacion que Coq realiza para llegar a esta conclusion
    puede verse como sigue: *)

(*  [plus (S (S (S O))) (S (S O))]
==> [S (plus (S (S O)) (S (S O)))] por la segunda clausula de [match]
==> [S (S (plus (S O) (S (S O))))] por la segunda clausula de [match]
==> [S (S (S (plus O (S (S O)))))] por la segunda clausula de [match]
==> [S (S (S (S (S O))))]          por la primer clausula de [match]
*)

(** Los argumentos se pueden agrupar si tienen el mismo tipo para
    facilitar la lectura.  En la siguiente definicion [(n m : nat)]
    significa lo mismo que si hubieramos escrito [(n : nat) (m : nat)]. *)

Fixpoint mult (n m : nat) : nat :=
  match n with
    | O => O
    | S n' => plus m (mult n' m)
  end.

Example test_mult1: (mult 3 3) = 9.
Proof. reflexivity.  Qed.

(** Se pueden matchear dos expresiones a la vez poniendo una coma entre ellas: *)

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O   , _    => O
  | S _ , O    => n
  | S n', S m' => minus n' m'
  end.

(** El _ en la primer linea es un _patron comodin_.  Escribir _ en un
    patron es lo mismo que escribir una variable que luego no es
    utilizada en el lado derecho de la clausula.  Esto evita tener que
    inventar nombres innecesarios. *)

End Playground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
    | O => S O
    | S p => mult base (exp base p)
  end.

(** **** Ejercicio: 1 star (factorial) *)
(** Recuerde la funcion factorial (notada normalmente n!):
<<
    factorial(0)  =  1
    factorial(n)  =  n * factorial(n-1)     (si n>0)
>>
    Traducir esto a Coq. *)

Fixpoint factorial (n:nat) : nat :=
(* FILL IN HERE *) admit.

Example test_factorial1:          (factorial 3) = 6.
(* FILL IN HERE *) Admitted.
Example test_factorial2:          (factorial 5) = (mult 10 12).
(* FILL IN HERE *) Admitted.
(** [] *)

(** Podemos hacer las expresiones numericas mas faciles de leer
    introduciendo notaciones para la adicion, multiplicacion, y
    resta. *)

Notation "x + y" := (plus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x - y" := (minus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x * y" := (mult x y)
                       (at level 40, left associativity)
                       : nat_scope.

Check ((0 + 1) + 1).

(** (Las anotaciones [level], [associativity], y [nat_scope] controlan
   como estas notaciones deben ser tratadas por el parser de Coq.  Los
   detalles no son importantes, pero el interesado puede ir a la
   subseccion "Mas sobre Notacion" en la seccion "Material Opcional"
   al final de este capitulo). *)

(** Notar que estas notaciones no cambian las definiciones que
    hicimos: son simplemente instrucciones al parser de Coq para
    aceptar [x + y] ademas de [plus x y] y, de forma inversa, para
    indicar al "pretty-printer" (la funcion de impresion en pantalla)
    que imprima [plus x y] como [x + y]. *)

(** Cuando decimos que Coq no viene con nada "built-in", lo decimos en
    serio: hasta la igualdad de numeros naturales es una operacion
    definida!  *)

(** La funcion [beq_nat] verifica si dos numeros [nat]urales son
   [eq]uivalentes, retornando un [b]ooleano.  Notar el uso de
   [match]es sucesivos (tambien podriamos haber hecho un match
   simultaneo, como hicimos con [minus]). *)

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.

(** De forma analoga, la funcion [ble_nat] verifica si dos numeros
    [nat]urales son "[l]ess-or-[e]qual" (menor o igual), retornando un
    [b]ooleano. *)

Fixpoint ble_nat (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => ble_nat n' m'
      end
  end.

Example test_ble_nat1:             (ble_nat 2 2) = true.
Proof. reflexivity.  Qed.
Example test_ble_nat2:             (ble_nat 2 4) = true.
Proof. reflexivity.  Qed.
Example test_ble_nat3:             (ble_nat 4 2) = false.
Proof. reflexivity.  Qed.

(** **** Ejercicio: 2 stars (blt_nat) *)
(** La funcion [blt_nat] verifica si dos numeros [nat]urales son
    "[l]ess-[t]han" (menor), retornando un [b]ooleano.  En vez de
    hacer un nuevo [Fixpoint] para esta funcion, definala en terminos
    de definiciones previas.

    Nota: Si tiene problemas con la tactica [simpl], intente usar
    [compute], que es como [simpl] con esteroides.  Sin embargo, hay
    una solucion simple y elegante para la cual [simpl] es
    suficiente. *)

Definition blt_nat (n m : nat) : bool :=
  (* FILL IN HERE *) admit.

Example test_blt_nat1:             (blt_nat 2 2) = false.
(* FILL IN HERE *) Admitted.
Example test_blt_nat2:             (blt_nat 2 4) = true.
(* FILL IN HERE *) Admitted.
Example test_blt_nat3:             (blt_nat 4 2) = false.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** * Demostracion por Simplificacion *)

(** Ahora que definimos un par de tipos de datos y funciones, pasemos
    a la pregunta de como establecer y demostrar propiedades sobre su
    comportamiento.  De hecho, en cierto sentido, ya empezamos a hacer
    esto: cada [Example] en las secciones previas conjetura de forma
    precisa cual debe ser el comportamiento de alguna funcion con un
    input particular.  Las pruebas de estas conjeturas fueron siempre
    igual: usar [reflexivity] para verificar que ambos lados de la [=]
    simplifican (es decir, pueden ser reducidos) a valores identicos.

    (Dicho sea de paso, va a ser util mas tarde saber que
    [reflexivity] de hecho hace algo mas que [simpl] -- por ejemplo,
    intenta hacer "unfolding" sobre terminos definidos, reemplazando
    el nombre de una definicion con su cuerpo.  La razon para esta
    diferencia es que, cuando [reflexivity] termina, el objetivo esta
    alcanzado y no queremos mirar a ver como es que expandiendo las
    expresiones [reflexivity] encontro la solucion.  En contraste,
    [simpl] se utiliza en situaciones donde queremos leer y entender
    el nuevo objetivo, con lo que no queremos que expanda definiciones
    de forma ciega.)

    El mismo tipo de "demostracion por simplificacion" puede ser
    utilizado para probar propiedades mas interesantes tambien.  Por
    ejemplo, el hecho de que [0] es un "elemento neutral" para [+] a
    la izquierda puede ser provado simplemente observando que [0 + n]
    reduce a [n], sin importar el [n], un hecho que se puede observar
    de la definicion de [plus].*)

Theorem plus_O_n : forall n : nat, 0 + n = n.
Proof.
  intros n. reflexivity.  Qed.

(** (_Nota_: Puede notar que el teorema de arriba se ve diferente en
    la version html que en la version original.  En los archivos Coq
    escribimos el cuantificado universal con la palabra reservada
    "_forall_".  Esto se imprime en el html como la "A" invertida, la
    notacion tipica en logica.)  *)

(** La forma de este teorema y la prueba son casi iguales a los
    ejemplos anteriores; hay apenas unas diferencias.

    Primero, usamos el comando [Theorem] en vez de [Example].  De
    hecho, esta diferencia es puramente un tema de estilo; los
    comandos [Example] y [Theorem] (y otros como [Lemma], [Fact], y
    [Remark]) tienen el mismo significado en Coq.

    Segundo, hemos agregado el cuantificador [forall n:nat], de forma
    que nuestro teorema hable de _todo_ numero natural [n].  Para
    poder probar teoremas de esta forma, necesitamos poder razonar
    _asumiendo_ la existencia de un numero arbitrario [n].  Este
    razonamiento se ve reflejado en la prueba con el comando [intros
    n], que, en cierto sentido, mueve el cuantificador desde el
    objetivo hacia el "contexto" de asunciones actuales.  En efecto,
    empezamos la prueba diciendo "OK, supongamos [n] es un numero
    natural arbitrario".

    Las palaras claves [intros], [simpl], y [reflexivity] son ejemplos
    de _tacticas_.  Una tactica es un comando que es utilizado entre
    [Proof] y [Qed] para decirle a Coq como debe verificar la
    correccion de una conjetura que estamos haciendo.  Vamos a ver
    varias tacticas mas en el resto de este capitulo, y muchas mas en
    capitulos futuros. *)

(** Vaya paso por paso en las siguientes pruebas, y note como el
    objetivo y el contexto cambian. *)

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity.  Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity.  Qed.

(** El sufijo [_l] en los nombres de estos teoremas se pronuncia "a la
    izquierda" (por [l]eft, en ingles). *)

(* ###################################################################### *)
(** * Demostracion por Reescritura *)

(** Aqui hay un teorema ligeramente mas interesante: *)

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.

(** En vez de hacer una conjetura universal sobre todo los numeros [n]
    y [m], este teorema es sobre una propiedad mas especifica que solo
    vale cuando [n = m].  El simbolo flecha [->] se pronuncia
    "implica".

    Como antes, necesitamos poder razonar asumiendo la existencia de
    numeros naturales [n] y [m].  Tambien necesitamos asumir la
    hipotesis [n = m].  La tactica [intros] sirve para mover las tres
    hipotesis desde el objetivo al contexto actual.

    Como [n] y [m] son arbitrarios, no podemos simplemente simplificar
    para provar este teorema.  En vez, lo probamos observando que, si
    estamos asumiendo que [n = m], entonces podemos reemplazar a [n]
    por [m] en el objetivo y obtener una igualdad con la misma
    expresion de ambos lados.  La tactica que le dice a Coq como
    realizar este reemplazo se llama [rewrite] (reescribir). *)

Proof.
  intros n m.   (* mover ambos cuantificadores al contexto *)
  intros H.     (* movee la hipotesis al contexto *)
  rewrite -> H. (* Reescribir el objetivo usando la hipotesis *)
  reflexivity.  Qed.

(** La primera linea de la prueba, como dijumos, mueve las variables
    cuantificadas universalmente [n] y [m] en el contexto.  La segunda
    mueve la hipotesis [n = m] en el contexto, y le asigna el nombre
    (arbitrario) [H].  La tercera le dice a Coq que reescriba el
    objetivo actual ([n + n = m + m]) reemplazando el lado izquierda
    de la hipotesis de igualdad [H] con el lado derecho, obteniendo [m + m = m + m].

    (La flecha en el [rewrite] no tiene nada que ver con la
    implicacion: le dice a Coq en que direccion realizar la
    reescritura, en este caso de izquierda a derecha.  Para reescribir
    en la direccion contraria, es decir de derecha a izquierda ([m]
    por [n] en vez de [n] por [m]), se puede utilizar [rewrite <-].
    Pruebe haciendo este cambio en la preuba anterior y vea la
    diferencia). *)

(** **** Ejercicio: 1 star (plus_id_exercise) *)
(** Remover "[Admitted.]" y llenar la prueba. *)

Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Como hemos visto en ejemplos anteriores, el comando [Admitted] le
    dice a Coq que queremos saltearnos la prueba del teorema y que la
    acepte como dada.  Esto es util cuando estamos realizando una
    prueba larga, porque podemos establecer lemas intermedios que
    creemos que pueden sernos util para resolver una prueba mas
    grande, admitirlas (con [Admitted]) por el momento, y continuar
    pensando en la preuba principal hasta que estamos seguros que
    tiene sentido.  Luego podemos volver y llenar las pruebas que nos
    salteamos.  Pero debe ser cuidadoso: cada vez que dice [Admitted]
    (o [admit]), usted esta dejando una puerta abierta a un argumento
    falso en el limpio, riguroso, y formalmente verificado mundo de
    Coq!  *)

(** No solo podemos utilizar hiptosis del contexto con la tactica
    [rewrite].  Tambien podemos utilizarla con un teorema demostrado
    anteriormente. *)

Theorem mult_0_plus : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity.  Qed.

(** **** Ejercicio: 2 stars (mult_S_1) *)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** * Prueba por Analisis por Caso *)

(** Por supuesto, no todo puede ser probado por una simple
    simplificacion: En general, valores hipoteticos (numeros,
    booleanos, listas, etc. arbitrarios) pueden bloquear la reduccion.
    Por ejemplo, si intentamos probar el siguiente teorema usando la
    tactica [simpl] como hicimos antes, nos quedamos bloqueados. *)

Theorem plus_1_neq_0_firsttry : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  simpl.  (* does nothing! *)
Abort.

(** La razon para esto es que las definiciones de ambos [beq_nat] y
    [+] comienzan haciendo un [match] en su primer argumento.  Pero
    aqui, el primer argumento de [+] es el numero desconocido [n], y
    el argumento de [beq_nat] es la expresion compuesta [n + 1];
    ninguno puede ser simplificado.

    Lo que necesitamos es tener la capacidad de razonar las posibles
    formas de [n] por separado.  Si [n] es [O], entonces calculamos el
    resultado final de [beq_nat (n + 1) 0] y verificamos que es, en
    efecto, [false].  Y si [n = S n'], para algun numero [n'],
    entonces, aunque no sabemos exactamente que numero [n + 1] va a
    retornar, igual podemos calcular que, al menos, va a empezar con
    un [S].  Y eso es suficiente para calcular que, de nuevo, [beq_nat
    (n + 1) 0] va a retornar [false].

    La tactica que le dice a Coq que considere por separado los casos
    donde [n = O] y donde [n = S n'] se llama [destruct]. *)

Theorem plus_1_neq_0 : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n. destruct n as [| n'].
    reflexivity.
    reflexivity.  Qed.

(** La tactica [destruct] genera _dos_ sub-objetivos, que debemos
    demostrar por separado para que Coq acepte el teorema como
    demostrado.  (No se necesita ningun comando especial para pasar
    del primer sub-objetivo al siguiente.  Cuado el primero ha sido
    demostrado, simplemente desaparece y nos deja con el otro "en foco").
    En esta prueba, ambos sub-objetivos son facilmente demostrados por
    el uso de [reflexivity].

    La notacion "[as [| n']]" se denomina _patron intro_.  Le dice a
    Coq que nombres de variables introducir en cada sub-objetivo.  En
    general, lo que sigue entre los corchetes es una _lista_ de lista
    de nombres, separada por [|].  Aqui, el primer componente es la
    lista vacia, porque el constructor [O] es nulario (no contiene
    niguna informacion).  El segundo componente provee un solo nombre
    [n'], puesto que [S] es un constructor unario.

    La tactica [destruct] puede ser utilizada con cualquier tipo de
    datos definido inductivamente.  Por ejemplo, la usamos aqui para
    demostrar que la negacion booleana es involutiva -- es decir, que
    negacion es su propio inverso. *)

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b.
    reflexivity.
    reflexivity.  Qed.

(** Notar que el uso de [destruct] aqui no tiene ninguna clausula
    [as], porque ninguno de los sub-casos de [destruct] necesita ligar
    alguna variable, con lo que no necesitamos nombres.  (Tambien
    podriamos haber escrito [as [|]], o [as []]).  De hecho, podemos
    omitir la clausula [as] de _cualquier_ [destruct] y Coq va a
    llenar el contexto con nombres generados automaticamente.  Aunque
    puede parecer util, se puede argumentar que es un mal estilo de
    programacion, porque Coq elige los nombres de forma abitraria, y a
    veces inconsistentes.  *)

(** **** Ejercicio: 1 star (zero_nbeq_plus_1) *)
Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################################### *)
(** * Mas Ejercicios *)

(** **** Ejercicio: 2 stars (funciones booleanas) *)
(** Use las tacticas que ha aprendido hasta ahora para demostrar el
    siguiente teorema acerca de funciones booleanas. *)

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  (* FILL IN HERE *) Admitted.

(** Ahora indique y demuestre un teorema [negation_fn_applied_twice]
    similar a la previa definicion pero en que la segunda hipotesis
    dice que la funcion [f] tiene la propiedad [f x = negb x].*)

(* FILL IN HERE *)

(** **** Ejercicio: 2 stars (andb_eq_orb) *)
(** Demuestre el siguiente teorema.  (Tal vez quiera provar primero
    algun lema auxiliar o dos).  *)

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  (* FILL IN HERE *) Admitted.

(** **** Ejercicio: 3 stars (binary) *)
(** Considere una representacion diferente, y mas eficiente, de
    numeros naturales, usando un sistema binario en vez de unario.  Es
    decir, en vez de decir que cada numero es o cero o el sucesor de
    un numero natural, podemos decir que cada numero binario es o

      - cero,
      - dos veces un numero binario, o
      - uno mas que dos veces un numero binario.

    (a) Primero, escriba una definicion inductiva del tipo [bin]
        correspondiente a esta descripcion de numeros binarios.

    Ayuda: Recuerde que la definicion de [nat],

    Inductive nat : Type :=
      | O : nat
      | S : nat -> nat.

    no dice nada acerca de lo que [O] y [S] "significan".  Solo dicen
    "[O] esta en el conjunto llamado [nat], y si [n] esta en el
    conjunto, entonces tambien [S n] esta".  La interpretacion de que
    [O] es el numero cero y [S] el sucesor/mas uno viene por la froma
    en que _usamos_ los valores de [nat], cuando escribimos funciones
    que los utilizan, cuando probamos cosas acerca de ellos, etc.  Su
    definicion de [bin] debe ser, en consecuencia, simple; son las
    funciones que va a escribir a continuacion las que le de
    significado matematico.

    (b) A continuacion, escriba una funcion que incremente un numero
        binario en uno, y otra que convierta de un numero binario a un
        numero unario.

    (c) Escriba algunos tests de unidad para ambas funciones.  Note
        que incrementar un numero binario y convertirlo a un numero
        unario debe retornar el mismo resultado que primero
        convertirlo y luego incrementarlo como unario.  *)

(* FILL IN HERE *)
(** [] *)

(* ###################################################################### *)
(** * Material Opcional *)

(** ** Mas sobre Notacion *)

Notation "x + y" := (plus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x * y" := (mult x y)
                       (at level 40, left associativity)
                       : nat_scope.

(** Por cada simbolo de notacion en Coq podemos especificar su _nivel
    de precedencia_ y su _asociatividad_.  El nivel de presedencia [n]
    puede ser especificado con las palabras claves [at level n] y es
    util para disambiguar expresiones conteniendo distintos simbolos.
    La asociatividad es util para disambiguar expresiones conteniendo
    mas de una ocurrencia del mismo simbolo.  Por ejemplo, los
    parametros especificados arriba para [+] y [*] dicen que la
    expresion [1+2*3*4] es la forma corta para la expresion
    [(1+((2*3)*4))]. Coq usa niveles de precedencia de 0 a 100, y
    asociatividad _left_ (izquierda), _right_ (derecha), o _no_
    asociatividad.

    Cada simbolo de notacion en Coq es activo en un _contexto de
    notacion_.  Coq intenta adivinar el contexto, de forma que cuando
    escribimos [S(O*O)] adivina que debe ser [nat_scope], pero cuando
    escribimos el tipo del producto cartesiano (tupla) [bool*bool]
    adivina [type_scope].  Ocasionalmente debemos ayudarlo escribiendo
    el contexto prefijado con un simbolo de porcentaje, como
    [(x*y)%nat], y a veces Coq va a indicar en el output que esta
    usando un cierto "scope" para determinada expresion.

    Los contextos de notacion tambien aplican a la notacion numeral
    (3,4,5, etc.), con lo que a veces es comun ver [0%nat] para decir
    [O], o [0%Z] para indicar el cero de los enteros (Integer).  *)

(** ** [Fixpoint]s y Recursion Estructural  *)

Fixpoint plus' (n : nat) (m : nat) : nat :=
  match n with
    | O => m
    | S n' => S (plus' n' m)
  end.

(** Cuando Coq verifica esta definicion, nota que [plus'] esta
    "decreciendo en su primer argumento".  Lo que esto significa es
    que estamos realizando _recursion estructural_ sobre el argumento
    [n] -- es decir, que vamos a hacer llamadas recursivas unicamente a un
    valor estrictamente menor al argumento [n].  Esto implica que
    todas las llamadas a [plus'] van a terminar eventualmente.  Coq
    exige que _algun_ argumento de _cada_ definicion de punto fijo sea
    "decresciente".

    Este requerimiento es un feature fundamental en el disenio de Coq:
    En particular garantiza que cada funcion que se pueda definir va a
    terminar en todo input.  Sin embargo, el analisis que realiza
    Coq para determinar que una funcion es decresciente no es muy
    sofisticado, y a veces es necesario escribir funciones de forma un
    tanto poco natural para convencerlo.  *)

(** **** Ejercicio: 2 stars, opcional (decreasing) *)
(** Para concretizar lo dicho, busque una forma de escribir un punto
    fijo perfectamente valido, es decir, que _termine_ en todo input,
    pero que Coq _no_ acepte por esta restriccion.  *)

(* FILL IN HERE *)
(** [] *)

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


Require Import String.
Require Import Ascii.
Require Import Lia.

Fixpoint add_padding (s : string) (n : nat) : string :=
	match (n, s) with
	| (S o, String c t) => String c (add_padding t o)
	| (S o, ""%string) => (add_padding "" o) ++ " "
	| _ => ""
	end.

Lemma concat_len (s1 s2 : string) : length (s1 ++ s2) = length s1 + length s2.
Proof.
induction s1.
+ now simpl.
+ simpl; now rewrite IHs1.
Qed.

Theorem padding_len (s : string) (n : nat) : length (add_padding s n) = n.
Proof.
generalize s; clear s.
induction n; intros; simpl; auto.
destruct s.
+ rewrite concat_len, (IHn ""%string); simpl; lia.
+ now simpl; rewrite (IHn s).
Qed.


(*-------------Description --------------------------------------------------------------

This file implements the union of all sets present in a list C as (union_over C). We
then define the notion of sets covers (Set_Cov C l) as a proposition which
states that the collection of sets C is a cover for the set l. Furthermore, we also
define a function (mk_disj C) which produces another collection of sets which are
disjoint to each other.

Following are the exact deinition of these  notions present in this file:

 Fixpoint union_over (C: list (list A)): list A:= match C with
                                                   | nil => nil
                                                   |c::C' => c [u] (union_over C')
                                                   end.

 Fixpoint fix_nat (n:nat)(l: list A): list (A * nat):= match l with
                                                    |nil => nil
                                                    |a::l' => (a,n)::(fix_nat n l')
                                                    end.
 Notation "l [,] n" := (fix_nat n l) (at level 65).

 Definition mk_disj (C: list (list A)):= map (fun l => l [,] (idx l C) ) C.

 Definition set_cover (C: list (list A)) (l: list A):= equal l (union_over C).

 Definition Set_cover (C: list (list A)) (l: list A):= l [=] (union_over C).

Furthermore, we have the following results specifying these definitions:

Lemma union_over_intro (C: list (list A))(l: list A)(a: A):
 In a l -> In l C -> In a (union_over C).
Lemma union_over_elim (C: list (list A))(a: A):
    In a (union_over C)-> (exists (l: list A), In l C /\ In a l).

Lemma fix_nat_intro (n: nat)(l: list A)(x: A): In x l -> In (x,n) (l [,] n).
Lemma fix_nat_elim (n: nat)(l: list A)(x: A): In (x,n) (l [,] n) -> In x l.

Lemma mk_disj_intro (C:list (list A))(l:list A): In l C -> In (l [,] (idx l C)) (mk_disj C).
Lemma mk_disj_elim (C: list (list A))(l:list (A * nat)):
    In l (mk_disj C) -> (exists l0, In l0 C /\ l = l0 [,] (idx l0 C)).

Lemma set_coverP (C: list (list A))(l: list A): reflect (Set_cover C l)(set_cover C l).
Lemma Set_cover_elim (C: list (list A)) (l: list A)(c: list A):
    Set_cover C l -> In c C -> c [<=] l.

------------------------------------------------------------------------------------------*)

Require Export Omega.
Require Export SetMaps.
Require Export Powerset.

Set Implicit Arguments.

Section SetCover.

  Context { A: ordType }.

  (* ------------ Definition of union of all the sets present in the list l ----------- *)

  Fixpoint union_over (C: list (list A)): list A:= match C with
                                                   | nil => nil
                                                   |c::C' => c [u] (union_over C')
                                                   end.

  Lemma union_over_intro (C: list (list A))(l: list A)(a: A):
    In a l -> In l C -> In a (union_over C).
  Proof.  { induction C as [| c C'].
            { simpl. auto. }
            { intros h1 h2. destruct h2 as [h2 | h2].
              { subst c. simpl. auto. }
              { simpl. specialize (IHC' h1 h2) as h3. auto. } } } Qed.

  Lemma union_over_intro1 (C: list (list A))(l: list A): In l C -> l [<=] (union_over C).
  Proof. intros h1 a h2. eapply union_over_intro;eauto. Qed.

  Lemma union_over_intro3 (C: list (list A))(c: list A)(x:A): In x c -> In x (union_over (c::C)).
  Proof. simpl. auto. Qed.

  Lemma union_over_intro4 (C: list (list A))(c: list A)(x:A):
    In x (union_over C) -> In x (union_over (c::C)).
  Proof. simpl;auto. Qed.

  Lemma union_over_elim (C: list (list A))(a: A):
    In a (union_over C)-> (exists (l: list A), In l C /\ In a l).
  Proof.  { induction C as [| c C'].
            { simpl. intro h1. destruct h1.  }
            { simpl. intros h1.
              assert (h2: In a c \/ In a (union_over C')). auto.
              destruct h2 as [h2 | h2].
              { exists c. split. left;auto. auto. }
              { specialize (IHC' h2) as h3. destruct h3 as [l h3].
                exists l. split. right;apply h3. apply h3. } } } Qed.

  Lemma union_over_elim1 (C: list (list A))(c: list A)(x:A):
    In x (union_over (c::C)) -> (In x c \/ In x (union_over C)).
  Proof. simpl. auto. Qed.

  Hint Resolve union_over_intro union_over_intro1: core.
  Hint Resolve union_over_intro3 union_over_intro4: core.

  Hint Immediate union_over_elim union_over_elim1: core.

  Lemma union_over_intro2 (C: list (list A))(S: list A):
    (forall X, In X C -> X [<=] S) -> (union_over C [<=] S).
  Proof. { intros h1 x h2. specialize (union_over_elim C x h2) as h3.
           destruct h3 as [l h3]. cut (In x l). apply h1. all: apply h3. } Qed.

  Hint Immediate union_over_intro2: core.

  Lemma union_over_IsOrd (C: list (list A)): IsOrd (union_over C).
  Proof. induction C as [| c C']. simpl; constructor. simpl;auto. Qed.

 Hint Resolve union_over_IsOrd: core.

  (*------------- Definition of (fix_nat n l) which appends n behind each entry in l ----- *)

  Fixpoint fix_nat (n:nat)(l: list A): list (A * nat):= match l with
                                                    |nil => nil
                                                    |a::l' => (a,n)::(fix_nat n l')
                                                    end.

  Lemma fix_nat_intro (n: nat)(l: list A)(x: A): In x l -> In (x,n) (fix_nat n l).
  Proof. { induction l as [|a l' ].
           { simpl. auto. }
           { simpl. intros h1.
             destruct h1 as [h1 | h1].
             subst a. left;auto. right;auto. } } Qed.

  Lemma fix_nat_elim (n: nat)(l: list A)(x: A): In (x,n) (fix_nat n l)-> In x l.
  Proof.  { induction l as [|a l' ].
           { simpl. auto. }
           { simpl. intros h1.
             destruct h1 as [h1 | h1].
             left;inversion h1;auto. right;auto. } } Qed.

  Lemma fix_nat_elim1 (n m: nat)(l: list A)(x: A): In (x, m) (fix_nat n l)-> m = n.
  Proof. induction l as [|a l'].
         { simpl. auto. }
         { simpl. intro h1. destruct h1 as [h1 | h1].
           inversion h1. auto. auto. } Qed.

  Lemma fix_nat_size (n: nat)(l: list A): | l | = | fix_nat n l |.
  Proof.  { induction l as [|a l' ].
           { simpl. auto. }
           { simpl. omega.  } } Qed.

  Notation "l [,] n" := (fix_nat n l) (at level 65).

  Lemma fix_nat_IsOrd (n: nat)(l: list A): IsOrd l -> IsOrd (l [,] n).
  Proof. { revert n. induction l as [| a l'].
           { simpl;intros. constructor. }
           { intros n h1. simpl. apply IsOrd_intro.
           apply IHl'. eauto.
           intros x h2. destruct x as [x' m].
           assert (h3: m = n). eapply fix_nat_elim1. apply h2.
           subst m.
           assert (h3: In x' l'). eapply fix_nat_elim. apply h2.
           assert (h4: a <b x'). eauto.
           apply ltbp_intro1. simpl. auto. } } Qed.

  Lemma fix_nat_prop1 (n: nat)(l: list A): l = map fst (l [,] n).
  Proof. { induction l as [| a l'].
           { simpl. auto. }
           { simpl. rewrite <- IHl'. auto. } } Qed.

  Lemma fix_nat_prop2 (n: nat)(l: list A): IsOrd l -> l = img fst (l [,] n).
  Proof. { intro h1. replace (img fst (l [,] n)) with (map fst (l [,] n)).
           apply fix_nat_prop1. apply map_is_img. rewrite <- fix_nat_prop1. auto. } Qed.

  Hint Immediate fix_nat_elim fix_nat_elim1 fix_nat_IsOrd fix_nat_prop1 fix_nat_prop2: core.
  Hint Immediate fix_nat_intro: core.

  Lemma fix_nat_prop3 (l1 l2:list A)(n1 n2:nat): l1 <b l2 -> n1 <= n2 -> (l1 [,] n1) <b (l2 [,] n2).
  Proof. { intros h1 h2. revert h1. revert l2.
           induction l1 as [| a1 l1].
           { intros l2. unfold fix_nat. destruct l2. auto. simpl; auto. }
           { intros l2. destruct l2 as [| a2 l2]. simpl; auto.
             intros h3. simpl in h3. match_up a1 a2.
             { subst a1. simpl. match_up (a2, n1) (a2, n2).
               apply IHl1. apply h3. auto.
               assert (h4: n2 <b n1). eauto. move /ltP in h4. omega. }
             { apply ltbl_intro1. auto. }
             { inversion h3. } } } Qed.

  (*---- Definition of (mk_disj C) which makes each list in C disjoint with each other------*)

  Definition mk_disj (C: list (list A)):= map (fun l => l [,] (idx l C) ) C.

  Hint Resolve in_map map_cons map_length: core.
  Hint Immediate in_map_iff: core.

  Lemma mk_disj_intro (C:list (list A))(l:list A): In l C -> In (fix_nat (idx l C) l) (mk_disj C).
  Proof. { unfold mk_disj.
           set (f:= (fun l0 : list_eqType => fix_nat (idx l0 C) l0)).
           replace (fix_nat (idx l C) l) with (f l). auto. unfold f. auto. } Qed.

  Lemma mk_disj_elim (C: list (list A))(l:list (A * nat)):
    In l (mk_disj C) -> (exists l0, In l0 C /\ l = fix_nat (idx l0 C) l0).
  Proof.  { unfold mk_disj.
            set (f:= (fun l0 : list_eqType => fix_nat (idx l0 C) l0)).
            intros h1. apply in_map_iff in h1 as h2.
            destruct h2 as [l0 h2].
            exists l0. split. apply h2. symmetry;unfold f in h2;apply h2. }  Qed.

  Lemma mk_disj_size (C: list (list A)): | C | = | mk_disj C |.
  Proof. { unfold mk_disj. symmetry. apply map_length. } Qed.

  Lemma mk_disj_IsOrd (C: list (list A)): IsOrd C -> IsOrd (mk_disj C).
  Proof. { unfold mk_disj.
           set (f:= fun l => l [,] (idx l C)).
           intros h1. apply map_IsOrd. auto.
           intros l1 l2 h2 h3 h4. unfold f.
           apply fix_nat_prop3. auto.
           cut ( idx l1 C < idx l2 C). auto with arith.
           eapply idx_IsOrd;auto. } Qed.

  Hint Resolve mk_disj_IsOrd: core.

  (*--------------- Definition of (set_cover C l) ---------------------------------------*)

  Definition set_cover (C: list (list A)) (l: list A):= (l == (union_over C)).

  Definition Set_cover (C: list (list A)) (l: list A):=  l = (union_over C).

  Lemma set_coverP (C: list (list A))(l: list A): reflect (Set_cover C l)(set_cover C l).
  Proof. { unfold Set_cover. unfold set_cover. auto.  } Qed.

  Lemma Set_cover_elim (C: list (list A)) (l: list A)(c: list A):
    Set_cover C l -> In c C -> c [<=] l.
  Proof. { unfold Set_cover. intros h1 h2 x h3. subst l.
           eapply union_over_intro; eauto. } Qed.

  Lemma Set_cover_elim1 (C: list (list A)) (l: list A)(x: A):
    Set_cover C l -> In x l-> (exists c, In c C /\ In x c).
  Proof. unfold Set_cover. intro h1. subst l. auto. Qed.

  Lemma Set_cover_IsOrd (C: list (list A)) (l: list A): Set_cover C l -> IsOrd l.
  Proof. unfold Set_cover;intros;subst l;auto. Qed.

  Hint Resolve Set_cover_IsOrd: core.
  Hint Immediate Set_cover_elim Set_cover_elim1: core.

  Lemma cover_dij_intro (C: list (list A)) (c: list A):
    (forall y, In y C -> (c [i] y = nil))-> (c [i] (union_over C) = nil).
  Proof. { intros h1.
           assert (h2: (c [i] union_over C = nil) \/ ~(c [i] union_over C = nil)).
           { eauto. }
           destruct h2 as [h2 | h2].
           { auto. }
           { assert (h3: exists x, In x (c [i] union_over C)). auto.
             destruct h3 as [x h3].
             assert (h3a: In x c). eauto.
             assert (h3b: In x (union_over C)). eauto.
             assert (h3c: exists c', In c' C /\ In x c'). auto.
             destruct h3c as [c' h3c]. destruct h3c as [h3c h3d].
             specialize (h1 c' h3c) as h4.
             absurd (In  x (c [i] c')). rewrite h4. auto. auto. } } Qed.

  Lemma cover_dij_elim (C: list (list A)) (c: list A):
     (c [i] (union_over C) = nil) -> (forall y, In y C -> (c [i] y = nil)).
   Proof. { induction C as [| c' C'].
            { simpl. auto. }
            { simpl. intros h1 y h2.
              destruct h2 as [h2 | h2].
              { subst y.  eauto. }
              { apply IHC'. eauto. auto. } } } Qed.

Hint Immediate cover_dij_elim cover_dij_intro: core.

  (*------------- Cardinalities and set covers ------------------------------------------*)

  Lemma disj_cover_card (C: list (list A))(l: list A)(n: nat):
    Set_cover C l -> NoDup C-> (forall x, In x C -> (IsOrd x /\ |x|=n))->
    (forall x y, In x C -> In y C-> x <> y -> x [i] y = nil)-> |l| = |C| * n.
  Proof. { revert l. induction C as [|c C'].
           { intros l h1 h2 h3 h4. unfold Set_cover in h1.
             subst l. simpl. auto. }
           { intros l h1 h2 h3 h4. unfold Set_cover in h1.
             subst l. simpl.
             replace (| c [u] union_over C' |) with (|c| + |union_over C'|).
             set (l':= union_over C').
             assert (h5: Set_cover C' l').
             { unfold Set_cover. subst l'. auto. }
             assert (h6: (|l'|) = (|C'|)* n).
             { apply IHC'. auto. eauto.
               intros x h6. apply h3. auto.
               intros x y hx hy. apply h4. all: auto. }
             rewrite h6. cut (|c| = n). omega.
             apply h3. auto. symmetry; apply inc_exc1.
             apply h3. auto. apply cover_dij_intro.
             intros y h5. apply h4. auto. auto. intro h6; subst c.
             absurd (In y C'); auto. } } Qed.

  Lemma large_set_in_cover (C: list (list A))(l: list A):
   l <> nil-> (forall x, In x C -> IsOrd x)-> Set_cover C l -> (exists x, In x C /\ (|x| * |C|) >= |l|).
  Proof. { revert l. induction C as [| c C'].
           { intros l h1 h2.  unfold Set_cover in h2. simpl in h2. contradiction. }
           { intros l h1 h2 hl.
             set (l':= union_over C').
             assert (h3: l = c [u] l').
             { unfold Set_cover in hl. subst l;subst l'. simpl. auto. }
             assert (h4: l' = nil \/ l' <> nil). eauto.
             destruct h4 as [h4 | h4].
             { (* ----l' = nil--- *)
               exists c. split. auto. rewrite h4 in h3.
               replace (c [u] nil) with (nil [u] c) in h3. simpl in h3.
               subst l. simpl. auto using mult_le.
               apply union_equal. constructor. auto. }
             { (*-----  l' <> nil -----*)
               specialize (IHC' l' h4) as h4a.
               assert (h6: exists x : list A, In x C' /\ (| x |) * (| C' |) >= (| l' |)).
               { apply h4a. intros x h6. apply h2. auto.
                 unfold Set_cover. subst l';auto. }
               destruct h6 as [x' h6].

               assert (h7: (|c| <= |x'|) \/ ~ (|c| <= |x'|)). eauto.
               destruct h7 as [h7 | h7].
               {(*-- (| c |) <= (| x' |) --*)
                 exists x'.
                 split.
                 { cut (In x' C'). auto. apply h6. }
                 { destruct h6 as [h6 h6a]. simpl. rewrite h3.
                   assert (h8: (| c [u] l' |) <= (|c|) + (|l'|)).
                   { cut (IsOrd c). cut (IsOrd l'). auto.
                     subst l'. auto. auto. }
                   assert (h9: (| c |) + (| l' |) <=  (| c |) + (| x' |) * (| C' |) ).
                   omega.
                   assert (h10: (| c |) + (| x' |) * (| C' |) <= (| x' |) + (| x' |) * (| C' |)).
                   omega.
                   replace ((| x' |) * S (| C' |)) with ((| x' |) * (| C' |) + |x'|).
                   omega. auto with arith. } }
               {(*--- ~ (| c |) <= (| x' |) ----*)
                 assert (h7a: |c| > |x'|). omega.
                 exists c.
                 split.
                 { auto. }
                 { destruct h6 as [h6 h6a]. simpl. rewrite h3.
                   assert (h8: (| c [u] l' |) <= (|c|) + (|l'|)).
                   { cut (IsOrd c). cut (IsOrd l'). auto.
                     subst l'. auto. auto. }
                   assert (h9: (| c |) + (| l' |) <=  (| c |) + (| x' |) * (| C' |) ).
                   omega.
                   assert (h9a:  (| x' |) * (| C' |) <=  (| c |) * (| C' |) ).
                   { apply mult_le1. omega. }
                   assert (h10: (| c |) + (| x' |) * (| C' |) <= (| c |) + (| c |) * (| C' |)).
                   omega.
                   replace ((| c |) * S (| C' |)) with ((| c |) * (| C' |) + |c|).
                   omega. auto with arith. } } } } } Qed.

End SetCover.

Hint Resolve in_map map_cons map_length: core.
Hint Immediate in_map_iff: core.
Hint Resolve union_over_intro3 union_over_intro4: core.
Hint Immediate union_over_elim union_over_elim1: core.
Hint Immediate union_over_intro2 union_over_intro: core.
Hint Resolve union_over_IsOrd: core.
Hint Resolve mk_disj_intro: core.
 Hint Resolve mk_disj_IsOrd: core.

Hint Resolve Set_cover_elim:core.
Hint Resolve Set_cover_IsOrd: core.

Notation "l [,] n" := (fix_nat n l) (at level 65).

Hint Immediate fix_nat_elim fix_nat_elim1 fix_nat_IsOrd fix_nat_prop1 fix_nat_prop2: core.
 Hint Immediate fix_nat_intro: core.

 Hint Immediate cover_dij_elim cover_dij_intro: core.

 Section UnionOverDisj.

  Context { A: ordType }.

   Lemma union_over_mk_disj (C: list (list A)):
     union_over C = img fst (union_over (mk_disj C)).
   Proof. { apply set_equal. all: auto.
            split.
            { intros x h1.
              assert (h2: exists I, In I C /\ In x I). auto.
              destruct h2 as [I h2]. destruct h2 as [h2a h2b].
              set (n:= idx I C).
              assert (h3: In (I [,] n) (mk_disj C)).
              { subst n. auto. }
              assert (h4: In (x,n) (union_over (mk_disj C))).
              { cut (In (x,n) (I [,] n)). intro h4.
                eapply union_over_intro. apply h4. auto. auto. }
              replace (x) with (fst (x,n)). auto.
              simpl. auto. }
            { intros x h1.
              assert (h2: exists p, In p (union_over (mk_disj C)) /\ x = fst p).
              auto. destruct h2 as [p h2]. destruct h2 as [h2a h2b].
              assert (h3: exists I', In I' (mk_disj C) /\ In p I'). auto.
              destruct h3 as [I' h3]. destruct h3 as [h3 h4].
              specialize (mk_disj_elim C I' h3) as h5.
              destruct h5 as [I h5]. destruct h5 as [h5 h6].
              subst I'.
              assert (h6: In (fst p) I).
              { destruct p as [p1 p2]. simpl in h2b.
                simpl. replace (idx I C) with p2 in h4. eauto.
                eapply fix_nat_elim1. apply h4. }
              subst x.  eauto. } } Qed.

 End UnionOverDisj.

 Hint Resolve union_over_mk_disj: core.

Section LocateInC.

   Context { A: ordType }.

  (*--- Following function (idc x C) finds the location of set in C which contains x ----*)
  Fixpoint idc (x:A)(C: list (list A)):= match C with
                                |nil => 0
                                |c::C' => match (memb x c) with
                                        | true => 1
                                        |false => match (memb x (union_over C')) with
                                                 |true => S (idc x C')
                                                 |false => 0
                                                 end
                                         end
                                          end.

Lemma absnt_idc_zero (x:A)(C:list (list A)): ~ In x (union_over C) -> (idc x C) = 0.
Proof. { induction C.
       { simpl. auto. }
       { intro H. simpl.
         replace (memb x a) with false. replace (memb x (union_over C)) with false. auto.
         symmetry;switch; auto.
         symmetry;switch. move /membP. intro H1. auto.  } } Qed.

Lemma idc_zero_absnt (x:A)(C:list (list A)): (idc x C) = 0 -> ~ In x (union_over C).
Proof. { induction C.
         { simpl. auto. }
         { intros H1 H2. inversion H1.
           destruct (memb x a) eqn:Hxa. inversion H0.
           destruct (memb x (union_over C)) eqn: Hxl. move /membP in Hxl.
           inversion H0. assert (H3: In x a \/ In x (union_over C)). auto.
           destruct H3.
           { move /membP in Hxa. contradiction. }
           { move /membP in Hxl. contradiction. } } } Qed.

Lemma idc_gt_zero (x:A)(C:list (list A)) : In x (union_over C) -> (idc x C) > 0.
Proof. { intro H. assert (H1: idc x C = 0 \/ ~ idc x C = 0). eauto.
       destruct H1.
       { absurd (In x (union_over C)). apply idc_zero_absnt. auto. auto. }
       { omega. } } Qed.

Lemma idc_is_one (x:A)(c: list A)(C: list (list A)): In x c -> idc x (c::C) = 1.
Proof. simpl. intro h1. replace (memb x c) with true; auto. Qed.

Hint Immediate absnt_idc_zero idc_zero_absnt idc_gt_zero idc_is_one: core.

Lemma idc_from_idx (x: A)(C: list (list A)): In x (union_over C)->
                                             exists c, In c C /\  In x c /\ idc x C = idx c C.
Proof. { revert x. induction C as [|l C'].
       { intros x. simpl. tauto. }
       { intros x h1.
         assert (h2: In x l \/ In x (union_over C')). auto.
         simpl idc. destruct (memb x l) eqn: Hxl.
         { exists l. split. auto.  split. move /membP in Hxl. auto. symmetry;auto. }
         { assert (h3: In x (union_over C')).
           { destruct h2. move /membP in Hxl. contradiction. auto. }
           specialize (IHC' x h3) as h4.
           destruct h4 as [c h4].
           exists c. split. cut (In c C'). auto. apply h4.
           split. apply h4. replace (memb x (union_over C')) with true.
           simpl idx. replace (eqbl c l) with false. replace (memb c C') with true.
           cut (idc x C' = idx c C'). omega. apply h4.
           symmetry; apply /membP; apply h4.
           symmetry. apply /eqP.
           intro h5. subst c.
           absurd (In x l). move /membP in Hxl; auto. apply h4.
           symmetry;auto. } } } Qed.

Lemma idc_eq_both_in (x y: A)(C: list (list A)): In x (union_over C) -> idc x C = idc y C ->
                                                 In y (union_over C).
Proof. { intros h1 h2.
         assert (h3: In y (union_over C) \/ ~ In y (union_over C)). eauto.
         destruct h3 as [h3 | h3]. auto.
         replace (idc y C) with 0 in h2.
         absurd (In x (union_over C));auto. symmetry;auto. } Qed.

Lemma idc_eq_same_set (x y: A)(C: list (list A)): In x (union_over C) -> idc x C = idc y C ->
                                                  exists c, In c C /\ In x c /\ In y c.
Proof. { intros h1 h2. specialize (idc_eq_both_in x y C h1 h2) as h3.
         apply idc_from_idx in h1 as h1a. apply idc_from_idx in h3 as h3a.
         destruct h1a as [c1 h1a]. destruct h3a as [c2 h3a].
         assert (h4: c1 = c2).
         { cut (idx c1 C = idx c2 C).
           cut (In c2 C).
           cut (In c1 C).
           apply same_index. apply h1a. apply h3a.
           cut (idc x C = idx c1 C).
           cut (idc y C = idx c2 C).
           intros;omega. apply h3a. apply h1a. }
         subst c2. exists c1.
         split. apply h1a.  split. apply h1a. apply h3a. } Qed.

End LocateInC.

Hint Immediate absnt_idc_zero idc_zero_absnt idc_gt_zero idc_is_one: core.

Hint Immediate idc_from_idx idc_eq_same_set: core.


Require Import List.
Import ListNotations.
Require Import Arith.
Require Import Permutation.

Require Export poly_unif.

(** * Introduction *)

(** Here we implement the algorithm for successive variable elimination. The
    basic idea is to remove a variable from the problem, solve that simpler
    problem, and build a solution from the simpler solution. The algorithm is
    recursive, so variables are removed and problems are generated until we are
    left with either of two problems; $1 \stackrel{?}{\approx}_{B} 0$ or
    $0 \stackrel{?}{\approx}_{B} 0$. In the former case, the whole original
    problem is not unifiable. In the latter case, the problem is solved without
    any need to substitute since there are no variables. From here, we begin the
    process of building up substitutions until we reach the original problem. *)

(** * Eliminating Variables *)

(** This section deals with the problem of removing a variable [x] from a term
    _t_. The first thing to notice is that _t_ can be written in polynomial form
    $t\downarrow_{P}$. This polynomial is just a set of monomials, and each
    monomial a set of variables. We can now seperate the polynomials into two
    sets [qx] and [r]. The term [qx] will be the set of monomials in
    $t\downarrow_{P}$ that contain the variable [x]. The term [q], or the
    quotient, is [qx] with the [x] removed from each monomial. The term [r], or
    the remainder, will be the monomials in $t\downarrow_{P}$ that do not
    contain [x]. The original term can then be written as $x \ast q + r$. *)

(** Implementing this procedure is pretty straightforward. We define a function
    [div_by_var] that produces two polynomials given a polynomial [p] and a
    variable [x] to eliminate from it. The first step is dividing [p] into [qx]
    and [r] which is performed using a partition over [p] with the predicate
    [has_var]. The second step is to remove [x] from [qx] using the helper
    [elim_var]. *)

(** The function [has_var] determines whether a variable appears in a monomial.
    *)

Definition has_var (x : var) := existsb (beq_nat x).

(** The function [elim_var] removes a variable from each monomial in a
    polynomial. It is possible that this leaves the term not in polynomial form
    so it is then repaired with [make_poly]. *)

Definition elim_var (x : var) (p : poly) : poly :=
  make_poly (map (remove var_eq_dec x) p).

(** The function [div_by_var] produces a quotient [q] and remainder [r] from a
    polynomial [p] and variable [x] such that $p \approx_{B} x \ast q + r$ and
    [x] does not occur in [r]. *)

Definition div_by_var (x : var) (p : poly) : prod poly poly :=
  let (qx, r) := partition (has_var x) p in
  (elim_var x qx, r).

(** We would also like to prove some lemmas about varaible elimination that
    will be helpful in proving the full algorithm correct later. The main lemma
    below is [div_eq], which just asserts that after eliminating [x] from [p]
    into [q] and [r] the term can be put back together as in
    $p \approx_{B} x \ast q + r$. This fact turns out to be rather hard to prove
    and needs the help of 10 or so other sudsidiary lemmas. *)

(** After eliminating a variable [x] from a polynomial to produdce [r], [x] does
    not occur in [r]. *)

Lemma elim_var_not_in_rem : forall x p r,
  elim_var x p = r ->
  (forall m, In m r -> ~ In x m).
Proof.
  intros.
  unfold elim_var in H.
  unfold make_poly in H.
  rewrite <- H in H0.
  apply In_sorted in H0.
  apply nodup_cancel_in in H0.
  rewrite map_map in H0.
  apply in_map_iff in H0 as [n []].
  rewrite <- H0.
  intro.
  rewrite make_mono_In in H2.
  apply remove_In in H2.
  auto.
Qed.

(** Eliminating a variable from a polynomial produces a term in polynomial form.
    *)

Lemma elim_var_is_poly : forall x p,
  is_poly (elim_var x p).
Proof.
  intros.
  unfold elim_var.
  apply make_poly_is_poly.
Qed.

Hint Resolve elim_var_is_poly.

(** The next four lemmas deal with the following scenario: Let [p] be a term in
    polynomial form, [x] be a variable that occurs in each monomial of [p], and
    [r = elim_var x p]. *)

(** The term [r] is a permutation of removing [x] from [p]. Another way of
    looking at this statement is when [elim_var] repairs the term produced from
    removing a variable it only sorts that term. *)

Lemma elim_var_map_remove_Permutation : forall p x,
  is_poly p ->
  (forall m, In m p -> In x m) ->
  Permutation (elim_var x p) (map (remove var_eq_dec x) p).
Proof.
  intros p x H H0. destruct p as [|a p].
  - simpl. unfold elim_var, make_poly, MonoSort.sort. auto.
  - simpl. unfold elim_var. simpl. unfold make_poly.
    rewrite <- Permutation_MonoSort_l. rewrite unsorted_poly; auto.
    + rewrite <- map_cons. apply NoDup_map_remove; auto.
    + apply poly_cons in H. intros m Hin. destruct Hin.
      * rewrite <- H1. apply remove_is_mono. apply H.
      * apply in_map_iff in H1 as [y []]. rewrite <- H1. apply remove_is_mono.
        destruct H. unfold is_poly in H. destruct H. apply H4. auto.
Qed.

(** The term $(x \ast r)\downarrow_{P}$ is a permutation of the result of
    removing [x] from [p], appending [x] to the end of each monomial, and
    repairing each monomial. The proof relies on the [mulPP_map_app_permutation]
    lemma from the [poly] library, which has a simpler goal but does much of the
    heavy lifting. *)

Lemma rebuild_map_permutation : forall p x,
  is_poly p ->
  (forall m, In m p -> In x m) ->
  Permutation (mulPP [[x]] (elim_var x p))
              (map (fun a => make_mono (a ++ [x]))
                   (map (remove var_eq_dec x) p)).
Proof.
  intros p x H H0. apply mulPP_map_app_permutation; auto.
  - apply (elim_var_not_in_rem x p); auto.
  - apply elim_var_map_remove_Permutation; auto.
Qed.

(** The term [p] is a permutation of ($x \ast r)\downarrow_{P}$. Proof of this
    fact relies on the lengthy [map_app_remove_Permutation] lemma from [poly].
    *)

Lemma elim_var_permutation : forall p x,
  is_poly p ->
  (forall m, In m p -> In x m) ->
  Permutation p (mulPP [[x]] (elim_var x p)).
Proof.
  intros p x H H0. pose (rebuild_map_permutation p x H H0).
  apply Permutation_sym in p0.
  pose (map_app_remove_Permutation p x H H0).
  apply (Permutation_trans p1 p0).
Qed.

(** Finally, $p = (x \ast r)\downarrow_{P}$. *)

Lemma elim_var_mul : forall x p,
  is_poly p ->
  (forall m, In m p -> In x m) ->
  p = mulPP [[x]] (elim_var x p).
Proof.
  intros. apply Permutation_Sorted_eq.
  - apply elim_var_permutation; auto.
  - unfold is_poly in H. apply Sorted_MonoSorted. apply H.
  - pose (mulPP_is_poly [[x]] (elim_var x p)). unfold is_poly in i.
    apply Sorted_MonoSorted. apply i.
Qed.

(** The function [has_var] is an equivalent boolean version of the [In]
    predicate. *)

Lemma has_var_eq_in : forall x m,
  has_var x m = true <-> In x m.
Proof.
  intros.
  unfold has_var.
  rewrite existsb_exists.
  split; intros.
  - destruct H as [x0 []].
    apply Nat.eqb_eq in H0.
    rewrite H0. apply H.
  - exists x. rewrite Nat.eqb_eq. auto.
Qed.

(** Let a polynomial [p] be partitioned by [has_var x] into two sets [qx] and
    [r]. Obviously, every monomial in [qx] contains [x] and no monomial in [r]
    contains [x]. *)

Lemma part_var_eq_in : forall x p qx r,
  partition (has_var x) p = (qx, r) ->
  ((forall m, In m qx -> In x m) /\
   (forall m, In m r -> ~ In x m)).
Proof.
  intros.
  split; intros.
  - apply part_fst_true with (a:=m) in H.
    + apply has_var_eq_in. apply H.
    + apply H0.
  - apply part_snd_false with (a:=m) in H.
    + rewrite <- has_var_eq_in. rewrite H. auto.
    + apply H0.
Qed.

(** The function [div_by_var] produces two terms both in polynomial form. *)

Lemma div_is_poly : forall x p q r,
  is_poly p ->
  div_by_var x p = (q, r) ->
  is_poly q /\ is_poly r.
Proof.
  intros.
  unfold div_by_var in H0.
  destruct (partition (has_var x) p) eqn:Hpart.
  apply (part_is_poly _ _ _ _ H) in Hpart as Hp.
  destruct Hp as [Hpl Hpr].
  injection H0. intros Hr Hq.
  rewrite Hr in Hpr.
  apply part_var_eq_in in Hpart as [Hin Hout].
  split.
  - rewrite <- Hq; auto.
  - apply Hpr.
Qed.

(** As explained earlier, given a polynomial [p] decomposed into a variable [x],
    a quotient [q], and a remainder [r], [div_eq] asserts that
    $p = (x \ast q + r)\downarrow_{P}$. *)

Lemma div_eq : forall x p q r,
  is_poly p ->
  div_by_var x p = (q, r) ->
  p = addPP (mulPP [[x]] q) r.
Proof.
  intros x p q r HP HD.
  assert (HE := HD).
  unfold div_by_var in HE.
  destruct ((partition (has_var x) p)) as [qx r0] eqn:Hqr.
  injection HE. intros Hr Hq.
  assert (HIH: forall m, In m qx -> In x m). intros.
  apply has_var_eq_in.
  apply (part_fst_true _ _ _ _ _ Hqr _ H).
  assert (is_poly q /\ is_poly r) as [HPq HPr].
  apply (div_is_poly _ _ _ _ HP HD).
  assert (is_poly qx /\ is_poly r0) as [HPqx HPr0].
  apply (part_is_poly _ _ _ _ HP Hqr).
  rewrite <- Hq.
  rewrite <- (elim_var_mul x qx HPqx HIH).
  apply (part_add_eq (has_var x) _ _ _ HP).
  rewrite <- Hr.
  apply Hqr.
Qed.

(** Given a variable [x], [div_by_var] produces two polynomials neither of which
    contain [x]. *)

Lemma div_var_not_in_qr : forall x p q r,
  div_by_var x p = (q, r) ->
  ((forall m, In m q -> ~ In x m) /\
   (forall m, In m r -> ~ In x m)).
Proof.
  intros.
  unfold div_by_var in H.
  assert (exists qxr, qxr = partition (has_var x) p) as [[qx r0] Hqxr]. eauto.
  rewrite <- Hqxr in H.
  injection H. intros Hr Hq.
  split.
  - apply (elim_var_not_in_rem _ _ _ Hq).
  - rewrite Hr in Hqxr.
    symmetry in Hqxr.
    intros. intro.
    apply has_var_eq_in in H1.
    apply Bool.negb_false_iff in H1.
    revert H1.
    apply Bool.eq_true_false_abs.
    apply Bool.negb_true_iff.
    revert m H0.
    apply (part_snd_false _ _ _ _ _ Hqxr).
Qed.

(** This helper function [build_poly] is used to construct
    $p' = ((q + 1) * r)\downarrow_{P}$ given the two polynomials [q] and [r] as
    input. *)

Definition build_poly (q r : poly) : poly :=
  mulPP (addPP [[]] q) r.

(** The function [build_poly] produces a term in polynomial form. *)

Lemma build_poly_is_poly : forall q r,
  is_poly (build_poly q r).
Proof.
  unfold build_poly. auto.
Qed.

Hint Resolve build_poly_is_poly.

(** The second main lemma about varaible elimination is below. Given that a term
    [p] has been decomposed into the form $(x \ast q + r)\downarrow_{P}$, we can
    define $p' = ((q + 1) * r)\downarrow_{P}$. The lemma [div_build_unif] states
    that any unifier of $p \stackrel{?}{\approx}_{B} 0$ is also a unifier of
    $p' \stackrel{?}{\approx}_{B} 0$. Much of this proof relies on the axioms of
    polynomial arithmetic. *)

Lemma div_build_unif : forall x p q r s,
  is_poly p ->
  div_by_var x p = (q, r) ->
  unifier s p ->
  unifier s (build_poly q r).
Proof.
  unfold build_poly, unifier.
  intros x p q r s HPp HD [Hps Hsp0].
  apply (div_eq _ _ _ _ HPp) in HD as Hp.
  (* multiply both sides of Hsp0 by s(q+1) *)
  assert (exists q1, q1 = addPP [[]] q) as [q1 Hq1]. eauto.
  assert (exists sp, sp = substP s p) as [sp Hsp]. eauto.
  assert (exists sq1, sq1 = substP s q1) as [sq1 Hsq1]. eauto.
  rewrite <- (mulPP_0 (substP s q1)).
  rewrite <- Hsp0.
  rewrite Hp, Hq1.
  rewrite <- substP_distr_mulPP; auto.
  f_equal.
  apply (div_is_poly x p q r HPp) in HD.
  destruct HD as [HPq HPr].
  rewrite mulPP_addPP_1; auto.
Qed.

(** Given a polynomial [p] and a variable [x], [div_by_var] produces two
    polynomials [q] and [r] that have no more variables than [p] has. Obviously,
    [q] and [r] don't contain [x] either. *)

Lemma incl_div : forall x p q r xs,
  is_poly p ->
  div_by_var x p = (q, r) ->
  incl (vars p) (x :: xs) ->
  incl (vars q) xs /\ incl (vars r) xs.
Proof.
  intros. assert (Hdiv:=H0). unfold div_by_var in H0.
  destruct partition as [qx r0] eqn:Hpart. apply partition_Permutation in Hpart.
  apply Permutation_incl in Hpart as []. inversion H0. clear H2.
  assert (incl (vars q) (vars p)). unfold incl, vars in *. intros a Hin.
    apply nodup_In. apply nodup_In in Hin. apply In_concat_exists in Hin.
    destruct Hin as [m []]. rewrite <- H5 in H2. unfold elim_var in H2.
    apply In_sorted in H2. apply nodup_cancel_in in H2. rewrite map_map in H2.
    apply in_map_iff in H2. destruct H2 as [mx []]. rewrite <- H2 in H4.
    rewrite make_mono_In in H4. apply In_remove in H4. apply In_concat_exists.
    exists mx. split; auto. apply H3. intuition.
  assert (incl (vars r) (vars p)). rewrite H6 in H3. unfold incl, vars in *.
    intros a Hin. apply nodup_In. apply nodup_In in Hin.
    apply In_concat_exists in Hin. destruct Hin as [l []].
    apply In_concat_exists. exists l. split; auto. apply H3. intuition.
  split.
  - rewrite H5. apply incl_tran with (n:=(x::xs)) in H2; auto.
    apply incl_not_in in H2; auto. apply div_var_not_in_qr in Hdiv as [Hq _].
    apply in_mono_in_vars in Hq. auto.
  - apply incl_tran with (n:=(x::xs)) in H4; auto.
    apply incl_not_in in H4; auto. apply div_var_not_in_qr in Hdiv as [_ Hr].
    apply in_mono_in_vars in Hr. auto.
Qed.

(** Given a term [p] decomposed into the form $(x \ast q + r)\downarrow_{P}$,
    then the polynomial $p' = ((q + 1) * r)\downarrow_{P}$ has no more variables
    than [p] and does not contain [x]. *)

Lemma div_vars : forall x xs p q r,
  is_poly p ->
  incl (vars p) (x :: xs) ->
  div_by_var x p = (q, r) ->
  incl (vars (build_poly q r)) xs.
Proof.
  intros x xs p q r H Hincl Hdiv. unfold build_poly.
  apply div_var_not_in_qr in Hdiv as Hin. destruct Hin as [Hinq Hinr].
  apply in_mono_in_vars in Hinq. apply in_mono_in_vars in Hinr.
  apply incl_vars_mulPP. apply (incl_div _ _ _ _ _ H Hdiv) in Hincl. split.
  - apply incl_vars_addPP; auto. apply div_is_poly in Hdiv as []; auto. split.
    + unfold vars. simpl. unfold incl. intros a [].
    + apply Hincl.
  - apply Hincl.
Qed.

Hint Resolve div_vars.

(** * Building Substitutions *)

(** This section handles how a solution is built from subproblem solutions.
    Given that term [p] decomposed into $(x \ast q + r)\downarrow_{P}$ and
    $p' = ((q + 1) * r)\downarrow_{P}$, the lemma [reprod_build_subst] states
    that if some substitution $\sigma$ is a reproductive unifier of
    $p' \stackrel{?}{\approx}_{B} 0$, then we can build a substitution $\sigma'$
    which is a reproductive unifier of $p \stackrel{?}{\approx}_{B} 0$. The way
    $\sigma'$ is built from $\sigma$ is defined in [build_subst]. Another
    replacement is added to $\sigma$ of the form
    $\{x \mapsto (x \ast (\sigma(q) + 1) + \sigma(r))\downarrow_{P}\}$ to
    construct $\sigma'$. *)

Definition build_subst (s : subst) (x : var) (q r : poly) : subst :=
  let q1 := addPP [[]] q in
  let q1s := substP s q1 in
  let rs  := substP s r in
  let xs  := (x, addPP (mulPP [[x]] q1s) rs) in
  xs :: s.

(** The function [build_subst] produces a substitution whose range only
    contains polynomials. *)

Lemma build_subst_is_poly : forall s x q r,
  is_poly_subst s ->
  is_poly_subst (build_subst s x q r).
Proof.
  unfold build_subst.
  unfold is_poly_subst.
  intros.
  destruct H0.
  - inversion H0. auto.
  - apply (H x0). auto.
Qed.

(** Given that term [p] decomposed into $(x \ast q + r)\downarrow_{P}$,
    $p' = ((q + 1) * r)\downarrow_{P}$, and $\sigma$ is a reproductive unifier
    of $p' \stackrel{?}{\approx}_{B} 0$, then the substitution $\sigma'$ built
    from $\sigma$ unifies $p \stackrel{?}{\approx}_{B} 0$. *)

Lemma build_subst_is_unif : forall x p q r s,
  is_poly p ->
  div_by_var x p = (q, r) ->
  reprod_unif s (build_poly q r) ->
  unifier (build_subst s x q r) p.
Proof.
  unfold reprod_unif, unifier.
  intros x p q r s Hpoly Hdiv [[Hps Hunif] Hreprod].
  assert (is_poly_subst (build_subst s x q r)).
    apply build_subst_is_poly; auto.
  split; auto.
  unfold build_poly in Hunif.
  assert (Hnqr := Hdiv).
  apply div_var_not_in_qr in Hnqr.
  destruct Hnqr as [Hnq Hnr].
  assert (HpolyQR := Hdiv).
  apply div_is_poly in HpolyQR as [HpolyQ HpolyR]; auto.
  apply div_eq in Hdiv; auto.
  rewrite Hdiv.
  rewrite substP_distr_addPP; auto.
  rewrite substP_distr_mulPP; auto.
  unfold build_subst.
  rewrite (substP_cons _ _ Hnq).
  rewrite (substP_cons _ _ Hnr).
  assert (Hsx: (substP
        ((x,
         addPP
           (mulPP [[x]]
              (substP s (addPP [[]] q)))
           (substP s r)) :: s)
        [[x]]) = (addPP
         (mulPP [[x]]
            (substP s (addPP [[]] q)))
         (substP s r))).
    unfold substP. simpl.
    rewrite <- beq_nat_refl.
    rewrite mulPP_1r; auto. rewrite app_nil_r.
    rewrite no_make_poly; auto.
  rewrite Hsx.
  rewrite substP_distr_addPP; auto.
  rewrite substP_1.
  rewrite mulPP_distr_addPPr; auto.
  rewrite mulPP_1r; auto.
  rewrite mulPP_distr_addPP; auto.
  rewrite mulPP_distr_addPP; auto.
  rewrite mulPP_assoc.
  rewrite mulPP_p_p; auto.
  rewrite addPP_p_p; auto.
  rewrite addPP_0; auto.
  rewrite <- substP_distr_mulPP; auto.
  rewrite <- substP_distr_addPP; auto.
  rewrite <- (mulPP_1r r) at 2; auto.
  rewrite mulPP_comm; auto.
  rewrite (mulPP_comm r [[]]); auto.
  rewrite <- mulPP_distr_addPP; auto.
  rewrite addPP_comm; auto.
Qed.

(** Given that term [p] decomposed into $(x \ast q + r)\downarrow_{P}$,
    $p' = ((q + 1) * r)\downarrow_{P}$, and $\sigma$ is a reproductive unifier
    of $p' \stackrel{?}{\approx}_{B} 0$, then the substitution $\sigma'$ built
    from $\sigma$ is reproductive with regards to unifiers of
    $p \stackrel{?}{\approx}_{B} 0$. *)

Lemma build_subst_is_reprod : forall x p q r s,
  is_poly p ->
  div_by_var x p = (q, r) ->
  reprod_unif s (build_poly q r) ->
  forall t, unifier t p ->
            subst_comp_eq (build_subst s x q r) t t.
Proof.
  unfold reprod_unif.
  intros x p q r s HpolyP Hdiv [[HpsS HunifS] Hsub_comp] t HunifT.
  assert (HunifT' := HunifT).
  destruct HunifT as [HpsT HunifT].
  apply (div_build_unif _ _ _ _ _ HpolyP Hdiv) in HunifT'.
  unfold subst_comp_eq in *.
  intros y.
  destruct (y =? x) eqn:Hyx.
  - unfold build_subst.
    assert (H: (substP ((x, addPP (mulPP [[x]] (substP s (addPP [[]] q)))
                                  (substP s r)) :: s) [[y]]) =
               (addPP (mulPP [[x]] (substP s (addPP [[]] q))) (substP s r))).
      unfold substP. simpl.
      rewrite Hyx.
      rewrite mulPP_1r; auto. rewrite app_nil_r.
      rewrite no_make_poly; auto.
    rewrite H.
    rewrite substP_distr_addPP; auto.
    rewrite substP_distr_mulPP; auto.
    pose (div_is_poly _ _ _ _ HpolyP Hdiv); destruct a.
    rewrite substP_distr_addPP; auto.
    rewrite substP_distr_addPP; auto.
    rewrite substP_1.
    assert (Hdiv2 := Hdiv).
    apply div_eq in Hdiv; auto.
    apply div_is_poly in Hdiv2 as [HpolyQ HpolyR]; auto.
    rewrite (subst_comp_eq_poly s t t); auto.
    rewrite (subst_comp_eq_poly s t t); auto.
    rewrite mulPP_comm; auto.
    rewrite mulPP_distr_addPP; auto.
    rewrite mulPP_comm; auto.
    rewrite mulPP_1r; auto.
    rewrite (addPP_comm (substP t [[x]]) _); auto.
    rewrite addPP_assoc; auto.
    rewrite (addPP_comm (substP t [[x]]) _ ); auto.
    rewrite <- addPP_assoc; auto.
    rewrite <- substP_distr_mulPP; auto.
    rewrite <- substP_distr_addPP; auto.
    rewrite mulPP_comm; auto.
    rewrite <- Hdiv.
    unfold unifier in HunifT.
    rewrite HunifT.
    rewrite addPP_0; auto.
    apply beq_nat_true in Hyx.
    rewrite Hyx.
    reflexivity.
  - unfold build_subst.
    rewrite substP_cons; auto.
    intros.
    inversion H; auto.
    rewrite <- H0.
    simpl. intro.
    destruct H1; auto.
    apply Nat.eqb_eq in H1.
    rewrite Hyx in H1.
    inversion H1.
Qed.

(** Given that term [p] decomposed into $(x \ast q + r)\downarrow_{P}$,
    $p' = ((q + 1) * r)\downarrow_{P}$, and a reproductive unifier $\sigma$ of
    $p' \stackrel{?}{\approx}_{B} 0$, then the substitution $\sigma'$ built from
    $\sigma$ is a reproductive unifier $p \stackrel{?}{\approx}_{B} 0$ based on
    the previous two lemmas. *)

Lemma reprod_build_subst : forall x p q r s,
  is_poly p ->
  div_by_var x p = (q, r) ->
  reprod_unif s (build_poly q r) ->
  reprod_unif (build_subst s x q r) p.
Proof.
  intros. unfold reprod_unif. split.
  - apply build_subst_is_unif; auto.
  - apply build_subst_is_reprod; auto.
Qed.

(** * Recursive Algorithm *)

(** Now we define the actual algorithm of successive variable elimination.
    Built using five helper functions, the definition is not too difficult to
    construct or understand. The general idea, as mentioned before, is to remove
    one variable at a time, creating simpler problems. Once the simplest problem
    has been reached, to which the solution is already known, every solution to
    each subproblem can be built from the solution to the successive subproblem.
    Formally, given the polynomials $p = (x \ast q + r)\downarrow_{P}$ and
    $p' = ((q + 1) * r)\downarrow_{P}$, the solution to
    $p \stackrel{?}{\approx}_{B} 0$ is built from the solution to
    $p' \stackrel{?}{\approx}_{B} 0$. If $\sigma$ solves
    $p' \stackrel{?}{\approx}_{B} 0$, then $\sigma \cup \{x \mapsto (x \ast
    (\sigma(q) + 1) + \sigma(r))\downarrow_{P}\}$ solves
    $p \stackrel{?}{\approx}_{B} 0$. *)

(** The function [sve] is the final result, but it is [sveVars] which actually
    has all of the meat. Due to Coq's rigid type system, every recursive
    function must be obviously terminating. This means that one of the arguments
    must decrease with each nested call. It turns out that Coq's type checker
    is unable to deduce that continually building polynomials from the quotient
    and remainder of previous ones will eventually result in [0] or [1]. So
    instead we add a fuel argument that explicitly decreases per recursive call.
    We use the set of variables in the polynomial for this purpose, since each
    subsequent call has at least one less variable. *)

Fixpoint sveVars (varlist : list var) (p : poly) : option subst :=
  match varlist with
  | [] =>
      match p with
      | [] => Some [] (* p = 0, Identity substitution *)
      | _  => None    (* p = 1, No solution *)
      end
  | x :: xs =>
      let (q, r) := div_by_var x p in
      let p' := (build_poly q r) in
      match sveVars xs p' with
      | None => None
      | Some s => Some (build_subst s x q r)
      end
  end.

(** The function [sve] simply calls [sveVars] with an initial fuel of [vars p].
    *)

Definition sve (p : poly) : option subst := sveVars (vars p) p.

(** * Correctness *)

(** Finally, we must show that this algorithm is correct. As discussed in the
    beginning, the correctness of a unification algorithm is proven for two
    cases. If the algorithm produces a solution for a problem, then the solution
    must be most general. If the algorithm produces no solution, then the
    problem must be not unifiable. These statements have been formalized in the
    theorem [sve_correct] with the help of the predicates [mgu] and [unifiable]
    as defined in the library [poly_unif]. The two cases of the proof are
    handled seperately by the lemmas [sveVars_some] and [sveVars_none]. *)

(** If [sveVars] produces a substitution $\sigma$, then the range of $\sigma$
    only contains polynomials. *)

Lemma sveVars_poly_subst : forall xs p,
  incl (vars p) xs ->
  is_poly p ->
  forall s, sveVars xs p = Some s ->
            is_poly_subst s.
Proof.
  induction xs as [|x xs]; intros.
  - simpl in H1. destruct p; inversion H1. unfold is_poly_subst.
    intros x p [].
  - intros.
    assert (exists qr, div_by_var x p = qr) as [[q r] Hqr]. eauto.
    simpl in H1.
    rewrite Hqr in H1.
    destruct (sveVars xs (build_poly q r)) eqn:Hs0; inversion H1.
    apply IHxs in Hs0; eauto.
    apply build_subst_is_poly; auto.
Qed.

(** If [sveVars] produces a substitution $\sigma$ for the polynomial [p], then
    $\sigma$ is a most general unifier of $p \stackrel{?}{\approx}_{B} 0$. *)

Lemma sveVars_some :  forall (xs : list var) (p : poly),
  NoDup xs ->
  incl (vars p) xs ->
  is_poly p ->
  forall s, sveVars xs p = Some s ->
            mgu s p.
Proof.
  intros xs p Hdup H H0 s H1.
  apply reprod_is_mgu.
  revert xs p Hdup H H0 s H1.
  induction xs as [|x xs].
  - intros. simpl in H1. destruct p; inversion H1.
    apply empty_reprod_unif.
  - intros.
    assert (exists qr, div_by_var x p = qr) as [[q r] Hqr]. eauto.
    simpl in H1.
    rewrite Hqr in H1.
    destruct (sveVars xs (build_poly q r)) eqn:Hs0; inversion H1.
    apply NoDup_cons_iff in Hdup as Hnin. destruct Hnin as [Hnin Hdup0].
    apply sveVars_poly_subst in Hs0 as HpsS0; eauto.
    apply IHxs in Hs0; eauto.
    apply reprod_build_subst; auto.
Qed.

(** If [sveVars] does not produce a substitution for the polynomial [p], then
    the problem $p \stackrel{?}{\approx}_{B} 0$ is not unifiable. *)

Lemma sveVars_none : forall (xs : list var) (p : poly),
  NoDup xs ->
  incl (vars p) xs ->
  is_poly p ->
  sveVars xs p = None ->
  ~ unifiable p.
Proof.
  induction xs as [|x xs].
  - intros p Hdup H H0 H1. simpl in H1. destruct p; inversion H1. intro.
    unfold unifiable in H2. destruct H2. unfold unifier in H2.
    apply incl_nil in H. apply no_vars_is_ground in H; auto.
    destruct H; inversion H.
    rewrite H4 in H2.
    rewrite H5 in H2.
    rewrite substP_1 in H2.
    inversion H2. inversion H6.
  - intros p Hdup H H0 H1.
    assert (exists qr, div_by_var x p = qr) as [[q r] Hqr]. eauto.
    simpl in H1.
    rewrite Hqr in H1.
    destruct (sveVars xs (build_poly q r)) eqn:Hs0; inversion H1.
    apply NoDup_cons_iff in Hdup as Hnin. destruct Hnin as [Hnin Hdup0].
    apply IHxs in Hs0; eauto.
    unfold not, unifiable in *.
    intros.
    apply Hs0.
    destruct H2 as [s Hu].
    exists s.
    apply (div_build_unif x p); auto.
Qed.

Hint Resolve NoDup_vars incl_refl.

(** If [sveVars] produces a substitution $\sigma$ for the polynomial [p], then
    $\sigma$ is a most general unifier of $p \stackrel{?}{\approx}_{B} 0$.
    Otherwise, $p \stackrel{?}{\approx}_{B} 0$ is not unifiable. *)

Lemma sveVars_correct : forall (p : poly),
  is_poly p ->
  match sveVars (vars p) p with
  | Some s => mgu s p
  | None => ~ unifiable p
  end.
Proof.
  intros.
  destruct (sveVars (vars p) p) eqn: Hsve.
  - apply (sveVars_some (vars p)); auto.
  - apply (sveVars_none (vars p)); auto.
Qed.

(** If [sve] produces a substitution $\sigma$ for the polynomial [p], then
    $\sigma$ is a most general unifier of $p \stackrel{?}{\approx}_{B} 0$.
    Otherwise, $p \stackrel{?}{\approx}_{B} 0$ is not unifiable. *)

Theorem sve_correct : forall (p : poly),
  is_poly p ->
  match sve p with
  | Some s => mgu s p
  | None => ~ unifiable p
  end.
Proof.
  intros.
  apply sveVars_correct.
  auto.
Qed.

(** %
\addcontentsline{toc}{chapter}{Bibliography}
\bibliographystyle{plainnat}
\bibliography{intro}
% *)


Section ARG_MIN_INEQUALITY.
Require FunInd.
Require Export List.
Require Export Nat.

Require Import Coq.Logic.Classical_Prop.
Require Import ZArith.

(* Intuition: there exists an element for which P holds.
              thus there exists an element for which P holds, that has the minimum f-value
                of all elements where P holds

    - {m : nat | m < n} is a finite set
    - you take all elements from this where P holds (at least one) -- still finite
    - you map f onto all elements                                  -- finite set of nat
    - you take the minimum (maybe not unique)                      -- finite sets of nat must have a minimum
 *)

Variable n : nat.
Definition mnnat := { m : nat | m < n }.
Variable f : mnnat -> nat.
Variable g : mnnat -> nat.

Definition P x : Prop := f x < g x.
Definition ltn (n m : nat) : Prop :=  m < n.
Definition minimal_Pholder x : Prop := P x /\ (forall y, P y -> f x <= f y).
Definition exists_Px : Prop := exists x, P x.

Fixpoint nat_lessthan_n (n : nat) : list nat :=
  match n with
  | 0 => nil
  | S(x) => x :: (nat_lessthan_n x)
  end.

Lemma nat_lessthan_n_lessthan_n : forall n x,
  In x (nat_lessthan_n n) <-> x < n.
Proof.
  split ; intros ; induction n0 ; simpl in * ; subst ; intuition ; subst ; intuition.
  inversion H ; intuition.
Qed.

Lemma exists_mnnat_exists_nat_lessthan_n : forall (P : mnnat -> Prop),
  (exists (y : nat) (H0 : ltn n y),
  (In y (nat_lessthan_n n) -> P (exist (ltn n) y H0))) ->
    exists x : mnnat, P x.
Proof.
  intros.
  unfold ltn in H.
  destruct H. destruct H.
  assert (H0' := x0).
  apply <- nat_lessthan_n_lessthan_n in H0'.
  intuition.
  exists (exist (ltn n) x x0). auto.
Qed.

Lemma exists_mnnat_exists_nat_lessthan_n' : forall P,
(exists (y : nat) (H0 : ltn n y), P (exist (ltn n) y H0) /\ forall (y0 : nat) (H1 : ltn n y0),
                   P (exist (ltn n) y0 H1) -> f (exist (ltn n) y H0) <= f (exist (ltn n) y0 H1)) ->
exists (y : nat) (H1 : ltn n y),
  In y (nat_lessthan_n n) ->
  P (exist (ltn n) y H1) /\ (forall y0 : mnnat, P y0 -> f (exist (ltn n) y H1) <= f y0).
Proof.
  intros.
  repeat destruct H.
  exists x. exists x0.
  split ; intros ; auto.
  assert (ltn n (proj1_sig y0)).
  destruct y0.
  auto.
  destruct y0.
  simpl in *.
  specialize (H0 x1 l).
  auto.
Qed.

Lemma exists_f'_implies : forall P,
(exists f' : nat -> nat,
      (forall (x : nat) (H0 : x < n), f (exist (fun m : nat => m < n) x H0) = f' x) /\
(exists (y : nat) (H0 : y < n), P (exist (fun m : nat => m < n) y H0) /\
  forall (y0 : nat) (H1 : y0 < n), P (exist (fun m : nat => m < n) y0 H1) ->
  f' y <= f' y0)) ->
(exists (y : nat) (H0 : y < n), P (exist (fun m : nat => m < n) y H0) /\
  forall (y0 : nat) (H1 : y0 < n), P (exist (fun m : nat => m < n) y0 H1) ->
  f (exist (fun m : nat => m < n) y H0) <= f (exist (fun m : nat => m < n) y0 H1)).
Proof.
  intros.
  destruct H as [f' H]. destruct H.
  repeat destruct H0.
  exists x. exists x0. intros.
  assert (H' := H).
  specialize (H x x0).
  rewrite H.
  split ; auto. intros.
  specialize (H' y0 H2).
  rewrite H'.
  apply (H1 y0 H2) ; auto.
Qed.

Lemma mod_mnnat : forall m,
  n > 0 -> m mod n < n.
Proof.
  intros.
  apply PeanoNat.Nat.mod_upper_bound.
  intuition.
Qed.

Lemma mod_mnnat' : forall m,
  m < n -> m mod n = m.
Proof.
  intros.
  apply PeanoNat.Nat.mod_small.
  auto.
Qed.

(* One main point: because of proof_irrelevance, the intuition holds, that
  the proof (proj2_sig) doesn't change the element, as long as it is there. *)
Lemma proj1_sig_eq : forall (x y : mnnat),
  proj1_sig x = proj1_sig y -> x = y.
Proof.
  intros.
  rewrite (sig_eta x).
  rewrite (sig_eta y).
  destruct x. destruct y as [y H0].
  simpl in *.
  subst.
  assert (l = H0).
  apply proof_irrelevance.
  subst.
  intuition.
Qed.

(* Second main point: we constructed a transformation for Functions and properties,
  with `mod`. After `mod n` we alwayy get a number smaller than n, apart from the
  case n = 0. The transformation needs a proof itself, which was tricky. *)
Lemma Pf'exists : forall A (a : A) (Pf : mnnat -> A), exists Pf' : nat -> A,
  (forall (x0 : nat) (H1 : x0 < n), Pf' x0 = Pf (exist (ltn n) x0 H1)).
Proof.
  intros.
  assert (n = 0 \/ n > 0).
  induction n.
  auto.
  intuition.
  destruct H.
  exists (fun n => a).
  intuition. assert (l' := H1). rewrite H in l'. inversion l'.
  unfold mnnat in *.

  exists (fun m : nat => Pf (exist (ltn n) (m mod n) (mod_mnnat m H))).
  intros.
  unfold ltn.
  assert (l' := H1).
  apply mod_mnnat' in l'.

  assert (proj1_sig (exist (fun m : nat => m < n) x0 H1) =
          proj1_sig (exist (fun m : nat => m < n) (x0 mod n) (mod_mnnat x0 H))).
  simpl. rewrite l'.
  auto.
  apply proj1_sig_eq in H0.
  rewrite H0.
  auto.
Qed.

Lemma P'exists_implies : forall f',
(exists (P' : nat -> Prop), (forall (x : nat) (H0 : x < n), P' x = P (exist (ltn n) x H0)) /\
(exists (y : nat) (H1 : y < n),
  P' y /\
  (forall (y0 : nat) (H2 : y0 < n),
   P' y0 -> f' y <= f' y0))) ->
(exists (y : nat) (H1 : y < n),
  P (exist (fun m : nat => m < n) y H1) /\
  (forall (y0 : nat) (H2 : y0 < n),
   P (exist (fun m : nat => m < n) y0 H2) -> f' y <= f' y0)).
Proof.
  intros.
  destruct H as [P' H].
  destruct H.
  repeat destruct H0.
  exists x. exists x0.
  split ; intros ; intuition.
  unfold ltn in *.
  rewrite <- (H x x0) ; auto.
  apply (H1 y0) ; auto.
  rewrite (H y0 H2) ; auto.
Qed.

(* The actual induction proof, after all transformations took place. *)
Lemma induction_proof : forall n (f' : nat -> nat) (P' : nat -> Prop) x,
 x < n -> P' x ->
(exists (y : nat) (_ : y < n),
  P' y /\ (forall y0 : nat, y0 < n -> P' y0 -> f' y <= f' y0)).
Proof.
  clear n f g.
  intros n0.
  induction n0 ; intros f'0 ; intros ; intuition.
  inversion H.

  inversion H ; subst ; intuition.
  + specialize (IHn0 f'0 P').
    assert ((exists x : nat, x < n0 /\ P' x) \/ ~(exists x : nat, x < n0 /\ P' x)).
    apply classic. destruct H1.
    - destruct H1. destruct H1.
      specialize (IHn0 x). intuition.
      destruct H4. destruct H3.
      assert (f'0 x0 <= f'0 n0 \/ ~ f'0 x0 <= f'0 n0). apply classic. destruct H4.
      exists x0. assert (x0 < S n0). auto. exists H5. intuition.
      inversion H3 ; subst ; intuition.
      exists n0. exists H. intuition.
      inversion H3 ; subst ; intuition.
      specialize (H6 y0) ; intuition.
    - exists n0. exists H.
      intuition.
      inversion H2 ; subst ; intuition.
      assert (y0 < n0). auto.
      exfalso. apply H1. exists y0 ; auto.
  + specialize (IHn0 f'0 P' x). intuition.
    clear H2.
    destruct H3. destruct H1. destruct H1.
    assert (f'0 x0 <= f'0 n0 \/ ~ f'0 x0 <= f'0 n0). apply classic. destruct H3.
    exists x0. assert (x0 < S n0). auto. exists H4.
    intuition.
    inversion H5 ; subst ; intuition.
    assert (P' n0 \/ ~ P' n0). apply classic. destruct H4.
    exists n0. assert (n0 < S n0). auto. exists H5.
    intuition.
    inversion H6 ; subst ; intuition.
    specialize (H2 y0) ; intuition.
    exists x0. assert (x0 < S n0). auto. exists H5.
    intuition.
    inversion H6 ; subst ; intuition.
Qed.

Lemma exists_Px_minimal_Pholder :
  (exists x, P x) -> exists x, (P x /\ (forall y, P y -> f x <= f y)).
Proof.
  intros.

  auto.
  destruct H. destruct x.
  assert (H' := l). rename l into x1. rename H into H0.
  apply <- nat_lessthan_n_lessthan_n in H'.
  apply exists_mnnat_exists_nat_lessthan_n.
  apply exists_mnnat_exists_nat_lessthan_n'.
  unfold ltn.
  apply (exists_f'_implies P).
  assert (exists (f' : nat -> nat),
    forall (x : nat) (H0: x < n), f' x = f (exist (fun m : nat => m < n) x H0)).
  intros.
  apply (Pf'exists nat 0 f).
  destruct H as [f' Hf'].
  exists f'. split ; auto ; intros.

  clear H'.
  apply P'exists_implies.
  assert (exists P' : nat -> Prop,
    (forall (x0 : nat) (H1 : x0 < n), P' x0 = P (exist (ltn n) x0 H1))).
  apply (Pf'exists Prop False P).
  destruct H as [P' H].
  exists P'.
  split ; intros.
  auto.
  unfold ltn in *.
  rewrite <- (H x x1) in H0.
  apply (induction_proof n _ _ x) ; auto.
Qed.

Definition exists_P_x : Prop := exists x, P x.
Definition minimal_P_holder x : Prop := P x /\ (forall y, P y -> f x <= f y).

Lemma exists_minimal_P_holder :
  exists_P_x -> exists x, minimal_P_holder x.
Proof.
  intros.
  unfold exists_P_x in *. unfold minimal_P_holder.
  apply (exists_Px_minimal_Pholder) ; auto.
Qed.

(* Main Lemma of this file. *)
Lemma arg_min_inequality : forall x,
  (f x < g x) -> (exists x, f x < g x /\
                            forall y, f y < f x -> f y >= g y).
Proof.
  intros.
  assert (exists x, minimal_P_holder x).
  apply exists_minimal_P_holder.
  unfold exists_P_x.
  unfold P.
  exists x ; auto.
  destruct H0. exists x0.
  unfold minimal_P_holder in H0.
  destruct H0.
  unfold P in *.
  split ; intros.
  + auto.
  + specialize (H1 y) ; intuition.
Qed.

End ARG_MIN_INEQUALITY.