interpretor/signal.ml

   1 (**
   2         Module: Signal
   3         Description: type signal = rate * (int -> value), operations of signals.
   4         @author WANG Haisheng
   5         Created: 03/06/2013     Modified: 03/06/2013
   6 *)
   7
   8 open Types;;
   9 open Value;;
  10
  11 (* EXCEPTIONS *)
  12
  13 (** Exception raised in operations of signals.*)
  14 exception Signal_operation of string;;
  15
  16
  17
  18 (* MACRO *)
  19
  20 (** Macro constants of the file.*)
  21 type signal_macro = Delay_Memory_Length_int;;
  22
  23
  24 (** val signal_macro_to_int : signal_macro -> int.*)
  25 let signal_macro_to_int m = match m with
  26                                  |Delay_Memory_Length_int -> 10000;;
  27
  28
  29 (* SIGNAL OPERATIONS *)
  30
  31 (** val frequency : signal -> int, returns the frequency of a signal.*)
  32 let frequency s = fst s;;
  33
  34
  35 (** val signal_fun : signal -> (int -> value), returns the functional part of a signal.*)
  36 let signal_fun s = snd s;;
  37
  38
  39 (** val check_frequency : int -> int -> int, returns the correction of frequency.*)
  40 let check_frequency = fun f1 -> fun f2 ->
  41         if f1 = f2 || f2 = 0 then f1
  42         else if f1 = 0 then f2
  43         else raise (Signal_operation "frequency not matched.");;
  44
  45 (** val signal_check_frequency : signal -> signal -> int,
  46 checks the frequencies of two input signals, and returns common frequency or raise an exception.*)
  47 let signal_check_frequency = fun s1 -> fun s2 ->
  48         let f1 = frequency s1 in
  49         let f2 = frequency s2 in
  50         check_frequency f1 f2;;
  51
  52
  53 (** val signal_check_frequency3 : signal -> signal -> signal -> int,
  54 checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
  55 let signal_check_frequency3 = fun s1 -> fun s2 -> fun s3 ->
  56         let f1 = signal_check_frequency s1 s2 in
  57         let f2 = signal_check_frequency s1 s3 in
  58         check_frequency f1 f2;;
  59
  60
  61 (** val signal_check_frequency4 : signal -> signal -> signal -> signal -> int,
  62 checks the frequencies of three input signal, and returns common frequency or raise an exception.*)
  63 let signal_check_frequency4 = fun s1 -> fun s2 -> fun s3 -> fun s4 ->
  64         let f1 = signal_check_frequency s1 s2 in
  65         let f2 = signal_check_frequency s3 s4 in
  66         check_frequency f1 f2;;
  67
  68
  69 (** val signal_add_one_memory : signal -> signal,
  70 returns the signal with memory of one latest sample.*)
  71 let signal_add_one_memory = fun s ->
  72         let new_signal = factory_add_memory (signal_fun s) 1 in
  73             (frequency s, new_signal);;
  74
  75
  76 (** val beam_add_one_memory : signal list -> signal list,
  77 adds memory of one latest sample for each element in signal list.*)
  78 let beam_add_one_memory = fun beam ->
  79         List.map signal_add_one_memory beam;;
  80
  81
  82 (** val signal_add : signal -> signal -> signal, output(t) = input1(t) + input2(t),
  83     frequency consistent.*)
  84 let signal_add s1 s2 =
  85         let f = signal_check_frequency s1 s2 in
  86         let new_signal = fun t -> ((signal_fun s1) t) +~ ((signal_fun s2) t) in
  87         (f, new_signal);;
  88
  89
  90 (** val signal_neg : signal -> signal, output(t) = -input(t), frequency consistent.*)
  91 let signal_neg s =
  92         let new_signal = fun t -> v_neg ((signal_fun s) t) in
  93         (frequency s, new_signal);;
  94
  95
  96 (** val signal_sub : signal -> signal -> signal, output(t) = input1(t) - input2(t),
  97     frequency consistent.*)
  98 let signal_sub s1 s2 = signal_add s1 (signal_neg s2);;
  99
 100
 101 (** val signal_mul : signal -> signal -> signal, output(t) = input1(t) * input2(t),
 102     frequency consistent.*)
 103 let signal_mul s1 s2 =
 104         let f = signal_check_frequency s1 s2 in
 105         let new_signal = fun t -> ((signal_fun s1) t) *~ ((signal_fun s2) t) in
 106         (f, new_signal);;
 107
 108
 109 (** val signal_div : signal -> signal -> signal, output(t) = input1(t) / input2(t),
 110     frequency consistent.*)
 111 let signal_div s1 s2 =
 112         let f = signal_check_frequency s1 s2 in
 113         let new_signal = fun t -> ((signal_fun s1) t) /~ ((signal_fun s2) t) in
 114         (f, new_signal);;
 115
 116
 117 (** val signal_delay : signal -> signal -> signal, output(t) = input1(t - input2(t)),
 118     Attention: delay dynamic, frequency of output signal equals to that of first input signal.*)
 119 let signal_delay s1 s2 =
 120         let s1_mem = factory_add_memory (signal_fun s1)
 121             (signal_macro_to_int Delay_Memory_Length_int) in
 122         let new_signal = fun t ->
 123         let delay = (signal_fun s2) t in
 124                 match delay with
 125                 |N i -> if i < 0 then raise (Signal_operation "Delay time < 0.")
 126                                 else if (t - i) >= 0 then s1_mem (t - i)
 127                                 else v_zero (s1_mem 0)
 128                 |R f -> let i = int_of_float f in
 129                                 if i < 0 then raise (Signal_operation "Delay time < 0.")
 130                                 else if (t - i) >= 0 then s1_mem (t - i)
 131                                 else v_zero (s1_mem 0)
 132                 |Vec (size, vec) -> raise (Signal_operation "Delay time can not be a vector.")
 133                 |Zero -> s1_mem t
 134                 |W -> raise (Signal_operation "Delay time error.")
 135         in
 136         (frequency s1, new_signal);;
 137
 138
 139 (** val signal_mem : signal -> signal, equivalent to signal_delay with constant delay 1.*)
 140 let signal_mem s = signal_delay s (1, (fun t -> N 1));;
 141
 142
 143 (** val signal_vectorize : signal -> signal -> signal, output(t)(i) = input1(input2(0) * t + i),
 144 Attention: vector size n static, frequency of output signal is (1/n * frequency of input1)*)
 145 let signal_vectorize s1 s2 =
 146         let size = (signal_fun s2) 0 in
 147         match size with
 148         |N size_int ->
 149                 (
 150                         let new_signal = fun t ->
 151                           make_vector size_int (fun i -> (signal_fun s1) (size_int * t + i)) in
 152                         let new_frequency = (frequency s1) / size_int in
 153                         (new_frequency, new_signal)
 154                 )
 155         |_ -> raise (Signal_operation "Vectorize: vector size should be int.");;
 156
 157
 158 (** val signal_serialize : signal -> signal, output(t) = input(floor(t/n))(t%n),
 159     with n = size of input(0).
 160     Attention: input size unknown in the cas of "rec".*)
 161 let signal_serialize s =
 162         let temp0 = (signal_fun s) 0 in
 163         match temp0 with
 164         |Vec (size0, vec0) ->
 165             let new_signal = fun t ->
 166                 (
 167                         let temp = (signal_fun s) (t/size0) in
 168                         match temp with
 169                         |Vec (size, vec) ->
 170                                 if size = size0 then
 171                                   vec (t mod size)
 172                                 else
 173                                   raise (Signal_operation "Serialize: vector length not consistent.")
 174                         |_ -> raise (Signal_operation "Serialize: signal type not consistent.")
 175                 )
 176             in
 177             let new_frequency = (frequency s) * size0 in
 178             (new_frequency, new_signal)
 179         |_ -> raise (Signal_operation "Serialize: input signal should be vector.");;
 180
 181
 182 (** val signal_append : signal -> signal -> signal, symbol "#",
 183     appends vectors of the two input signals at each time, frequency consistent.*)
 184 let signal_append s1 s2 =
 185         let f = signal_check_frequency s1 s2 in
 186         let new_signal = fun t ->
 187                 let temp1 = (signal_fun s1) t in
 188                 let temp2 = (signal_fun s2) t in
 189                 match (temp1, temp2) with
 190                 |(Vec (size1, vec1), Vec (size2, vec2)) ->
 191                         let new_vec = fun i -> if i < size1 then vec1 i else vec2 (i - size1) in
 192                         make_vector (size1 + size2) new_vec
 193                 |_ -> raise (Signal_operation "Append: input signals should be vectors.")
 194         in
 195         (f, new_signal);;
 196
 197
 198 (** val signal_nth : signal -> signal -> signal, symbol "[]", output(t) = input1(t)(input2(t)),
 199     frequency consistent. Attention: selection index dynamic.*)
 200 let signal_nth s1 s2 =
 201         let f = signal_check_frequency s1 s2 in
 202         let new_signal = fun t ->
 203                 let temp1 = (signal_fun s1) t in
 204                 let temp2 = (signal_fun s2) t in
 205                 match temp1 with
 206                 |Vec (size1, vec1) ->
 207                 (
 208                         match temp2 with
 209                         |N i -> vec1 i
 210                         |R f ->
 211                             raise (Signal_operation "Get: second input signal should be int.")
 212                         |Vec (size2, vec2) ->
 213                             raise (Signal_operation "Get: second input signal should be int.")
 214                         |Zero -> vec1 0
 215                         |W ->
 216                             raise (Signal_operation "Get: second input signal should be int.")
 217                 )
 218                 |_ -> raise (Signal_operation "Get: first input signal should be vector.")
 219         in
 220         (f, new_signal);;
 221
 222
 223 (** val signal_floor : signal -> signal, output(t) = v_floor(input(t)), frequency consistent.*)
 224 let signal_floor s =
 225         let new_signal = fun t -> v_floor ((signal_fun s) t) in
 226         (frequency s, new_signal);;
 227
 228
 229 (** val signal_int : signal -> signal, output(t) = v_int(input(t)), frequency consistent.*)
 230 let signal_int s =
 231         let new_signal = fun t -> v_int ((signal_fun s) t) in
 232         (frequency s, new_signal);;
 233
 234
 235 (** val signal_sin : signal -> signal, output(t) = v_sin(input(t)), frequency consistent.*)
 236 let signal_sin s =
 237         let new_signal = fun t -> v_sin ((signal_fun s) t) in
 238         (frequency s, new_signal);;
 239
 240
 241 (** val signal_cos : signal -> signal, output(t) = v_cos(input(t)), frequency consistent.*)
 242 let signal_cos s =
 243         let new_signal = fun t -> v_cos ((signal_fun s) t) in
 244         (frequency s, new_signal);;
 245
 246
 247 (** val signal_atan : signal -> signal, output(t) = v_atan(input(t)), frequency consistent.*)
 248 let signal_atan s =
 249         let new_signal = fun t -> v_atan ((signal_fun s) t) in
 250         (frequency s, new_signal);;
 251
 252
 253 let signal_atantwo s1 s2 =
 254         let new_signal = fun t -> v_atantwo ((signal_fun s1) t) ((signal_fun s2) t) in
 255         (frequency s1, new_signal);;
 256
 257
 258 (** val signal_sqrt : signal -> signal, output(t) = v_sqrt(input(t)), frequency consistent.*)
 259 let signal_sqrt s =
 260         let new_signal = fun t -> v_sqrt ((signal_fun s) t) in
 261         (frequency s, new_signal);;
 262
 263
 264 (** val signal_rdtable : signal -> signal -> signal,
 265     output(t) = input1(input2(t)), frequency equals to that of input2.
 266     Attention: no memory implemented, very expensive when input1 comes from rec or delays.*)
 267 let signal_rdtable s0 s1 s2 =
 268         let memory_length_int = take_off_N ((signal_fun s0) 0) in
 269         let s1_mem = factory_add_memory (signal_fun s1) memory_length_int in
 270         let new_signal = fun t ->
 271                 let index = (signal_fun s2) t in
 272                 match index with
 273                 |N i -> s1_mem i
 274                 |R f -> raise (Signal_operation "Rdtable index cannot be float.")
 275                 |Vec (size, vec) -> raise (Signal_operation "Rdtable index cannot be vector.")
 276                 |Zero -> s1_mem 0
 277                 |W -> raise (Signal_operation "Rdtable index cannot be Error.")
 278         in
 279         (frequency s2, new_signal);;
 280
 281
 282 (** val signal_mod : signal -> signal -> signal,
 283     output(t) = input1(t) % input2(t), frequency consistent.*)
 284 let signal_mod s1 s2 =
 285         let f = signal_check_frequency s1 s2 in
 286         let new_signal = fun t -> v_mod ((signal_fun s1) t) ((signal_fun s2) t) in
 287         (f, new_signal);;
 288
 289
 290 (** val signal_sup : signal -> signal -> signal,
 291     output(t) = input1(t) > input2(t), frequency consistent.*)
 292 let signal_sup s1 s2 =
 293         let f = signal_check_frequency s1 s2 in
 294         let new_signal = fun t -> v_sup ((signal_fun s1) t) ((signal_fun s2) t) in
 295         (f, new_signal);;
 296
 297
 298 (** val signal_inf : signal -> signal -> signal,
 299     output(t) = input1(t) < input2(t), frequency consistent.*)
 300 let signal_inf s1 s2 =
 301         let f = signal_check_frequency s1 s2 in
 302         let new_signal = fun t -> v_inf ((signal_fun s1) t) ((signal_fun s2) t) in
 303         (f, new_signal);;
 304
 305
 306 (** val signal_select2 : signal -> signal -> signal -> signal,
 307 [signal_select2 si s0 s1] selects s0 or s1 by index si, frequency consistent.*)
 308 let signal_select2 si s0 s1 =
 309         let f = signal_check_frequency3 si s0 s1 in
 310         let new_signal = fun t ->
 311                 if (signal_fun si) t = N 0 then (signal_fun s0) t
 312                 else if (signal_fun si) t = N 1 then (signal_fun s1) t
 313                 else raise (Signal_operation "select2 index should be 0 or 1.")
 314         in
 315         (f, new_signal);;
 316
 317
 318 (** val signal_select3 : signal -> signal -> signal -> signal -> signal,
 319 [signal_select3 si s0 s1 s2] selects s0 or s1 or s2 by index si, frequency consistent.*)
 320 let signal_select3 si s0 s1 s2 =
 321         let f = signal_check_frequency4 si s0 s1 s2 in
 322         let new_signal = fun t ->
 323                 if (signal_fun si) t = N 0 then (signal_fun s0) t
 324                 else if (signal_fun si) t = N 1 then (signal_fun s1) t
 325                 else if (signal_fun si) t = N 2 then (signal_fun s2) t
 326                 else raise (Signal_operation "select3 index should be 0 or 1 or 2.")
 327         in
 328         (f, new_signal);;
 329
 330
 331 (** val signal_prefix : signal -> signal -> signal,
 332 [signal_prefix s0 s1] returns s0(0) if t = 0, s1(t-1) if t > 0, frequency same to s1.*)
 333 let signal_prefix = fun s0 -> fun s1 ->
 334         let new_signal = fun t ->
 335                 if t = 0 then (signal_fun s0) 0
 336                 else if t > 0 then (signal_fun s1) t
 337                 else raise (Signal_operation "prefix time cannot be < 0.")
 338         in
 339         (frequency s1, new_signal);;