Merge pull request #11 from benknoble/compare-csv

prototype comparison of anonymized appraisal files

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 <files>."
+   "Outputs CSV, one row per appraisal item."
+   ""
+   "All <files> 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)))))

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 '())

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:].]+)%\\]"