fft_test(n,m) = vectorize(n) : fft(n) : pcplx_moduls(n) : nconcat(n);
//process = +, _ : + : fft_test(128);
-process = fft_test(128,128) : serialize;
+process = fft_test(128,128) : serialize : vectorize(1);
//process = (0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7) <: shuffle(8);
* Implementation contributed by Remy Muller
*****************************************************************/
-// bus(n) : n parallel cables
-bus(2) = _,_; // avoids a lot of "bus(1)" labels in block diagrams
-bus(n) = par(i, n, _);
// twiddle_mult(n) : n parallel cables
twiddle_mult(k, n) = _, W(k, n) : pcplx_mul;
-// selector(i,n) : select ith cable among n
-selector(i,n) = par(j, n, S(i, j)) with { S(i,i) = _; S(i,j) = !; };
-
-// interleave(m,n) : interleave m*n cables : x(0), x(m), x(2m), ..., x(1),x(1+m), x(1+2m)...
-//interleave(m,n) = bus(m*n) <: par(i, m, par(j, n, selector(i+j*m,m*n)));
-
-// interleave(row,col) : interleave row*col cables from column order to row order.
-// input : x(0), x(1), x(2) ..., x(row*col-1)
-// output: x(0+0*row), x(0+1*row), x(0+2*row), ..., x(1+0*row), x(1+1*row), x(1+2*row), ...
-interleave(row,col) = bus(row*col) <: par(r, row, par(c, col, selector(r+c*row,row*col)));
-
// butterfly(n) : addition then substraction of interleaved signals :
xbutterfly(n) = (bus(n/2), par(k, n/2, twiddle_mult(k, n))) <: interleave(n/2,2), interleave(n/2,2) : par(i, n/2, pcplx_add), par(i, n/2, pcplx_sub);
*)
+let array_map = fun f -> fun a ->
+ let n = Array.length a in
+ Array.init n (fun i -> f a.(i));;
let array_map2 = fun f -> fun a -> fun b ->
let n1 = Array.length a in
let memorize : int -> (index -> basic) -> (index -> basic) =
fun size ->
fun vec ->
- let memory_array = Array.create size Error in
- let index_array = Array.create size false in
+ let memory = Array.create size Error in
+ let filled = Array.create size false in
let vec_mem : index -> basic =
fun i ->
if i >= 0 && i < size then (
- if index_array.(i) then
- memory_array.(i)
+ if filled.(i) then
+ memory.(i)
else
let result = vec i in
- let () = memory_array.(i) <- result in
- let () = index_array.(i) <- true in
+ let () = memory.(i) <- result in
+ let () = filled.(i) <- true in
result)
else raise (Invalid_argument "vector overflow.") in
vec_mem;;
fun v ->
match v with
|Vec vec ->
- let result : basic array =
+ let basics : basic array =
Array.init vec#size vec#nth in
- Array.map basic_to_float result
+ Array.map basic_to_float basics
|_ -> [| (basic_to_float v)|];;
let signal_at = fun (t : time) -> fun (s : signal_type) -> s#at t in
Array.map (signal_at t) self#get
- method output : int -> value_type array array =
+ method output : int -> float array array array =
fun (length_max : int) ->
let transpose : 'a array array -> 'a array array =
fun matrix ->
let get_element = fun i -> fun array -> array.(i) in
let get_column = fun m -> fun i -> Array.map (get_element i) m in
Array.init self#width (get_column matrix) in
- let value_init = new value Error in
+ let value2float = fun (v : value_type) -> v#to_float_array in
+ let init = [|0.|] in
let container = Array.make length_max
- (Array.make self#width value_init) in
+ (Array.make self#width init) in
let index = ref 0 in
try
while !index < length_max do
- container.(!index) <- self#at !index;
+ container.(!index) <- Array.map value2float (self#at !index);
incr index;
done;
transpose container
- with x ->
+ with x ->
let error_message =
match x with
| Convert_Error s -> "Convert_Error: " ^ s
| Basic_operation s -> "Basic_operation: " ^ s
| Signal_operation s -> "Signal_operation: " ^ s
| Beam_matching s -> "Beam_Matching_Error: " ^ s
- | _ -> "Compute finished."
+ | Invalid_argument s -> "Compute finished."
in
let () = print_string error_message in
transpose (Array.sub container 0 !index)
class virtual io =
object
method virtual read : string array -> beam
- method virtual write : int array -> value_type array array -> string array
- method private to_float : value_type array array -> float array array =
- fun (origin : value_type array array) ->
- let data =
- let value2float = fun (v : value_type) -> v#to_float_array in
- Array.map (Array.map value2float) origin in
- Array.map Array.concat (Array.map Array.to_list data)
+ method virtual write : int array -> float array array array -> string array
+ method private concat : float array array array -> float array array =
+ fun (origin : float array array array) ->
+ Array.map Array.concat (Array.map Array.to_list origin)
end;;
class waveio : io_type =
array_map2 (new signal) rates (Array.map stream2func containers) in
new beam signals
- method write : int array -> value_type array array -> string array =
+ method write : int array -> float array array array -> string array =
fun (rates : int array) ->
- fun (output : value_type array array) ->
+ fun (output : float array array array) ->
let () = print_string(" Faustine -> Writing wave files...") in
let tic = Sys.time () in
let channels =
let get_channel = fun s ->
let l = Array.length s in
- match s.(l - 1)#get with
- | Vec vec -> vec#size
- | _ -> 1 in
+ Array.length s.(l - 1) in
Array.map get_channel output in
let file_format = Sndfile.format
Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
let openwr = fun path -> fun channel -> fun rate ->
Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, rate) path in
array_map3 openwr paths channels rates in
+
let () =
- let data = self#to_float output in
+ let data = self#concat output in
let _ = array_map2 Sndfile.write files data in
let _ = Array.map Sndfile.close files in
let toc = Sys.time () in
let rates = output#frequency in
let output_paths = wave#write rates data in
- let _ = Array.map print_string output_paths in
+ let _ = Array.map print_endline output_paths in
();;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
(*
try
(* preprocess *)
method append : beam_type -> beam_type
method matching : int -> beam_type
method at : time -> value_type array
- method output : int -> value_type array array
+ method output : int -> float array array array
method frequency : int array
end;;
class type io_type =
object
method read : string array -> beam_type
- method write : int array -> value_type array array -> string array
+ method write : int array -> float array array array -> string array
end;;