Re: list of speakers

Subject: Re: list of speakers
From: Brandon Ibach <bibach@xxxxxxxxxxxxxx>
Date: Sun, 19 Jul 1998 11:58:35 -0500 (CDT)
Jim_Albright@xxxxxxx said:
> 
> Is it possible to extract the unique list of speakers in a play?
> Is it possible to sort by number of times they speak?
> 
> Assume that each speech is marked with
> <VOICE>name of person who speaks</VOICE>
> <TEXT>what the person says</TEXT>
> 
> I am interested in final output like
> 
> --speaker-----times they speak---
> Little girl         20
> Mother              13
> Friends of family    7
> Father               4
> Crowd                4
> Soldiers             2
> 
   When I first started thinking about this, I wasn't sure it could be
done, given DSSSL's side-effect-free nature.  (On that note, can
anyone explain the devotion to this?  I understand the basic
philosophy - a style sheet just styles, and shouldn't do anything else
on the side - but...)
   However, with some furthur thought, I was able to come up with a
solutions.  A couple of hours (and a dozen or so runs of jade) later,
we have...

Here's the DTD I used:
<!element play  - - (line)*>
<!element line  - o (voice,text)>
<!element voice o o (#PCDATA)*>
<!element text  - o (#PCDATA)*>

and the stylesheet:
<!doctype style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN">

<style-specification>

(declare-flow-object-class element
  "UNREGISTERED::James Clark//Flow Object Class::element")

; ***** This first part can be modified as needed *****
; *****   to get the output the way you want it   *****

; spit out a 2 column table with |speaker  |  lines|, sorted
(element PLAY
  (make element gi: "TABLE"
    (tablify (sort (tally (descendants (current-node)))))))

; don't output anything for any other elements
(default (empty-sosofo))

; construct a table row for a single pair of ("string" . count)
(define tablifyp (lambda (p)
  (make element gi: "TR" (make sequence
    (make element gi: "TD" attributes: (list (list "ALIGN" "LEFT"))
      (literal (car p)))
    (make element gi: "TD" attributes: (list (list "ALIGN" "RIGHT"))
      (literal (number->string (cdr p))))))))

; construct table rows for a list of pairs
(define tablify (lambda (pl)
  (let loop ((p pl))
    (if (null? p) (empty-sosofo)
        (sosofo-append (tablifyp (car p)) (loop (cdr p)))))))

; ***** Now the important stuff begins... *****

; take a singleton node-list and a list of pairs, each of which
; is a string (from the data of a node) and a count, and return
; the list of pairs, updated to include the node
; example: (tallya ([node: "b"]) (("a" . 1) ("b" . 1)) =>
;                                (("a" . 1) ("b" . 2))
;      or: (tallya ([node: "c"]) (("a" . 1) ("b" . 2)) =>
;                                (("a" . 1) ("b" . 2) ("c" . 1))
(define tallya (lambda (nd t)
  (let loop ((tl t))
    (if (null? tl) (list `(,(data nd) . 1))
        (if (string=? (data nd) (car (car tl)))
            (cons `(,(car (car tl)) . ,(+ (cdr (car tl)) 1)) (cdr tl))
            (cons (car tl) (loop (cdr tl))))))))

; run through a node-list and return a list of pairs with the counts
(define tally (lambda (nl)
  (let loop ((n nl) (t '()))
    (if (node-list-empty? n) t
        (loop (node-list-rest n)
              (if (string=? (or (gi (node-list-first n)) "") "VOICE")
                  (tallya (node-list-first n) t) t))))))

; take two pairs of form (somedatum . count)
; return  0 if the counts are equal
; return  1 if the first count is less    than the second
; return -1 if the first count is greater than the second
; Note: this is reverse of usual, so our list will be greatest-first
(define sortp (lambda (a b)
  (cond ((= (cdr a) (cdr b)) 0)
        ((< (cdr a) (cdr b)) 1)
        ((> (cdr a) (cdr b)) -1))))

; return the average count (rounded) of a list of pairs (datum . count)
(define avgp (lambda (lst)
  (round (/ (let loop ((l lst))
                 (if (= (length l) 1) (cdr (car l))
                     (+ (cdr (car l)) (loop (cdr l)))))
            (length lst)))))

; take a list of pairs and return the results of a qsort on it
(define sort (lambda (l) (qsort l sortp avgp)))

; take a list and a procedure and return a list of those
; members of the list which return true for the procedure
(define qdiv (lambda (lst cp)
  (let loop ((l lst))
       (if (null? l) '()
           (let ((a (car l)) (d (cdr l)))
                (if (cp a) (cons a (loop d)) (loop d)))))))

; Quick-sorts a list based on supplied comparison and average procs
(define qsort (lambda (l sp ap)
  (cond ((< (length l) 2) l)
        ((= (length l) 2)
         (if (< (sp (car (cdr l)) (car l)) 0)
             (cons (car (cdr l)) (car l)) l))
        (else (let* ((a (ap l)) (cp (lambda (p) (sp p (cons 'a a)))))
                (append (qsort (qdiv l (lambda (p) (<= (cp p) 0))) sp ap)
                        (qsort (qdiv l (lambda (p) (>  (cp p) 0))) sp ap)))))))

--------
Note that the speakers are tallied up case-sensitively.  You should be
able to fix this by changing the (string=? ...) to (string-ci=? ...)
(I think) in (tallya).

Enjoy!

-Brandon :)


 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist


Current Thread
  • list of speakers
    • Jim_Albright - from mail1.ability.netby web4-1.ability.net (8.8.5/8.6.12) with ESMTP id TAA28284Sat, 18 Jul 1998 19:27:16 -0400 (EDT)
      • Brandon Ibach - from mail1.ability.netby web4-1.ability.net (8.8.5/8.6.12) with ESMTP id NAA17179Sun, 19 Jul 1998 13:01:52 -0400 (EDT) <=
      • <Possible follow-ups>
      • Paul Prescod - from mail1.ability.netby web4-1.ability.net (8.8.5/8.6.12) with ESMTP id QAA20795Sun, 19 Jul 1998 16:03:47 -0400 (EDT)
      • Jim_Albright - from mail1.ability.netby web4-1.ability.net (8.8.5/8.6.12) with ESMTP id XAA11956Mon, 20 Jul 1998 23:46:42 -0400 (EDT)
        • Paul Prescod - from mail1.ability.netby web4-1.ability.net (8.8.5/8.6.12) with ESMTP id CAA16649Tue, 21 Jul 1998 02:59:37 -0400 (EDT)