[clinton/scratch.git] / distance.scm

(use-modules (srfi srfi-1))

(define distance (a b)
  (abs (- a b)))

(define (distance-change bpm_c bpm_n bpm_n+1)
  (- (abs (distance bpm_c bpm_n) (distance bpm_c bpm_n+1))
     (distance bpm_a bpm_b)))

(define (insert-song song playlist)
  (let ((last
	 (let find-minimum ((current-minimum (inf))
			    (min-cons '())
			    (plist playlist))
	   (cond
	    ((null? (cdr rest))
	     '())
	    ((< (distance-change song (first plist) (second plist))
		current-minimum)
	     (find-minimum (distance-change song (first plist) (second plist))
			   (first plist)
			   (rest plist)))
	    (else (find-minimum current-minimum min-cons (rest plist)))))))
    (let insert-copy ((old-list playlist))
      (cond ((eq? last old-list)
	     ;; (list... (car old-list) song (cdr old-list))
	     (cons* (car old-list) song (cdr old-list)))
	    (else (cons (car old-list) (insert-copy (cdr old-list))))))))
Commit	Line	Data
2d6a241e CE	1	(use-modules (srfi srfi-1))
	2
	3	(define distance (a b)
	4	(abs (- a b)))
	5
	6	(define (distance-change bpm_c bpm_n bpm_n+1)
	7	(- (abs (distance bpm_c bpm_n) (distance bpm_c bpm_n+1))
	8	(distance bpm_a bpm_b)))
	9
	10	(define (insert-song song playlist)
	11	(let ((last
	12	(let find-minimum ((current-minimum (inf))
	13	(min-cons '())
	14	(plist playlist))
	15	(cond
	16	((null? (cdr rest))
	17	'())
	18	((< (distance-change song (first plist) (second plist))
	19	current-minimum)
	20	(find-minimum (distance-change song (first plist) (second plist))
	21	(first plist)
	22	(rest plist)))
	23	(else (find-minimum current-minimum min-cons (rest plist)))))))
	24	(let insert-copy ((old-list playlist))
	25	(cond ((eq? last old-list)
	26	;; (list... (car old-list) song (cdr old-list))
	27	(cons* (car old-list) song (cdr old-list)))
	28	(else (cons (car old-list) (insert-copy (cdr old-list))))))))
	29