X-Git-Url: https://svn.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/06159b51a934937f647ec7119b47cb466d8e50b1..d6a658d27ada22781784b8e5e47947589c052583:/interpretor/signal.ml?ds=inline diff --git a/interpretor/signal.ml b/interpretor/signal.ml index 3440adc..a32923e 100644 --- a/interpretor/signal.ml +++ b/interpretor/signal.ml @@ -1,339 +1,211 @@ (** Module: Signal - Description: type signal = rate * (int -> value), operations of signals. + Description: signal definition and operations. @author WANG Haisheng Created: 03/06/2013 Modified: 03/06/2013 *) open Types;; +open Basic;; open Value;; -(* EXCEPTIONS *) - -(** Exception raised in operations of signals.*) exception Signal_operation of string;; - - -(* MACRO *) - -(** Macro constants of the file.*) -type signal_macro = Delay_Memory_Length_int;; - - -(** val signal_macro_to_int : signal_macro -> int.*) -let signal_macro_to_int m = match m with - |Delay_Memory_Length_int -> 10000;; - - -(* SIGNAL OPERATIONS *) - -(** val frequency : signal -> int, returns the frequency of a signal.*) -let frequency s = fst s;; - - -(** val signal_fun : signal -> (int -> value), returns the functional part of a signal.*) -let signal_fun s = snd s;; - - -(** val check_frequency : int -> int -> int, returns the correction of frequency.*) -let check_frequency = fun f1 -> fun f2 -> - if f1 = f2 || f2 = 0 then f1 - else if f1 = 0 then f2 - else raise (Signal_operation "frequency not matched.");; - -(** val signal_check_frequency : signal -> signal -> int, -checks the frequencies of two input signals, and returns common frequency or raise an exception.*) -let signal_check_frequency = fun s1 -> fun s2 -> - let f1 = frequency s1 in - let f2 = frequency s2 in - check_frequency f1 f2;; - - -(** val signal_check_frequency3 : signal -> signal -> signal -> int, -checks the frequencies of three input signal, and returns common frequency or raise an exception.*) -let signal_check_frequency3 = fun s1 -> fun s2 -> fun s3 -> - let f1 = signal_check_frequency s1 s2 in - let f2 = signal_check_frequency s1 s3 in - check_frequency f1 f2;; - - -(** val signal_check_frequency4 : signal -> signal -> signal -> signal -> int, -checks the frequencies of three input signal, and returns common frequency or raise an exception.*) -let signal_check_frequency4 = fun s1 -> fun s2 -> fun s3 -> fun s4 -> - let f1 = signal_check_frequency s1 s2 in - let f2 = signal_check_frequency s3 s4 in - check_frequency f1 f2;; - - -(** val signal_add_one_memory : signal -> signal, -returns the signal with memory of one latest sample.*) -let signal_add_one_memory = fun s -> - let new_signal = factory_add_memory (signal_fun s) 1 in - (frequency s, new_signal);; - - -(** val beam_add_one_memory : signal list -> signal list, -adds memory of one latest sample for each element in signal list.*) -let beam_add_one_memory = fun beam -> - List.map signal_add_one_memory beam;; - - -(** val signal_add : signal -> signal -> signal, output(t) = input1(t) + input2(t), - frequency consistent.*) -let signal_add s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> ((signal_fun s1) t) +~ ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_neg : signal -> signal, output(t) = -input(t), frequency consistent.*) -let signal_neg s = - let new_signal = fun t -> v_neg ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_sub : signal -> signal -> signal, output(t) = input1(t) - input2(t), - frequency consistent.*) -let signal_sub s1 s2 = signal_add s1 (signal_neg s2);; - - -(** val signal_mul : signal -> signal -> signal, output(t) = input1(t) * input2(t), - frequency consistent.*) -let signal_mul s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> ((signal_fun s1) t) *~ ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_div : signal -> signal -> signal, output(t) = input1(t) / input2(t), - frequency consistent.*) -let signal_div s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> ((signal_fun s1) t) /~ ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_delay : signal -> signal -> signal, output(t) = input1(t - input2(t)), - Attention: delay dynamic, frequency of output signal equals to that of first input signal.*) -let signal_delay s1 s2 = - let s1_mem = factory_add_memory (signal_fun s1) - (signal_macro_to_int Delay_Memory_Length_int) in - let new_signal = fun t -> - let delay = (signal_fun s2) t in - match delay with - |N i -> if i < 0 then raise (Signal_operation "Delay time < 0.") - else if (t - i) >= 0 then s1_mem (t - i) - else v_zero (s1_mem 0) - |R f -> let i = int_of_float f in - if i < 0 then raise (Signal_operation "Delay time < 0.") - else if (t - i) >= 0 then s1_mem (t - i) - else v_zero (s1_mem 0) - |Vec (size, vec) -> raise (Signal_operation "Delay time can not be a vector.") - |Zero -> s1_mem t - |W -> raise (Signal_operation "Delay time error.") - in - (frequency s1, new_signal);; - - -(** val signal_mem : signal -> signal, equivalent to signal_delay with constant delay 1.*) -let signal_mem s = signal_delay s (1, (fun t -> N 1));; - - -(** val signal_vectorize : signal -> signal -> signal, output(t)(i) = input1(input2(0) * t + i), -Attention: vector size n static, frequency of output signal is (1/n * frequency of input1)*) -let signal_vectorize s1 s2 = - let size = (signal_fun s2) 0 in - match size with - |N size_int -> - ( - let new_signal = fun t -> - make_vector size_int (fun i -> (signal_fun s1) (size_int * t + i)) in - let new_frequency = (frequency s1) / size_int in - (new_frequency, new_signal) - ) - |_ -> raise (Signal_operation "Vectorize: vector size should be int.");; - - -(** val signal_serialize : signal -> signal, output(t) = input(floor(t/n))(t%n), - with n = size of input(0). - Attention: input size unknown in the cas of "rec".*) -let signal_serialize s = - let temp0 = (signal_fun s) 0 in - match temp0 with - |Vec (size0, vec0) -> - let new_signal = fun t -> - ( - let temp = (signal_fun s) (t/size0) in - match temp with - |Vec (size, vec) -> - if size = size0 then - vec (t mod size) - else - raise (Signal_operation "Serialize: vector length not consistent.") - |_ -> raise (Signal_operation "Serialize: signal type not consistent.") - ) - in - let new_frequency = (frequency s) * size0 in - (new_frequency, new_signal) - |_ -> raise (Signal_operation "Serialize: input signal should be vector.");; - - -(** val signal_append : signal -> signal -> signal, symbol "#", - appends vectors of the two input signals at each time, frequency consistent.*) -let signal_append s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> - let temp1 = (signal_fun s1) t in - let temp2 = (signal_fun s2) t in - match (temp1, temp2) with - |(Vec (size1, vec1), Vec (size2, vec2)) -> - let new_vec = fun i -> if i < size1 then vec1 i else vec2 (i - size1) in - make_vector (size1 + size2) new_vec - |_ -> raise (Signal_operation "Append: input signals should be vectors.") - in - (f, new_signal);; - - -(** val signal_nth : signal -> signal -> signal, symbol "[]", output(t) = input1(t)(input2(t)), - frequency consistent. Attention: selection index dynamic.*) -let signal_nth s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> - let temp1 = (signal_fun s1) t in - let temp2 = (signal_fun s2) t in - match temp1 with - |Vec (size1, vec1) -> - ( - match temp2 with - |N i -> vec1 i - |R f -> - raise (Signal_operation "Get: second input signal should be int.") - |Vec (size2, vec2) -> - raise (Signal_operation "Get: second input signal should be int.") - |Zero -> vec1 0 - |W -> - raise (Signal_operation "Get: second input signal should be int.") - ) - |_ -> raise (Signal_operation "Get: first input signal should be vector.") - in - (f, new_signal);; - - -(** val signal_floor : signal -> signal, output(t) = v_floor(input(t)), frequency consistent.*) -let signal_floor s = - let new_signal = fun t -> v_floor ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_int : signal -> signal, output(t) = v_int(input(t)), frequency consistent.*) -let signal_int s = - let new_signal = fun t -> v_int ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_sin : signal -> signal, output(t) = v_sin(input(t)), frequency consistent.*) -let signal_sin s = - let new_signal = fun t -> v_sin ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_cos : signal -> signal, output(t) = v_cos(input(t)), frequency consistent.*) -let signal_cos s = - let new_signal = fun t -> v_cos ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_atan : signal -> signal, output(t) = v_atan(input(t)), frequency consistent.*) -let signal_atan s = - let new_signal = fun t -> v_atan ((signal_fun s) t) in - (frequency s, new_signal);; - - -let signal_atantwo s1 s2 = - let new_signal = fun t -> v_atantwo ((signal_fun s1) t) ((signal_fun s2) t) in - (frequency s1, new_signal);; - - -(** val signal_sqrt : signal -> signal, output(t) = v_sqrt(input(t)), frequency consistent.*) -let signal_sqrt s = - let new_signal = fun t -> v_sqrt ((signal_fun s) t) in - (frequency s, new_signal);; - - -(** val signal_rdtable : signal -> signal -> signal, - output(t) = input1(input2(t)), frequency equals to that of input2. - Attention: no memory implemented, very expensive when input1 comes from rec or delays.*) -let signal_rdtable s0 s1 s2 = - let memory_length_int = take_off_N ((signal_fun s0) 0) in - let s1_mem = factory_add_memory (signal_fun s1) memory_length_int in - let new_signal = fun t -> - let index = (signal_fun s2) t in - match index with - |N i -> s1_mem i - |R f -> raise (Signal_operation "Rdtable index cannot be float.") - |Vec (size, vec) -> raise (Signal_operation "Rdtable index cannot be vector.") - |Zero -> s1_mem 0 - |W -> raise (Signal_operation "Rdtable index cannot be Error.") - in - (frequency s2, new_signal);; - - -(** val signal_mod : signal -> signal -> signal, - output(t) = input1(t) % input2(t), frequency consistent.*) -let signal_mod s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> v_mod ((signal_fun s1) t) ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_sup : signal -> signal -> signal, - output(t) = input1(t) > input2(t), frequency consistent.*) -let signal_sup s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> v_sup ((signal_fun s1) t) ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_inf : signal -> signal -> signal, - output(t) = input1(t) < input2(t), frequency consistent.*) -let signal_inf s1 s2 = - let f = signal_check_frequency s1 s2 in - let new_signal = fun t -> v_inf ((signal_fun s1) t) ((signal_fun s2) t) in - (f, new_signal);; - - -(** val signal_select2 : signal -> signal -> signal -> signal, -[signal_select2 si s0 s1] selects s0 or s1 by index si, frequency consistent.*) -let signal_select2 si s0 s1 = - let f = signal_check_frequency3 si s0 s1 in - let new_signal = fun t -> - if (signal_fun si) t = N 0 then (signal_fun s0) t - else if (signal_fun si) t = N 1 then (signal_fun s1) t - else raise (Signal_operation "select2 index should be 0 or 1.") - in - (f, new_signal);; - - -(** val signal_select3 : signal -> signal -> signal -> signal -> signal, -[signal_select3 si s0 s1 s2] selects s0 or s1 or s2 by index si, frequency consistent.*) -let signal_select3 si s0 s1 s2 = - let f = signal_check_frequency4 si s0 s1 s2 in - let new_signal = fun t -> - if (signal_fun si) t = N 0 then (signal_fun s0) t - else if (signal_fun si) t = N 1 then (signal_fun s1) t - else if (signal_fun si) t = N 2 then (signal_fun s2) t - else raise (Signal_operation "select3 index should be 0 or 1 or 2.") - in - (f, new_signal);; - - -(** val signal_prefix : signal -> signal -> signal, -[signal_prefix s0 s1] returns s0(0) if t = 0, s1(t-1) if t > 0, frequency same to s1.*) -let signal_prefix = fun s0 -> fun s1 -> - let new_signal = fun t -> - if t = 0 then (signal_fun s0) 0 - else if t > 0 then (signal_fun s1) t - else raise (Signal_operation "prefix time cannot be < 0.") - in - (frequency s1, new_signal);; +let delay_memory_length = 10000;; + +class signal : int -> (time -> value_type) -> signal_type = + fun (freq_init : int) -> + fun (func_init : time -> value_type) -> + object (self) + val mutable signal_func = func_init + val mutable memory_length = 0 + method frequency = freq_init + method at = signal_func + + method private check_freq : signal_type list -> int = + fun (sl : signal_type list) -> + let check : int -> signal_type -> int = + fun (f : int) -> + fun (s : signal_type) -> + if f = s#frequency || s#frequency = 0 then f + else if f = 0 then s#frequency + else raise (Signal_operation "frequency not matched.") in + List.fold_left check self#frequency sl + + method add_memory : int -> unit = + fun (length : int) -> + assert (length >= 0); + if memory_length >= length then () + else + let memory = Hashtbl.create length in + let func : time -> value = + fun (t : time) -> + try Hashtbl.find memory t + with Not_found -> + let result = func_init t in + let () = Hashtbl.replace memory t result in + let () = + if (t - length) >= 0 then + Hashtbl.remove memory (t - length) + else () in + result in + memory_length <- length; + signal_func <- func + + method private delay_by : int -> time -> value = + fun i -> fun t -> + if (t - i) >= 0 then + self#at (t - i) + else if t >= 0 && (t - i) < 0 then + (self#at 0)#zero + else raise (Signal_operation "Delay time < 0.") + + method private prim1 : + (time -> value_type) -> signal_type = + fun (func : time -> value_type) -> + let freq = self#frequency in + new signal freq func + + method private prim2 : + (time -> value_type -> value_type) -> signal_type -> signal_type = + fun (func_binary : time -> value_type -> value_type) -> + fun (s : signal_type) -> + let freq = self#check_freq [s] in + let func = fun t -> (func_binary t) (s#at t) in + new signal freq func + + method neg = self#prim1 (fun t -> (self#at t)#neg) + method floor = self#prim1 (fun t -> (self#at t)#floor) + method sin = self#prim1 (fun t -> (self#at t)#sin) + method cos = self#prim1 (fun t -> (self#at t)#cos) + method atan = self#prim1 (fun t -> (self#at t)#atan) + method sqrt = self#prim1 (fun t -> (self#at t)#sqrt) + method int = self#prim1 (fun t -> (self#at t)#int) + + method add = self#prim2 (fun t -> (self#at t)#add) + method sub = self#prim2 (fun t -> (self#at t)#sub) + method mul = self#prim2 (fun t -> (self#at t)#mul) + method div = self#prim2 (fun t -> (self#at t)#div) + method atan2 = self#prim2 (fun t -> (self#at t)#atan2) + method _mod = self#prim2 (fun t -> (self#at t)#_mod) + method larger = self#prim2 (fun t -> (self#at t)#larger) + method smaller = self#prim2 (fun t -> (self#at t)#smaller) + method max = self#prim2 (fun t -> (self#at t)#max) + method min = self#prim2 (fun t -> (self#at t)#min) + + method delay : signal_type -> signal_type = + fun (s : signal_type) -> + let freq = self#check_freq [s] in + let () = self#add_memory delay_memory_length in + let func : time -> value_type = + fun (t : time) -> + let i = (s#at t)#to_int in + self#delay_by i t in + new signal freq func + + method mem : signal_type = + let freq = self#frequency in + let () = self#add_memory 1 in + let func = fun (t : time) -> self#delay_by 1 t in + new signal freq func + + method rdtable : signal_type -> signal_type -> signal_type = + fun (s_size : signal_type) -> + fun (s_index : signal_type) -> + let freq = self#check_freq [s_index] in + let () = self#add_memory ((s_size#at 0)#to_int) in + let func : time -> value_type = fun t -> + self#at ((s_index#at t)#to_int) in + new signal freq func + + method select2 : signal_type -> signal_type -> signal_type = + fun s_first -> + fun s_second -> + let freq = self#check_freq [s_first; s_second] in + let func : time -> value_type = + fun t -> let i = (self#at t)#to_int in + if i = 0 then s_first#at t + else if i = 1 then s_second#at t + else raise (Signal_operation "select2 index 0|1.") in + new signal freq func + + method select3 : + signal_type -> signal_type -> signal_type -> signal_type = + fun s_first -> fun s_second -> fun s_third -> + let freq = self#check_freq [s_first; s_second; s_third] in + let func : time -> value_type = + fun t -> let i = (self#at t)#to_int in + if i = 0 then s_first#at t + else if i = 1 then s_second#at t + else if i = 2 then s_third#at t + else raise (Signal_operation "select2 index 0|1.") in + new signal freq func + + method prefix : signal_type -> signal_type = + fun (s_init : signal_type) -> + let () = self#add_memory 1 in + let func : time -> value_type = + fun t -> + if t = 0 then s_init#at 0 + else if t > 0 then self#at (t - 1) + else raise (Signal_operation "prefix time < 0.") in + new signal self#frequency func + + + method vectorize : signal_type -> signal_type = + fun s_size -> + let size = (s_size#at 0)#to_int in + if size <= 0 then + raise (Signal_operation "Vectorize: size <= 0.") + else + let freq = self#frequency / size in + let func : time -> value_type = + fun t -> + let vec = fun i -> (self#at (size * t + i))#get in + new value (Vec (new vector size vec)) in + new signal freq func + + + method serialize : signal_type = + let size = + match (self#at 0)#get with + | Vec vec -> vec#size + | _ -> raise (Signal_operation "Serialize: scalar input.") in + let freq = self#frequency * size in + let func : time -> value_type = + fun t -> + match (self#at (t/size))#get with + | Vec vec -> new value (vec#nth (t mod size)) + | _ -> raise (Signal_operation + "Serialize: signal type not consistent.") in + new signal freq func + + method vconcat : signal_type -> signal_type = + fun s -> + let freq = self#check_freq [s] in + let func : time -> value_type = + fun t -> + match ((self#at t)#get, (s#at t)#get) with + | (Vec vec1, Vec vec2) -> + let size1 = vec1#size in + let size2 = vec2#size in + let size = size1 + size2 in + let vec = fun i -> + if i < size1 then vec1#nth i + else vec2#nth (i - size1) in + new value (Vec (new vector size vec)) + | _ -> raise (Signal_operation "Vconcat: scalar.") in + new signal freq func + + method vpick : signal_type -> signal_type = + fun s_index -> + let freq = self#check_freq [s_index] in + let func : time -> value_type = + fun t -> + let i = (s_index#at t)#to_int in + match (self#at t)#get with + | Vec vec -> new value (vec#nth i) + | _ -> raise (Signal_operation "Vpick: scalar.") in + new signal freq func + + end;;