annotate cpack/dml/lib/computations.pl @ 0:718306e29690 tip

commiting public release

/* Part of DML (Digital Music Laboratory)
	Copyright 2014-2015 Samer Abdallah, University of London
	 
	This program is free software; you can redistribute it and/or
	modify it under the terms of the GNU General Public License
	as published by the Free Software Foundation; either version 2
	of the License, or (at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
*/

:- module(computations,
		[	computation/3
      ,  computation_memo/3
      ,  vamp/3
      ,  transform/2
      ,  transform_param/3
      ,  sparse_to_dense/4
      ,  fold_commutative/3
      ,  map_reduce/4
      ,  map_reduce/5
      ,  unzip/3
      ,  pair/3
      ,  add/3, mul/3, div_by/3
      ,  fst/3, snd/3
      ,  with_csv_rows/3
      ,  csv_op/3
      ,  (*)/4
      ,  array_list/2
      ,  microtone_map/4
      ,  rows_cols/3
      ,  tempo_curves_stats/3
      ,  map_edges/3
      ,  csv_pitch_count_prob/5
      ,  pitch_hist_prob/4
      ,  pitch_name_number/2
      ,  pitch_number_name/2
      ,  freq_note_number/2
      ,  histof/4
      ,  histof/3
      ,  weighted_histof/5
      ,  weighted_histof/4
		]).

:- use_module(library(rdfutils)).
:- use_module(library(dcg/basics)).
:- use_module(library(dcg_core)).
:- use_module(library(dcg_macros)).
:- use_module(library(csvutils)).
:- use_module(library(listutils)).
:- use_module(library(lambda)).
:- use_module(library(memo)).
:- use_module(library(mlserver)).
:- use_module(library(sandbox)).
:- use_module(library(backend_json)).
:- use_module(library(real)).

:- volatile_memo pitch_name_number(+atom,-integer).

:- initialization <-library(pracma).

:- rdf_meta vamp(?,r,r).

%% vamp(+T:transform_class, +R:uri, -X:uri) is nondet.
%% vamp(-T:transform_class, -R:uri, -X:uri) is nondet.
%
%  See transform/2 for values transform_class type.
vamp(Class,In,Out) :-
   transform(Class,F),
   computation(F,In,Out).

%% transform(+T:transform_class, -R:uri) is det.
%% transform(-T:transform_class, -R:uri) is nondet.
%
%  Mapping between short transform descriptors and full VAMP transform URIs for
%  transforms currently known to the system. Currently recognised transform classes are:
%  ==
%  transform_class ---> transcription           % equivalent to transcription(0)
%                     ; transcription({0,1})    % 0: semitone, 1:microtonal
%                     ; beats({beatroot,qm})    % beats using one of two plugins
%                     ; beats                   % beats using any plugin
%                     ; tempo
%                     ; chords
%                     ; chord_notes
%                     ; key
%                     ; tonic
%                     ; chromagram
%                     ; mfcc.
% ==
transform(Class,Transform) :- 
   ground(Class), !,
   transforms(Class,Transforms), 
   member(Transform,Transforms).
transform(Class,Transform) :- 
   transform1(Class,Transform).

% memoised collection of all transforms
:- volatile_memo transforms(+ground,-list(atom)).
transforms(Class,Transforms) :- 
   findall(T,transform1(Class,T),Transforms).

%% transform1(-Class:transform_class,-R:uri) is nondet.
%  Searches the RDF database for resources of class vamp:Transform which
%  match the various transform classes. See transform/2.
transform1(beats,Transform)         :- transform1(beats(_),Transform).
transform1(transcription,Transform) :- transform1(transcription(0),Transform).
transform1(transcription(Fine),Transform) :-
   transform1(notes,Transform),
   transform_param(Transform,finetune,Lit),
   literal_number(Lit,Fine).

transform1(Class,Transform) :-
   def_transform(Class,Plugin,Output),
   rdf(Transform,vamp:plugin,Plugin),
   rdf(Transform,vamp:output,Output).

:- rdf_meta transform_param(r,r,-).
transform_param(Transform,ParamId,Value) :-
   rdf(Transform,vamp:parameter_binding,Binding),
   rdf(Binding,vamp:parameter,Param),
   rdf(Param,vamp:identifier,literal(ParamId)),
   rdf(Binding,vamp:value,literal(Value)).


:- rdf_meta def_transform(-,r,r).

% transform class, plugin, output
def_transform(notes,                 vamp_plugins:'silvet#silvet',                   vamp_plugins:'silvet#silvet_output_notes').
def_transform(pitch_activation,      vamp_plugins:'silvet#silvet',                   vamp_plugins:'silvet#silvet_output_pitchactivation').
def_transform(silvet_timefreq,       vamp_plugins:'silvet#silvet',                   vamp_plugins:'silvet#silvet_output_timefreq').
def_transform(beats(beatroot),       vamp_plugins:'beatroot-vamp#beatroot',          vamp_plugins:'beatroot-vamp#beatroot_output_beats').
def_transform(beats(qm),             vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_beats').
def_transform(tempo,                 vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_tempo').
def_transform(onset_dfn(tempo),      vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_detection_fn').
def_transform(chords,                vamp_plugins:'nnls-chroma#chordino',            vamp_plugins:'nnls-chroma#chordino_output_simplechord').
def_transform(chord_notes,           vamp_plugins:'nnls-chroma#chordino',            vamp_plugins:'nnls-chroma#chordino_output_chordnotes').
def_transform(harmonic_change,       vamp_plugins:'nnls-chroma#chordino',            vamp_plugins:'nnls-chroma#chordino_output_harmonicchange').
def_transform(key,                   vamp_plugins:'qm-vamp-plugins#qm-keydetector',  vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_key').
def_transform(key_strength,          vamp_plugins:'qm-vamp-plugins#qm-keydetector',  vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_keystrength').
def_transform(tonic,                 vamp_plugins:'qm-vamp-plugins#qm-keydetector',  vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_tonic').
def_transform(mode,                  vamp_plugins:'qm-vamp-plugins#qm-keydetector',  vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_mode').
def_transform(mfcc,                  vamp_plugins:'qm-vamp-plugins#qm-mfcc',         vamp_plugins:'qm-vamp-plugins#qm-mfcc_output_coefficients').
def_transform(mfcc_means,            vamp_plugins:'qm-vamp-plugins#qm-mfcc',         vamp_plugins:'qm-vamp-plugins#qm-mfcc_output_means').
def_transform(onsets,                vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_onsets').
def_transform(onset_dfn,             vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_detection_fn').
def_transform(onset_smoothed_dfn,    vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_smoothed_df').
def_transform(chromagram,            vamp_plugins:'qm-vamp-plugins#qm-chromagram',   vamp_plugins:'qm-vamp-plugins#qm-chromagram_output_chromagram').
def_transform(chromameans,           vamp_plugins:'qm-vamp-plugins#qm-chromagram',   vamp_plugins:'qm-vamp-plugins#qm-chromagram_output_chromameans').
def_transform(chromagram(upper),     vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_chroma').
def_transform(chromagram(bass),      vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_basschroma').
def_transform(chromagram(both),      vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_bothchroma').
def_transform(spectrogram(semitone), vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_semitonespectrum').
def_transform(spectrogram(log_freq), vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_logfreqspec').
def_transform(spectrogram(tuned),    vamp_plugins:'nnls-chroma#nnls-chroma',         vamp_plugins:'nnls-chroma#nnls-chroma_output_tunedlogfreqspec').
def_transform(melody,                vamp_plugins:'mtg-melodia#melodia',             vamp_plugins:'mtg-melodai#melodia_output_melody').
def_transform(spectrogram(const_q),  vamp_plugins:'qm-vamp-plugins#qm-constantq',    vamp_plugins:'qm-vamp-plugins#qm-constantq_output_constantq').
def_transform(segments,              vamp_plugins:'qm-vamp-plugins#qm-segmenter',    vamp_plugins:'qm-vamp-plugins#qm-segmenter_output_segmentation').
def_transform(speech_music,          vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter',    
                                     vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter_output_segmentation').
def_transform(speech_music_dfn,      vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter',    
                                     vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter_output_skewness').

      
%% computation_memo(+Transform:uri,+Input:uri,-Output:uri) is det.
%  Memoised functional Relation between transforms, inputs and outputs.

:- multifile do_computation/3.

:- rdf_meta computation_memo(r,r,r).
computation_memo(Fn,Input,Output) :-
   must_be(atom,Fn),
   must_be(atom,Input),
   must_be(var,Output),
   (  computation(Fn,Input,Output) -> true
   ;  memo:timed(computations:do_computation(Fn,Input,Output),comp(_,Time,Dur)),
      format_time(atom(Timestamp),'%FT%T%:z',Time),
      memo:hostname(Host),
      phrase( (   vamp:computation_triples(Comp,Input,Fn,Output),
                  vamp:rdf(Comp,dml:'comp/time',literal(type(xsd:dateTime,Timestamp))),
                  vamp:rdf(Comp,dml:'comp/duration',literal(type(xsd:float,Dur))),
                  vamp:rdf(Comp,dml:'comp/host',literal(Host))
              ), Triples,[]),
      forall(member(rdf(S,P,O),Triples), rdf_assert(S,P,O,vamp_memo))
   ).


%% computation(-Transform:uri,-Input:uri,-Output:uri) is nondet.
%  Relation between transforms, inputs and outputs using RDF database
%  of existing computations.

:- rdf_meta computation(r,r,r).
computation(Fn,Input,Output) :- nonvar(Output), !,
   rdf(Comp,dml:'comp/output',Output),
   rdf(Comp,dml:'comp/function',Fn),
   rdf(Comp,dml:'comp/input',Input).

computation(Fn,Input,Output) :-  nonvar(Input), !, 
   rdf(Comp,dml:'comp/input',Input),
   rdf(Comp,dml:'comp/function',Fn),
   rdf(Comp,dml:'comp/output',Output).

computation(Fn,Input,Output) :- 
   rdf(Comp,dml:'comp/input',Input),
   rdf(Comp,dml:'comp/function',Fn),
   rdf(Comp,dml:'comp/output',Output).

% ------------ Framework for doing computations on CSV files -----------
:- meta_predicate with_csv_rows(2,+,-).
with_csv_rows(Pred,CSV,Result) :- 
   insist(uri_to_csv(CSV,Rows)),
   insist(call(Pred,Rows,Result), failed_on_csv(Pred,CSV)).

csv_op(Op,CSV,Result) :- 
   (  memoise(Op) 
   -> csv_op_memo(Op,CSV,Result) % ,_-ok)
   ;  with_csv_rows(row_op(Op),CSV,Result)
   ),
   debug(computations(item),'Done csv_op(~q,~q).',[Op,CSV]).

sandbox:safe_primitive(computations:csv_op(_,_,_)).

:- persistent_memo csv_op_memo(+ground,+atom,-ground).
csv_op_memo(Op,CSV,Result) :- with_csv_rows(row_op(Op),CSV,Result).

:- initialization time(memo_attach(memo(computations2),[])).

memoise(pitch_hist(_)).
memoise(freq_hist(_,_)).
memoise(tempo_hist(_,_)).
memoise(uniform_tempo(_)).
memoise(uniform_tempo_r(_)).
memoise(normalised_tempo(_)).
memoise(normalised_tempo_r(_)).

row_op(id,Rows,Rows) :- !.
row_op(column(N),Rows,Vals)        :- !, maplist(arg(N),Rows,Vals).
row_op(array,Rows,Array)           :- !, maplist(row_list(_),Rows,Array).
row_op(chord_hist,Rows,Hist)       :- !, histof(Chord,T,member(row(T,Chord),Rows),Hist).
row_op(pitch_hist(none),Rows,Hist) :- !, histof(Pitch,t(T,Dur),note(Rows,T,Dur,Pitch),Hist).
row_op(pitch_hist(W),Rows,Hist)    :- !, weighted_histof(Weight,Pitch,t(T,Dur),weighted_note(W,Rows,T,Dur,Pitch,Weight),Hist).
row_op(beat_times,Rows,Times)      :- !, row_op(column(1),Rows,Times).
row_op(onset_times,Rows,Times)     :- !, row_op(column(1),Rows,Times).
row_op(tempo,Rows,Tempo)           :- !, maplist(row_pair(1,2),Rows,Tempo).
row_op(uniform_tempo(DT),Rows,Samples)     :- !, row_op(tempo,Rows,Tempo), uniform_sample(ml,cubic,DT,Tempo,Samples).
row_op(uniform_tempo_r(DT),Rows,Samples)   :- !, row_op(tempo,Rows,Tempo), uniform_sample(r,cubic,DT,Tempo,Samples).
row_op(uniform_tempo(Meth,DT),Rows,Samples)     :- !, row_op(tempo,Rows,Tempo), uniform_sample(ml,Meth,DT,Tempo,Samples).
row_op(uniform_tempo_r(Meth,DT),Rows,Samples)   :- !, row_op(tempo,Rows,Tempo), uniform_sample(r,Meth,DT,Tempo,Samples).
row_op(normalised_tempo(N),Rows,Samples)   :- !, row_op(tempo,Rows,Tempo), normalised_sample(ml,N,Tempo,Samples).
row_op(normalised_tempo_r(N),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), normalised_sample(r,N,Tempo,Samples).
row_op(tempo_hist(DT,Map),Rows,Edges-Counts) :- !,
   row_op(uniform_tempo(DT),Rows,_-Tempo),
   M===Map,
   [arr(Counts), arr(Edges)] === 
      deal(accumhist(flatten(feval(M,Tempo)),1,cardr(M)), flatten(edges(M))).

row_op(tempo_hist_r(DT,Map),Rows,Edges-Counts) :- !,
   map_to_r_edges(Map,REdges),
   row_op(uniform_tempo_r(DT),Rows,_-Tempo),
   Counts <- table(cut(Tempo,breaks=REdges)),
   Edges <- REdges.
   % memberchk(counts=Counts,Hist),
   % memberchk(breaks=Edges,Hist).

row_op(freq_hist(Map1,W),Rows,Counts) :- 
   column(transcription,freq,J),
   (  W=none 
   -> maplist(arg(J),Rows,Freqs), Weights=1
   ;  column(transcription,W,I),
      rows_cols([J,I],Rows,[Freqs,Weights])
   ),
   Map===Map1, % evaluate map and keep in Matlab workspace
   X=feval(Map,12*log2(Freqs)-(12*log2(440)-69)),
   array_list(accumhist(flatten(X),flatten(Weights),cardr(Map)),Counts).

row_op(freq_hist_r(Map1,W),Rows,Counts) :- 
   column(transcription,freq,J),
   map_to_r_edges(Map1,REdges),
   Pitches=12*log2(Freqs)-(12*log2(440)-69),
   (  W=none 
   -> maplist(arg(J),Rows,Freqs), 
      Hist <- hist(Pitches,breaks=REdges,plot=0)
   ;  column(transcription,W,I),
      rows_cols([J,I],Rows,[Freqs,Weights]),
      Hist <- hist(Pitches,Weights,breaks=REdges,plot=0)
   ),
   memberchk(counts=Counts,Hist).

map_edges(r,Map,Edges) :-
   map_to_r_edges(Map,Expr),
   Edges <- Expr.
map_edges(ml,Map,Edges) :-
   array_list(edges(Map),Edges).

map_to_r_edges(expmap(Min,Max,N),sapply(seq(log(Min),log(Max),len=N+1),exp)).
map_to_r_edges(binmap(Min,Max,N),seq(Min-HalfWidth,Max+HalfWidth,len=N+1)) :- HalfWidth=(Max-Min)/(2*(N-1)).

column(Format, Name, Number) :- csv(Format,Row), arg(Number,Row,Name).
csv(transcription, row(time,dur,freq,vel,pitch)).

gather(P,Rows,Xs) :- findall(X,(member(R,Rows),call(P,R,X)),Xs).
   

microtone_map(Min,Max,Res,binmap(Min,Max,N)) :- N is (Max-Min)*Res+1.

% qfreq(Q,Rows,T,Dur,QFreq) :- member(row(T,Dur,Freq,_,_),Rows), qlogfreq(Q,Freq,QFreq).
% weighted_qfreq(dur,Q,Rows,T,Dur,QFreq,Dur) :- member(row(T,Dur,Freq,_,_),Rows), qlogfreq(Q,Freq,QFreq).
% weighted_qfreq(vel,Q,Rows,T,Dur,QFreq,Vel) :- member(row(T,Dur,Freq,Vel,_),Rows), qlogfreq(Q,Freq,QFreq).
% qlogfreq(Q,In,Out) :- B is 12/log(2), Out is 69+round(Q*B*(log(In)-log(440)))/Q.
% goal_expansion(qlogfreq(Q,In,Out), Out is 69+round(Q*B*(log(In)-A))/Q) :- B is 12/log(2), A=log(440).

uniform_sample(DT,In,Out) :- uniform_sample(ml,linear,DT,In,Out).

uniform_sample(_,_,_,[Time-Val],[Time]-[Val]) :- !.
uniform_sample(Lang,Meth,DT,Pairs,Times1-Vals1) :-
   unzip(Pairs,Times,Vals),
   aggregate(max(T), member(T,Times), MaxT),
   interp1(Lang,Meth,0:DT:MaxT,Times,Vals,Times1,Vals1).

normalised_sample(N,In,Out) :- normalised_sample(ml,N,In,Out).

normalised_sample(_,N,[Time-Val],Times-Vals) :- !,
   rep(N,Time,Times),
   rep(N,Val,Vals).
normalised_sample(Lang,N,Pairs,Times1-Vals1) :-
   unzip(Pairs,Times,Vals),
   aggregate(max(T), member(T,Times), MaxT),
   interp1(Lang,cubic,linspace(0,MaxT,N),Times,Vals,Times1,Vals1).

interp1(ml,Meth,TSpec,Times,Vals,Times1,Vals1) :-
   length(Times,N),
   (N<4 -> Method=q(linear); Method=q(Meth)),
   T1===flatten(TSpec),
   [arr(Times1), arr(Vals1)]===deal(T1,interp1(Times,Vals,T1,Method)).
interp1(r,Meth,TSpec,Times,Vals,Times1,Vals1) :-
   ml_r(TSpec,RTSpec),
   length(Times,N),
   (N<4 -> Method = +linear; Method = +Meth),
   Times1 <- RTSpec,
   Vals1  <- interp1(Times,Vals,Times1,Method).

ml_r(X1:DX:X2, seq(X1,X2,DX)).
ml_r(linspace(X1,X2,N), seq(X1,X2,len=N)).

array_list(Array,List) :- arr(List)===flatten(Array).

:- meta_predicate '*'(2,2,+,-).
*(F1,F2,X,Y) :- call(F1,X,Z), call(F2,Z,Y).

note(Rows,T,Dur,NN) :- member(row(T,Dur,_,_,Pitch),Rows), pitch_name_number(Pitch,NN).

weighted_note(dur,Rows,T,Dur,NN,Dur) :- member(row(T,Dur,_,_,Pitch),Rows),  pitch_name_number(Pitch,NN).
weighted_note(vel,Rows,T,Dur,NN,Vel) :- member(row(T,Dur,_,Vel,Pitch),Rows), pitch_name_number(Pitch,NN).
weighted_note(dur*vel,Rows,T,Dur,NN,Weight) :-
   member(row(T,Dur,_,Vel,Pitch),Rows), pitch_name_number(Pitch,NN),
   Weight is Dur*Vel.


tempo_curves_stats(ml,Curves, _{means:Means,std_devs:StdDevs}) :-
   Data===arr(Curves),
   array_list(mean(Data,2),Means),
   array_list(std(Data,0,2),StdDevs).

tempo_curves_stats(r,Curves, _{means:Means,std_devs:Stds}) :-
   data  <- Curves,
   Means <- apply(data,2,mean),
   Stds  <- apply(data,2,sd).

:- meta_predicate histof(-,0,-)
               ,  histof(-,-,0,-)
               ,  weighted_histof(-,-,0,-)
               ,  weighted_histof(-,-,-,0,-)
               .

%% histof(@Dom:A,+Goal:callable,-Hist:list(pair(A,natural))) is nondet.
%  Compile a histogram over values taken by the variable Dom while enumerating
%  all solutions of Goal. Repeated solutions of Goal with the same values
%  count as distinct observations. See also histof/4.
histof(Dom,Goal,Hist) :-
   setof(Dom-N,aggregate(count,Goal,N),Hist).

%% histof(@Dom:A,@Disc:_,+Goal:callable,-Hist:list(pair(A,natural))) is nondet.
%  Compile a histogram over values taken by the variable Dom while enumerating
%  all solutions of Goal. The value of Disc is used to discriminate between
%  solutions of Goal with the same value of Dom. See also histof/3 and aggregate/4
%  for more information about discriminator variables.
histof(Dom,Disc,Goal,Hist) :-
   setof(Dom-N,aggregate(count,Disc,Goal,N),Hist).

weighted_histof(W,Dom,Goal,Hist) :-
   setof(Dom-N,aggregate(sum(W),Goal,N),Hist).

weighted_histof(W,Dom,Disc,Goal,Hist) :-
   setof(Dom-N,aggregate(sum(W),Disc,Goal,N),Hist).

sparse_to_dense(Min,Max,Hist,Counts) :-
   s_to_d(Min,Max,Hist,Counts).

s_to_d(I,Max,[],[]) :- I>Max, !.
s_to_d(I,Max,[],[0|Counts]) :- !, succ(I,J), s_to_d(J,Max,[],Counts).
s_to_d(I,Max,[I-C|Hist],[C|Counts]) :- !, succ(I,J), s_to_d(J,Max,Hist,Counts).
s_to_d(I,Max,Hist,[0|Counts]) :- succ(I,J), s_to_d(J,Max,Hist,Counts).


add(X,Y,Z) :- Z is X+Y.

:- meta_predicate 
      map_reduce(1,2,3,-),
      map_reduce(1,2,3,-,-),
      fold_commutative(3,+,-).

%% map_reduce(+Generator:pred(-R), +Mapper:pred(+R,-A), +Reducer:pred(+A,+A,-A), -Result:A, -Errors:list(error_report(R))) is det.
%% map_reduce(+Generator:pred(-R), +Mapper:pred(+R,-A), +Reducer:pred(+A,+A,-A), -Result:A) is semidet.
%
%  Simple implementation of map-reduce: Mapper is applied to each item produced by Generator
%  and the results all combined using Reducer. Mapper should be a deterministic predicate.
%  Failures and exceptions encountered in the mapping phase are reported in Errors.
%  However, if the items are successfully mapped, this predicate fails.
%  Any choice points left by mapper after its first solution are cut.
%
%  ==
%  error_report(R) ---> failed(R);  error(R,exception).
%  ==
map_reduce(Finder,Mapper,Reducer,Result) :-
   map_reduce(Finder,Mapper,Reducer,Result,_).

map_reduce(Finder,Mapper,Reducer,Result,Errors-Failures) :-
   setof(X,call(Finder,X),Xs),
   maplist(safe_call(Mapper),Xs,Ys),
   partition_ok(Ys,Ok,Errors,Failures),
   insist(fold_commutative(Reducer,Ok,Result)).

%% safe_call(+P:pred(+A,-B), +X:A, -Y:result(A,B)) is det.
%
%  Call binary predicate P with arguments of type A and B. The result
%  term Y is of type
%  ==
%     result(A,B) ---> ok(B); failed(A); error(A,exception).
%  ==
%  and encodes the result of the call, including the input value that
%  caused any failure or exception.
safe_call(Mapper,X,Z) :-
   (  catch((call(Mapper,X,Y), Z=ok(Y)), Ex, 
            (Ex=abort_map -> throw(map_aborted); Z=error(X,Ex))), !
   ;  Z=failed(X)
   ).

partition_ok([],[],[],[]).
partition_ok([In|Ins],Goods,Bads,Uglies) :- 
   (  In=ok(X) 
   -> Goods=[X|Goods1], partition_ok(Ins,Goods1,Bads,Uglies)
   ;  In=error(_,_)
   -> Bads=[In|Bads1], partition_ok(Ins,Goods,Bads1,Uglies)
   ;  In=failed(X)
   -> Uglies=[X|Uglies1],  partition_ok(Ins,Goods,Bads,Uglies1)
   ).

fold_commutative(Op,Items,Result) :-
   Items=[I1|Rest],
   seqmap(Op,Rest,I1,Result), !.

freq_note_number(F,N) :- N is 69+round(12*log(F/440)/log(2)).

pitch_name_number(Name,Number) :- 
   atom_codes(Name,Chars),
   phrase(note(Number),Chars).

pitch_number_name(Number,Name) :-
   phrase(note(Number),Chars),
   atom_codes(Name,Chars).

:- use_module(library(clpfd)).
note(Num) --> 
   [Nom], ({Mod=0}; [0'#],{Mod=1}),
   {  PC in 0..11, 
      Num #= 12*(Oct+1)+PC+Mod, 
      nom_semis(Nom,PC) 
   },
   integer(Oct).

nom_semis(0'C,0).
nom_semis(0'D,2).
nom_semis(0'E,4).
nom_semis(0'F,5).
nom_semis(0'G,7).
nom_semis(0'A,9).
nom_semis(0'B,11).

unzip(Pairs,Xs,Ys) :- maplist(pair,Xs,Ys,Pairs).
pair(X,Y,X-Y).

row_pair(I,J,Row,X-Y) :- arg(I,Row,X), arg(J,Row,Y).
row_list(N,Row,List)  :- functor(Row,_,N), Row=..[_|List].
rows_cols(Is,[],Cols) :- !, maplist(nil,Is,Cols).
rows_cols(Is,[R|Rs],Cols) :- 
   (  maplist(arg_cons(R),Is,Tails,Cols)
   -> rows_cols(Is,Rs,Tails)
   ;  fail % rows_cols(Is,Rs,Cols)
   ).

arg_cons(Row,I,T,[X|T]) :- arg(I,Row,X).
nil(_,[]).

fst(F,K1-V,K2-V) :- call(F,K1,K2).
snd(F,K-V1,K-V2) :- call(F,V1,V2).
div_by(K,X,Y) :- Y is X/K.

mul(X,Y,Z) :- Z is round(X*Y).

:- dynamic pitch_hist_table/5, pitch_hist_tabled/1.

csv_pitch_count_prob(W,CSV,Pitch,Count,Prob) :-
   must_be(ground,W),
   (  pitch_hist_tabled(W) -> true
   ;  table_pitch_hist(W)
   ),
   pitch_hist_table(W,CSV,Pitch,Count,Prob).

table_pitch_hist(W) :-
   retractall(pitch_hist_table_cached(W)),
   forall( browse(csv_op_memo(pitch_hist(W),CSV,Hist)),
           ( retractall(pitch_hist_table(W,CSV,_,_,_)),
             forall( pitch_hist_prob(Hist,Pitch,Count,Prob),
                     assert(pitch_hist_table(W,CSV,Pitch,Count,Prob))))),
   assert(pitch_hist_tabled(W)).

pitch_hist_prob(Hist,Pitch,Count,Prob) :-
   unzip(Hist,_,Counts),
   sumlist(Counts,Total),
   member(Pitch-Count,Hist),
   Prob is Count/Total.