Re: Pattern-generating Scheme function challenge

[David Kastrup]

Urs Liska <address@hidden> writes:

> Hi Harm,
>
> I did a quick compilation (further investigation to follow) - and
> that's awesome! Thenk you very much.
> Of course it will be hard to 'sell' it with a 'hey, look how easy it
> is to realize that with LilyPond ;-)

Let's see how we can improve on that.

> Am 20.07.2013 23:48, schrieb Thomas Morley:
>> \version "2.17.22"
>> %% While compiling with 2.16.2, a little modification in \layout is
>> %% recommended.
>>
>> %% Used to get access to integer->list
>> %% Though, returns a warning:
>> %%   imported module (srfi srfi-60) overrides core binding `bit-count'
>> #(use-modules (srfi srfi-60))
>>
>> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>> %% definitions, helpers and functions
>> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>
>> %% c/p from lily-library.scm
>> %% Why not public?
>> #(define (list-minus a b)
>>    "Return list of elements in A that are not in B."
>>    (lset-difference eq? a b))
>>
>> %% Affects beaming for mixed notes and rests.
>> %% For debugging, uncomment modified 'thickness and 'color
>> #(define modify-beaming
>>    (lambda (grob)
>>      (let* ((all-stems
>>                (ly:grob-array->list (ly:grob-object grob 'stems)))
>>             (visible-stems
>>                (ly:grob-array->list (ly:grob-object grob 'normal-stems)))
>>             ;; not visible stems
>>             (stx (list-minus all-stems visible-stems)))
>>       (map

You probably mean for-each here?

>>        (lambda (x y z)
>>          (let* ((beaming-x (ly:grob-property x 'beaming))
>>                 (beaming-y (ly:grob-property y 'beaming))
>>                 (all-stems-length (length all-stems)))
>>          (cond
>>            ;;RED
>>                ((and (member x visible-stems)
>>                      (member y stx)
>>                      (or (member z visible-stems) (member z stx))
>>                      (not (equal? x (first all-stems))))
>>                   ;(ly:grob-set-property! x 'thickness 10)
>>                   ;(ly:grob-set-property! x 'color red)
>>                   (ly:grob-set-property! x 'beaming
>>                                            (cons (car beaming-x) (list 0))))
>>            ;;CYAN
>>                ((and (member x visible-stems)
>>                      (member y visible-stems)
>>                      (member z stx)
>>                      (equal? x (first all-stems)))
>>                   ;(ly:grob-set-property! y 'thickness 10)
>>                   ;(ly:grob-set-property! y 'color cyan)
>>                   (ly:grob-set-property! y 'beaming
>>                                            (cons (car beaming-y) (list 0))))
>>            ;;BLUE
>>                ((and (member x stx)
>>                      (member y visible-stems)
>>                      (member z visible-stems))
>>                   ;(ly:grob-set-property! y 'thickness 10)
>>                   ;(ly:grob-set-property! y 'color blue)
>>                   (ly:grob-set-property! y 'beaming
>>                                            (cons (list 0) (cdr beaming-y))))
>>                (else #f))))
>>         all-stems
>>         (cdr all-stems)
>>         (cddr all-stems))

This would seem to throw an error unless there are at least two stems.

But the real question is: what are you doing here, and why isn't there a
simpler way to do this?

>>    ;; print only one beam over rests
>>    (map
for-each
>>      (lambda (x)
>>        (ly:grob-set-property! x 'beaming (cons (list 0) (list 0))))
>>      stx))))
>>
>> modifyBeaming = \override Beam #'after-line-breaking = #modify-beaming
>>
>> #(define (position-in-list obj ls)
>>    "Search the positions of obj in ls"
>>     (define (position-in-list-helper obj ls ls1 bypassed)
>>       (if (null? ls)
>>           (reverse ls1)
>>           (if (equal? obj (car ls))
>>               (position-in-list-helper
>>                   obj (cdr ls) (cons bypassed ls1) (+ bypassed 1))
>>               (position-in-list-helper
>>                   obj (cdr ls) ls1 (+ bypassed 1)))))
>>    (position-in-list-helper obj ls '() 0))

Ok, this accumulates in ls1 the positions of obj.  What do you use this
for?  To call (position-in-list #t bool-list) when bool-list only
contains #t and #f as it is generated using integer->list.  So there is
no point whatsoever in doing comparisons here, you could just use the
boolean itself.  What do you do with `trues' afterwards?

Very little.  You use the position of the first set bit, and the
position of the last set bit, and the length.  Let's see what you do
here:

>> pattern =
>> #(define-music-function (parser location dur-log n)(integer? integer?)
>> "
>>   Returns one musical pattern, depending on
>>   @var{dur-log} for the general duration of note and rests
>>   @var{n} as the integer, whose bitwise representation is used
>>   to build the pattern.
>> "
>>    (let* ((bool-list (integer->list n))
>>           (bool-list-length (length bool-list))
>>           (trues (position-in-list #t bool-list))
>>           (trues-length (length trues))
>>           (music (map
>>                    (lambda (t c)
>>                      (if t
>>                          (make-music
>>                            'NoteEvent
>>                            'duration (ly:make-duration dur-log 0 1)
>>                            'pitch (ly:make-pitch 1 0 0)
>>                            'articulations
>>                              (if (and (> dur-log 2) (> trues-length 1))
>>                                  (cond ((= (car trues) c)
>>                                         (list (make-music
>>                                                 'BeamEvent
>>                                                 'span-direction
>>                                                 -1)))
>>                                        ((= (car (last-pair trues)) c)
>>                                         (list (make-music
>>                                                 'BeamEvent
>>                                                 'span-direction
>>                                                 1)))
>>                                         (else '()))
>>                                  '()))
>>                          (make-music
>>                            'RestEvent
>>                            'duration (ly:make-duration dur-log 0 1))))
>>                    bool-list (iota bool-list-length))))
>>
>>    (make-music 'SequentialMusic 'elements music)))

So we are going through the "bool list" here, special-casing the first
and the last set bit if there are at least two of them.  Let's just do
that explicitly, and let's just take a proper duration instead of the log:

pattern =
#(define-music-function (parser location dur n)(ly:duration? integer?)
  (let* ((first #f) (last #f)
         (mus #{ #@(map-in-order
                     (lambda (f) (if f
                                   (let ((m #{ c''$dur #}))
                                      (if first
                                          (set! last m)
                                          (set! first m))
                                       m)
                                    #{ r$dur #}))
                     (integer->list n)) #}))
       (if last
           (map-some-music
             (lambda (m)
               (cond ((eq? first m) #{ $m[ #})
                     ((eq? last m) #{ $m] #})
                     (else #f)))
             mus)
           mus)))

I'm a bit too tired to go through the rest (and obviously, if you want
to fit the rest together with the above unchanged, having a different
definition of the first argument is not going to work without further
changes).

And perhaps using map-some-music in order to have to avoid using
ly:music-property is a bit cheeky.  The main point is that the above
code gets away with knowing very little about how music expressions are
organized, so it's Scheme and LilyPond knowledge that are needed to do
it, but pretty much nothing about how LilyPond's data structures are
organized.

Which is very much how I prefer things to be for example code.  There is
still enough opportunity for intimidation.

-- 
David Kastrup