heapq added
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 28 Feb 2018 12:24:08 +0000 (13:24 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 28 Feb 2018 12:24:08 +0000 (13:24 +0100)
modules/language/python/for.scm
modules/language/python/list.scm
modules/language/python/module/collections.scm
modules/language/python/module/heapq.scm [new file with mode: 0644]
modules/language/python/module/python.scm
modules/language/python/try.scm

index 8db5aa7c06d01b62031b728492f0186b17adf640..4541df2a407cefabee011648bef17efb1b1124ce 100644 (file)
@@ -77,7 +77,9 @@
                        (set! x x1)
                        ... ...
                        (call-with-values
-                           #,(wrap-continue #'lp #'(code ...))
+                           #,(wrap-continue
+                             #'lp
+                             #'((let ((x x) ... ...) code ...)))
                          (lambda (cc ... . q) (llp cc ...)))))
                    (lambda q fin))))))))))
 
index 0cbd30aa80ad3964a8971d84bb0a587aceff5c0c..b101da73e597a16f5454cbd329ea57690dfd7d7a 100644 (file)
@@ -11,7 +11,7 @@
   #:use-module (language python try)
   #:use-module (language python exceptions)
   #:use-module (language python persist)
-  #:export (to-list to-pylist <py-list> 
+  #:export (to-list to-pylist <py-list> py-list
             pylist-append!
             pylist-slice pylist-subset! pylist-reverse!
             pylist-pop! pylist-count pylist-extend! len in
          (vec (slot-ref o 'vec))
          (N   (vector-length vec)))
     (if (< n N)
-        (begin
-          (vector-set! vec n val)
-          (slot-set! o 'n (+ n 1)))
+       (vector-set! vec n val)
         (let* ((N    (* 2 N))
                (vec2 (make-vector N)))
           (let lp ((i 0))
     (slot-set! out 'd   1)
     out))
 
+(define-method (wrap-in (o <vector>))
+  (let ((out (make <py-list-iter>)))
+    (slot-set! out 'n   (vector-length o))
+    (slot-set! out 'vec o)
+    (slot-set! out 'i   0)
+    (slot-set! out 'd   1)
+    out))
+
 (define-method (py-reversed (o <py-list>))
   (let ((out (make <py-list-iter>)))
     (slot-set! out 'i   (- (slot-ref o 'n) 1))
              (next-method)))))
 
 
-(define-method (wrap-in (o <py-list-iter>))
-  (let ((out (make <py-list-iter>)))
-    (slot-set! out 'vec (slot-ref o 'vec))
-    (slot-set! out 'i   (slot-ref o 'i))
-    (slot-set! out 'n   (slot-ref o 'n))
-    (slot-set! out 'd   (slot-ref o 'd))
-    out))
-
-(define-method (wrap-in (o <py-seq-iter>))
-  (let ((out (make <py-seq-iter>)))
-    (slot-set! out 'o (slot-ref o 'o))
-    (slot-set! out 'i (slot-ref o 'i))
-    (slot-set! out 'n (slot-ref o 'n))
-    (slot-set! out 'd (slot-ref o 'd))
-    out))
-
+(define-method (wrap-in (o <py-list-iter>)) o)
 
+(define-method (wrap-in (o <py-seq-iter>)) o)
         
 (define-method (wrap-in (o <py-seq-iter> )) o)
 
     (for ((x1 : o1) (x2 : o2)) ()
       (if (< x1 x2)
           (break #t))
+      (if (> x1 x2)
+         (break #f))
       #:final
       (< n1 n2))))
 
     (for ((x1 : o1) (x2 : o2)) ()
       (if (< x1 x2)
           (break #t))
+      (if (> x1 x2)
+         (break #f))
+
       #:final
       (<= n1 n2))))
 
     (for ((x1 : o1) (x2 : o2)) ()
       (if (> x1 x2)
           (break #t))
+      (if (< x1 x2)
+         (break #f))
+
       #:final
       (> n1 n2))))
 
     (for ((x1 : o1) (x2 : o2)) ()
          (if (> x1 x2)
              (break #t))
+        (if (< x1 x2)
+         (break #f))
+
          #:final
          (>= n1 n2))))
 
            (break #t))
        #:final
        #f))
+
+(define py-list list)
index bfb75fa24a5900720ea463f9e00a33eb3befeca1..6e004a3e4a9013a6f071ccefc37105dd5f1713b8 100644 (file)
@@ -1,8 +1,19 @@
 (define-module (language python module collections)
   #:use-module (oop pf-objects)
   #:use-module (language python module collections abc)
-  #:export (ChainMap))
+  #:export (abc ChainMap))
 
+(define-python-class class-from-dict ()
+  (define __init__
+    (lambda (self d)
+      (for ((k v : d))
+          (set self k v)))))
+
+(define abc
+  (class-from-dict
+   (resolve-module (module-public-interface
+                   '(language python module collections abc)))))
+  
 (define (u self)
   (let ((s (set)))
     (apply (ref s 'union) (ref self 'maps)))
             (sorted ((ref self 'items) #:key (_itemgetter 1) #:reverse #t)
            _heapq.nlargest(n ((ref self 'items)) #:key (_itemgetter 1))
 
-
+           
               
 
 
   
 
-(define* (namedtuple typename field-names #key (verbose #f) (rename=#f)
-(module None))
   
   
 
diff --git a/modules/language/python/module/heapq.scm b/modules/language/python/module/heapq.scm
new file mode 100644 (file)
index 0000000..768aee2
--- /dev/null
@@ -0,0 +1,236 @@
+(define-module (language python module heapq)
+  #:use-module (ice-9 control)
+  #:use-module (language python for)
+  #:use-module (language python yield)
+  #:use-module (language python try)
+  #:use-module (language python exceptions)
+  #:use-module (language python list)
+  #:use-module (language python def)
+  #:use-module (oop pf-objects)
+  #:use-module ((language python module python)
+               #:select (zip sorted range enumerate iter max min))
+  #:export (heappush heappop heapify heapreplace merge nlargest nsmallest
+                    heappushpop))
+
+(define-syntax-rule (aif it p a b) (let ((it p)) (if it a b)))
+
+(define (heappush heap item)
+  (pylist-append! heap item)
+  (siftdown heap 0 (- (len heap) 1)))
+
+(define (heappop heap)
+  (let ((lastelt (pylist-pop! heap)))
+    (if (> (len heap) 0)
+       (let ((ret (pylist-ref heap 0)))
+         (pylist-set! heap 0 lastelt)
+         (siftup heap 0)
+         ret)
+       lastelt)))
+
+(define (heapreplace heap item)
+  (let ((ret (pylist-ref heap 0)))
+    (pylist-set! heap 0 item)
+    (siftup heap 0)
+    ret))
+
+(define (heapify x)
+  (let lp ((i (- (floor-quotient (len x) 2) 1)))
+    (if (>= i 0)
+       (begin
+         (siftup x i)
+         (lp (- i 1))))))
+
+(define (heappop_max heap)
+  (let ((lastelt (pylist-pop! heap)))
+    (if (> (len heap) 0)
+       (let ((ret (pylist-ref heap 0)))
+         (pylist-set! heap 0 lastelt)
+         (siftup_max heap 0)
+         ret)
+       lastelt)))
+
+(define (heapreplace_max heap item)
+  (let ((ret (pylist-ref heap 0)))
+    (pylist-set! heap 0 item)
+    (siftup_max heap 0)
+    ret))      
+
+(define (heapify_max x)
+  (let lp ((i (- (floor-quotient (len x) 2) 1)))
+    (if (>= i 0)
+       (begin
+         (siftup_max x i)
+         (lp (- i 1))))))
+
+(define (siftdown heap startpos pos)
+  (define newitem (pylist-ref heap pos))
+  
+  (let lp ((pos pos))
+    (if (> pos startpos)
+       (let ()
+         (define parentpos (ash (- pos 1) 1))
+         (define parent    (pylist-ref heap parentpos))
+         (if (< newitem parent)
+             (begin
+               (pylist-set! heap pos parent)
+               (lp parentpos))
+             (pylist-set! heap pos newitem)))
+       (pylist-set! heap pos newitem))))
+
+(define (siftup heap pos)
+  (define endpos   (len heap))
+  (define startpos pos)
+  (define newitem  (pylist-ref heap pos))
+  (let lp ((pos pos) (childpos (+ (* 2 pos) 1)))
+    (if (< childpos endpos)
+       (let* ((rightpos (+ childpos 1))
+              (childpos
+               (if (and (< rightpos endpos)
+                        (not (< (pylist-ref heap childpos)
+                                (pylist-ref heap rightpos))))
+                   rightpos
+                   childpos)))
+         (pylist-set! heap pos (pylist-ref heap childpos))
+         (lp childpos (+ (* 2 childpos) 1)))
+       (begin
+         (pylist-set! heap pos newitem)
+         (siftdown heap startpos pos)))))
+
+(define (siftdown_max heap startpos pos)
+  (define newitem (pylist-ref heap pos))
+  
+  (let lp ((pos pos))
+    (if (> pos startpos)
+       (let ()
+         (define parentpos (ash (- pos 1) 1))
+         (define parent    (pylist-ref heap parentpos))
+         (if (< parent newitem)
+             (begin
+               (pylist-set! heap pos parent)
+               (lp parentpos))
+             (pylist-set! heap pos newitem)))
+       (pylist-set! heap pos newitem))))
+
+(define (siftup_max heap pos)
+  (define endpos   (len heap))
+  (define startpos pos)
+  (define newitem  (pylist-ref heap pos))
+  (let lp ((pos pos) (childpos (+ (* 2 pos) 1)))
+    (if (< childpos endpos)
+       (let* ((rightpos (+ childpos 1))
+              (childpos
+               (if (and (< rightpos endpos)
+                        (not (< (pylist-ref heap rightpos)
+                                (pylist-ref heap childpos))))
+                   rightpos
+                   childpos)))
+         (pylist-set! heap pos (pylist-ref heap childpos))
+         (lp childpos (+ (* 2 childpos) 1)))
+       (begin
+         (pylist-set! heap pos newitem)
+         (siftdown_max heap startpos pos)))))
+
+(def (merge (* iterables) (= key (lambda (x) x)) (= reverse #f))
+    ((make-generator ()
+       (lambda (yield)
+        (define h (py-list))
+        (define (h_append x) (pylist-append! h x))
+        (define-values (-heapify -heappop -heapreplace direction)
+          (if reverse
+              (values heapify_max
+                      heappop_max
+                      heapreplace_max
+                      -1)
+              (values heapify
+                      heappop
+                      heapreplace
+                      1)))
+          
+                (for ((order it : (enumerate (map iter iterables)))) ()
+             (define next- (aif x (ref it '__next__)
+                                x
+                                (lambda () (next it))))
+             (try
+              (lambda ()
+                (h_append (vector (key (next-))
+                                  (* order direction)
+                                  next-)))
+              (#:except StopIteration =>
+                        (lambda x (-heappop h)))))
+
+        (-heapify h)
+        (let lp ()
+          (if (> (len h) 1)
+              (try
+               (lambda ()
+                 (let lp ()
+                   (let ((s (pylist-ref h 0)))
+                     (yield (vector-ref s 0))
+                     (vector-set! s 0 (key ((vector-ref s 2))))
+                     (-heapreplace h s)
+                     (lp))))
+               (#:except StopIteration =>
+                         (lambda x (-heappop h) (lp))))))
+
+        (if (> (len h) 0)
+            (let* ((x (pylist-ref h 0))
+                   (n (pylist-ref x 2)))
+              (let lp ((i (vector-ref x 0)))
+                (yield i)
+                (lp (n)))))))))
+                
+
+
+        
+(define-syntax-rule (mkn nsmallest heapify_max heapreplace_max q< ran o ++)
+  (define* (nsmallest n iterable #:key (key (lambda (x) x)))
+    (let/ec return
+      (if (equal? n 1)
+         (return
+          (let* ((sent (list 1))
+                 (res  (min (iter iterable) #:default sent #:key key)))
+            (if (eq? sent res)
+                '()
+                (list res)))))
+
+      (let ((size (try
+                  (lambda () (len iterable))
+                  (#:except (or TypeError AttributeError) =>
+                            (lambda x #f)))))
+       (if (and size (>= n size))
+           (return (pylist-slice (sorted iterable #:key key) 0
+                                 ((@ (guile) min) n size)
+                                 1))))
+  
+      (let ((it     (iter iterable))
+           (result (py-list)))
+    
+       (for ((i elem : (zip (ran n) it))) ()
+            (pylist-append! result (vector (key elem) i elem)))
+
+       (if (= 0 (len result))
+           (return result))
+
+       (heapify_max result)
+
+       (for ((elem : it)) ((top   (vector-ref (pylist-ref result 0) 0))
+                           (order (o n)))
+            (let ((k (key elem)))
+              (if (q< k top)
+                  (begin
+                    (heapreplace_max result (vector k order elem))
+                    (values (vector-ref (pylist-ref result 0) 0)
+                            (++ order)))
+                  (values top order))))
+       (pylist-sort! result)
+       (return
+        (let ((r (py-list)))
+          (for ((x : result)) ()
+               (pylist-append! r (vector-ref x 2)))
+          r))))))
+
+(mkn nsmallest heapify_max heapreplace_max < (lambda (n) (range n))
+     (lambda (n) n) (lambda (x) (+ x 1)))
+
+(mkn nlargest  heapify     heapreplace     > (lambda (n) (range 0 (- n) -1))
+     (lambda (n) (- n)) (lambda (x) (- x 1)))
index 2ea57eba8bb1deba3c8e73a74e0e4a250ff9ad81..8264feec768fb1a3f9370c99c768af09318c83f5 100644 (file)
 (define staticmethod static-method)
 
 (define (enumerate l)
-  (make-generator enumerate
-     (lambda (yield)
+  ((make-generator ()
+    (lambda (yield)
        (for ((x : l)) ((i 0))
             (yield i x)
-           (+ i 1)))))
+           (+ i 1))))))
 
 (define (filter f l)
-  (make-generator enumerate
-    (lambda (yield)
-      (for ((x : l)) ()
-           (if (f x)
-               (yield x))))))
+  ((make-generator ()
+     (lambda (yield)
+       (for ((x : l)) ()
+            (if (f x)
+                (yield x)))))))
 
 (define miss ((@ (guile) list) 'miss))
 
      (let lp ((l l))
        (match l
          ((it)
-          (for ((x : it)) ((s default) (b default))
+          (for ((x : it)) ((s miss) (b miss))
                (if (eq? s miss)
                    (values (key x) x)
                    (let ((k (key x)))
                          (values s b))))
                #:final
                (if (eq? b miss)
-                   (raise ValueError "min does not work for zero length list")
+                  (if (eq? default miss)
+                      (raise ValueError
+                             "min does not work for zero length list")
+                      default)
                    b)))
          (_ (lp ((@ (guile) list) l))))))
 
      (let lp ((l l))
        (match l
          ((it)
-          (for ((x : it)) ((s default) (b default))
-               (if (eq? default miss)
+          (for ((x : it)) ((s miss) (b miss))
+               (if (eq? s miss)
                    (values (key x) x)
                    (let ((k (key x)))
                      (if (> k s)
                          (values s b))))
                #:final
                (if (eq? b miss)
-                   (raise ValueError "min does not work for zero length list")
+                  (if (eq? default miss)
+                      (raise ValueError
+                             "min does not work for zero length list")
+                      default)
                    b)))
          (_ (lp ((@ (guile) list) l))))))
 
index a36263b029102fe5f27c2b0a7f367b209528f366..36d9b04f3e12d717ca58bca1e04a57d31291345c 100644 (file)
     ((_ E tag l)
      (check E tag l))))
 
+(define (m code)
+  (let ((c code))
+    (lambda (k . l)
+      (if (eq? k StopIteration)
+         (apply c 'python k l)
+         (apply c k l)))))
+
 (define-syntax handler
   (syntax-rules (=>)
-
     ((handler ecx)
-     (lambda (k tag . l)
-       (handler ecx tag l)))
+     (m 
+      (lambda (k tag . l)
+       (handler ecx tag l))))
     
     ((handler ((#:except E => lam) . ecx) tag l)
      (if (check-exception E tag l)