diff --git a/dia/compare-anonymous-appraisal.rkt b/dia/compare-anonymous-appraisal.rkt new file mode 100644 index 0000000..ed6a894 --- /dev/null +++ b/dia/compare-anonymous-appraisal.rkt @@ -0,0 +1,50 @@ +#lang racket + +;; Run with `racket compare-anonymous-appraisal.rkt` +;; or `racket -l- abe/compare-anonymous-appraisal` + +(require "tree-parser.rkt") + +(define (get-tree ip) + (when (regexp-match-peek #rx"#lang" ip) + (read-line ip 'any)) + (read-anonymous-attribution-tree2 ip)) + +(define (make-rows trees) + (let ([trees (map flatten trees)]) + (reverse + (let loop ([result '()] + [trees trees]) + (match trees + [(list '() ...) result] + [(list (cons (? string? x) rest) ...) + #:when (apply string=? x) + (loop (cons (list (car x)) result) + rest)] + [(list (cons (? number? n) rest) ...) + (loop (cons (append (car result) n) + (cdr result)) + rest)]))))) + +(define (make-table headers trees) + (cons headers (make-rows trees))) + +(module+ main + (require csv-writing) + (command-line + #:usage-help + "" + "Compares anonymous appraisals in ." + "Outputs CSV, one row per appraisal item." + "" + "All should be in either #lang abe/attribution2" + "or #lang abe/ideas2 format and should have the same items" + "in the same order." + "" + "Example:" + " compare-anonymous-appraisal /path/to/appraisals/*/capital.md" + #:args files + (display-table + (make-table (cons "Item" files) + (map (λ (f) (call-with-input-file f get-tree)) + files))))) diff --git a/dia/info.rkt b/dia/info.rkt index 6b8f9b3..75f2a9b 100644 --- a/dia/info.rkt +++ b/dia/info.rkt @@ -3,6 +3,7 @@ (define version "0.0") (define collection "abe") (define deps '("base" + "csv-writing" "qi-lib" "relation-lib")) (define build-deps '()) diff --git a/dia/tree-parser.rkt b/dia/tree-parser.rkt index 8106daf..a4043ea 100644 --- a/dia/tree-parser.rkt +++ b/dia/tree-parser.rkt @@ -2,6 +2,7 @@ (provide read-attribution-tree read-attribution-tree2 + read-anonymous-attribution-tree2 read-idea-attribution-tree read-idea-antecedents-tree) @@ -32,6 +33,12 @@ corresponding kind of tree. (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " "))) (tree-map label->attribution leaf->attribution2))) +(define-flow (read-anonymous-attribution-tree2 ip) + (~> port->lines + (filter non-empty-string? _) + (make-indent-based-tree (flow (regexp-replace* #px"[[:blank:]]" _ " "))) + (tree-map label->attribution leaf->anonymous-attribution2))) + (define-flow (read-idea-attribution-tree ip) (~> port->lines (filter non-empty-string? _) @@ -136,6 +143,12 @@ on format. (if (~> cdr null?) car _)) attribution)])) +(define (leaf->anonymous-attribution2 x) + (match x + [(regexp #px"^\\s*\\* (.*)\\[([[:digit:].]+)%\\]" + (list _ line (app string->number attribution))) + (cons line attribution)])) + (define (label->attribution x) (match x [(regexp #px"^\\s*\\* (.*) \\[([[:digit:].]+)%\\]"