newLISP Fan Club

The previous code is wrong. Sorry.

Let's write a function that associates each index of a list with a different index of the list itself.
(define (sel-idx lst)
  (let ((out '()) (len (length lst)))
    (dolist (el lst)
      ; select and index of the list different from the current
      (while (= (setq idx (rand len)) $idx))
      ;(println "coppia: " $idx idx)
      (push (list $idx idx) out -1))
    out))

Now if lst has only one value, the function should loop (because it's not possible to select an index other than 0):
(sel-idx '(1))
;-> ((0 0))  --> ERROR
If lst has more than one value, the function should work correctly:
(sel-idx '(1 2))
;-> ((0 1) (1 0))  --> OK
(sel-idx '(1 2))
;-> ((0 1) (1 1))  --> ERROR
Why doesn't the function produce correct results?
Because 'until' (and 'while') also have an internal variable $idx.
So we're not comparing the generated value 'idx' to $idx from 'dolist', but to $idx from 'until'.
To fix this, we need to copy the value '$idx' from 'dolist' into a variable and apply it within the 'until' loop.
(define (sel-idx-ok lst)
  (let ((out '()) (len (length lst)) (tmp 0))
    (dolist (el lst)
      (setq tmp $idx)
      ; select and index of the list different from the current
      (while (= (setq idx (rand len)) tmp))
      ;(println "coppia: " $idx idx)
      (push (list tmp idx) out -1))
    out))

(sel-idx-ok '(1))
;-> ... --> infinite loop
(sel-idx-ok '(1 2))
;-> ((0 1) (1 0)) --> OK
(sel-idx '(0 1 2 3 4 5 6 7 8 9))
;-> ((0 4) (1 9) (2 4) (3 8) (4 8) (5 9) (6 1) (7 1) (8 6) (9 6))


(define (test lst)
  (let (len (length lst))
    (dolist (el lst)
      ; select and index of the list different from the current
      (while (!= (setq idx (rand len)) $idx)))
    (println "index: " idx)))
Why (test '(1 2 3 4 5)) fall (almost always) into an infinite loop?
Why (test '(1)) return always 0? The function should fall into an infinite loop.

I know the answer...

A fast function to generate all prime numbers less than or equal to a given number

(define (primes-to num)
"Generate all prime numbers less than or equal to a given number"
  (cond ((< num 2) '())
        ((< num 3) '(2))
        (true
          (letn ((m (/ (- num 3) 2))
                 (arr (array (+ m 1)))
                 (lim (/ (- (int (sqrt num)) 3) 2))
                 (lst '(2)))
            (for (i 0 lim)
              (when (nil? (arr i))
                (letn ((p (+ (* 2 i) 3))
                       (j (/ (- (* p p) 3) 2)))
                  (for (k j m p (> k m))
                    (setf (arr k) true)))))
            (for (i 0 m)
              (when (nil? (arr i))
                (push (+ (* 2 i) 3) lst -1)))
            lst))))

(time (println (length (primes-to 1e6))))
;-> 78498
;-> 100.292
(time (println (length (primes-to 1e7))))
;-> 664579
;-> 1396.784
(time (println (length (primes-to 1e8))))
;-> 5761455
;-> 15544.004
(time (println (length (primes-to 1e9))))
;-> 50847534
;-> 178960.989
S.O.: Windows 10
CPU: intel i7
RAM: 32 GB

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

Does anyone know of any more efficient methods than the following to calculate all the matches of a regex?
Thanks.
(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))


Interesting, but I'm fond of parentheses.

Problem Solving with newLISP
https://github.com/cameyo42/newLISP-Code
More than 3000 topics on newLISP:
- Algorithms
- Project Euler
- Rosetta Code
- Programming interview questions
- Library for recreational mathematics (344 functions)
- a lot of programming problems

;---------------------------------
; 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)

Thanks Ralph.
This is my solution:
(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

Write a function that generates a random integer within a closed interval and with predefined digits.

For example:
Range: (1 200)
Digits: 1 2 3
Possible numbers: 1 2 3 11 21 31 12 22 32 13 23 33
 111 211 311 121 221 321 131 231 331 112 212 312 122 222
 322 132 232 332 113 213 313 123 223 323 133 233 333
Numbers in the range: 1 2 3 11 21 31 12 22 32 13 23 33
 111 112 113 121 122 123 131 132 133
Random Number: Any of the numbers in the range

(define (test a) (extend '() (sequence 1 a)))
(test 4)
;-> (1 2 3 4)
(test 4)
;-> (1 2 3 4 1 2 3 4)
(test 4)
;-> (1 2 3 4 1 2 3 4 1 2 3 4)
test
;-> (lambda (a) (extend '(1 2 3 4 1 2 3 4) (sequence 1 a)))

From the newLISP manual:

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.

Some test:

(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"


In C++:
#include <iostream>

using namespace std;

int main()
{
    cout<<(1e16 - 1) << endl;
    cout<<(10000000000000000 - 1);
    return 0;
}
=> 1e+16
=> 9999999999999999

Thanks!!

Maybe a bug of "rotate" when negative rotations and absolute rotations multiple of length of list.

(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
Workaround:
(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")