Mercurial > hg > dml-open-cliopatria
view cpack/dml/lib/computations.pl @ 0:718306e29690 tip
commiting public release
| author | Daniel Wolff |
|---|---|
| date | Tue, 09 Feb 2016 21:05:06 +0100 |
| parents | |
| children |
line wrap: on
line source
/* 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.