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 |
---|
|
<- Previous | Index | Next -> |
---|---|---|
list of speakers, Jim_Albright | Thread | Re: list of speakers, Paul Prescod |
list of speakers, Jim_Albright | Date | On that last post..., Brandon Ibach |
Month |