Commit 1e8430f9 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

progress

parent 8a9b0c86
Pipeline #1686 passed with stages
in 32 seconds
......@@ -30,7 +30,8 @@ let to_caml_arg = function
| Symbol s ->
let module S = (val s : SYM) in
Arg.Symbol (S.list, fun s -> S.content := S.of_string s)
type samplingMeth =
Exact
| Receding of int
......
......@@ -33,10 +33,12 @@ module type WeightStructure = sig
val var_of_int : int -> var
val int_of_var : var -> int
val zero : t
val var : ?exp:int -> var -> t
val const : fl -> t
val (+..) : t -> t -> t
val (-..) : t -> t -> t
val ( **.) : fl -> t -> t
val ( *..) : t -> t -> t
val vector_space : (t * (t -> t -> t) * (float -> t -> t))
val print : Format.formatter -> t -> unit
val apply_bound: t-> var -> bound -> t
......@@ -182,7 +184,10 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
let comp_exp target s (f,df,ddf) =
(*Format.printf "f: %a df: %a ddf:%a@." P.print f P.print f P.print ddf;*)
match to_float ~smp:s f ,to_float ~smp:s df, to_float ~smp:s ddf with
Some v,Some dv,Some ddv -> -. dv /. v -.target , -.ddv /. v +. dv*.dv /. (v*.v)
Some v,Some dv,Some ddv ->
(*Format.printf "s: %g v: %g dv: %g@." s v dv;
if abs_float v > 10e100 && abs_float dv > 10e100 then assert false;*)
-. dv /. v -.target , -.ddv /. v +. dv*.dv /. (v*.v)
| _ -> failwith "fail to evaluate"
let print_dom f (i,j,v) =
......@@ -211,8 +216,16 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
let w = weights.(rg.init) in
let dw = diff w svar in
let ddw = diff dw svar in
(*Format.printf "@.weight: %a@. dweight: %a@." P.print w P.print dw;*)
let svarexp = var ~exp:(rg.nb_poly+1) svar in
let wts = svarexp *.. w in
let dwts = svarexp *.. dw in
let ddwts = svarexp *.. ddw in
(*Format.printf "weight: %a dweight: %a@." P.print w P.print dw;*)
(*Format.printf "weight*s: %a@. dweight*s: %a@." P.print wts P.print dwts;*)
(* computing limit for s -> -infty and s -> + infty *)
let low_w,high_w = dominating_s w in
let low_dw,high_dw = dominating_s dw in
......@@ -222,8 +235,10 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
let compv s =
(*Format.printf "test s: %g@." s;*)
let calc =
(* When s close to 0 use a taylor expansion to compute the duration*)
if abs_float s <= 0.1 then
if abs_float s < 1.0 then
(* When s very close to 0 use a taylor expansion to compute the duration*)
if abs_float s <= 0.005 then
let we = taylor_exp_s w rg.nb_poly in
(*Format.printf "vte: %a@." P.print we;*)
let de = taylor_exp_s dw (rg.nb_poly+1) in
......@@ -242,6 +257,8 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
let d0 = apply_const ~smp:s de svar (F.of_float s) in
let dd0 = apply_const ~smp:s dde svar (F.of_float s) in
w0,d0,dd0
else
wts,dwts,ddwts
else w,dw,ddw in
comp_exp expected_duration s calc in
......@@ -252,7 +269,7 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
let range = limsup, Float.infinity , Float.infinity in
if expected_duration < limsup then Error range
else (
let x = Common.newton_raphson_iterate ~max_iter:100 compv (1.0) in
let x = Common.newton_raphson_iterate ~max_iter:1000 compv (1.0) in
let v,_ = compv x in
Ok (x,range,v+. expected_duration )
) else
......@@ -260,7 +277,7 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
if expected_duration >= liminf || expected_duration < limsup then (
Error range
) else (
let x = Common.newton_raphson_iterate ~max_iter:100 compv (1.0) in
let x = Common.newton_raphson_iterate ~max_iter:1000 compv (1.0) in
let v,_ = compv x in
Ok (x,range,v+. expected_duration )
)
......
......@@ -11,10 +11,12 @@ module type WeightStructure =
val var_of_int : int -> var
val int_of_var : var -> int
val zero : t
val var : ?exp:int -> var -> t
val const : fl -> t
val ( +.. ) : t -> t -> t
val ( -.. ) : t -> t -> t
val ( **. ) : fl -> t -> t
val ( *.. ) : t -> t -> t
val vector_space : t * (t -> t -> t) * (float -> t -> t)
val print : Format.formatter -> t -> unit
val apply_bound : t -> var -> Common.bound -> t
......
......@@ -40,6 +40,7 @@ module type S = sig
val (+..) : t -> t -> t
val (-..) : t -> t -> t
val ( **.) : fl -> t -> t
val ( *..) : t -> t -> t
val vector_space : (t * (t -> t -> t) * (float -> t -> t))
val const : fl -> t
val map_var : t -> (var -> var) -> t
......@@ -146,9 +147,31 @@ module Make (P:Polynome.S) (Param:sig val smp:float option val tvar:P.var val sv
let (-..) a b = add a (mult_scalar F.minus_one b)
let mult_poly v p =
Poly.fold (fun k v2 p2 ->
add_mon k (P.( *..) v v2) p2
)
p
Poly.empty
let ( *..) a b =
match Poly.choose_opt a with
Some ((Const 0),p) ->
assert (Poly.cardinal a=1);
Poly.fold (fun k2 v2 p2 -> Poly.add k2 (P.( *..) p v2) p2) b Poly.empty
| Some _ -> assert false
| None -> Poly.empty
let vector_space = (zero, (+..), fun x y -> (F.of_float x) **. y )
let map f p =
Poly.map f p
let var ?exp v =
let ex = P.var ?exp v in
Poly.singleton (Const 0) ex
let const x =
(* Const 0 means e-0 i.e. 1.0 *)
Poly.singleton (Const 0) (P.const x)
......@@ -157,7 +180,7 @@ module Make (P:Polynome.S) (Param:sig val smp:float option val tvar:P.var val sv
let ca,a = copy zero in
a.(var) <- p;
ca,a
*)
*)
let apply_ep ep f =
Poly.fold (fun k v acc ->
......@@ -178,9 +201,6 @@ module Make (P:Polynome.S) (Param:sig val smp:float option val tvar:P.var val sv
| Const _ -> add_mon k v2 acc
) ep Poly.empty
let map f p =
Poly.map f p
let s_poly = match Param.smp with
None -> P.var Param.svar
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment