From a0a84a9e90387b3657a40fffce2258b04ec69cac Mon Sep 17 00:00:00 2001 From: barras Date: Fri, 6 Mar 2009 11:02:10 +0000 Subject: oups (module Entiers remplace par Big_int) git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11965 85f007b7-540e-0410-9357-904b9bb8a0f7 --- contrib/groebner/groebner.ml4 | 1 - contrib/groebner/polynom.ml | 9 ++--- contrib/groebner/utile.ml | 83 +++++-------------------------------------- contrib/groebner/utile.mli | 10 ------ 4 files changed, 13 insertions(+), 90 deletions(-) (limited to 'contrib') diff --git a/contrib/groebner/groebner.ml4 b/contrib/groebner/groebner.ml4 index 895725f83..00cd8ae5d 100644 --- a/contrib/groebner/groebner.ml4 +++ b/contrib/groebner/groebner.ml4 @@ -36,7 +36,6 @@ open Entries open Num open Unix open Utile -open Entiers open Ideal let num_0 = Int 0 diff --git a/contrib/groebner/polynom.ml b/contrib/groebner/polynom.ml index 13acaa240..5c859f755 100644 --- a/contrib/groebner/polynom.ml +++ b/contrib/groebner/polynom.ml @@ -11,6 +11,7 @@ Polynomes récursifs: Z[x1]...[xn]. *) open Utile +open Util (*********************************************************************** 1. Opérations sur les coefficients. @@ -146,7 +147,6 @@ let rec eqP p q = with _ -> false) | (_,_) -> false - (* vire les zéros de tête d'un polynôme non normalisé, dont les coefficients sont supposés normalisés. si constant, rend le coef constant. @@ -837,8 +837,9 @@ let factorise = (* liste des facteurs sans carré non constants, avec coef entier de tête positif *) let facteurs2 p = - List.map normc (list_select (fun q -> (deg_total q)>0) - (List.flatten (factorise (normc p)))) + List.map normc + (List.filter (fun q -> deg_total q >0) + (List.flatten (factorise (normc p)))) (* produit des facteurs non constants d'une décomposition sans carré *) @@ -909,7 +910,7 @@ let rec is_positif p = match p with Pint a -> le_coef coef0 a |Prec(x,p1) -> - (array_test is_positif p1) + (array_for_all is_positif p1) && (try (Array.iteri (fun i c -> if (i mod 2)<>0 && not (eqP c cf0) then failwith "pas pair") p1; diff --git a/contrib/groebner/utile.ml b/contrib/groebner/utile.ml index cc4d31978..52a69dc10 100644 --- a/contrib/groebner/utile.ml +++ b/contrib/groebner/utile.ml @@ -18,89 +18,22 @@ let prt s = let info s = output_string stderr s; flush stderr -(********************************************************************** - Tableaux -*) -(* compte les occurrences de i dans le tableau t *) -let compte t i = - let r = ref 0 in - Array.iter (fun x -> if x=i then r:= !r + 1) t; - !r ;; - -(* maximum d'un tableau d'entiers *) -let maximum t = - Array.fold_left max 0 t -;; - - -(* appliquer une fonction a tous les elements d'une matrice *) -let matrix_map f m= - let s=Array.length m in - let res=Array.create s [| |] in - for i=0 to s-1 do - res.(i)<-Array.map f m.(i) - done; -res -;; -(* selectionne dans un tableau *) -let array_select f l = - let res = ref [] in - Array.iter (fun x -> if (f x) then res:=(!res)@[x]) l; - Array.of_list !res -;; -(* teste si tous les elements d'un tableau verifient f *) -let array_test f t = - try (Array.iter (fun x -> if not (f x) then failwith "raté") t; - true) - with _ -> false -;; - -(* cherche a dans t, rend l'indice ou il se trouve ou declenche une exception*) -let array_find a t = - let n = Array.length t in - let ok = ref true in - let res = ref 0 in - while !ok do - if (!res = n) then raise Not_found -else (if t.(!res) = a then ok := false - else res := !res +1;) - done; -!res -;; - (********************************************************************** Listes *) - -let set_of_list l = - let r = Hashtbl.create 51 in - List.iter (fun x -> - try (Hashtbl.find r x;()) - with _ -> Hashtbl.add r x true) l; - let res = ref [] in - Hashtbl.iter (fun x _ -> res:=x::(!res)) r; - !res (* appartenance à une liste , on donne l'égalité *) let rec list_mem_eq eq x l = match l with [] -> false |y::l1 -> if (eq x y) then true else (list_mem_eq eq x l1) -;; (* vire les repetitions d'une liste, on donne l'égalité *) let set_of_list_eq eq l = let res = ref [] in List.iter (fun x -> if not (list_mem_eq eq x (!res)) then res:=x::(!res)) l; List.rev !res -;; -(* selectionne dans une liste *) -let list_select f l = - let res = ref [] in - List.iter (fun x -> if (f x) then res:=(!res)@[x]) l; - !res -;; (*********************************************************************** Un outil pour faire une mémo-fonction: @@ -121,7 +54,7 @@ let memo memoire egal valeur fonction x = memoire:=(x,v)::(!memoire); v) with _ -> !res -;; + (* un autre plus efficace, utilisant une fonction intermediaire (utile si on n'a pas @@ -134,7 +67,7 @@ let memos s memoire print fonction x = let v = fonction x in Hashtbl.add memoire (print x) v; v) -;; + (********************************************************************** Eléments minimaux pour un ordre partiel de division. @@ -150,7 +83,7 @@ let memos s memoire print fonction x = *) let facteurs_liste div constant lp = - let lp = list_select (fun x -> not (constant x)) lp in + let lp = List.filter (fun x -> not (constant x)) lp in let rec factor lmin lp = (* lmin: ne se divisent pas entre eux *) match lp with [] -> lmin @@ -179,7 +112,7 @@ let facteurs_liste div constant lp = else factor lmin ((!l1)@lp1)) in factor [] lp -;; + (* On suppose que tout élément de A est produit d'éléments de B et d'un de C: A et B sont deux tableaux, rend un tableau de couples @@ -207,7 +140,7 @@ let factorise_tableau div zero c f l1 = res.(i)<-(!r,!li)) f; (l1,res) -;; + (* exemples: @@ -215,13 +148,13 @@ let l = [1;2;6;24;720] and div1 = (fun a b -> if a mod b =0 then a/b else failwith "div") and constant = (fun x -> x<2) and zero = (fun x -> x=0) -;; + let f = facteurs_liste div1 constant l -;; + factorise_tableau div1 zero 0 (Array.of_list l) (Array.of_list f) -;; + *) diff --git a/contrib/groebner/utile.mli b/contrib/groebner/utile.mli index 927e6f433..209258dd6 100644 --- a/contrib/groebner/utile.mli +++ b/contrib/groebner/utile.mli @@ -6,19 +6,9 @@ val prt0 : 'a -> unit val prt : string -> unit val info : string -> unit -(* Array *) -val compte : 'a array -> 'a -> int -val maximum : int array -> int -val matrix_map : ('a -> 'b) -> 'a array array -> 'b array array -val array_select : ('a -> bool) -> 'a array -> 'a array -val array_test : ('a -> bool) -> 'a array -> bool -val array_find : 'a -> 'a array -> int - (* Listes *) -val set_of_list : 'a list -> 'a list val list_mem_eq : ('a -> 'b -> bool) -> 'a -> 'b list -> bool val set_of_list_eq : ('a -> 'a -> bool) -> 'a list -> 'a list -val list_select : ('a -> bool) -> 'a list -> 'a list (* Memoization *) val memo : -- cgit v1.2.3