SF.ml

(* Copyright INRIA and Microsoft Corporation, 2008-2013. *)
(* DDMF is distributed under CeCILL-B license. *)

INCLUDE "preamble.ml"

exception UndefinedFunction of string
exception UndefinedInitialCondition
exception WrongNumberOfParameters

type arg_type = Diff | Param

type singularity_type = RegOrOrd | Irreg

type monomial = {
  x_expon : any maple ;
  ln_expon : any maple ;
  coeff : any maple ;
}

type expansion = {
  sing_type : singularity_type ;
  prefactor : any maple ;
  transf : any maple ;
  monomials : monomial list ;
}

type initial_condition = {
  point : any maple ;
  analytic : bool ;
  expansions : expansion list ;
}

type t = {
  (* Names of the variables and parameters and their types (Diff, Param). *)
  names_and_types : (name maple * arg_type) list ;
  (* Maple object like AiryAi(x) or exp(x). *)
  rep : any maple ;
  (* like "Airy function of the first kind" or "exponential". *)
  full_name : string ;
  (* LODE as a Maple expression. *)
  lode : diffeq maple ;
  (* List of pairs (cond, ic_list), where cond encodes some conditions on *)
  (* the parameters, and ic_list is a list of initial_condition records *)
  (* (one for each point) that are valid if cond is true. *)
  ics : (any maple * (initial_condition list)) list ;
  (* id of the corresponding differential equation. *)
  ode_id : string ;
}

let get_initial_conditions sf point =
  if List.length sf.ics != 1 then raise UndefinedInitialCondition;
  let rec search = function
    | h :: q -> if <:bool< $(h.point) = $(point) >> then h else search q
    | [] -> raise UndefinedInitialCondition in
  search (snd (List.hd sf.ics))

let var_of_t sf =
  let nats = sf.names_and_types in
  let vars = List.filter (fun (_, t) -> t = Diff) nats in
  (* FIXME: Raise a better error than this failwith. *)
  if List.length vars != 1 then failwith ("SF.var_of_t: " ^ sf.full_name)
  else List.hd (List.map (fun (n, _) -> n) vars)

let params_of_t sf =
  let nats = sf.names_and_types in
  let params = List.filter (fun (_, t) -> t = Param) nats in
  List.map (fun (n, _) -> n) params

let instantiate_parameters sf values =
  let vals = CommonTools.parse_string_list values in
  let rec search = function
    | h :: q -> if <:bool< $(fst h)($(vals)) >> then snd h else search q
    | [] -> raise UndefinedInitialCondition in
  let ic_list = search sf.ics in
  let params = params_of_t sf in
  if (List.length values) != (List.length params) then
    raise WrongNumberOfParameters;
  let eval expr = CommonTools.eval_expr expr params values in
  let eval_monomial m =
    {x_expon = eval m.x_expon ;
     ln_expon = eval m.ln_expon ;
     coeff = eval m.coeff ; } in
  let eval_expansion e =
    {e with
     prefactor = eval e.prefactor ;
     transf = eval e.transf ;
     monomials = List.map eval_monomial e.monomials ; } in
  let eval_ic i =
    {i with
     point = eval i.point ;
     expansions = List.map eval_expansion i.expansions ; } in
  {sf with
   rep = eval sf.rep ;
   lode = eval sf.lode ;
   ics = [ << a -> true >> , List.map eval_ic ic_list ] ; }


(* TODO: Are those string_of_* dead code? *)

let string_of_monomial = fun { x_expon = e_x ; ln_expon = e_ln ; coeff = c } ->
  <:string< sprintf("{ x_expon = \<\:symb< %a \>\> ; \
                     ln_expon = \<\:symb< %a \>\> ; \
                     coeff = \<\:symb< %a \>\> ; }", $(e_x), $(e_ln), $(c)) >>

let string_of_monomial_list l =
  (List.fold_left (fun s m -> s ^ string_of_monomial m ^ " ; ") "[ " l) ^ "]"

let string_of_expansion =
  fun { sing_type = _ ; prefactor = pf ; transf = tr ; monomials = ml } ->
    let s_ml = string_of_monomial_list ml in
    <:string<
      sprintf("{ prefactor = \<\:symb< %a \>\> ; transf = \<\:symb< %a \>\> ;
        monomials = %s ; }", $(pf), $(tr), $(str:s_ml)) >>

let string_of_expansion_list l =
  (List.fold_left (fun s e -> s ^ string_of_expansion e ^ " ; ") "[ " l) ^ "]"

let string_of_initial_condition =
  fun { point = p ; analytic = a ; expansions = el } ->
    let s_a = string_of_bool a and s_el = string_of_expansion_list el in
    <:string<
      sprintf("{ point = \<\:symb< %a \>\> ; analytic = %s ; \
               expansions = %s ; }", $(p), $(str:s_a), $(str:s_el)) >>

Generated by GNU Enscript 1.6.5.90.