Advertisement
Guest User

Untitled

a guest
Jun 15th, 2019
132
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.40 KB | None | 0 0
  1.  
  2. (defun bit-vector-rle (bit-vector)
  3. (loop
  4. :for start := (position 1 bit-vector) :then (position 1 bit-vector :start end)
  5. :for end := (and start (position 0 bit-vector :start start))
  6. :when start
  7. :collect (list start (- (or end (length bit-vector)) start))
  8. :while end))
  9.  
  10. (bit-vector-rle #*000011111000010000001100000000111000001111)
  11. ;; --> ((4 5) (13 1) (20 2) (30 3) (38 4))
  12.  
  13. (defun make-sparse-bit-array (dims fraction)
  14. (let ((a (make-array dims :element-type 'bit))
  15. (1/fraction (round (/ fraction))))
  16. (map-into (make-array (reduce (function *) dims) :displaced-to a)
  17. (lambda () (if (zerop (random 1/fraction)) 1 0)))
  18. a))
  19.  
  20. (make-sparse-bit-array '(3 4 5) 1/10)
  21. ;; --> #3A((#*00011 #*00000 #*00010 #*00000) (#*00000 #*10000 #*00001 #*00000) (#*00000 #*00000 #*10010 #*11000))
  22.  
  23. (let ((a (make-sparse-bit-array '(100 200 50) 1/10000)))
  24. (cons (array-dimensions a)
  25. (bit-vector-rle (make-array (reduce (function *) (array-dimensions a)) :displaced-to a))))
  26.  
  27. ;; --> ((100 200 50) (4875 1) (9030 1) (18384 1) (25414 1) (25796 1)
  28. ;; (42876 1) (47408 1) (55961 1) (59155 1) (83003 1) (86934 1)
  29. ;; (106079 1) (107280 1) (130275 1) (134302 1) (151378 1) (152584 1)
  30. ;; (156697 1) (168991 1) (174469 1) (181932 1) (216868 1) (229294 1)
  31. ;; (232355 1) (246310 1) (262710 1) (264827 1) (268005 1) (272363 1)
  32. ;; (281095 1) (299608 1) (311162 1) (322136 1) (338928 1) (351475 1)
  33. ;; (358421 1) (364863 1) (370054 1) (372213 1) (377422 1) (378743 1)
  34. ;; (379297 1) (423362 1) (450352 1) (461227 1) (461656 1) (467111 1)
  35. ;; (471959 1) (512637 1) (518342 1) (522537 1) (560988 1) (614199 1)
  36. ;; (624459 1) (625495 1) (634680 1) (635251 1) (644395 1) (675568 1)
  37. ;; (686224 1) (689156 1) (697248 1) (704984 1) (719677 1) (727749 1)
  38. ;; (741435 1) (751115 1) (758944 1) (766851 1) (768477 1) (781804 1)
  39. ;; (786879 1) (794195 1) (800876 1) (808826 1) (821835 1) (824166 1)
  40. ;; (839867 1) (851918 1) (858868 1) (913626 1) (916740 1) (917476 1)
  41. ;; (927992 1) (935764 1) (940657 1) (944920 1) (985199 1) (989985 1))
  42.  
  43. (apply (function format) t "~S~%~@{~{~A*~A~}~^ ~}~%"
  44. (let ((a (make-sparse-bit-array '(100 200 50) 1/10000)))
  45. (cons (array-dimensions a)
  46. (bit-vector-rle (make-array (reduce (function *) (array-dimensions a)) :displaced-to a)))))
  47.  
  48. (100 200 50)
  49. 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