interpretor/beam.ml

   1 (**
   2         Module: Beam
   3         Description: beam definition and operations
   4         @author WANG Haisheng
   5         Created: 21/07/2013     Modified: 21/07/2013
   6 *)
   7
   8 exception Beam_matching of string;;
   9
  10 open Types;;
  11 open Basic;;
  12 open Value;;
  13 open Signal;;
  14
  15 class beam : signal_type array -> beam_type =
  16   fun (signals_init : signal_type array) ->
  17     object (self)
  18       val signals = signals_init
  19
  20       method get = signals
  21       method width = Array.length signals
  22
  23       method sub : int -> int -> beam_type =
  24         fun start ->
  25           fun len ->
  26             new beam (Array.sub self#get start len)
  27
  28       method cut : int -> beam_type * beam_type =
  29         fun (cut_width : int)->
  30           ((self#sub 0 cut_width),(self#sub cut_width (self#width - cut_width)))
  31
  32       method append : beam_type -> beam_type =
  33         fun (b : beam_type) ->
  34           new beam (Array.append self#get b#get)
  35
  36       method private add_memory : int -> unit =
  37         fun (window : int) ->
  38           let signal_add_memory : int -> signal_type -> unit =
  39             fun (l : int) ->
  40               fun (s : signal) ->
  41                 s#add_memory l in
  42           let _ = Array.map (signal_add_memory window) self#get in ()
  43
  44       method matching : int -> beam_type =
  45           fun size ->
  46             if size = self#width then new beam self#get
  47
  48             else if (size > self#width) && (size mod self#width = 0) then
  49               let () = self#add_memory 1 in
  50               let split_signals =
  51                 Array.concat (Array.to_list
  52                      (Array.make (size/self#width) self#get)) in
  53               new beam split_signals
  54
  55             else if (size < self#width) && (self#width mod size = 0) then
  56               let rec merge_rec  =
  57                 fun (sa : signal_type array) ->
  58                   fun (l : int) ->
  59                     fun (i : int) ->
  60                       if i + l < Array.length sa then
  61                         (sa.(i))#add (merge_rec sa l (i + l))
  62                       else sa.(i) in
  63               let merge_signals = Array.init size (merge_rec self#get size) in
  64               new beam merge_signals
  65
  66             else raise (Beam_matching "matching size error")
  67
  68       method at : time -> value_type array =
  69         fun t ->
  70           let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
  71           Array.map (signal_at t) self#get
  72
  73       method output : int -> float array array array =
  74           fun (length_max : int) ->
  75             let () = print_string("    Faustine -> Calculating...") in
  76             let tic = Sys.time () in
  77
  78             let transpose : 'a array array -> 'a array array =
  79               fun matrix ->
  80                 let get_element = fun i -> fun array -> array.(i) in
  81                 let get_column = fun m -> fun i -> Array.map (get_element i) m in
  82                 Array.init self#width (get_column matrix) in
  83             let value2float = fun (v : value_type) -> v#to_float_array in
  84             let init = [|0.|] in
  85             let container = Array.make length_max
  86                 (Array.make self#width init) in
  87             let index = ref 0 in
  88
  89             try
  90               while !index < length_max do
  91                 container.(!index) <- Array.map value2float (self#at !index);
  92                 incr index;
  93               done;
  94               let result = transpose container in
  95               let toc = Sys.time () in
  96               let () = print_endline (" Done. (duration: " ^ (string_of_float (toc -. tic)) ^ "s.)") in
  97               result
  98
  99             with x ->
 100               let error_message =
 101                 match x with
 102                 | Convert_Error s -> "Convert_Error: " ^ s
 103                 | Basic_operation s -> "Basic_operation: " ^ s
 104                 | Signal_operation s -> "Signal_operation: " ^ s
 105                 | Beam_matching s -> "Beam_Matching_Error: " ^ s
 106                 | Invalid_argument s -> ""
 107                 | _ -> "Unknown error"
 108               in
 109               let () = print_string (error_message) in
 110               let result = transpose (Array.sub container 0 !index) in
 111               let toc = Sys.time () in
 112               let () = print_endline (" Done. (duration: " ^ (string_of_float (toc -. tic)) ^ "s.)") in
 113               result
 114
 115       method frequency : int array =
 116         let each_rate : signal -> int =
 117           fun (s : signal) ->
 118             let rate = s#frequency in
 119             if rate > 0 then rate
 120             else if rate = 0 then 44100
 121             else raise (Beam_matching "frequency error.") in
 122         Array.map each_rate self#get
 123
 124     end