17

examples/dataviz/my_timeline.ody

@@ -38,14 +38,14 @@
   ("01.01.2014" "14")
   ("01.01.2015" "2015" #t)
   ("01.01.2016" "16")
-  ("01.01.2017" "17")  
+  ("01.01.2017" "17")
 ))
 
 
 (.svg
   (timeline
     #:mind "28.08.1979"
-    #:maxd "08.04.2017"
+    #:maxd "01.06.2017"
     #:title "Дни в моей жизни, которые я помню"
     ;#:title "My days I remember"
     #:zebra-background '("#f0f0f0")
@@ -56,6 +56,8 @@
     #:data (@
               "Denis Shirshov"
               (hash-filter
-                      (λ (k v) (re-matches? "^\\d\\d?\\.\\d\\d\\.\\d\\d\\d\\d$" k))
+                      (λ (k v) (or
+                                  (re-matches? "^\\d\\d?\\.\\d\\d\\.\\d\\d\\d\\d$" k)))
+                                  ;(re-matches? "^\\d\\d-\\d\\d\\.\\d\\d\\.\\d\\d\\d\\d$" k)))
                       ds_timeline))
   ))

lib/hash.rkt

@@ -24,6 +24,22 @@
     (λ (x) (list (car x) (cdr x)))
     (hash->list h)))
 
+(define (hash-print h #:delimeter (delimeter ", ") #:prefix (prefix "") #:equal-sign (equal-sign "="))
+  (let ((hl (hash-length h)))
+    (for/fold
+      ((s ""))
+      (((k v) (in-hash h)) (i hl))
+      (let ((vp (cond
+                  ((string? v) (str "'" v "'"))
+                  (else v))))
+      (if (< i (dec hl))
+        (str s prefix k equal-sign vp delimeter)
+        (str s prefix k equal-sign vp))))))
+
+(define (hash-print-json h #:prefix (prefix ""))
+  (format "{~a}"
+          (hash-print h #:delimeter ", " #:prefix prefix #:equal-sign ": ")))
+
 (define (hash-map f h)
   (for/hash (((k v) (in-hash h))) (f k v)))
 
@@ -199,3 +215,13 @@
     (((k v) (in-hash h))
     (i keys-order))
     (hash-ref h i #f)))
+
+(define (hash-take h n)
+  (let ((hl (hash-length h)))
+    (cond
+      ((>= n hl) h)
+      (else (for/hash
+              ( ((k v) (in-hash h))
+                (i (in-range hl))
+                #:break (= i n))
+              (values k v))))))

lib/math.rkt

@@ -82,3 +82,15 @@
           (pushr x0 (op (last x0) x)))
         (list (car lst))
         (cdr lst)))))
+
+; sum up sequence
+; (sum-seq (lambda (n) (/ 1.0 (* n n n))) 1e7) -> Apery's constant
+(define (sum-seq f k (s 0))
+  (cond
+    ((= k 0) s)
+    (else (sum-seq f (dec k) (+ s (f k))))))
+
+(define (reqsum f k (s 0))
+  (cond
+    ((= 0 k) s)
+    (else (reqsum f (dec k) (+ s (f s))))))

lib/optimize.rkt

 #lang racket
 
 (require compatibility/defmacro)
+(require "base.rkt")
 (require "seqs.rkt")
 (require "hash.rkt")
 
@@ -25,3 +26,22 @@
 (define (opt/uniques/unordered lst)
   (hash-keys
     (make-hash (map (λ (x) (cons x #t)) lst))))
+
+(define (opt/implode lst (sep ""))
+  (let* ((lst-length (length lst))
+        (res-lst
+          (for/fold
+            ((s null))
+            (
+              (i (reverse lst))
+              (c (in-range lst-length)))
+            (cond
+              ((= c (dec lst-length))
+                (if (not (null? i))
+                  (cons (format "~a" i) s)
+                  s))
+              ((null? i) (cons sep s))
+              (else
+                (cons sep (cons (format "~a" i) s)))
+                ))))
+    (apply string-append res-lst)))

lib/strings.rkt

@@ -16,8 +16,8 @@
 ;    ((hash? seq) template)
 ;    (else (format (re-substitute template '("~(l|h)") '("~a")) seq))))
 
-(define (str/escape astr)
-  (let ((replace-syms '("\\" "\"")))
+(define (str/escape astr (escapees empty))
+  (let ((replace-syms (merge (list "\\" "\"") escapees)))
     (for/fold
       ((res astr))
       ((sym replace-syms))

lib/tests/hash_test.rkt

@@ -34,6 +34,15 @@
   (check-equal? (hash-pair (hash (hash 'u 3 'w 30) 100 'b 20) (hash 'u 3 'w 30)) (cons (hash 'u 3 'w 30) 100))
 
   (check-true (alist? (hash->alist (hash 'a 1 'b 2))))
+  (check-equal? (hash->alist (hash 'a 1 'b 2)) '((a 1) (b 2)))
+
+  (check-equal? (hash-print (hash 'a 1 'b 2)) "a=1, b=2")
+  (check-equal? (hash-print (hash 'a 1 'b 2 'c 10) #:delimeter " AND ") "a=1 AND c=10 AND b=2")
+  (check-equal? (hash-print (hash 'a 1 'b 2) #:delimeter " AND " #:prefix "n.") "n.a=1 AND n.b=2")
+  (check-equal? (hash-print (hash 'a 1 'b 2) #:delimeter ", " #:prefix "n." #:equal-sign ": " ) "n.a: 1, n.b: 2")
+  (check-equal? (hash-print (hash 'a 1 'b "Polyphem") #:delimeter ", " #:prefix "n." #:equal-sign ": " ) "n.a: 1, n.b: 'Polyphem'")
+
+  (check-equal? (hash-print-json (hash 'a 1 'b 2)) "{a: 1, b: 2}")
 
   (check-equal? (@. h.a.aa) 10)
   (check-equal? (@. h.c) #f)
@@ -162,6 +171,11 @@
       (hash-delete (hash 'a 10 'b 20 'c 40) 'c)
       (hash 'a 10 'b 20)))
 
+  (check-true
+    (check-hash-equal?
+      (hash-delete (hash 'a 10 'b 20 'c 40) 'd)
+      (hash 'a 10 'b 20 'c 40)))
+
   (check-true
     (check-hash-equal?
       (hash-delete (hash (hash 'aa 10 'ab 20) 10 'b 20 'c 40) (hash 'aa 10 'ab 20))
@@ -297,5 +311,11 @@
 
 (check-equal?
   (hash->ordered-list (hash 'b 20 "a" 10 8 17 'c 30) '("a" b c 8))
-  '(10 20 30 17))          
+  '(10 20 30 17))
+
+(check-equal? (hash-length (hash 'a 10 'b '(1 2 3) 3 7)) 3)
+
+(check-equal?
+  (hash-length (hash-take (hash 'a 1 'b 2 'c 3 'd 4 'e 5) 2))
+  2)
 )

lib/tests/optimize_test.rkt

@@ -8,4 +8,10 @@
   (check-equal? (opt/uniques '(8 1 2 3 3 4 5 2 10 2)) '(8 1 2 3 4 5 10))
 
   ;(check-equal? (opt/flatten '((8 1) ((2)) (3 (3 (4 5))) 2 10 2 '())) '(8 1 2 3 3 4 5 2 10 2))
+
+  (check-equal? (opt/implode empty) "")
+  (check-equal? (opt/implode '(" " "b" "a" "k" "e" "\n" "r" "y")) " bake\nry")
+  (check-equal? (opt/implode '(1 2 3 4)) "1234")
+  (check-equal? (opt/implode '(1 2 3 4) "+") "1+2+3+4")
+  (check-equal? (opt/implode (list null null null) ",") ",,")
 )

lib/tests/strings_test.rkt

@@ -10,4 +10,5 @@
 
   ;(check-equal? (format-n "hello ~a" "world") "hello world")
   ;(check-equal? (format-n "hello ~l(, )" '("world" "verden")) "hello world, verden")
+
 )

lib/time.rkt

@@ -65,6 +65,7 @@
 (define (date->days d)
   (let*
       ((date-lst (split d "."))
+      ;(day (->number (first (split (first date-lst) "-")))) ; take first day in the days interval
       (day (->number (first date-lst)))
       (month (->number (second date-lst)))
       (year (->number (third date-lst)))

pmf/timeline.rkt

+#lang racket
+
+(require "../lib/all.rkt")
+
+(provide (all-defined-out))
+
+(define BDATE "28.08.1979")
+(define REFDATE "01.06.1985")
+
+;; (relative-hour-duration "01.06.1985" "11.05.2017" ) -> 4.89 [1 hour in 1985 is equal to 4.89 in 2017]
+(define (relative-hour-duration t1 t2 (t0 BDATE))
+  (/ (date-diff t2 t0) (date-diff t1 t0) 1.0))
+
+; effective years passed since the reference date
+(define (effective-years t (tr REFDATE))
+  (let ((dr (date-diff tr BDATE))
+        (n (date-diff t tr))) ; number of iterations
+    (/
+      (sum-seq
+        (λ (k) (/ dr (+ k dr))) ; increment
+        n
+        dr) ; start sum value
+      365.0)))

reports/widgets/eventline.rkt

@@ -62,7 +62,7 @@
                     res)))
           (items (if rate-lambda
                       (sort (hash-keys data) (make-rate-lambda rate-lambda data))
-                      (hash-keys data))) ;; STX sort
+                      (hash-keys data))) 
           (items (if top (lshift items top) items))
           (items-number (length items))
           (legend-x-h 20)

reports/widgets/timeline.rkt

@@ -75,6 +75,7 @@
                 (dates (sort
                           (hash-keys track-events) d<))
                 (y (* (+ track-h gap) $idx)))
+            (printf "[widgets/timeline.rkt] dates number: ~a~n" (length dates))
             (str
               s
               (g (@ 'transform (svg/translate y-axis-w 0))

scrap/csv.rkt

@@ -17,35 +17,30 @@
               (transpose first-break-list)))))
 
 (define (list->csv-file filename lst #:delimeter (delimeter ",") #:headers (headers #t) #:quoted (quoted #t))
-  (write-file
-    filename
-    (implode
-      (map
-        (λ (s)
-          (implode
-            (if quoted
-              (map (λ (ss) (str "\"" ss "\"")) s)
-              s)
-            delimeter))
-        lst)
-      "\n"))) ; STX curry, curryr
+  (let* ((content
+            (opt/implode
+              (map
+                (λ (s)
+                  (opt/implode
+                    (if quoted
+                      (map (λ (ss) (str "\"" (str/escape ss) "\"")) s)
+                      s)
+                    delimeter))
+                lst)
+              "\n")))
+  (write-file filename content)))
 
 (define (hash->csv-file filename h #:headers (headers #f) #:delimeter (delimeter ","))
-  (let ((headers (if headers headers (hash-keys (car (hash-values h))))))
-    (println
-      (pushl
-        (hash-values
-          (map-hash
-            (λ (k v) (values k (hash->ordered-list v headers)))
-            h))
-        headers))
+  (let* ((headers (if headers headers (hash-keys (car (hash-values h)))))
+        (llst (pushl
+                (hash-values
+                  (map-hash
+                    (λ (k v) (values k (hash->ordered-list v headers)))
+                    h))
+                headers)))
+    (println "hash->csv-file 1")
     (list->csv-file
       filename
-      (pushl
-        (hash-values
-          (map-hash
-            (λ (k v) (values k (hash->ordered-list v headers)))
-            h))
-        headers)
+      llst
       #:headers headers
       #:delimeter delimeter)))

scrap/neo4j/neo4j.rkt

@@ -3,7 +3,13 @@
 (require "../../lib/all.rkt")
 (require "../../../settings/APIs.rkt")
 
-(provide neo4j/authenticate neo4j/cypher gdb/create-database gdb/create-node gdb/import-csv)
+(provide
+    neo4j/authenticate neo4j/cypher
+    ;gdb/create-database
+    gdb/delete-nodes
+    gdb/create-node gdb/create-rel
+    gdb/create-index gdb/drop-index
+    gdb/import-csv)
 
 (define (cypher->json cypher-str (params-str #f))
   (format "{\"query\": \"~a\" ~a}"
@@ -40,31 +46,58 @@
 
 ;;;;;;;;;;;;
 
-(define (gdb/create-database db-name)
-  (neo4j/cypher (format "CREATE (n:~a)" db-name)))
+;(define (gdb/create-database db-name)
+;  (neo4j/cypher (format "CREATE (n:~a)" db-name)))
 
-(define (gdb/create-node
-            #:labels (labels #f)
-            #:properties (properties #f))
+(define (gdb/create-node n)
+  (let ((label (@. n.:label))
+        (properties (hash-delete n ':label)))
+    (neo4j/cypher
+      (format
+        "CREATE (~a ~a)"
+        (if label (str ":" label) "")
+        (hash-print-json properties)))))
+
+; n1: (hash ':label "person:queens_giant" 'id 5 'name "Richard Roe"))
+; n2: (hash ':label "person:queens_giant" 'id 7 'name "John Doe"))
+; rel: (hash ':label "test_rel" 'rate 10)
+(define (gdb/create-rel n1 n2 rel)
+  (let ((label1 (@. n1.:label))
+        (label2 (@. n2.:label))
+        (labelr (@. rel.:label)))
+  (neo4j/cypher
+    (format
+      "MATCH (n1~a), (n2~a) WHERE ~a AND ~a CREATE (n1)-[r~a ~a]->(n2)"
+      (if label1 label1 "")
+      (if label2 label2 "")
+      (hash-print (hash-delete n1 ':label) #:delimeter " AND " #:prefix "n1.")
+      (hash-print (hash-delete n2 ':label) #:delimeter " AND " #:prefix "n2.")
+      (if labelr (str ":" labelr) "")
+      (hash-print-json (hash-delete rel ':label))))))
+
+(define (gdb/delete-nodes #:label (label #f) #:limit (limit #f))
   (neo4j/cypher
     (format
-      "CREATE (n~a ~a)"
-      (cond
-        ((not labels) "")
-        ((list? labels) (str ":" (implode labels ":")))
-        (else (str ":" labels)))
-      (cond
-        ((not properties) "")
-        ((hash? properties) (hash->json properties "'"))
-        (else properties)))))
+      "MATCH (n~a) ~a DETACH DELETE n"
+      (if label (str ":" label) "")
+      (if limit (format "WITH n LIMIT ~a" limit) ""))))
+
+(define (gdb/create-index label property)
+  (neo4j/cypher
+    (format "CREATE INDEX ON :~a(~a)" label property)))
+
+(define (gdb/drop-index label property)
+  (neo4j/cypher
+    (format "DROP INDEX ON :~a(~a)" label property)))
 
 ; (gdb/import-csv "http://data.rusvegia.com/odysseus/test.csv" #:headers '(name surname rate) #:labels "Test")
-(define (gdb/import-csv csvfile #:headers (headers #f) #:labels (labels "Node"))
+(define (gdb/import-csv csvfile #:headers (headers #f) #:label (label "Node") #:large-dataset (large-dataset #f))
   (let ((req
-          (format "LOAD CSV ~a FROM '~a' AS row CREATE (:~a {~a} );"
+          (format "~a LOAD CSV ~a FROM '~a' AS row CREATE (:~a {~a} );"
+                  (if large-dataset "USING PERIODIC COMMIT" "")
                   (if headers "WITH HEADERS" "")
                   csvfile
-                  (if (list? labels) (implode labels ":") labels)
+                  (if (list? label) (implode label ":") label)
                   (if headers
                         (implode
                           (map
@@ -73,5 +106,5 @@
                           ", ")
                         "")
           )))
-    (println req)
+    ;(println req)
     (neo4j/cypher req)))