Changeset 37361 in project


Ignore:
Timestamp:
03/12/19 20:42:26 (4 months ago)
Author:
iraikov
Message:

cis: bug fixes in difference [thanks to Andre Sa]

Location:
release/5/cis/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/cis/trunk/cis.scm

    r36461 r37361  
    100100(define (cis? x) (and (pair? x) (eq? 'cis (car x))))
    101101
    102   (define (empty? x)
    103     (cases cis x
    104            ((Nil) #t)
    105            ((Single _ _) #f)
    106            ((Interv _ _ _) #f)))
     102(define (empty? x)
     103  (cases cis x
     104         ((Nil) #t)
     105         ((Single _ _) #f)
     106         ((Interv _ _ _) #f)))
    107107 
    108108
    109   (define empty (Nil))
    110 
    111   (define (subset? t1 t2)
    112     (cases cis t1
    113            ((Nil)  #t)
    114            ((Single x1 t1-tail)
    115             (cases cis t2
    116                    ((Nil)  #f)
    117                    ((Single x2 t2-tail)
    118                     (cond ((> x1 x2)  #f)
    119                           ((> x2 x1)  (subset? t1 t2-tail))
    120                           (else (subset? t1-tail t2-tail))))
    121                    ((Interv xmax2 xmin2 t2-tail)
    122                     (cond ((> x1 xmax2)  #f)
    123                           ((> xmin2 x1)  (subset? t1 t2-tail))
    124                           (else (subset? t1-tail t2))))))
    125            ((Interv xmax1 xmin1 t1-tail)
    126             (cases cis t2
    127                    ((Nil)  #f)
    128                    ((Single x2 t2-tail)
    129                     (cond ((> x2 xmax1)  (subset? t1 t2-tail))
    130                           ((> xmin1 x2)  #f)
    131                           (else #f)))
    132                    ((Interv xmax2 xmin2 t2-tail)
    133                     (cond ((> xmin2 xmax1)  (subset? t1 t2-tail))
    134                           ((> xmin1 xmax2)  #f)
    135                           (else (and (>= xmax2 xmax1) (>= xmin1 xmin2) (subset? t1-tail t2)))))
    136                    ))
    137            ))
    138 
    139  
    140   (define (get-max t)
     109(define empty (Nil))
     110
     111(define (subset? t1 t2)
     112  (cases cis t1
     113         ((Nil)  #t)
     114         ((Single x1 t1-tail)
     115          (cases cis t2
     116                 ((Nil)  #f)
     117                 ((Single x2 t2-tail)
     118                  (cond ((> x1 x2)  #f)
     119                        ((> x2 x1)  (subset? t1 t2-tail))
     120                        (else (subset? t1-tail t2-tail))))
     121                 ((Interv xmax2 xmin2 t2-tail)
     122                  (cond ((> x1 xmax2)  #f)
     123                        ((> xmin2 x1)  (subset? t1 t2-tail))
     124                        (else (subset? t1-tail t2))))))
     125         ((Interv xmax1 xmin1 t1-tail)
     126          (cases cis t2
     127                 ((Nil)  #f)
     128                 ((Single x2 t2-tail)
     129                  (cond ((> x2 xmax1)  (subset? t1 t2-tail))
     130                        ((> xmin1 x2)  #f)
     131                        (else #f)))
     132                 ((Interv xmax2 xmin2 t2-tail)
     133                  (cond ((> xmin2 xmax1)  (subset? t1 t2-tail))
     134                        ((> xmin1 xmax2)  #f)
     135                        (else (and (>= xmax2 xmax1) (>= xmin1 xmin2) (subset? t1-tail t2)))))
     136                 ))
     137         ))
     138
     139
     140(define (get-max t)
     141  (cases cis t
     142         ((Nil)  (error 'get-max "set is empty"))
     143         ((Single x _)  x)
     144         ((Interv xmax _ _)  xmax)))
     145
     146
     147(define (get-min t)
     148  (cases cis t
     149         ((Nil) (error 'get-min "set is empty"))
     150         ((Single x t1) (if (empty? t1) x (get-min t1)))
     151         ((Interv xmax xmin t1) (if (empty? t1) xmin (get-min t1)))))
     152
     153
     154(define (cons-single x t)
     155  (cases cis t
     156         ((Nil)
     157          (Single x (Nil)))
     158         ((Single x1 t1)
     159          (if (= x (+ 1 x1)) (Interv x x1 t1) (Single x t)))
     160         ((Interv xmax1 xmin1 t1)
     161          (if (= x (+ 1 xmax1)) (Interv x xmin1 t1) (Single x t)))
     162         ))
     163
     164
     165(define (cons-interval xmax xmin t)
     166  (cond ((< xmax xmin) t)
     167        ((= xmax xmin) (cons-single xmin t))
     168        (else
     169         (cases cis t
     170                ((Nil)
     171                 (Interv xmax xmin (Nil)))
     172                ((Single x1 t1)
     173                 (if (= xmin (+ 1 x1)) (Interv xmax x1 t1) (Interv xmax xmin t)))
     174                ((Interv xmax1 xmin1 t1)
     175                 (if (= xmin (+ 1 xmax1)) (Interv xmax xmin1 t1) (Interv xmax xmin t)))
     176                ))
     177        ))
     178
     179
     180(define (cardinal t)
     181  (let recur ((t t) (ax 0))
    141182    (cases cis t
    142            ((Nil)  (error 'get-max "set is empty"))
    143            ((Single x _)  x)
    144            ((Interv xmax _ _)  xmax)))
    145  
    146  
    147   (define (get-min t)
    148     (cases cis t
    149            ((Nil) (error 'get-min "set is empty"))
    150            ((Single x t1) (if (empty? t1) x (get-min t1)))
    151            ((Interv xmax xmin t1) (if (empty? t1) xmin (get-min t1)))))
    152  
    153  
    154   (define (cons-single x t)
    155     (cases cis t
    156            ((Nil)
    157             (Single x (Nil)))
    158            ((Single x1 t1)
    159             (if (= x (+ 1 x1)) (Interv x x1 t1) (Single x t)))
    160            ((Interv xmax1 xmin1 t1)
    161             (if (= x (+ 1 xmax1)) (Interv x xmin1 t1) (Single x t)))
    162            ))
    163 
    164 
    165   (define (cons-interval xmax xmin t)
    166     (cond ((< xmax xmin) (cons-interval xmin xmax t))
    167           ((= xmax xmin) (cons-single xmin t))
    168           (else
    169            (cases cis t
    170                   ((Nil)
    171                    (Interv xmax xmin (Nil)))
    172                   ((Single x1 t1)
    173                    (if (= xmin (+ 1 x1)) (Interv xmax x1 t1) (Interv xmax xmin t)))
    174                   ((Interv xmax1 xmin1 t1)
    175                    (if (= xmin (+ 1 xmax1)) (Interv xmax xmin1 t1) (Interv xmax xmin t)))
    176                   ))
    177           ))
    178  
    179  
    180   (define (cardinal t)
    181     (let recur ((t t) (ax 0))
    182       (cases cis t
    183              ((Nil) ax)
    184              ((Single x1 t1) (recur t1 (+ 1 ax)))
    185              ((Interv xmax1 xmin1 t1) (recur t1 (+ ax (+ 1 (- xmax1 xmin1)))))
    186              )))
    187  
    188 
    189   (define (in? x t)
    190     (cases cis t
    191            ((Nil) #f)
    192            ((Single x1 t1)
    193             (or (= x x1) (and (> x1 x) (in? x t1))))
    194            ((Interv xmax xmin t1)
    195             (or (and (>= xmax x) (>= x xmin))
    196                 (and (> xmin x) (in? x t1))))
    197            ))
     183           ((Nil) ax)
     184           ((Single x1 t1) (recur t1 (+ 1 ax)))
     185           ((Interv xmax1 xmin1 t1) (recur t1 (+ ax (+ 1 (- xmax1 xmin1)))))
     186           )))
     187
     188
     189(define (in? x t)
     190  (cases cis t
     191         ((Nil) #f)
     192         ((Single x1 t1)
     193          (or (= x x1) (and (> x1 x) (in? x t1))))
     194         ((Interv xmax xmin t1)
     195          (or (and (>= xmax x) (>= x xmin))
     196              (and (> xmin x) (in? x t1))))
     197         ))
    198198
    199199
     
    218218                                        ((and (>= xmax1 x) (>= x xmin1)) t)
    219219                                        (else (cons-interval xmax1 xmin1 (add x t1)))))
    220            
     220         
    221221         ))
    222222
     
    253253                     (Interv (+ xmax1 n) (+ xmin1 n) (shift n t1)))
    254254                    )))))
    255  
    256  
     255
     256
    257257
    258258(define (union t1 t2)
     
    261261         ((Single x1 t1-tail)
    262262          (begin
    263           (cases cis t2
    264                 ((Nil) t1)
    265                 ((Single x2 t2-tail)
    266                   (cond ((> x1 (+ 1 x2))
    267                         (cons-single x1 (union t1-tail t2)))
    268                         ((> x2 (+ 1 x1))
    269                         (cons-single x2 (union t1 t2-tail)))
    270                         ((= x1 (+ 1 x2))
    271                         (cons-interval x1 x2 (union t1-tail t2-tail)))
    272                         ((= x2 (+ 1 x1))
    273                         (cons-interval x2 x1 (union t1-tail t2-tail)))
    274                         (else
    275                         (cons-single x1 (union t1-tail t2-tail)))
    276                         ))
    277                 ((Interv xmax2 xmin2 t2-tail)
     263            (cases cis t2
     264                  ((Nil) t1)
     265                  ((Single x2 t2-tail)
     266                    (cond ((> x1 (+ 1 x2))
     267                          (cons-single x1 (union t1-tail t2)))
     268                          ((> x2 (+ 1 x1))
     269                          (cons-single x2 (union t1 t2-tail)))
     270                          ((= x1 (+ 1 x2))
     271                          (cons-interval x1 x2 (union t1-tail t2-tail)))
     272                          ((= x2 (+ 1 x1))
     273                          (cons-interval x2 x1 (union t1-tail t2-tail)))
     274                          (else
     275                          (cons-single x1 (union t1-tail t2-tail)))
     276                          ))
     277                  ((Interv xmax2 xmin2 t2-tail)
    278278                    (cond ((> x1 xmax2) (cons-single x1 (union t1-tail t2)))
    279279                          ((> xmin2 (+ 1 x1)) (cons-interval xmax2 xmin2 (union t1 t2-tail)))
    280280                          ((= xmin2 (+ 1 x1)) (cons-interval xmax2 x1 (union t1-tail t2-tail)))
    281281                          (else (cons-interval xmax2 x1 (union t1-tail (cons-interval (- x1 1) xmin2 t2-tail))))))
    282                 )))
     282                  )))
    283283
    284284         ((Interv xmax1 xmin1 t1-tail)
     
    308308  (cases cis t1
    309309         ((Nil) empty)
    310            ((Single x1 t1-tail)
    311             (cases cis t2
    312                    ((Nil) empty)
    313                    ((Single x2 t2-tail)
    314                     (cond ((> x1 (+ 1 x2))
    315                            (intersection t1-tail t2))
    316                           ((> x2 (+ 1 x1))
    317                            (intersection t1 t2-tail))
    318                           ((= x1 (+ 1 x2))
    319                            (intersection t1-tail t2-tail))
    320                           ((= x2 (+ 1 x1))
    321                            (intersection t1-tail t2-tail))
    322                           (else
    323                            (cons-single x1 (intersection t1-tail t2-tail)))
    324                           ))
    325                    ((Interv xmax2 xmin2 t2-tail)
    326                     (cond ((> x1 xmax2) (intersection t1-tail t2))
    327                           ((> xmin2 x1) (intersection t1 t2-tail))
    328                           (else (cons-single x1 (intersection t1-tail t2)))))
    329                    ))
    330            ((Interv xmax1 xmin1 t1-tail)
    331             (cases cis t2
    332                    ((Nil)  empty)
    333                    ((Single x2 t2-tail)
    334                     (cond ((> x2 xmax1)  (intersection t1 t2-tail))
    335                           ((> xmin1 x2)  (intersection t1-tail t2))
    336                           (else (cons-single x2 (intersection t1 t2-tail)))))
    337                    ((Interv xmax2 xmin2 t2-tail)
    338                     (cond ((> xmin2 xmax1) (intersection t1 t2-tail))
    339                           ((> xmin1 xmax2) (intersection t1-tail t2))
    340                           (else (cons-interval (min xmax1 xmax2) (max xmin1 xmin2)
    341                                                (if (>= xmin1 xmin2)
    342                                                    (intersection t1-tail t2)
    343                                                    (intersection t1 t2-tail))))))
    344                    ))
    345            ))
    346  
    347   (define (difference t1 t2)
    348     (cases cis t1
    349            ((Nil) empty)
    350            ((Single x1 t1-tail)
    351             (cases cis t2
    352                    ((Nil)  t1)
    353                    ((Single x2 t2-tail)
    354                     (cond ((> x1 x2)  (cons-single x1 (difference t1-tail t2)))
    355                           ((> x2 x1)  (difference t1 t2-tail))
    356                           (else (difference t1-tail t2-tail))))
    357                    ((Interv xmax2 xmin2 t2-tail)
    358                     (cond ((> x1 xmax2) (cons-single x1 (difference t1-tail t2)))
    359                           ((> xmin2 x1) (difference t1 t2-tail))
    360                           (else (difference t1-tail t2-tail))))))
    361            ((Interv xmax1 xmin1 t1-tail)
    362             (cases cis t2
    363                    ((Nil)  t1)
    364                    ((Single x2 t2-tail)
    365                     (cond ((> x2 xmax1)  (difference t1 t2-tail))
    366                           ((> xmin1 x2)  (cons-interval xmax1 xmin1 (difference t1-tail t2)))
    367                           (else  (cons-interval xmax1 (+ 1 x2) (difference (cons-interval (- x2 1) xmin1 t1-tail)
    368                                                                              t2-tail)))))
    369                    ((Interv xmax2 xmin2 t2-tail)
    370                     (cond ((> xmin2 xmax1)  (difference t1 t2-tail))
    371                           ((> xmin1 xmax2)  (cons-interval xmax1 xmin1 (difference t1-tail t2)))
    372                           (else
    373                            (cons-interval xmax1 (+ 1 xmax2)
    374                                           (if (>= xmin1 xmin2)
    375                                               (difference t1-tail t2)
    376                                               (difference (cons-interval (- xmin2 1) xmin1 t1-tail)
    377                                                           t2-tail))))))
    378                    ))
    379            ))
    380  
    381  
    382  
     310         ((Single x1 t1-tail)
     311          (cases cis t2
     312                 ((Nil) empty)
     313                 ((Single x2 t2-tail)
     314                  (cond ((> x1 (+ 1 x2))
     315                         (intersection t1-tail t2))
     316                        ((> x2 (+ 1 x1))
     317                         (intersection t1 t2-tail))
     318                        ((= x1 (+ 1 x2))
     319                         (intersection t1-tail t2-tail))
     320                        ((= x2 (+ 1 x1))
     321                         (intersection t1-tail t2-tail))
     322                        (else
     323                         (cons-single x1 (intersection t1-tail t2-tail)))
     324                        ))
     325                 ((Interv xmax2 xmin2 t2-tail)
     326                  (cond ((> x1 xmax2) (intersection t1-tail t2))
     327                        ((> xmin2 x1) (intersection t1 t2-tail))
     328                        (else (cons-single x1 (intersection t1-tail t2)))))
     329                 ))
     330         ((Interv xmax1 xmin1 t1-tail)
     331          (cases cis t2
     332                 ((Nil)  empty)
     333                 ((Single x2 t2-tail)
     334                  (cond ((> x2 xmax1)  (intersection t1 t2-tail))
     335                        ((> xmin1 x2)  (intersection t1-tail t2))
     336                        (else (cons-single x2 (intersection t1 t2-tail)))))
     337                 ((Interv xmax2 xmin2 t2-tail)
     338                  (cond ((> xmin2 xmax1) (intersection t1 t2-tail))
     339                        ((> xmin1 xmax2) (intersection t1-tail t2))
     340                        (else (cons-interval (min xmax1 xmax2) (max xmin1 xmin2)
     341                                             (if (>= xmin1 xmin2)
     342                                                 (intersection t1-tail t2)
     343                                                 (intersection t1 t2-tail))))))
     344                 ))
     345         ))
     346
     347(define (difference t1 t2)
     348  (cases cis t1
     349         ((Nil) empty)
     350         ((Single x1 t1-tail)
     351          (cases cis t2
     352                 ((Nil)  t1)
     353                 ((Single x2 t2-tail)
     354                  (cond ((> x1 x2)  (cons-single x1 (difference t1-tail t2)))
     355                        ((> x2 x1)  (difference t1 t2-tail))
     356                        (else (difference t1-tail t2-tail))))
     357                 ((Interv xmax2 xmin2 t2-tail)
     358                  (cond ((> x1 xmax2) (cons-single x1 (difference t1-tail t2)))
     359                        ((> xmin2 x1) (difference t1 t2-tail))
     360                        (else (difference t1-tail t2-tail))))))
     361         ((Interv xmax1 xmin1 t1-tail)
     362          (cases cis t2
     363                 ((Nil)  t1)
     364                 ((Single x2 t2-tail)
     365                  (cond ((> x2 xmax1)  (difference t1 t2-tail))
     366                        ((> xmin1 x2)  (cons-interval xmax1 xmin1 (difference t1-tail t2)))
     367                        ;; x2 <= xmax1 & xmin1 <= x2
     368                        (else  (cons-interval xmax1 (+ 1 x2) (difference (cons-interval (- x2 1) xmin1 t1-tail)
     369                                                                         t2-tail)))))
     370                 ((Interv xmax2 xmin2 t2-tail)
     371                  (cond ((> xmin2 xmax1)  (difference t1 t2-tail))
     372                        ((> xmin1 xmax2)  (cons-interval xmax1 xmin1 (difference t1-tail t2)))
     373                        (else
     374                         (cons-interval xmax1 (+ 1 xmax2)
     375                                        (if (> xmin1 xmin2)
     376                                            (difference t1-tail t2)
     377                                            (difference (cons-interval (- xmin2 1) xmin1 t1-tail)
     378                                                        (if (> xmax1 xmax2) t2-tail (interval xmax2 (+ 1 xmax1))))))))
     379                  ))
     380         ))
     381  )
     382
     383
    383384(define (foreach f t)
    384385  (let outer ((t t))
  • release/5/cis/trunk/tests/run.scm

    r36461 r37361  
    2323            )
    2424
    25 (test-group "set operations"
     25(test-group "set operations 1"
    2626            (let ((t (add 4 (add 1 (add 5 empty)))))
    2727              (test "adding elements out of order" '(5 4 1) (elements t)))
     
    6060              ))
    6161
     62(test-group "difference operations"
     63
     64            (test "difference of an interval and a singleton"
     65                  '(1) (elements (difference (interval 1 2) (singleton 2))))
     66            (test "difference of non-overlapping ranges"
     67                  '(2) (elements (difference (interval 2 4) (interval 3 5))))
     68            (test "difference of non-overlapping ranges"
     69                  '(5) (elements (difference (interval 3 5) (interval 2 4))))
     70            )
    6271
    6372(test-exit)
Note: See TracChangeset for help on using the changeset viewer.