mbk/hsmusic
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

i don't think i like the hashset approach

Browse source 
also the name normalizing SUCKS
This commit is contained in:
mehbark 2024-04-14 21:43:35 -04:00
parent ce07ab9308
commit d0653d7170
1 changed files with 11 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
hsmusic.lisp
View file

@ -1,6 +1,6 @@
(ql:quickload '(:cl-yaml :alexandria :cl-graph :cl-ppcre))
(ql:quickload '(:cl-yaml :alexandria :cl-ppcre))
(defpackage :hsmusic
(:use :common-lisp :alexandria :cl-graph))
(:use :common-lisp :alexandria))
(in-package :hsmusic)
(defparameter tracks
@ -17,22 +17,14 @@
(sb-unicode:normalize-string (string-downcase name) :nfkd)
""))
(defparameter graph (containers:make-container 'graph-container :default-edge-type :directed))
(defun track-normalized-name (track)
(normalize-name (gethash "Track" track)))
(defparameter edges (make-hash-table :test 'equal))
; (from . to)
; conceptually, from -> to
(loop for track in tracks
do
(loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
do (format t "~a -> ~a~%" (normalize-name (gethash "Track" track)) (normalize-name ref))
do (add-edge-between-vertexes
graph
(normalize-name (gethash "Track" track))
(normalize-name ref))))
(defun track-vertex (name)
(find-vertex-if graph (lambda (x) (equal (slot-value x 'element) (normalize-name name)))))
; instead of this whole graph thing, i *could* do an alist
; rassoc exists
; BUT the graph library has :o algorithms :o
; BUT still would be faster than 1st attempt
do (let ((name (track-normalized-name track)))
(loop for ref in (append (gethash "Referenced Tracks" track) (gethash "Sampled Tracks" track))
do (setf (gethash (cons (normalize-name ref) name) edges) t))))