Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun bit-vector-rle (bit-vector)
- (loop
- :for start := (position 1 bit-vector) :then (position 1 bit-vector :start end)
- :for end := (and start (position 0 bit-vector :start start))
- :when start
- :collect (list start (- (or end (length bit-vector)) start))
- :while end))
- (bit-vector-rle #*000011111000010000001100000000111000001111)
- ;; --> ((4 5) (13 1) (20 2) (30 3) (38 4))
- (defun make-sparse-bit-array (dims fraction)
- (let ((a (make-array dims :element-type 'bit))
- (1/fraction (round (/ fraction))))
- (map-into (make-array (reduce (function *) dims) :displaced-to a)
- (lambda () (if (zerop (random 1/fraction)) 1 0)))
- a))
- (make-sparse-bit-array '(3 4 5) 1/10)
- ;; --> #3A((#*00011 #*00000 #*00010 #*00000) (#*00000 #*10000 #*00001 #*00000) (#*00000 #*00000 #*10010 #*11000))
- (let ((a (make-sparse-bit-array '(100 200 50) 1/10000)))
- (cons (array-dimensions a)
- (bit-vector-rle (make-array (reduce (function *) (array-dimensions a)) :displaced-to a))))
- ;; --> ((100 200 50) (4875 1) (9030 1) (18384 1) (25414 1) (25796 1)
- ;; (42876 1) (47408 1) (55961 1) (59155 1) (83003 1) (86934 1)
- ;; (106079 1) (107280 1) (130275 1) (134302 1) (151378 1) (152584 1)
- ;; (156697 1) (168991 1) (174469 1) (181932 1) (216868 1) (229294 1)
- ;; (232355 1) (246310 1) (262710 1) (264827 1) (268005 1) (272363 1)
- ;; (281095 1) (299608 1) (311162 1) (322136 1) (338928 1) (351475 1)
- ;; (358421 1) (364863 1) (370054 1) (372213 1) (377422 1) (378743 1)
- ;; (379297 1) (423362 1) (450352 1) (461227 1) (461656 1) (467111 1)
- ;; (471959 1) (512637 1) (518342 1) (522537 1) (560988 1) (614199 1)
- ;; (624459 1) (625495 1) (634680 1) (635251 1) (644395 1) (675568 1)
- ;; (686224 1) (689156 1) (697248 1) (704984 1) (719677 1) (727749 1)
- ;; (741435 1) (751115 1) (758944 1) (766851 1) (768477 1) (781804 1)
- ;; (786879 1) (794195 1) (800876 1) (808826 1) (821835 1) (824166 1)
- ;; (839867 1) (851918 1) (858868 1) (913626 1) (916740 1) (917476 1)
- ;; (927992 1) (935764 1) (940657 1) (944920 1) (985199 1) (989985 1))
- (apply (function format) t "~S~%~@{~{~A*~A~}~^ ~}~%"
- (let ((a (make-sparse-bit-array '(100 200 50) 1/10000)))
- (cons (array-dimensions a)
- (bit-vector-rle (make-array (reduce (function *) (array-dimensions a)) :displaced-to a)))))
- (100 200 50)
- 65233*1 65491*1 72034*1 89306*1 101340*1 119805*1 122975*1 123732*1 127087*1 131574*1 134751*1 135203*1 175781*1 184927*1 190481*1 238865*1 239880*1 243172*1 246334*1 249080*1 249806*1 262890*1 277668*1 281629*1 282485*1 293434*1 293839*1 307945*1 324157*1 337402*1 344185*1 344679*1 355402*1 358737*1 365548*1 370043*1 375396*1 378839*1 381539*1 392176*1 400662*1 404033*1 435758*1 446233*1 449754*1 476248*1 499679*1 514159*1 516487*1 518158*1 528412*1 533629*1 588544*1 590092*1 624028*1 629483*1 637423*1 641059*1 662717*1 673635*1 674624*1 699687*1 704602*1 722782*1 749074*1 762439*1 762712*1 771130*1 784251*1 784690*1 790302*1 799310*1 821382*1 827809*1 837847*1 842752*1 848341*1 849669*1 868565*1 870583*1 880882*1 882256*1 886964*1 894527*1 898096*1 909485*1 909608*1 913284*1 916257*1 920912*1 931987*1 939899*1 940010*1 955001*1 979493*1 991980*1
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement