comparison 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.