-
-
-(* 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 rate : int -> int -> rate_type =
+ fun (num_init : int) ->
+ fun (denom_init : int) ->
+ let rec pgcd : int -> int -> int =
+ fun i1 -> fun i2 ->
+ let r = i1 mod i2 in
+ if r = 0 then i2 else pgcd i2 r in
+ let num_positive =
+ if num_init >= 0 then num_init
+ else (-num_init) in
+ let denom_positive =
+ if denom_init > 0 then denom_init
+ else if denom_init < 0 then -denom_init
+ else raise (Signal_operation "sample rate denominater = 0.") in
+ let factor = pgcd num_positive denom_positive in
+ let num_corrected = num_init / factor in
+ let denom_corrected = denom_init / factor in
+ object (self)
+ val _num = num_corrected
+ val _denom = denom_corrected
+ method num = _num
+ method denom = _denom
+ method to_int =
+ self#num / self#denom
+ method to_float =
+ (float_of_int self#num) /. (float_of_int self#denom)
+ method to_string =
+ (string_of_int self#num) ^ "/" ^ (string_of_int self#denom)
+ method equal : rate_type -> bool =
+ fun (r : rate_type) -> (self#num = r#num) && (self#denom = r#denom)
+ method mul : int -> rate_type =
+ fun (i : int) -> new rate (self#num * i) self#denom
+ method div : int -> rate_type =
+ fun (i : int) -> new rate self#num (self#denom * i)
+ end
+
+
+class signal : rate_type -> (time -> value_type) -> signal_type =
+ fun (freq_init : rate_type) ->
+ 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 -> rate_type =
+ fun (sl : signal_type list) ->
+ let check : rate_type -> signal_type -> rate_type =
+ fun (f : rate_type) ->
+ fun (s : signal_type) ->
+ if f#equal s#frequency || s#frequency#num = 0 then f
+ else if f#num = 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 ceil = self#prim1 (fun t -> (self#at t)#ceil)
+ method rint = self#prim1 (fun t -> (self#at t)#rint)
+ method sin = self#prim1 (fun t -> (self#at t)#sin)
+ method asin = self#prim1 (fun t -> (self#at t)#asin)
+ method cos = self#prim1 (fun t -> (self#at t)#cos)
+ method acos = self#prim1 (fun t -> (self#at t)#acos)
+ method tan = self#prim1 (fun t -> (self#at t)#tan)
+ method atan = self#prim1 (fun t -> (self#at t)#atan)
+ method exp = self#prim1 (fun t -> (self#at t)#exp)
+ method sqrt = self#prim1 (fun t -> (self#at t)#sqrt)
+ method ln = self#prim1 (fun t -> (self#at t)#ln)
+ method lg = self#prim1 (fun t -> (self#at t)#lg)
+ method int = self#prim1 (fun t -> (self#at t)#int)
+ method float = self#prim1 (fun t -> (self#at t)#float)
+ method abs = self#prim1 (fun t -> (self#at t)#abs)
+
+ 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 power = self#prim2 (fun t -> (self#at t)#power)
+ method _and = self#prim2 (fun t -> (self#at t)#_and)
+ method _or = self#prim2 (fun t -> (self#at t)#_or)
+ method _xor = self#prim2 (fun t -> (self#at t)#_xor)
+ method atan2 = self#prim2 (fun t -> (self#at t)#atan2)
+ method _mod = self#prim2 (fun t -> (self#at t)#_mod)
+ method fmod = self#prim2 (fun t -> (self#at t)#fmod)
+ method remainder = self#prim2 (fun t -> (self#at t)#remainder)
+ method gt = self#prim2 (fun t -> (self#at t)#gt)
+ method lt = self#prim2 (fun t -> (self#at t)#lt)
+ method geq = self#prim2 (fun t -> (self#at t)#geq)
+ method leq = self#prim2 (fun t -> (self#at t)#leq)
+ method eq = self#prim2 (fun t -> (self#at t)#eq)
+ method neq = self#prim2 (fun t -> (self#at t)#neq)
+ method max = self#prim2 (fun t -> (self#at t)#max)
+ method min = self#prim2 (fun t -> (self#at t)#min)
+ method shl = self#prim2 (fun t -> (self#at t)#shl)
+ method shr = self#prim2 (fun t -> (self#at t)#shr)
+
+ 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 rwtable : signal_type -> signal_type ->
+ signal_type -> signal_type -> signal_type =
+ fun init -> fun wstream -> fun windex -> fun rindex ->
+ let freq = self#check_freq [init; wstream; windex; rindex] in
+ let () = init#add_memory ((self#at 0)#to_int) in
+ let () = wstream#add_memory ((self#at 0)#to_int) in
+ let func : time -> value_type = fun (ti : time) ->
+ let rec table : time -> index -> value_type =
+ fun t -> fun i ->
+ if t > 0 then
+ (if i = (windex#at t)#to_int then (wstream#at t)
+ else table (t - 1) i)
+ else if t = 0 then
+ (if i = (windex#at 0)#to_int then (wstream#at 0)
+ else init#at i)
+ else raise (Signal_operation "signal time should be > 0") in
+ table ti ((rindex#at ti)#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#div 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#mul 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;;
projects / Faustine.git / blobdiff