Pretty printing of main.ml.
[Faustine.git] / 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