; voice leading -- 4 part voice writing (see HW 6, problem 4) ; AUTHOR: *EDIT* (with help from Gary T. Leavens) ; You must fill in each place in the ; following where it says EDIT below ; this code uses: "abs", "and", "not", the "List" cluster ;;;;;;;;;;;;;;;;NOTES;;;;;;;;;;;;;;;; (cluster Note ; Export: create, degree, equal, closest, ; thirdAbove, fifthAbove, octaveAbove, octaveBelow, display ; SUMMARY: degrees of a scale in a key, with tonic = 1 (immutable) (rep down) ; a pun... down gets the rep from abstract in CLU... ; ABSTRACTION FUNCTION: r: rep represents the note of degree (down r) ; REP INVARIANT: true (define create (n) ; TYPE: Int -> Note ; EFFECT: return the Note representing n (Note n)) (define degree (n) ; TYPE: Note -> Int ; EFFECT: return the degree of n (down n)) (define equal (n1 n2) ; TYPE: Note, Note -> bool ; EFFECT: is n1 the same degree as n2? EDIT) (define lower (n1 n2) ; TYPE: Note, Note -> bool ; EFFECT: is n1 lower than n2? EDIT) (define higher (n1 n2) ; TYPE: Note, Note -> bool ; EFFECT: is n1 higher than n2? EDIT) (define closest (n1 n2 n3 direction) ; TYPE: Note, Note, Note -> Note ; REQUIRES: direction is either -1 or +1 ; EFFECT: return the closest of n2 and n3 to n1; ; if they are equally close, break ties in favor of the opposite sign ; of direction (that if direction is -1, pick the higher of n2 and n3) EDIT) (define thirdAbove (n) ; TYPE: Note -> Note ; EFFECT: return the Note whose degree is 2 more than n EDIT) (define fifthAbove (n) ; TYPE: Note -> Note ; EFFECT: return the Note whose degree is 4 more than n EDIT) (define octaveAbove (n) ; TYPE: Note -> Note ; EFFECT: return the Note whose degree is 7 more than n EDIT) (define octaveBelow (n) ; TYPE: Note -> Note ; EFFECT: return the Note whose degree is 7 less than n EDIT) (define display (n) ; TYPE: Note -> () ; EFFECT: print the degree of n EDIT) ) ; Note (define makeHigher (x y) ; TYPE: Note, Note -> Note ; EFFECT: return smallest note y' such that y' is 0 or more octaves ; above y and such that y' > x (if (Note$lower x y) y (makeHigher x (Note$octaveAbove y)))) ;;;;;;;;;;CHORDS;;;;;;;;;;;;;;;; (cluster Chord ; Export: create, soprano, alto, tenor, bass, display ; SUMMARY: 4-part chords (immutable) (rep b t a s) ; ABSTRACTION FUNCTION: r: rep represents a chord with bass b, ; tenor t, alto a, and soprano s ; REP INVARIANT: true (define create (bs ten alt sop) ; TYPE: Note, Note, Note, Note -> Chord ; EFFECT: return the chord with bass bs, tenor ten, alto alt, soprano sop (Chord bs ten alt sop)) (define soprano (c) ; TYPE: Chord -> Note ; EFFECT: Return the soprano note of c EDIT) (define alto (c) ; TYPE: Chord -> Note ; EFFECT: Return the alto note of c EDIT) (define tenor (c) ; TYPE: Chord -> Note ; EFFECT: Return the tenor note of c EDIT) (define bass (c) ; TYPE: Chord -> Note ; EFFECT: Return the bass note of c EDIT) (define display (c) ; TYPE: Chord -> () ; EFFECT: display the sop, alto, tenor and bass of c (in that order) (begin (Note$display (s c)) (Note$display (a c)) (Note$display (t c)) (Note$display (b c)))) ) ; Chord ;;;;;;;;;;;SOME OPERATIONS ON LISTS;;;;;;;;;;;;; (define append (lst1 lst2) ; TYPE: all a. a list, a list -> a list ; EFFECT: return the list of the elements of lst1 followed by those in lst2 EDIT) (define nl-member? (n lst) ; TYPE: note, Note list -> bool ; EFFECT: is n an element of lst? EDIT) (define nl-display (nl) ; TYPE: Note list -> () ; EFFECT: display each note of nl (if (List$null? nl) 0 ; do nothing (begin (Note$display (List$car nl)) (nl-display (List$cdr nl))))) ; you might want to EDIT in some other operations on lists here... ;;;;;;;;;;;;CHORD COMPLEXES;;;;;;;;;;;;;;;; (cluster ChordComplex ; Export: create, delete-note, choose-closest, elim-lower, ; empty?, any-thirds?, elements, display ; SUMMARY: List of notes for a potential chord (mutable) (rep third fifth octave base) ; you can EDIT this to use a different rep ; if you wish, but this one is fine. ; ABSTRACTION FUNCTION: r: rep represents ; a list of notes possible for a given chord ; such that taking any one of them out also ; takes out the other notes in the list that ; differ by an octave ; REP INVARIANT: for r: rep, ; the list (third r) contains notes of ; degree (Note$degree (base r)) + 2 + k*7 (for positive k) ; the list (fifth r) contains notes (Note$degree (base r)) + 4 + k*7 ; the list (octave r) contains notes (Note$degree (base r)) + 7 + k*7 (define create (bass sop) ; TYPE: Note, Note -> ChordComplex ; EFFECT: returns a new chord complex for a chord based on bass. (begin (set sop (Note$octaveAbove (makeHigher bass sop))) (ChordComplex (octave-list (Note$thirdAbove bass) sop) (octave-list (Note$fifthAbove bass) sop) (octave-list (Note$octaveAbove bass) sop) bass))) (define delete-note (cc n) ; TYPE: ChordComplex, Note -> bool ; REQUIRES: n is an element of cc ; MODIFIES: cc ; EFFECT: delete n and all its octaves from cc EDIT) (define choose-closest (cc n direction) ; TYPE: ChordComplex, Note, Int -> Note ; REQUIRES: direction is either -1 or +1 and cc is not empty ; MODIFIES: cc ; EFFECT: return the closest note to n in cc, ; breaking ties in favor of the lower if direction ; is +1 and the higher if direction is -1, ; and delete the note returned and all its octaves from cc. EDIT) (define elim-lower (cc n) ; TYPE: ChordComplex, Note -> () ; MODIFIES: cc ; EFFECT: Deletes all notes from cc that are lower than n EDIT) (define empty? (cc) ; TYPE: ChordComplex -> Bool ; EFFECT: is cc empty? EDIT) (define any-thirds? (cc) ; TYPE: ChordComplex -> Bool ; EFFECT: are there any thirds above the bass left in cc? (not (List$null? (third cc)))) (define display (cc) ; TYPE: ChordComplex -> () ; EFFECT: print the notes of cc (nl-display (elements cc))) (define elements (cc) ; TYPE: ChordComplex -> Note list ; EFFECT: return a list of the notes in cc (without duplicates) EDIT) ; internal opertions ; you might want to EDIT some internal operations here (define octave-list (first max) ; TYPE: Note, Note -> Note list ; EFFECT: return the list of all Notes that are 0 or more octaves higher ; than first and no higher than max. The list is in increasing order. (if (Note$higher first max) (List$nil) (List$cons first (octave-list (Note$octaveAbove first) max)))) ) ; ChordComplex (define signum (x) ; TYPE: Int -> Int ; EFFECT: return -1 if x is negative, 0 if x is 0, +1 if x is positive (+ (* (< x 0) -1) (> x 0))) (define voice-leading (initial-chord bass-line) ; TYPE: Chord, Note list -> Chord list ; REQUIRES: the first element of bass-line is (Chord$bass initial-chord) ; EFFECT: returns chord list following rules of the problem statement (List$cons initial-chord (voice-leading-aux initial-chord (List$cdr bass-line) (Chord$bass initial-chord)))) (define voice-leading-aux (last-chord bass-line last-bass) ; TYPE: Chord, Note list, Note -> Note list ; EFFECT: returns a chord list following rules of problem statement ; for initial chord last-chord and bass line with (Chord$bass last-chord) ; added on to the front of bass-line. (last-bass is a convenience here.) (if (List$null? bass-line) (List$nil) (begin (set dir ; direction of bass motion (signum (- (Note$degree (List$car bass-line)) (Note$degree last-bass)))) (set bass (List$car bass-line)) (set cc (ChordComplex$create bass (Chord$soprano last-chord))) (set tenor (ChordComplex$choose-closest cc (Chord$tenor last-chord) dir)) (ChordComplex$elim-lower cc tenor) (set alto EDIT) EDIT (set soprano EDIT) (set new-chord EDIT) (List$cons EDIT)))) ; test data (set n-c (Note$create 1)) (set n-d (Note$create 2)) (set n-e (Note$create 3)) (set n-f (Note$create 4)) (set n-g (Note$create 5)) (set n-a (Note$create 6)) (set n-b (Note$create 7)) (set ic (Chord$create n-c n-g (Note$octaveAbove n-e) (Note$octaveAbove (Note$octaveAbove n-c)))) (set bl (List$cons n-c (List$cons n-f (List$cons n-g (List$cons n-c (List$nil)))))) (define song-display (song) (if (List$null? song) 0 (begin (Chord$display (List$car song)) (print 0) ; spacing... (song-display (List$cdr song))))) ;(set song (voice-leading ic bl)) (set hard-bl (List$cons n-c (List$cons n-g (List$cons n-e (List$cons (Note$octaveAbove (Note$octaveAbove n-a)) (List$nil)))))) ;(set song (voice-leading ic hard-bl))