Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(computations, Daniel@0: [ computation/3 Daniel@0: , computation_memo/3 Daniel@0: , vamp/3 Daniel@0: , transform/2 Daniel@0: , transform_param/3 Daniel@0: , sparse_to_dense/4 Daniel@0: , fold_commutative/3 Daniel@0: , map_reduce/4 Daniel@0: , map_reduce/5 Daniel@0: , unzip/3 Daniel@0: , pair/3 Daniel@0: , add/3, mul/3, div_by/3 Daniel@0: , fst/3, snd/3 Daniel@0: , with_csv_rows/3 Daniel@0: , csv_op/3 Daniel@0: , (*)/4 Daniel@0: , array_list/2 Daniel@0: , microtone_map/4 Daniel@0: , rows_cols/3 Daniel@0: , tempo_curves_stats/3 Daniel@0: , map_edges/3 Daniel@0: , csv_pitch_count_prob/5 Daniel@0: , pitch_hist_prob/4 Daniel@0: , pitch_name_number/2 Daniel@0: , pitch_number_name/2 Daniel@0: , freq_note_number/2 Daniel@0: , histof/4 Daniel@0: , histof/3 Daniel@0: , weighted_histof/5 Daniel@0: , weighted_histof/4 Daniel@0: ]). Daniel@0: Daniel@0: :- use_module(library(rdfutils)). Daniel@0: :- use_module(library(dcg/basics)). Daniel@0: :- use_module(library(dcg_core)). Daniel@0: :- use_module(library(dcg_macros)). Daniel@0: :- use_module(library(csvutils)). Daniel@0: :- use_module(library(listutils)). Daniel@0: :- use_module(library(lambda)). Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(library(mlserver)). Daniel@0: :- use_module(library(sandbox)). Daniel@0: :- use_module(library(backend_json)). Daniel@0: :- use_module(library(real)). Daniel@0: Daniel@0: :- volatile_memo pitch_name_number(+atom,-integer). Daniel@0: Daniel@0: :- initialization <-library(pracma). Daniel@0: Daniel@0: :- rdf_meta vamp(?,r,r). Daniel@0: Daniel@0: %% vamp(+T:transform_class, +R:uri, -X:uri) is nondet. Daniel@0: %% vamp(-T:transform_class, -R:uri, -X:uri) is nondet. Daniel@0: % Daniel@0: % See transform/2 for values transform_class type. Daniel@0: vamp(Class,In,Out) :- Daniel@0: transform(Class,F), Daniel@0: computation(F,In,Out). Daniel@0: Daniel@0: %% transform(+T:transform_class, -R:uri) is det. Daniel@0: %% transform(-T:transform_class, -R:uri) is nondet. Daniel@0: % Daniel@0: % Mapping between short transform descriptors and full VAMP transform URIs for Daniel@0: % transforms currently known to the system. Currently recognised transform classes are: Daniel@0: % == Daniel@0: % transform_class ---> transcription % equivalent to transcription(0) Daniel@0: % ; transcription({0,1}) % 0: semitone, 1:microtonal Daniel@0: % ; beats({beatroot,qm}) % beats using one of two plugins Daniel@0: % ; beats % beats using any plugin Daniel@0: % ; tempo Daniel@0: % ; chords Daniel@0: % ; chord_notes Daniel@0: % ; key Daniel@0: % ; tonic Daniel@0: % ; chromagram Daniel@0: % ; mfcc. Daniel@0: % == Daniel@0: transform(Class,Transform) :- Daniel@0: ground(Class), !, Daniel@0: transforms(Class,Transforms), Daniel@0: member(Transform,Transforms). Daniel@0: transform(Class,Transform) :- Daniel@0: transform1(Class,Transform). Daniel@0: Daniel@0: % memoised collection of all transforms Daniel@0: :- volatile_memo transforms(+ground,-list(atom)). Daniel@0: transforms(Class,Transforms) :- Daniel@0: findall(T,transform1(Class,T),Transforms). Daniel@0: Daniel@0: %% transform1(-Class:transform_class,-R:uri) is nondet. Daniel@0: % Searches the RDF database for resources of class vamp:Transform which Daniel@0: % match the various transform classes. See transform/2. Daniel@0: transform1(beats,Transform) :- transform1(beats(_),Transform). Daniel@0: transform1(transcription,Transform) :- transform1(transcription(0),Transform). Daniel@0: transform1(transcription(Fine),Transform) :- Daniel@0: transform1(notes,Transform), Daniel@0: transform_param(Transform,finetune,Lit), Daniel@0: literal_number(Lit,Fine). Daniel@0: Daniel@0: transform1(Class,Transform) :- Daniel@0: def_transform(Class,Plugin,Output), Daniel@0: rdf(Transform,vamp:plugin,Plugin), Daniel@0: rdf(Transform,vamp:output,Output). Daniel@0: Daniel@0: :- rdf_meta transform_param(r,r,-). Daniel@0: transform_param(Transform,ParamId,Value) :- Daniel@0: rdf(Transform,vamp:parameter_binding,Binding), Daniel@0: rdf(Binding,vamp:parameter,Param), Daniel@0: rdf(Param,vamp:identifier,literal(ParamId)), Daniel@0: rdf(Binding,vamp:value,literal(Value)). Daniel@0: Daniel@0: Daniel@0: :- rdf_meta def_transform(-,r,r). Daniel@0: Daniel@0: % transform class, plugin, output Daniel@0: def_transform(notes, vamp_plugins:'silvet#silvet', vamp_plugins:'silvet#silvet_output_notes'). Daniel@0: def_transform(pitch_activation, vamp_plugins:'silvet#silvet', vamp_plugins:'silvet#silvet_output_pitchactivation'). Daniel@0: def_transform(silvet_timefreq, vamp_plugins:'silvet#silvet', vamp_plugins:'silvet#silvet_output_timefreq'). Daniel@0: def_transform(beats(beatroot), vamp_plugins:'beatroot-vamp#beatroot', vamp_plugins:'beatroot-vamp#beatroot_output_beats'). Daniel@0: def_transform(beats(qm), vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_beats'). Daniel@0: def_transform(tempo, vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_tempo'). Daniel@0: def_transform(onset_dfn(tempo), vamp_plugins:'qm-vamp-plugins#qm-tempotracker', vamp_plugins:'qm-vamp-plugins#qm-tempotracker_output_detection_fn'). Daniel@0: def_transform(chords, vamp_plugins:'nnls-chroma#chordino', vamp_plugins:'nnls-chroma#chordino_output_simplechord'). Daniel@0: def_transform(chord_notes, vamp_plugins:'nnls-chroma#chordino', vamp_plugins:'nnls-chroma#chordino_output_chordnotes'). Daniel@0: def_transform(harmonic_change, vamp_plugins:'nnls-chroma#chordino', vamp_plugins:'nnls-chroma#chordino_output_harmonicchange'). Daniel@0: def_transform(key, vamp_plugins:'qm-vamp-plugins#qm-keydetector', vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_key'). Daniel@0: def_transform(key_strength, vamp_plugins:'qm-vamp-plugins#qm-keydetector', vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_keystrength'). Daniel@0: def_transform(tonic, vamp_plugins:'qm-vamp-plugins#qm-keydetector', vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_tonic'). Daniel@0: def_transform(mode, vamp_plugins:'qm-vamp-plugins#qm-keydetector', vamp_plugins:'qm-vamp-plugins#qm-keydetector_output_mode'). Daniel@0: def_transform(mfcc, vamp_plugins:'qm-vamp-plugins#qm-mfcc', vamp_plugins:'qm-vamp-plugins#qm-mfcc_output_coefficients'). Daniel@0: def_transform(mfcc_means, vamp_plugins:'qm-vamp-plugins#qm-mfcc', vamp_plugins:'qm-vamp-plugins#qm-mfcc_output_means'). Daniel@0: def_transform(onsets, vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_onsets'). Daniel@0: def_transform(onset_dfn, vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_detection_fn'). Daniel@0: def_transform(onset_smoothed_dfn, vamp_plugins:'qm-vamp-plugins#qm-onsetdetector',vamp_plugins:'qm-vamp-plugins#qm-onsetdetector_output_smoothed_df'). Daniel@0: def_transform(chromagram, vamp_plugins:'qm-vamp-plugins#qm-chromagram', vamp_plugins:'qm-vamp-plugins#qm-chromagram_output_chromagram'). Daniel@0: def_transform(chromameans, vamp_plugins:'qm-vamp-plugins#qm-chromagram', vamp_plugins:'qm-vamp-plugins#qm-chromagram_output_chromameans'). Daniel@0: def_transform(chromagram(upper), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_chroma'). Daniel@0: def_transform(chromagram(bass), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_basschroma'). Daniel@0: def_transform(chromagram(both), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_bothchroma'). Daniel@0: def_transform(spectrogram(semitone), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_semitonespectrum'). Daniel@0: def_transform(spectrogram(log_freq), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_logfreqspec'). Daniel@0: def_transform(spectrogram(tuned), vamp_plugins:'nnls-chroma#nnls-chroma', vamp_plugins:'nnls-chroma#nnls-chroma_output_tunedlogfreqspec'). Daniel@0: def_transform(melody, vamp_plugins:'mtg-melodia#melodia', vamp_plugins:'mtg-melodai#melodia_output_melody'). Daniel@0: def_transform(spectrogram(const_q), vamp_plugins:'qm-vamp-plugins#qm-constantq', vamp_plugins:'qm-vamp-plugins#qm-constantq_output_constantq'). Daniel@0: def_transform(segments, vamp_plugins:'qm-vamp-plugins#qm-segmenter', vamp_plugins:'qm-vamp-plugins#qm-segmenter_output_segmentation'). Daniel@0: def_transform(speech_music, vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter', Daniel@0: vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter_output_segmentation'). Daniel@0: def_transform(speech_music_dfn, vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter', Daniel@0: vamp_plugins:'bbc-vamp-plugins#bbc-speechmusic-segmenter_output_skewness'). Daniel@0: Daniel@0: Daniel@0: %% computation_memo(+Transform:uri,+Input:uri,-Output:uri) is det. Daniel@0: % Memoised functional Relation between transforms, inputs and outputs. Daniel@0: Daniel@0: :- multifile do_computation/3. Daniel@0: Daniel@0: :- rdf_meta computation_memo(r,r,r). Daniel@0: computation_memo(Fn,Input,Output) :- Daniel@0: must_be(atom,Fn), Daniel@0: must_be(atom,Input), Daniel@0: must_be(var,Output), Daniel@0: ( computation(Fn,Input,Output) -> true Daniel@0: ; memo:timed(computations:do_computation(Fn,Input,Output),comp(_,Time,Dur)), Daniel@0: format_time(atom(Timestamp),'%FT%T%:z',Time), Daniel@0: memo:hostname(Host), Daniel@0: phrase( ( vamp:computation_triples(Comp,Input,Fn,Output), Daniel@0: vamp:rdf(Comp,dml:'comp/time',literal(type(xsd:dateTime,Timestamp))), Daniel@0: vamp:rdf(Comp,dml:'comp/duration',literal(type(xsd:float,Dur))), Daniel@0: vamp:rdf(Comp,dml:'comp/host',literal(Host)) Daniel@0: ), Triples,[]), Daniel@0: forall(member(rdf(S,P,O),Triples), rdf_assert(S,P,O,vamp_memo)) Daniel@0: ). Daniel@0: Daniel@0: Daniel@0: %% computation(-Transform:uri,-Input:uri,-Output:uri) is nondet. Daniel@0: % Relation between transforms, inputs and outputs using RDF database Daniel@0: % of existing computations. Daniel@0: Daniel@0: :- rdf_meta computation(r,r,r). Daniel@0: computation(Fn,Input,Output) :- nonvar(Output), !, Daniel@0: rdf(Comp,dml:'comp/output',Output), Daniel@0: rdf(Comp,dml:'comp/function',Fn), Daniel@0: rdf(Comp,dml:'comp/input',Input). Daniel@0: Daniel@0: computation(Fn,Input,Output) :- nonvar(Input), !, Daniel@0: rdf(Comp,dml:'comp/input',Input), Daniel@0: rdf(Comp,dml:'comp/function',Fn), Daniel@0: rdf(Comp,dml:'comp/output',Output). Daniel@0: Daniel@0: computation(Fn,Input,Output) :- Daniel@0: rdf(Comp,dml:'comp/input',Input), Daniel@0: rdf(Comp,dml:'comp/function',Fn), Daniel@0: rdf(Comp,dml:'comp/output',Output). Daniel@0: Daniel@0: % ------------ Framework for doing computations on CSV files ----------- Daniel@0: :- meta_predicate with_csv_rows(2,+,-). Daniel@0: with_csv_rows(Pred,CSV,Result) :- Daniel@0: insist(uri_to_csv(CSV,Rows)), Daniel@0: insist(call(Pred,Rows,Result), failed_on_csv(Pred,CSV)). Daniel@0: Daniel@0: csv_op(Op,CSV,Result) :- Daniel@0: ( memoise(Op) Daniel@0: -> csv_op_memo(Op,CSV,Result) % ,_-ok) Daniel@0: ; with_csv_rows(row_op(Op),CSV,Result) Daniel@0: ), Daniel@0: debug(computations(item),'Done csv_op(~q,~q).',[Op,CSV]). Daniel@0: Daniel@0: sandbox:safe_primitive(computations:csv_op(_,_,_)). Daniel@0: Daniel@0: :- persistent_memo csv_op_memo(+ground,+atom,-ground). Daniel@0: csv_op_memo(Op,CSV,Result) :- with_csv_rows(row_op(Op),CSV,Result). Daniel@0: Daniel@0: :- initialization time(memo_attach(memo(computations2),[])). Daniel@0: Daniel@0: memoise(pitch_hist(_)). Daniel@0: memoise(freq_hist(_,_)). Daniel@0: memoise(tempo_hist(_,_)). Daniel@0: memoise(uniform_tempo(_)). Daniel@0: memoise(uniform_tempo_r(_)). Daniel@0: memoise(normalised_tempo(_)). Daniel@0: memoise(normalised_tempo_r(_)). Daniel@0: Daniel@0: row_op(id,Rows,Rows) :- !. Daniel@0: row_op(column(N),Rows,Vals) :- !, maplist(arg(N),Rows,Vals). Daniel@0: row_op(array,Rows,Array) :- !, maplist(row_list(_),Rows,Array). Daniel@0: row_op(chord_hist,Rows,Hist) :- !, histof(Chord,T,member(row(T,Chord),Rows),Hist). Daniel@0: row_op(pitch_hist(none),Rows,Hist) :- !, histof(Pitch,t(T,Dur),note(Rows,T,Dur,Pitch),Hist). Daniel@0: row_op(pitch_hist(W),Rows,Hist) :- !, weighted_histof(Weight,Pitch,t(T,Dur),weighted_note(W,Rows,T,Dur,Pitch,Weight),Hist). Daniel@0: row_op(beat_times,Rows,Times) :- !, row_op(column(1),Rows,Times). Daniel@0: row_op(onset_times,Rows,Times) :- !, row_op(column(1),Rows,Times). Daniel@0: row_op(tempo,Rows,Tempo) :- !, maplist(row_pair(1,2),Rows,Tempo). Daniel@0: row_op(uniform_tempo(DT),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), uniform_sample(ml,cubic,DT,Tempo,Samples). Daniel@0: row_op(uniform_tempo_r(DT),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), uniform_sample(r,cubic,DT,Tempo,Samples). Daniel@0: row_op(uniform_tempo(Meth,DT),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), uniform_sample(ml,Meth,DT,Tempo,Samples). Daniel@0: row_op(uniform_tempo_r(Meth,DT),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), uniform_sample(r,Meth,DT,Tempo,Samples). Daniel@0: row_op(normalised_tempo(N),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), normalised_sample(ml,N,Tempo,Samples). Daniel@0: row_op(normalised_tempo_r(N),Rows,Samples) :- !, row_op(tempo,Rows,Tempo), normalised_sample(r,N,Tempo,Samples). Daniel@0: row_op(tempo_hist(DT,Map),Rows,Edges-Counts) :- !, Daniel@0: row_op(uniform_tempo(DT),Rows,_-Tempo), Daniel@0: M===Map, Daniel@0: [arr(Counts), arr(Edges)] === Daniel@0: deal(accumhist(flatten(feval(M,Tempo)),1,cardr(M)), flatten(edges(M))). Daniel@0: Daniel@0: row_op(tempo_hist_r(DT,Map),Rows,Edges-Counts) :- !, Daniel@0: map_to_r_edges(Map,REdges), Daniel@0: row_op(uniform_tempo_r(DT),Rows,_-Tempo), Daniel@0: Counts <- table(cut(Tempo,breaks=REdges)), Daniel@0: Edges <- REdges. Daniel@0: % memberchk(counts=Counts,Hist), Daniel@0: % memberchk(breaks=Edges,Hist). Daniel@0: Daniel@0: row_op(freq_hist(Map1,W),Rows,Counts) :- Daniel@0: column(transcription,freq,J), Daniel@0: ( W=none Daniel@0: -> maplist(arg(J),Rows,Freqs), Weights=1 Daniel@0: ; column(transcription,W,I), Daniel@0: rows_cols([J,I],Rows,[Freqs,Weights]) Daniel@0: ), Daniel@0: Map===Map1, % evaluate map and keep in Matlab workspace Daniel@0: X=feval(Map,12*log2(Freqs)-(12*log2(440)-69)), Daniel@0: array_list(accumhist(flatten(X),flatten(Weights),cardr(Map)),Counts). Daniel@0: Daniel@0: row_op(freq_hist_r(Map1,W),Rows,Counts) :- Daniel@0: column(transcription,freq,J), Daniel@0: map_to_r_edges(Map1,REdges), Daniel@0: Pitches=12*log2(Freqs)-(12*log2(440)-69), Daniel@0: ( W=none Daniel@0: -> maplist(arg(J),Rows,Freqs), Daniel@0: Hist <- hist(Pitches,breaks=REdges,plot=0) Daniel@0: ; column(transcription,W,I), Daniel@0: rows_cols([J,I],Rows,[Freqs,Weights]), Daniel@0: Hist <- hist(Pitches,Weights,breaks=REdges,plot=0) Daniel@0: ), Daniel@0: memberchk(counts=Counts,Hist). Daniel@0: Daniel@0: map_edges(r,Map,Edges) :- Daniel@0: map_to_r_edges(Map,Expr), Daniel@0: Edges <- Expr. Daniel@0: map_edges(ml,Map,Edges) :- Daniel@0: array_list(edges(Map),Edges). Daniel@0: Daniel@0: map_to_r_edges(expmap(Min,Max,N),sapply(seq(log(Min),log(Max),len=N+1),exp)). Daniel@0: map_to_r_edges(binmap(Min,Max,N),seq(Min-HalfWidth,Max+HalfWidth,len=N+1)) :- HalfWidth=(Max-Min)/(2*(N-1)). Daniel@0: Daniel@0: column(Format, Name, Number) :- csv(Format,Row), arg(Number,Row,Name). Daniel@0: csv(transcription, row(time,dur,freq,vel,pitch)). Daniel@0: Daniel@0: gather(P,Rows,Xs) :- findall(X,(member(R,Rows),call(P,R,X)),Xs). Daniel@0: Daniel@0: Daniel@0: microtone_map(Min,Max,Res,binmap(Min,Max,N)) :- N is (Max-Min)*Res+1. Daniel@0: Daniel@0: % qfreq(Q,Rows,T,Dur,QFreq) :- member(row(T,Dur,Freq,_,_),Rows), qlogfreq(Q,Freq,QFreq). Daniel@0: % weighted_qfreq(dur,Q,Rows,T,Dur,QFreq,Dur) :- member(row(T,Dur,Freq,_,_),Rows), qlogfreq(Q,Freq,QFreq). Daniel@0: % weighted_qfreq(vel,Q,Rows,T,Dur,QFreq,Vel) :- member(row(T,Dur,Freq,Vel,_),Rows), qlogfreq(Q,Freq,QFreq). Daniel@0: % qlogfreq(Q,In,Out) :- B is 12/log(2), Out is 69+round(Q*B*(log(In)-log(440)))/Q. Daniel@0: % goal_expansion(qlogfreq(Q,In,Out), Out is 69+round(Q*B*(log(In)-A))/Q) :- B is 12/log(2), A=log(440). Daniel@0: Daniel@0: uniform_sample(DT,In,Out) :- uniform_sample(ml,linear,DT,In,Out). Daniel@0: Daniel@0: uniform_sample(_,_,_,[Time-Val],[Time]-[Val]) :- !. Daniel@0: uniform_sample(Lang,Meth,DT,Pairs,Times1-Vals1) :- Daniel@0: unzip(Pairs,Times,Vals), Daniel@0: aggregate(max(T), member(T,Times), MaxT), Daniel@0: interp1(Lang,Meth,0:DT:MaxT,Times,Vals,Times1,Vals1). Daniel@0: Daniel@0: normalised_sample(N,In,Out) :- normalised_sample(ml,N,In,Out). Daniel@0: Daniel@0: normalised_sample(_,N,[Time-Val],Times-Vals) :- !, Daniel@0: rep(N,Time,Times), Daniel@0: rep(N,Val,Vals). Daniel@0: normalised_sample(Lang,N,Pairs,Times1-Vals1) :- Daniel@0: unzip(Pairs,Times,Vals), Daniel@0: aggregate(max(T), member(T,Times), MaxT), Daniel@0: interp1(Lang,cubic,linspace(0,MaxT,N),Times,Vals,Times1,Vals1). Daniel@0: Daniel@0: interp1(ml,Meth,TSpec,Times,Vals,Times1,Vals1) :- Daniel@0: length(Times,N), Daniel@0: (N<4 -> Method=q(linear); Method=q(Meth)), Daniel@0: T1===flatten(TSpec), Daniel@0: [arr(Times1), arr(Vals1)]===deal(T1,interp1(Times,Vals,T1,Method)). Daniel@0: interp1(r,Meth,TSpec,Times,Vals,Times1,Vals1) :- Daniel@0: ml_r(TSpec,RTSpec), Daniel@0: length(Times,N), Daniel@0: (N<4 -> Method = +linear; Method = +Meth), Daniel@0: Times1 <- RTSpec, Daniel@0: Vals1 <- interp1(Times,Vals,Times1,Method). Daniel@0: Daniel@0: ml_r(X1:DX:X2, seq(X1,X2,DX)). Daniel@0: ml_r(linspace(X1,X2,N), seq(X1,X2,len=N)). Daniel@0: Daniel@0: array_list(Array,List) :- arr(List)===flatten(Array). Daniel@0: Daniel@0: :- meta_predicate '*'(2,2,+,-). Daniel@0: *(F1,F2,X,Y) :- call(F1,X,Z), call(F2,Z,Y). Daniel@0: Daniel@0: note(Rows,T,Dur,NN) :- member(row(T,Dur,_,_,Pitch),Rows), pitch_name_number(Pitch,NN). Daniel@0: Daniel@0: weighted_note(dur,Rows,T,Dur,NN,Dur) :- member(row(T,Dur,_,_,Pitch),Rows), pitch_name_number(Pitch,NN). Daniel@0: weighted_note(vel,Rows,T,Dur,NN,Vel) :- member(row(T,Dur,_,Vel,Pitch),Rows), pitch_name_number(Pitch,NN). Daniel@0: weighted_note(dur*vel,Rows,T,Dur,NN,Weight) :- Daniel@0: member(row(T,Dur,_,Vel,Pitch),Rows), pitch_name_number(Pitch,NN), Daniel@0: Weight is Dur*Vel. Daniel@0: Daniel@0: Daniel@0: tempo_curves_stats(ml,Curves, _{means:Means,std_devs:StdDevs}) :- Daniel@0: Data===arr(Curves), Daniel@0: array_list(mean(Data,2),Means), Daniel@0: array_list(std(Data,0,2),StdDevs). Daniel@0: Daniel@0: tempo_curves_stats(r,Curves, _{means:Means,std_devs:Stds}) :- Daniel@0: data <- Curves, Daniel@0: Means <- apply(data,2,mean), Daniel@0: Stds <- apply(data,2,sd). Daniel@0: Daniel@0: :- meta_predicate histof(-,0,-) Daniel@0: , histof(-,-,0,-) Daniel@0: , weighted_histof(-,-,0,-) Daniel@0: , weighted_histof(-,-,-,0,-) Daniel@0: . Daniel@0: Daniel@0: %% histof(@Dom:A,+Goal:callable,-Hist:list(pair(A,natural))) is nondet. Daniel@0: % Compile a histogram over values taken by the variable Dom while enumerating Daniel@0: % all solutions of Goal. Repeated solutions of Goal with the same values Daniel@0: % count as distinct observations. See also histof/4. Daniel@0: histof(Dom,Goal,Hist) :- Daniel@0: setof(Dom-N,aggregate(count,Goal,N),Hist). Daniel@0: Daniel@0: %% histof(@Dom:A,@Disc:_,+Goal:callable,-Hist:list(pair(A,natural))) is nondet. Daniel@0: % Compile a histogram over values taken by the variable Dom while enumerating Daniel@0: % all solutions of Goal. The value of Disc is used to discriminate between Daniel@0: % solutions of Goal with the same value of Dom. See also histof/3 and aggregate/4 Daniel@0: % for more information about discriminator variables. Daniel@0: histof(Dom,Disc,Goal,Hist) :- Daniel@0: setof(Dom-N,aggregate(count,Disc,Goal,N),Hist). Daniel@0: Daniel@0: weighted_histof(W,Dom,Goal,Hist) :- Daniel@0: setof(Dom-N,aggregate(sum(W),Goal,N),Hist). Daniel@0: Daniel@0: weighted_histof(W,Dom,Disc,Goal,Hist) :- Daniel@0: setof(Dom-N,aggregate(sum(W),Disc,Goal,N),Hist). Daniel@0: Daniel@0: sparse_to_dense(Min,Max,Hist,Counts) :- Daniel@0: s_to_d(Min,Max,Hist,Counts). Daniel@0: Daniel@0: s_to_d(I,Max,[],[]) :- I>Max, !. Daniel@0: s_to_d(I,Max,[],[0|Counts]) :- !, succ(I,J), s_to_d(J,Max,[],Counts). Daniel@0: s_to_d(I,Max,[I-C|Hist],[C|Counts]) :- !, succ(I,J), s_to_d(J,Max,Hist,Counts). Daniel@0: s_to_d(I,Max,Hist,[0|Counts]) :- succ(I,J), s_to_d(J,Max,Hist,Counts). Daniel@0: Daniel@0: Daniel@0: add(X,Y,Z) :- Z is X+Y. Daniel@0: Daniel@0: :- meta_predicate Daniel@0: map_reduce(1,2,3,-), Daniel@0: map_reduce(1,2,3,-,-), Daniel@0: fold_commutative(3,+,-). Daniel@0: Daniel@0: %% map_reduce(+Generator:pred(-R), +Mapper:pred(+R,-A), +Reducer:pred(+A,+A,-A), -Result:A, -Errors:list(error_report(R))) is det. Daniel@0: %% map_reduce(+Generator:pred(-R), +Mapper:pred(+R,-A), +Reducer:pred(+A,+A,-A), -Result:A) is semidet. Daniel@0: % Daniel@0: % Simple implementation of map-reduce: Mapper is applied to each item produced by Generator Daniel@0: % and the results all combined using Reducer. Mapper should be a deterministic predicate. Daniel@0: % Failures and exceptions encountered in the mapping phase are reported in Errors. Daniel@0: % However, if the items are successfully mapped, this predicate fails. Daniel@0: % Any choice points left by mapper after its first solution are cut. Daniel@0: % Daniel@0: % == Daniel@0: % error_report(R) ---> failed(R); error(R,exception). Daniel@0: % == Daniel@0: map_reduce(Finder,Mapper,Reducer,Result) :- Daniel@0: map_reduce(Finder,Mapper,Reducer,Result,_). Daniel@0: Daniel@0: map_reduce(Finder,Mapper,Reducer,Result,Errors-Failures) :- Daniel@0: setof(X,call(Finder,X),Xs), Daniel@0: maplist(safe_call(Mapper),Xs,Ys), Daniel@0: partition_ok(Ys,Ok,Errors,Failures), Daniel@0: insist(fold_commutative(Reducer,Ok,Result)). Daniel@0: Daniel@0: %% safe_call(+P:pred(+A,-B), +X:A, -Y:result(A,B)) is det. Daniel@0: % Daniel@0: % Call binary predicate P with arguments of type A and B. The result Daniel@0: % term Y is of type Daniel@0: % == Daniel@0: % result(A,B) ---> ok(B); failed(A); error(A,exception). Daniel@0: % == Daniel@0: % and encodes the result of the call, including the input value that Daniel@0: % caused any failure or exception. Daniel@0: safe_call(Mapper,X,Z) :- Daniel@0: ( catch((call(Mapper,X,Y), Z=ok(Y)), Ex, Daniel@0: (Ex=abort_map -> throw(map_aborted); Z=error(X,Ex))), ! Daniel@0: ; Z=failed(X) Daniel@0: ). Daniel@0: Daniel@0: partition_ok([],[],[],[]). Daniel@0: partition_ok([In|Ins],Goods,Bads,Uglies) :- Daniel@0: ( In=ok(X) Daniel@0: -> Goods=[X|Goods1], partition_ok(Ins,Goods1,Bads,Uglies) Daniel@0: ; In=error(_,_) Daniel@0: -> Bads=[In|Bads1], partition_ok(Ins,Goods,Bads1,Uglies) Daniel@0: ; In=failed(X) Daniel@0: -> Uglies=[X|Uglies1], partition_ok(Ins,Goods,Bads,Uglies1) Daniel@0: ). Daniel@0: Daniel@0: fold_commutative(Op,Items,Result) :- Daniel@0: Items=[I1|Rest], Daniel@0: seqmap(Op,Rest,I1,Result), !. Daniel@0: Daniel@0: freq_note_number(F,N) :- N is 69+round(12*log(F/440)/log(2)). Daniel@0: Daniel@0: pitch_name_number(Name,Number) :- Daniel@0: atom_codes(Name,Chars), Daniel@0: phrase(note(Number),Chars). Daniel@0: Daniel@0: pitch_number_name(Number,Name) :- Daniel@0: phrase(note(Number),Chars), Daniel@0: atom_codes(Name,Chars). Daniel@0: Daniel@0: :- use_module(library(clpfd)). Daniel@0: note(Num) --> Daniel@0: [Nom], ({Mod=0}; [0'#],{Mod=1}), Daniel@0: { PC in 0..11, Daniel@0: Num #= 12*(Oct+1)+PC+Mod, Daniel@0: nom_semis(Nom,PC) Daniel@0: }, Daniel@0: integer(Oct). Daniel@0: Daniel@0: nom_semis(0'C,0). Daniel@0: nom_semis(0'D,2). Daniel@0: nom_semis(0'E,4). Daniel@0: nom_semis(0'F,5). Daniel@0: nom_semis(0'G,7). Daniel@0: nom_semis(0'A,9). Daniel@0: nom_semis(0'B,11). Daniel@0: Daniel@0: unzip(Pairs,Xs,Ys) :- maplist(pair,Xs,Ys,Pairs). Daniel@0: pair(X,Y,X-Y). Daniel@0: Daniel@0: row_pair(I,J,Row,X-Y) :- arg(I,Row,X), arg(J,Row,Y). Daniel@0: row_list(N,Row,List) :- functor(Row,_,N), Row=..[_|List]. Daniel@0: rows_cols(Is,[],Cols) :- !, maplist(nil,Is,Cols). Daniel@0: rows_cols(Is,[R|Rs],Cols) :- Daniel@0: ( maplist(arg_cons(R),Is,Tails,Cols) Daniel@0: -> rows_cols(Is,Rs,Tails) Daniel@0: ; fail % rows_cols(Is,Rs,Cols) Daniel@0: ). Daniel@0: Daniel@0: arg_cons(Row,I,T,[X|T]) :- arg(I,Row,X). Daniel@0: nil(_,[]). Daniel@0: Daniel@0: fst(F,K1-V,K2-V) :- call(F,K1,K2). Daniel@0: snd(F,K-V1,K-V2) :- call(F,V1,V2). Daniel@0: div_by(K,X,Y) :- Y is X/K. Daniel@0: Daniel@0: mul(X,Y,Z) :- Z is round(X*Y). Daniel@0: Daniel@0: :- dynamic pitch_hist_table/5, pitch_hist_tabled/1. Daniel@0: Daniel@0: csv_pitch_count_prob(W,CSV,Pitch,Count,Prob) :- Daniel@0: must_be(ground,W), Daniel@0: ( pitch_hist_tabled(W) -> true Daniel@0: ; table_pitch_hist(W) Daniel@0: ), Daniel@0: pitch_hist_table(W,CSV,Pitch,Count,Prob). Daniel@0: Daniel@0: table_pitch_hist(W) :- Daniel@0: retractall(pitch_hist_table_cached(W)), Daniel@0: forall( browse(csv_op_memo(pitch_hist(W),CSV,Hist)), Daniel@0: ( retractall(pitch_hist_table(W,CSV,_,_,_)), Daniel@0: forall( pitch_hist_prob(Hist,Pitch,Count,Prob), Daniel@0: assert(pitch_hist_table(W,CSV,Pitch,Count,Prob))))), Daniel@0: assert(pitch_hist_tabled(W)). Daniel@0: Daniel@0: pitch_hist_prob(Hist,Pitch,Count,Prob) :- Daniel@0: unzip(Hist,_,Counts), Daniel@0: sumlist(Counts,Total), Daniel@0: member(Pitch-Count,Hist), Daniel@0: Prob is Count/Total.