Changeset 33330 in project


Ignore:
Timestamp:
05/18/16 17:23:33 (3 years ago)
Author:
Alex Shinn
Message:

adding optimized versions of iset-difference and iset-intersection

Location:
release/4/iset
Files:
4 edited
3 copied

Legend:

Unmodified
Added
Removed
  • release/4/iset/tags/2.0/iset-test.scm

    r20390 r33330  
    4141         ((129 2 127))
    4242         ((1 -128 -126))
     43         ((12354 12356 12358 12360 12362) (i 12354 12356 12362) (= 12354 12356 12362))
     44         ((12354 12356 12358 12360 12362) (d 12354 12356 12362) (= 12358 12360))
    4345         )))
    4446  (for-each
     
    6668            ((d)
    6769             (set! is (iset-difference! is (list->iset (cdr op))))
    68              (for-each (lambda (x) (test-assert (iset-contains? is x))) (cdr op)))
     70             (for-each (lambda (x) (test-assert (not (iset-contains? is x)))) (cdr op)))
    6971            ((e) (test-assert (and (iset-every (cadr op) is) #t)))
    7072            ((i) (set! is (iset-intersection! is (list->iset (cdr op)))))
  • release/4/iset/tags/2.0/iset.scm

    r30013 r33330  
    403403(define (bit-vector-and a . args)
    404404  (apply bit-vector-and! (bit-vector-copy a) args))
     405
     406(define (bit-vector-andc2! a . args)
     407  (u8vector-map! (lambda (i j) (fxand i (fxnot j))) (lambda (a lo hi) a) a args))
     408(define (bit-vector-andc2 a . args)
     409  (apply bit-vector-andc2! (bit-vector-copy a) args))
    405410
    406411(define (bit-vector-ior! a . args)
     
    653658    (if (bit-vector-full? bits (- (iset-end iset) (iset-start iset)))
    654659      (set-iset-bits! iset #f))))
     660
     661(define (iset-node-clear! iset)
     662  (if (iset-bits iset)
     663      (u8vector-fill! (iset-bits iset) 0)
     664      (set-iset-bits! iset
     665                      (make-bit-vector (- (iset-end iset) (iset-start iset) -1)
     666                                       #f))))
     667
     668;; start and/or end are inside the node, split into:
     669;;   1. node before start, if any
     670;;   2. node between start and end
     671;;   3. node after end, if any
     672(define (iset-node-split node start end)
     673  (list (and (< (iset-start node) start)
     674             (iset-node-extract node (iset-start node) (- start 1)))
     675        (iset-node-extract node start end)
     676        (and (> (iset-end node) end)
     677             (iset-node-extract node (+ end 1) (iset-end node)))))
     678
     679(define (iset-node-extract node start end)
     680  (cond
     681   ((iset-bits node)
     682    => (lambda (node-bits)
     683         (let* ((bits
     684                 (bit-vector-and
     685                  (bit-vector-shift node-bits (- (iset-start node) start))
     686                  (range->bit-vector start end)))
     687                (new-end (min end (+ start (bit-vector-length bits)))))
     688           (%make-iset start new-end bits #f #f))))
     689   (else
     690    (%make-iset (max start (iset-start node))
     691                (min end (iset-end node))
     692                #f #f #f))))
    655693
    656694(define (iset-adjoin1! iset n)
     
    878916   knil iset))
    879917
     918(define (iset->node-list a)
     919  (reverse (iset-fold-node cons '() a)))
     920
    880921(define (iset-unfold f p g seed . opt)
    881922  (let ((base-is (if (pair? opt) (iset-copy (car opt)) (make-iset))))
     
    10001041    (apply iset-union! (iset-copy (car args)) (cdr args))))
    10011042
     1043(define (iset-intersection2! a b)
     1044  (let lp ((nodes-a (iset->node-list a))
     1045           (nodes-b (iset->node-list b)))
     1046    (cond
     1047     ((null? nodes-a)
     1048      a)
     1049     ((null? nodes-b)
     1050      (iset-node-clear! (car nodes-a))
     1051      (set-iset-right! (car nodes-a) #f)
     1052      a)
     1053     ((> (iset-start (car nodes-b)) (iset-end (car nodes-a)))
     1054      (iset-node-clear! (car nodes-a))
     1055      (lp (cdr nodes-a) nodes-b))
     1056     ((> (iset-start (car nodes-a)) (iset-end (car nodes-b)))
     1057      (lp nodes-a (cdr nodes-b)))
     1058     (else
     1059      (let* ((a (car nodes-a))
     1060             (b (car nodes-b))
     1061             (a-ls (iset-node-split a (iset-start b) (iset-end b)))
     1062             (overlap (cadr a-ls))
     1063             (right (car (cddr a-ls)))
     1064             (b-ls (iset-node-split b (iset-start overlap) (iset-end overlap)))
     1065             (b-overlap (cadr b-ls))
     1066             (b-right (car (cddr b-ls))))
     1067        (set-iset-start! a (iset-start overlap))
     1068        (set-iset-end! a (iset-end overlap))
     1069        (if (iset-bits b-overlap)
     1070            (let ((a-bits (or (iset-bits overlap)
     1071                              (range->bit-vector (iset-start a) (iset-end a))))
     1072                  (b-bits (iset-bits b-overlap)))
     1073              (set-iset-bits! a (bit-vector-and a-bits b-bits)))
     1074            (set-iset-bits! a (iset-bits overlap)))
     1075        (if right
     1076            (iset-insert-right! a right))
     1077        (lp (if right (cons right (cdr nodes-a)) (cdr nodes-a))
     1078            (if b-right (cons b-right (cdr nodes-b)) (cdr nodes-b))))))))
     1079
    10021080(define (iset-intersection! a . args)
    10031081  (let-optionals* args ((b #f) rest)
    10041082    (cond
    10051083      (b
    1006        (iset-for-each
    1007         (lambda (i) (unless (iset-contains? b i) (iset-delete1! a i)))
    1008         a)
     1084       (iset-intersection2! a b)
    10091085       (apply iset-intersection! a rest))
    10101086      (else a))))
     
    10121088(define (iset-intersection a . args)
    10131089  (apply iset-intersection! (iset-copy a) args))
     1090
     1091(define (iset-difference2! a b)
     1092  (let lp ((nodes-a (iset->node-list a))
     1093           (nodes-b (iset->node-list b)))
     1094    (cond
     1095     ((null? nodes-a) a)
     1096     ((null? nodes-b) a)
     1097     ((> (iset-start (car nodes-b)) (iset-end (car nodes-a)))
     1098      (lp (cdr nodes-a) nodes-b))
     1099     ((> (iset-start (car nodes-a)) (iset-end (car nodes-b)))
     1100      (lp nodes-a (cdr nodes-b)))
     1101     (else
     1102      (let* ((a (car nodes-a))
     1103             (b (car nodes-b))
     1104             (a-ls (iset-node-split a (iset-start b) (iset-end b)))
     1105             (left (car a-ls))
     1106             (overlap (cadr a-ls))
     1107             (right (car (cddr a-ls)))
     1108             (b-ls (iset-node-split b (iset-start overlap) (iset-end overlap)))
     1109             (b-overlap (cadr b-ls))
     1110             (b-right (car (cddr b-ls))))
     1111        (if left
     1112            (iset-insert-left! a left))
     1113        (set-iset-start! a (iset-start overlap))
     1114        (set-iset-end! a (iset-end overlap))
     1115        (if (not (iset-bits b-overlap))
     1116            (iset-node-clear! a)
     1117            (let ((a-bits (or (iset-bits overlap)
     1118                              (range->bit-vector (iset-start a) (iset-end a))))
     1119                  (b-bits (iset-bits b-overlap)))
     1120              (set-iset-bits! a (bit-vector-andc2 a-bits b-bits))))
     1121        (if right
     1122            (iset-insert-right! a right))
     1123        (lp (if right (cons right (cdr nodes-a)) (cdr nodes-a))
     1124            (if b-right (cons b-right (cdr nodes-b)) (cdr nodes-b))))))))
    10141125
    10151126(define (iset-difference! a . args)
     
    10171128    a
    10181129    (begin
    1019       (iset-for-each (lambda (i) (iset-delete1! a i)) (car args))
     1130      (iset-difference2! a (car args))
    10201131      (apply iset-difference! a (cdr args)))))
    10211132
  • release/4/iset/tags/2.0/iset.setup

    r30013 r33330  
    55 'iset
    66 `("iset.so" "iset.import.so")
    7  `((version 1.9)))
     7 `((version 2.0)))
  • release/4/iset/trunk/iset-test.scm

    r20390 r33330  
    4141         ((129 2 127))
    4242         ((1 -128 -126))
     43         ((12354 12356 12358 12360 12362) (i 12354 12356 12362) (= 12354 12356 12362))
     44         ((12354 12356 12358 12360 12362) (d 12354 12356 12362) (= 12358 12360))
    4345         )))
    4446  (for-each
     
    6668            ((d)
    6769             (set! is (iset-difference! is (list->iset (cdr op))))
    68              (for-each (lambda (x) (test-assert (iset-contains? is x))) (cdr op)))
     70             (for-each (lambda (x) (test-assert (not (iset-contains? is x)))) (cdr op)))
    6971            ((e) (test-assert (and (iset-every (cadr op) is) #t)))
    7072            ((i) (set! is (iset-intersection! is (list->iset (cdr op)))))
  • release/4/iset/trunk/iset.scm

    r30013 r33330  
    403403(define (bit-vector-and a . args)
    404404  (apply bit-vector-and! (bit-vector-copy a) args))
     405
     406(define (bit-vector-andc2! a . args)
     407  (u8vector-map! (lambda (i j) (fxand i (fxnot j))) (lambda (a lo hi) a) a args))
     408(define (bit-vector-andc2 a . args)
     409  (apply bit-vector-andc2! (bit-vector-copy a) args))
    405410
    406411(define (bit-vector-ior! a . args)
     
    653658    (if (bit-vector-full? bits (- (iset-end iset) (iset-start iset)))
    654659      (set-iset-bits! iset #f))))
     660
     661(define (iset-node-clear! iset)
     662  (if (iset-bits iset)
     663      (u8vector-fill! (iset-bits iset) 0)
     664      (set-iset-bits! iset
     665                      (make-bit-vector (- (iset-end iset) (iset-start iset) -1)
     666                                       #f))))
     667
     668;; start and/or end are inside the node, split into:
     669;;   1. node before start, if any
     670;;   2. node between start and end
     671;;   3. node after end, if any
     672(define (iset-node-split node start end)
     673  (list (and (< (iset-start node) start)
     674             (iset-node-extract node (iset-start node) (- start 1)))
     675        (iset-node-extract node start end)
     676        (and (> (iset-end node) end)
     677             (iset-node-extract node (+ end 1) (iset-end node)))))
     678
     679(define (iset-node-extract node start end)
     680  (cond
     681   ((iset-bits node)
     682    => (lambda (node-bits)
     683         (let* ((bits
     684                 (bit-vector-and
     685                  (bit-vector-shift node-bits (- (iset-start node) start))
     686                  (range->bit-vector start end)))
     687                (new-end (min end (+ start (bit-vector-length bits)))))
     688           (%make-iset start new-end bits #f #f))))
     689   (else
     690    (%make-iset (max start (iset-start node))
     691                (min end (iset-end node))
     692                #f #f #f))))
    655693
    656694(define (iset-adjoin1! iset n)
     
    878916   knil iset))
    879917
     918(define (iset->node-list a)
     919  (reverse (iset-fold-node cons '() a)))
     920
    880921(define (iset-unfold f p g seed . opt)
    881922  (let ((base-is (if (pair? opt) (iset-copy (car opt)) (make-iset))))
     
    10001041    (apply iset-union! (iset-copy (car args)) (cdr args))))
    10011042
     1043(define (iset-intersection2! a b)
     1044  (let lp ((nodes-a (iset->node-list a))
     1045           (nodes-b (iset->node-list b)))
     1046    (cond
     1047     ((null? nodes-a)
     1048      a)
     1049     ((null? nodes-b)
     1050      (iset-node-clear! (car nodes-a))
     1051      (set-iset-right! (car nodes-a) #f)
     1052      a)
     1053     ((> (iset-start (car nodes-b)) (iset-end (car nodes-a)))
     1054      (iset-node-clear! (car nodes-a))
     1055      (lp (cdr nodes-a) nodes-b))
     1056     ((> (iset-start (car nodes-a)) (iset-end (car nodes-b)))
     1057      (lp nodes-a (cdr nodes-b)))
     1058     (else
     1059      (let* ((a (car nodes-a))
     1060             (b (car nodes-b))
     1061             (a-ls (iset-node-split a (iset-start b) (iset-end b)))
     1062             (overlap (cadr a-ls))
     1063             (right (car (cddr a-ls)))
     1064             (b-ls (iset-node-split b (iset-start overlap) (iset-end overlap)))
     1065             (b-overlap (cadr b-ls))
     1066             (b-right (car (cddr b-ls))))
     1067        (set-iset-start! a (iset-start overlap))
     1068        (set-iset-end! a (iset-end overlap))
     1069        (if (iset-bits b-overlap)
     1070            (let ((a-bits (or (iset-bits overlap)
     1071                              (range->bit-vector (iset-start a) (iset-end a))))
     1072                  (b-bits (iset-bits b-overlap)))
     1073              (set-iset-bits! a (bit-vector-and a-bits b-bits)))
     1074            (set-iset-bits! a (iset-bits overlap)))
     1075        (if right
     1076            (iset-insert-right! a right))
     1077        (lp (if right (cons right (cdr nodes-a)) (cdr nodes-a))
     1078            (if b-right (cons b-right (cdr nodes-b)) (cdr nodes-b))))))))
     1079
    10021080(define (iset-intersection! a . args)
    10031081  (let-optionals* args ((b #f) rest)
    10041082    (cond
    10051083      (b
    1006        (iset-for-each
    1007         (lambda (i) (unless (iset-contains? b i) (iset-delete1! a i)))
    1008         a)
     1084       (iset-intersection2! a b)
    10091085       (apply iset-intersection! a rest))
    10101086      (else a))))
     
    10121088(define (iset-intersection a . args)
    10131089  (apply iset-intersection! (iset-copy a) args))
     1090
     1091(define (iset-difference2! a b)
     1092  (let lp ((nodes-a (iset->node-list a))
     1093           (nodes-b (iset->node-list b)))
     1094    (cond
     1095     ((null? nodes-a) a)
     1096     ((null? nodes-b) a)
     1097     ((> (iset-start (car nodes-b)) (iset-end (car nodes-a)))
     1098      (lp (cdr nodes-a) nodes-b))
     1099     ((> (iset-start (car nodes-a)) (iset-end (car nodes-b)))
     1100      (lp nodes-a (cdr nodes-b)))
     1101     (else
     1102      (let* ((a (car nodes-a))
     1103             (b (car nodes-b))
     1104             (a-ls (iset-node-split a (iset-start b) (iset-end b)))
     1105             (left (car a-ls))
     1106             (overlap (cadr a-ls))
     1107             (right (car (cddr a-ls)))
     1108             (b-ls (iset-node-split b (iset-start overlap) (iset-end overlap)))
     1109             (b-overlap (cadr b-ls))
     1110             (b-right (car (cddr b-ls))))
     1111        (if left
     1112            (iset-insert-left! a left))
     1113        (set-iset-start! a (iset-start overlap))
     1114        (set-iset-end! a (iset-end overlap))
     1115        (if (not (iset-bits b-overlap))
     1116            (iset-node-clear! a)
     1117            (let ((a-bits (or (iset-bits overlap)
     1118                              (range->bit-vector (iset-start a) (iset-end a))))
     1119                  (b-bits (iset-bits b-overlap)))
     1120              (set-iset-bits! a (bit-vector-andc2 a-bits b-bits))))
     1121        (if right
     1122            (iset-insert-right! a right))
     1123        (lp (if right (cons right (cdr nodes-a)) (cdr nodes-a))
     1124            (if b-right (cons b-right (cdr nodes-b)) (cdr nodes-b))))))))
    10141125
    10151126(define (iset-difference! a . args)
     
    10171128    a
    10181129    (begin
    1019       (iset-for-each (lambda (i) (iset-delete1! a i)) (car args))
     1130      (iset-difference2! a (car args))
    10201131      (apply iset-difference! a (cdr args)))))
    10211132
  • release/4/iset/trunk/iset.setup

    r30013 r33330  
    55 'iset
    66 `("iset.so" "iset.import.so")
    7  `((version 1.9)))
     7 `((version 2.0)))
Note: See TracChangeset for help on using the changeset viewer.