Commit 2be0f3dc authored by Benoit Barbot's avatar Benoit Barbot
Browse files

tidying up

parent 1d0d5bfc
Pipeline #1679 passed with stages
in 49 seconds
......@@ -50,7 +50,6 @@ module type WeightStructure = sig
val fully_apply_float : ?smp:float -> t -> var -> float -> float
val taylor_exp_s: t -> int -> t
val dominating_s : t -> (int * int* F.t) * (int * int* F.t)
end
type 'a transChoice = Label of 'a | Rand of float | Fixed
......@@ -71,6 +70,8 @@ sig
?max_iter:int ->
?bound:float * float -> P.t -> ?diffp:P.t -> P.var -> float -> float
val compute_s : float -> P.t array -> (P.t,Bt.t) ZoneGraph.t ->
(float * (float * float * float) * float, float * float * float) result
type state = Bt.state (*= int * float array*)
val get_loc : state -> int
......@@ -178,6 +179,62 @@ module Make (Bt: ZoneGraphInput.BoundType) (P: WeightStructure) = struct
r
let comp_exp target s (f,df,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)
| _ -> failwith "fail to evaluate"
let comp_lim (cl,dl,vl) (dcl,ddl,dvl) =
if dcl - cl < 0 then F.zero
else if dcl -cl = 0 then (
if ddl - dl < 0 then F.zero
else if ddl-dl = 0 then F.sub F.zero (F.div dvl vl)
else F.infinity
) else F.infinity
let compute_s expected_duration weights rg =
let svar = var_of_int (nb_var-1) in
(* Weight in initial location *)
let w = weights.(rg.init) in
let dw = diff w svar in
let ddw = diff dw svar in
(* 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
let liminf = F.to_float @@ comp_lim low_w low_dw in
let limsup = F.to_float @@ comp_lim high_w high_dw in
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
let svar = var_of_int (P.nb_var-1) in
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
let dde = taylor_exp_s ddw (rg.nb_poly+2) in
let w0 = apply_const ~smp:s we svar (F.of_float s) in
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 w,dw,ddw in
comp_exp expected_duration s calc in
(* computing limit for s -> 0 *)
let exp0,_ = compv 0.0 in
let range = limsup,exp0 +. expected_duration, liminf in
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 v,_ = compv x in
Ok (x,range,v+. expected_duration )
)
(* State instantiation for simulation
!! first element of the array is the first clock not the var 0 *)
type state = int* float array
......
......@@ -46,7 +46,8 @@ sig
?factor:float ->
?max_iter:int ->
?bound:float * float -> P.t -> ?diffp:P.t -> P.var -> float -> float
val compute_s : float -> P.t array -> (P.t,Bt.t) ZoneGraph.t ->
(float * (float * float * float) * float, float * float *float) result
type state = int * float array
val get_loc : state -> int
......
......@@ -98,7 +98,7 @@ let _ =
!npoly; flush stdout;
print_flush ()
);
let rgp = FunIt.iterate_functionnal ~update:(fun () ->printf "|"; print_flush ())
let rgp = FunIt.iterate_functionnal ~update:(fun () ->if !verbose >0 then (printf "|"; print_flush ()))
rg !npoly in
if !verbose>0 then printf "] [%.2fs]@." (check_time ());
rgp
......@@ -114,20 +114,6 @@ let _ =
ZoneGraph.print_dot rgpoly Bound.print (Format.formatter_of_out_channel fdot);
close_out fdot
end;
let comp_exp target s (f,df,ddf) =
match Weight.to_float ~smp:s f ,Weight.to_float ~smp:s df, Weight.to_float ~smp:s ddf with
Some v,Some dv,Some ddv -> -. dv /. v -.target , -.ddv /. v +. dv*.dv /. (v*.v)
| _ -> failwith "fail to evaluate" in
let comp_lim (cl,dl,vl) (dcl,ddl,dvl) =
if dcl - cl < 0 then Weight.F.zero
else if dcl -cl = 0 then (
if ddl - dl < 0 then Weight.F.zero
else if ddl-dl = 0 then Weight.F.sub Weight.F.zero (Weight.F.div dvl vl)
else Weight.F.infinity
) else Weight.F.infinity in
(* Compute s from expected_duration *)
let smp = match !expected_duration with
......@@ -137,50 +123,17 @@ let _ =
printf "Computing laplace parameter s for E[T]=%g " target; flush stdout;
print_flush ();
);
let svar = Weight.var_of_int (Weight.nb_var-1) in
(* Weight in initial location *)
let w = weights.(rgpoly.init) in
let dw = Weight.diff w svar in
let ddw = Weight.diff dw svar in
(* computing limit for s -> -infty and s -> + infty *)
let low_w,high_w = Weight.dominating_s w in
let low_dw,high_dw = Weight.dominating_s dw in
let liminf = Weight.F.to_float @@ comp_lim low_w low_dw in
let limsup = Weight.F.to_float @@ comp_lim high_w high_dw in
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
let svar = Weight.var_of_int (P.nb_var-1) in
let we = Weight.taylor_exp_s w (!npoly) in
(*Format.printf "vte: %a@." P.print we;*)
let de = Weight.taylor_exp_s dw (!npoly+1) in
let dde = Weight.taylor_exp_s ddw (!npoly+2) in
let w0 = Weight.apply_const ~smp:s we svar (Weight.F.of_float s) in
let d0 = Weight.apply_const ~smp:s de svar (Weight.F.of_float s) in
let dd0 = Weight.apply_const ~smp:s dde svar (Weight.F.of_float s) in
w0,d0,dd0
else w,dw,ddw in
comp_exp target s calc in
(* computing limit for s -> 0 *)
let exp0,_ = compv 0.0 in
if !verbose>0 then (
printf "range:[%g; %g; %g] " limsup (exp0+.target) liminf;
print_flush ()
);
if target > liminf || target < limsup then (
printf "@.Target outside range, aborting@.";
exit 1
);
let x = Common.newton_raphson_iterate ~max_iter:100 compv (1.0) in
let v,_ = compv x in
if !verbose>0 then printf "-> s=%g;E[T]=%g [%.2fs]@." x (v+.target) (check_time ());
Some x
match FunIt.compute_s target weights rgpoly with
Error (low,mid,up) ->
printf "range:[%g; %g; %g]@." low mid up;
printf "Target outside range, aborting@.";
exit 1
| Ok ( x, (low,mid,up), nt) ->
if !verbose>0 then (
printf "range:[%g; %g; %g]" low mid up;
printf " -> s=%g;E[T]=%g [%.2fs]@." x nt (check_time ());
);
Some x
in
let module M = MainLoop.Make(FunIt) (struct let smp=smp end) in
......
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