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;;