Thanks.
You reminder me of 'collect' ...
You reminder me of 'collect' ...

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Show posts Menu(define (regex-all regexp str all)
"Find all occurrences of a regex in a string"
(let ( (out '()) (idx 0) (res nil) )
(setq res (regex regexp str 64 idx))
(while res
(push res out -1)
(if all
(setq idx (+ (res 1) 1)) ; contiguos pattern (overlap)
(setq idx (+ (res 1) (res 2)))) ; no contiguos pattern
(setq res (regex regexp str 64 idx)))
out))
(setq a "AAAaBAAAABcADccAAAB")
(regex "[A]{3}" a)
;-> ("AAA" 0 3)
(regex-all "[A]{3}" a)
;-> (("AAA" 0 3) ("AAA" 5 3) ("AAA" 15 3))
(regex-all "[A]{3}" a true)
;-> (("AAA" 0 3) ("AAA" 5 3) ("AAA" 6 3) ("AAA" 15 3))
;---------------------------------
; Minimalistic 2048 (4x4)
; Use "W" "A" "S" "D" key to move
; (load "g2048.lsp")
;---------------------------------
(define (print-grid)
(for (i 0 3)
(for (j 0 3)
(print (format "%4d " (grid i j))))
(println)) '>)
;
(define (find-zeros)
(let (pts '())
(for (i 0 3)
(for (j 0 3)
(if (zero? (grid i j)) (push (list i j) pts -1)))) pts))
;
(define (new-game)
(setq grid (array-list (array 4 4 '(0))))
(setq zeros (randomize (find-zeros)))
(setf (grid (zeros 0)) 2)
(setf (grid (zeros 1)) 2)
(input))
;
(define (input)
(print-grid)
(case (setq key (read-key))
(87 (up)) (119 (up))
(65 (left)) (97 (left))
(85 (down)) (115 (down))
(68 (right)) (100 (right))
(48 (exit)) ; "0" --> quit the game
(true (begin (println "Wrong key.") (setq key-error true)))
)
(cond ((ref 2048 grid) (println "Bravo! You win.") (print-grid))
((= key-error true) (setq key-error nil) (input))
(true
(setq zeros (randomize (find-zeros)))
(when zeros ; put 2 or 4 in a free cell
(if (zero? (rand 2))
(setf (grid (zeros 0)) 2)
(setf (grid (zeros 0)) 4)))
(input))))
;
(define (shift-right row)
(let ((non-zero (filter (fn (x) (!= x 0)) row))
(zeroes (filter (fn (x) (= x 0)) row)))
(extend zeroes non-zero)))
;
(define (shift-left row)
(let ((non-zero (filter (fn (x) (!= x 0)) row))
(zeroes (filter (fn (x) (= x 0)) row)))
(extend non-zero zeroes)))
;
(define (matrix-left matrix) (map shift-left matrix))
;
(define (matrix-right matrix) (map shift-right matrix))
;
(define (matrix-down matrix)
(let (trans (transpose matrix))
(transpose (map shift-right trans))))
;
(define (matrix-up matrix)
(let (trans (transpose matrix))
(transpose (map shift-left trans))))
;
(define (merge-numbers row)
(let ( (result '()) (idx 0) (len (length row)) )
(while (< idx len)
(if (and (< idx (- len 1)) (= (row idx) (row (+ idx 1))))
(begin
(push (* 2 (row idx)) result -1)
(++ idx 2))
(begin
(push (row idx) result -1)
(++ idx 1))))
(extend result (dup 0 (- len (length result))))))
;
(define (matrix-merge matrix) (map merge-numbers matrix))
;
(define (right)
(println "right")
(setq grid (matrix-right grid)) ; move the numbers to right
(setq grid (matrix-merge grid)) ; merge the numbers
(setq grid (matrix-right grid))) ; move the numbers to right
;
(define (left)
(println "left")
(setq grid (matrix-left grid))
(setq grid (matrix-merge grid))
(setq grid (matrix-left grid)))
;
(define (up)
(println "up")
(setq grid (matrix-up grid))
(setq grid (transpose (matrix-merge (transpose grid))))
(setq grid (matrix-up grid)))
;
(define (down)
(println "down")
(setq grid (matrix-down grid))
(setq grid (transpose (matrix-merge (transpose grid))))
(setq grid (matrix-down grid)))
;
(new-game)
(define (create-valid-numbers current)
(if (<= current max-val)
(begin
(if (and (>= current min-val) (<= current max-val))
(push current valid-numbers))
; creates numbers recursively
(dolist (d digits)
(create-valid-numbers (+ (* current 10) d))))))
(define (random-integer min-val max-val digits)
(let (valid-numbers'())
(dolist (d digits) (create-valid-numbers d))
(valid-numbers (rand (length valid-numbers)))))
(random-integer 1 300 '(1 2 3))
;-> 21
(time (println (random-integer 1 90000000 '(1 2 3 4 5 6 7))))
;-> 44377532
;-> 6875.421
QuotenewLISP has two types of basic arithmetic operators: integer (+ - * /) and floating point (add sub mul div).
The arithmetic functions convert their arguments into types compatible with the function's own type: integer function arguments into integers, floating point function arguments into floating points.
(format "%.20f" (sub 9999999999999999 9999999999999998))
=> "2.00000000000000000000" (error)
(format "%.20f" (sub 999999999999999 999999999999998))
=> "1.00000000000000000000" (ok)
(format "%.20f" (sub 8888888888888889 8888888888888888))
=> "1.00000000000000000000" (ok)
(format "%.20f" (sub 1000000000000000 999999999999999))
=> "1.00000000000000000000" (ok)
(format "%.20f" (sub 10000000000000000 9999999999999999))
=> "0.00000000000000000000" (error)
(format "%.20f" (sub 10000000000000000 1))
=> "10000000000000000.00000000000000000000"
(format "%.20f" (sub 10000000000000000 2))
=> "9999999999999998.00000000000000000000"
(format "%.20f" (sub 10000000000000000 3))
=> "9999999999999996.00000000000000000000"
(format "%.20f" (sub 10000000000000000 4))
=> "9999999999999996.00000000000000000000"
(format "%.20f" (sub 10000000000000000 5))
=> "9999999999999996.00000000000000000000"
(format "%.20f" (sub 10000000000000000 6))
=> "9999999999999994.00000000000000000000"
#include <iostream>
using namespace std;
int main()
{
cout<<(1e16 - 1) << endl;
cout<<(10000000000000000 - 1);
return 0;
}
=> 1e+16
=> 9999999999999999
(rotate '("1" "A" "B" "2") 8)
;-> ("1" "A" "B" "2")
(rotate '("1" "A" "B" "2") -8)
;-> ("1") ;ERROR
(rotate '("1" "A" "B" "2") 12)
;-> ("1" "A" "B" "2")
(rotate '("1" "A" "B" "2") -12)
;-> ("1") ;ERROR
(rotate lst (- (% r (length lst))))
(rotate '("1" "A" "B" "2") (- (% 12 4)))
;-> ("1" "A" "B" "2")
(rotate '("1" "A" "B" "2") (- (% 8 4)))
;-> ("1" "A" "B" "2")