Menu

Show posts

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

Topics - cameyo

Pages 1 2 3 4
#41
newLISP in the real world / Parallel assignment
May 25, 2020, 12:33:11 AM
Hi all,

this is my first macro to do parallel assignment:
Code Select
(define-macro (psetq)
  (let ((_var '()) (_ex '()))
    ; for each expression in (args 1) ...
    (for (i 0 (- (length (args 1)) 1))
      ; expand the i-th expression with the value
      ; of each variable in (args 0)
      (setq _ex (expand (args 1 i) (args 0 0)))
      ; loop that expands the i-th expression for each variable
      (for (j 1 (- (length (args 0)) 1))
        (setq _ex (expand _ex (args 0 j)))
        (println _ex)
      )
      ; adds the expanded expression to a list
      (push _ex _var -1)
    )
    (println _var)
    ; assigns to each variable the evaluation
    ; of the relative expression of the created list
    (dolist (el _var)
      (set (args 0 $idx) (eval el))
    )
  )
)
Examples:
(setq x 2 y 3)
(psetq (x y) ((+ 1 y) (+ 1 x)))
;-> (+ 1 3)
;-> (+ 1 2)
;-> ((+ 1 3) (+ 1 2))
(list x y)
;-> (4 3)

(setq x 1)
(setq y 2)
(setq z 3)
(psetq (x y z) ((+ x y z) (- z y x) (- x y z)))
;-> (+ 1 2 z)
;-> (+ 1 2 3)
;-> (- z 2 1)
;-> (- 3 2 1)
;-> (- 1 2 z)
;-> (- 1 2 3)
;-> ((+ 1 2 3) (- 3 2 1) (- 1 2 3))
(list x y z)
;-> (6 0 -4)
Does anyone have any advice to improve it?

cameyo

p.s. thank you all for reactivating the forum
#42
newLISP in the real world / Puzzle
November 21, 2019, 05:05:41 AM
Write a function f so that f (f (n)) = -n for every integer n.
Code Select
Examples:
(f (f -1)) = 1
(f (f 1)) = -1
(f (f 4)) = -4
(f (f -4)) = 4
(f (f 0)) = 0
I'll post the solution the next week :-)
#43
newLISP in the real world / Fractran language
November 18, 2019, 07:51:58 AM
Fractran is a Turing-complete esoteric programming language invented by the mathematician John Conway. A Fractran  program is an ordered list of positive fractions together with an initial positive integer input n. The program is run by updating the integer n as follows:

1) For the first fraction f in the list for which n*f is an integer, replace n by n*f

2) repeat this rule until no fraction in the list produces an integer when multiplied by n, then halt.

Conway 1987 gives the following formula for primes in Fractran:
Code Select
(17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1)
Starting with n=2, this Fractran program generates the following sequence of integers:
Code Select
2, 15, 825, 725, 1925, 2275, 425, 390, 330, 290, 770, ...
After 2, this sequence contains the following powers of 2:
Code Select
2^2 = 4, 2^3 = 8, 2^5 = 32, 2^7 = 128, 2^11 = 2048
2^13 = 8192, 2^17 = 131072, 2^19 = 5244288, ...
which are the prime powers of 2.



Represent the Fractran program as a list:
Code Select
(setq primegame '((17L 91L) (78L 85L) (19L 51L) (23L 38L) (29L 33L)
(77L 29L) (95L 23L) (77L 19L) (1L 17L) (11L 13L) (13L 11L) (15L 14L) (15L 2L) (55L 1L) (55L 1L)))
The "fractran" function takes the program and an initial value and returns the next value or stops if no integer value is found.
Code Select
(define (fractran prog n)
  (local (value stop)
    (setq stop nil)
    (dolist (el prog stop)
      (setq value (/ (* (first el) n) (last el)))
      (cond ((null? prog) (setq stop true))
            ((= 0 (% (* (first el) n) (last el)))
                (setq stop true))))
    value))
Note: Since the numbers soon exceed the 64-bit integer limit we must use big-integers.

The "run" function runs the entire fractran program:
Code Select
(define (run program start step)
  (dotimes (x step)
    (println start)
    (setq start (fractran program start)))
  'stop)
Let's try running the fractran program:
Code Select
(run primegame 2L 10)
; -> 2L
; -> 15L
; -> 825L
; -> 725L
; -> 1925L
; -> 2275L
; -> 425L
; -> 390L
; -> 330L
; -> 290L
; -> stop
To extract the prime numbers it is necessary to verify if a given integer is a power of two.

We define two function "ipow" (calculate the integer power of a number) and "ilog" (calculate the integer logarithm of a number):
Code Select
(define (ipow x n)
  (cond ((zero? n) 1)
        ((even? n) (ipow (* x x) (/ n 2)))
        (true (* x (ipow (* x x) (/ (- n 1) 2))))))

(define (ilog n b)
  (if (zero? n) -1
    (+ (ilog (/ n b) b) 1L)))
A number n is the power of two if it is:
Code Select
 (= n (ipow 2 (ilog n 2)))
(= 1122 (ipow 2 (ilog 1122 2)))
; -> nil
(= 4096 (ipow 2 (ilog 4096 2)))
; -> true
Now write the "run2" function which ends the prime numbers:
Code Select
(define (run2 program start step)
  (dotimes (x step)
    (if (= start (ipow 2 (ilog start 2)))
      (print (ilog start 2) {, }))
    (setq start (fractran program start)))
  'stop)
Run the program to generate the prime numbers:
Code Select
(run2 primegame 2L 1e6)
; -> 1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, stop
Conway is a very 'bad' guy :-)
#44
newLISP in the real world / Tree structure
October 21, 2019, 03:10:42 AM
Which is the best way to represent a tree with a list?

Do you know newLISP code that works with trees?

Thanks
#45
newLISP in the real world / newLISP at the University of Utah
October 16, 2019, 12:50:00 AM
A course with newLISP:

https://usu.instructure.com/courses/529318/pages/calendar">//https://usu.instructure.com/courses/529318/pages/calendar

https://usu.instructure.com/courses/529318/pages/lisp">//https://usu.instructure.com/courses/529318/pages/lisp
#46
So, what can you actually DO with newLISP? / Quine
September 26, 2019, 03:56:45 AM
A Quine on REPL:
Code Select
ERR: context expected : ERR:
;-> ERR: context expected : ERR:
Have a nice day
#47
newLISP in the real world / Timing function problem
September 18, 2019, 05:26:55 AM
I have a problem with the following function who merge two ordered lists in a new list.
Code Select
(define (merge lstA lstB op)
  (define (ciclo out lstA lstB)
    (cond ((null? lstA) (extend (reverse out) lstB))
          ((null? lstB) (extend (reverse out) lstA))
          ((op (first lstB) (first lstA))
            (ciclo (cons (first lstB) out) lstA (rest lstB)))
          (true
            (ciclo (cons (first lstA) out) (rest lstA) lstB))))
  (ciclo '() lstA lstB)
)
Ascending order:
Code Select
(setq A '(1 2 3 4 5 6 7 8))
(setq B '(2 3 4 5 11 12 13))
(merge A B <)
;-> (1 2 3 4 4 5 5 6 7 8 11 12 13 18 19)
Descending order:
Code Select
(setq C '(4 3 2))
(setq D '(8 5 3 1))
(merge C D >)
;-> (8 5 4 3 3 2 1)
Now timing the function:
Code Select
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 1751.43
Timing again:
Code Select
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 2234.945
and again:
Code Select
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 2672.319:
and again:
Code Select
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 3015.992
Why does the execution time increase each time?

More: raising an error on REPL reset the problem

For example, type the following on REPL:
Code Select
and again:
;-> and@4098B4
;-> ERR: symbol expected : " again:"
Now timing the function will restart the problem:
Code Select
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 1750.432
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 2218.979
Does anyone know the explanation of this problem?

Thanks.

System: Windows 10 Pro 64bit - newLISP 10.7.5 64bit-utf8
#48
newLISP in the real world / Check if a number is a perfect power
September 17, 2019, 02:35:51 AM
A perfect power is a number n of the form m^k, where m>1 is a positive integer and k>=2. If the prime factorization of n is n=p1^(a1)*p2^(a2)...pk^(ak), then n is a perfect power iff GCD(a1,a2,...,ak) > 1.

The "factor-exp-list" function calculates the list of exponents of the factorization of the number x:
Code Select
(define (factor-exp-list x)
  (if (= x 1) '(1)
    (letn (fattori (factor x)
           unici (unique fattori))
       (count unici fattori))))
1000 = 2^3 * 5^3
(factor-exp-list 1000)
;-> (3 3)
And now the final function:
Code Select
(define (checkpower n)
    (if (> (setq a (apply gcd (factor-exp-list n))) 1)
        (list (ceil (pow n (div 1 a))) a)
        nil)))
(checkpower (pow 3 12))
;-> (3 12)
(checkpower (pow 4 25))
;-> (2 50)
(checkpower (+ (pow 3 7) 1))
;-> nil
#49
newLISP in the real world / Wheel factorization for big integer
September 10, 2019, 08:38:53 AM
For theory see: https://en.wikipedia.org/wiki/Wheel_factorization">//https://en.wikipedia.org/wiki/Wheel_factorization
Code Select
(define (factorbig n)
  (local (f k i dist out)
    ; Distanze tra due elementi consecutivi della ruota (wheel)
    (setq dist (array 48 '(2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 6 4
                           6 8 4 2 4 2 4 8 6 4 6 2 4 6 2 6 6 4
                           2 4 6 2 6 4 2 4 2 10 2 10)))
    (setq out '())
    (while (zero? (% n 2)) (push '2L out -1) (setq n (/ n 2)))
    (while (zero? (% n 3)) (push '3L out -1) (setq n (/ n 3)))
    (while (zero? (% n 5)) (push '5L out -1) (setq n (/ n 5)))
    (while (zero? (% n 7)) (push '7L out -1) (setq n (/ n 7)))
    (setq k 11L i 0)
    (while (<= (* k k) n)
      (if (zero? (% n k))
        (begin
        (push k out -1)
        (setq n (/ n k)))
        (begin
        ;(++ k (dist i))
        (setq k (+ k (dist i)))
        (if (< i 47) (++ i) (setq i 0)))
      )
    )
    (if (> n 1) (push (bigint n) out -1))
    out
  )
)

(factorbig 9223372036854775809L)
;-> (3L 3L 3L 19L 43L 5419L 77158673929L)

(time (factorbig 9223372036854775809L))
;-> 46.875

(apply * '(3L 3L 3L 19L 43L 5419L 77158673929L))
;-> 9223372036854775809L

We check if factorbig and factor produce the same result (up to a million):
Code Select
(= (map factorbig (sequence 2 1e6)) (map factor (sequence 2 1e6)))
;-> true
Let's try a 20-digit number:
Code Select
(time (println (factorbig 92233720368547758091L)))
;-> (7L 13L 1013557366687338001L)
;-> 150515.93 ; 150 sec
The greater the value of the factors, the greater the execution time.
Code Select
(time (println (factorbig 1013557366687338001L)))
;-> (1013557366687338001L)
;-> 179855.465 ; 3 min
Instead in the following example the calculation is immediate:
Code Select
2^64 = 18446744073709551616
(setq d 18446744073709551616L)
(factorbig d)
;-> (2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L
;->  2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L
;->  2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L 2L
;->  2L 2L 2L 2L)

How to calculate wheel distance list

First you need to generate the numbers of the wheel, that is all the integers coprime from the base up to the number (+ (* 2 3 5 7) 11) = 221

Function to calculate the coprime:
Code Select
(define (coprimi? a b) (= (gcd a b) 1))
Function that checks if a number belongs to the wheel:
Code Select
(define (wheel7 n) (and (coprimi? n 2) (coprimi? n 3) (coprimi? n 5) (coprimi? n 7)))
Function that creates the number wheel:
Code Select
(define (dowheel7)
  (let (out '())
    (for (i 2 221) (if (wheel7 i) (push i out -1)))))
(dowheel7)
;-> (11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113
;->  121 127 131 137 139 143 149 151 157 163 167 169 173 179 181 187 191 193 197 199
;->  209 211 221)
To calculate the distances between two consecutive wheel elements we use the following function:

(thanks fdb: http://www.newlispfanclub.alh.net/forum/viewtopic.php?f=12&t=5006">//http://www.newlispfanclub.alh.net/forum/viewtopic.php?f=12&t=5006)
Code Select
(define (creadist lst) (map - (rest lst) (chop lst)))
(creadist (dowheel7))
;-> (2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6 2 6 6 4 2 4 6 2
;-> 6 4 2 4 2 10 2 10)
That's all.

Do you have a faster function to factorize big integer?
#50
newLISP in the real world / Carmichael numbers
September 05, 2019, 08:18:02 AM
In number theory, a Carmichael number is a composite number n which satisfies the modular arithmetic congruence relation:

 b^(n-1) ≡ 1 mod n

for all integers b which are relatively prime to n.

https://en.wikipedia.org/wiki/Carmichael_number">//https://en.wikipedia.org/wiki/Carmichael_number


Code Select
(define (fattorizza x)
  (letn (fattori (factor x)
         unici (unique fattori))
    (transpose (list unici (count unici fattori)))))
    ;(map list unici (count unici fattori))))

(fattorizza 45)
;-> ((3 2) (5 1))

(fattorizza 561)
;-> ((3 1) (11 1) (17 1))

(define (carmichael? n)
  (local (out fattori)
    (setq out true)
    (cond ((or (= n 1) (even? n) (= 1 (length (factor n)))) (setq out nil))
          (true
            (setq fattori (fattorizza n))
            (dolist (f fattori (= out nil))
              (if (> (f 1) 1) (setq out nil))
              (if (!= (% (- n 1) (- (f 0) 1)) 0) (setq out nil))
            )
          )
    )
    out
  )
)

(define (carmichael n)
  (let (out '())
    (for (i 3 n 2)
      (if (carmichael? i) (push i out -1))
    )
  out
  )
)

(carmichael 1000000)
;-> (561 1105 1729 2465 2821 6601 8911 10585 15841 29341 41041 46657 52633 62745 63973
;->  75361 101101 115921 126217 162401 172081 188461 252601 278545 294409 314821
:->  334153 340561 399001 410041 449065 488881 512461 530881 552721 656601 658801
;->  670033 748657 825265 838201 852841 997633)

(time (carmichael 1000000))
;-> 2043.545

(define (carmichael n)
  (filter carmichael? (sequence 3 n 2)))

(time (carmichael 1000000))
;-> 3510.422
#51
newLISP in the real world / Every odd integer is the difference of 2 squares
September 05, 2019, 06:34:11 AM
Try this:
Code Select
(define (breaknum n)
  (if (even? n) nil
    (list (* (- n (/ n 2)) (- n (/ n 2))) (* (/ n 2) (/ n 2)) )))

(breaknum 11)
;-> (36 25)

(breaknum 9527)
;-> (22695696 22686169)

Proof

1) Pick an odd number (5):

OOOOO



2)Bend it in half:

OOO

O

O



3) Fill the rest:

OOO

OXX

OXX



The odd number is the area difference of the big (9) and small (4) squares.
#52
newLISP in the real world / Twin primes
August 28, 2019, 07:14:43 AM
Two functions to calculate twin primes (pairs and pairs-i).
Code Select
(define (prime? n)
  (if (even? n) nil
      (= 1 (length (factor n)))))

(define (twin? n)
  (if (and (prime? n) (prime? (+ n 2)))
    (list n (+ n 2))
    nil))

(twin? 9)
;-> nil
(twin? 881)
;-> (881 883)

(define (pairs a b)
  (filter true? (map twin? (sequence a b))))

(pairs 3 1000)
;-> ((3 5) (5 7) (11 13) (17 19) (29 31) (41 43) (59 61) (71 73) (101 103) (107 109)
;->  (137 139) (149 151) (179 181) (191 193) (197 199) (227 229) (239 241) (269 271)
;->  (281 283) (311 313) (347 349) (419 421) (431 433) (461 463) (521 523) (569 571)
;->  (599 601) (617 619) (641 643) (659 661) (809 811) (821 823) (827 829) (857 859)
;->  (881 883))
(length (pairs 3 1000))
;-> 35
(time (pairs 3 2e7))
;-> 47479.457

==================================================

(define (pairs-i a b)
  (local (idx found out)
    (setq found nil)
    (setq idx a)
    ; only the number 5 belongs to two pairs of twin prime numbers
    (setq out '((3 5) (5 7)))
    (while (< idx b)
      (if (and (prime? idx) (prime? (+ idx 2)))
        (begin
        (push (list idx (+ idx 2)) out -1)
        (setq found true))
      )
      (if found (++ idx 4) (++ idx 2))
      (setq found nil)
    )
    out
  )
)

(pairs-i 7 1000)
;-> ((3 5) (5 7) (11 13) (17 19) (29 31) (41 43) (59 61) (71 73) (101 103) (107 109)
;->  (137 139) (149 151) (179 181) (191 193) (197 199) (227 229) (239 241) (269 271)
;->  (281 283) (311 313) (347 349) (419 421) (431 433) (461 463) (521 523) (569 571)
;->  (599 601) (617 619) (641 643) (659 661) (809 811) (821 823) (827 829) (857 859)
;->  (881 883))
(length (pairs-i 7 1000))
;-> 35
(time (pairs-i 7 2e7))
;-> 43177.908
Post yours :-)
#53
newLISP in the real world / Create polynomials
August 25, 2019, 08:45:03 AM
Suppose we have the polynomial y (x) = 3*x^2 - 7*x + 5 and we want to calculate the values of y for x ranging from 0 to 10 (with step 1).

We can define a function that represents the polynomial:
Code Select
(define (poly x)
  (+ 5 (mul 7 x) (mul 3 (pow x 2))))

(poly 0)
;-> 5
And then to get the searched values:
Code Select
(for (x 0 10) (println x { } (poly x)))
;-> 0 5
;-> 1 15
;-> 2 31
;-> 3 53
;-> 4 81
;-> 5 115
;-> 6 155
;-> 7 201
;-> 8 253
;-> 9 311
;-> 10 375
Since the polynomials have a well-defined structure, we can write a function that takes the coefficients of a polynomial and returns a function that represents the polynomial:

For example, the polynomial:
Code Select
  y(x) = 4*x^3 + 5*x^2 + 7*x + 10
is represented by the function:
Code Select
 (lambda (x) (add 10 (mul x 7) (mul (pow x 2) 5) (mul (pow x 3) 4)))
Our function must therefore construct a new lambda function that represents the polynomial (we work on the lambda function as if it were a list).
Code Select
(define (make-poly coeff)
  (local (fun body)
    (reverse coeff)
    (setq fun '(lambda (x) x)) ;funzione lambda base
    (setq body '()) ;corpo della funzione
    (push 'add body -1)
    (push (first coeff) body -1) ;termine noto
    (push (list 'mul 'x (coeff 1)) body -1) ;termine lineare
    (for (i 2 (- (length coeff) 1))
      (push (list 'mul (list 'pow 'x i) (coeff i)) body -1)
    )
    (setq (last fun) body) ;modifica corpo della funzione
    fun
  )
)
In this way we can define a new "poly" function that represents our polynomial:
Code Select
(setq poly (make-poly '(4 5 7 10)))
;-> (lambda (x) (add 10 (mul x 7) (mul (pow x 2) 5) (mul (pow x 3) 4)))
Evaluating the polynomial for x = 0 we obtain the constant term:
Code Select
(poly 0)
;-> 10
And to get the values:
Code Select
(for (x 0 10) (println x { } (poly x)))
;-> 0 10
;-> 1 26
;-> 2 76
;-> 3 184
;-> 4 374
;-> 5 670
;-> 6 1096
;-> 7 1676
;-> 8 2434
;-> 9 3394
;-> 10 4580

Do you known a better/elegant method to create lambda functions for polynomials?
#54
newLISP in the real world / Church encoding
July 21, 2019, 07:59:33 AM
In the Church encoding of natural numbers, the number N is encoded by a function that applies its first argument N times to its second argument.

Church zero always returns the identity function, regardless of its first argument. In other words, the first argument is not applied to the second argument at all.

Church one applies its first argument f just once to its second argument x, yielding f(x)

Church two applies its first argument f twice to its second argument x, yielding f(f(x))

and each successive Church numeral applies its first argument one additional time to its second argument, f(f(f(x))), f(f(f(f(x)))) ... The Church numeral 4, for example, returns a quadruple composition of the function supplied as its first argument.

Arithmetic operations on natural numbers can be similarly represented as functions on Church numerals.

I have written the following functions:
Code Select
(define (zero f x) x)
(define (uno f x) (f x))
(define (due f x) (f (f x)))
(define (tre f x) (f (f (f x))))
(define (quattro f x) (f (f (f (f x)))))
(define (cinque f x) (f (f (f (f (f x))))))
(define (sei f x) (f (f (f (f (f (f x)))))))
(define (sette f x) (f (f (f (f (f (f (f x))))))))
(define (otto f x) (f (f (f (f (f (f (f (f x)))))))))
(define (nove f x) (f (f (f (f (f (f (f (f (f x))))))))))
(zero inc 0)
;-> 0
(uno inc 0)
;-> 1
(due inc 0)
;-> 2
Or:
Code Select
(setq f inc)
(setq x 0)
(zero f x)
;-> 0
(sei f x)
;-> 6

I have defined the successor function:
Code Select
(define (succ n f x) (f (f n x)))
(succ 0 inc 0)
;-> 1
(succ 3 inc 0)
;-> 4
(succ 2 inc 0)
;-> 3

Now the plus operation:
Code Select
(define (plus m n f x) (f m (f n x)))
(plus 3 2 inc 0)
;-> 5
(plus (due inc 0) 5 inc 0)
;-> 7
(plus (due f x) 5 f x)
;-> 7
Now, i have some problem to write the following function:

1) multiplication (mult)

2) predecessor (pred)

3) subtraction (minus)



Can anyone help me?

cameyo



p.s. I'm not sure if what I wrote is correct

p.p.s. I forgot to translate the numbers into English :-)
#55
Whither newLISP? / pseudo-random number generator
July 13, 2019, 08:12:49 AM
Which type of pseudo-random number generator uses newLISP?

Thanks.
#56
newLISP in the real world / Pathological floating point problems
July 13, 2019, 06:49:54 AM
From https://rosettacode.org/wiki/Pathological_floating_point_problems">//https://rosettacode.org/wiki/Pathological_floating_point_problems

Problem

The Chaotic Bank Society is offering a new investment account to their customers.

You first deposit $ (e - 1) where "e" is 2.7182818 (the base of natural logarithms).

After each year, your account balance will be multiplied by the number of years that have passed, and $1 in service charges will be removed.

Example:

after 1 year, your balance will be multiplied by 1 and $1 will be removed for service charges.

after 2 years your balance will be doubled and $1 removed.

after 3 years your balance will be tripled and $1 removed.

...

after 10 years, multiplied by 10 and $1 removed, and so on.

What will your balance be after 25 years?

The correct result is:

   Starting balance: $ (e - 1)

   Balance = (Balance * year) - 1 for 25 years

   Balance after 25 years: $ 0.0399387296732302

Solution (using floating point math):
Code Select

(define (bank)
  (local (e balance)
    ;definiamo il numero e
    (setq e (exp 1))
    (setq balance (sub e 1))
    (for (i 1 25)
      (setq balance (sub (mul balance i) 1))
      (println i { } balance)
    )
    balance
  )
)

(bank)
;-> 1 0.7182818284590451
;-> 2 0.4365636569180902
;-> 3 0.3096909707542705
;-> ...
;-> 16 0.05924783418595325
;-> 17 0.007213181161205284
;-> 18 -0.8701627390983049
;-> 19 -17.53309204286779
;-> 20 -351.6618408573559
;-> 21 -7385.898658004473
;-> 22 -162490.7704760984
;-> 23 -3737288.720950264
;-> 24 -89694930.30280632
;-> 25 -2242373258.570158
;-> -2242373258.570158

The result is wrong, as the rounding of the floating point operations diverge the calculations.

To solve the problem we can use fractions, ie we perform all the calculations with fractions (integers) and we use the division only to get the value of the result as a floating point. To do this we must also represent the number "e" with a fraction:
Code Select
e = 106246577894593683/39085931702241241
The functions to use the four operations of the fractions are the following:
Code Select

(define (semplifica frac)
  (local (num den n d temp, nums dens)
    (setq num (first frac))
    (setq den (last frac))
    (setq n (first frac))
    (setq d (last frac))
    ; calcola il numero massimo che divide esattamente numeratore e denominatore
    (while (!= d 0)
      (setq temp d)
      (setq d (% n temp))
      (setq n temp)
    )
    (setq nums (/ num n))
    (setq dens (/ den n))
    ; controllo del segno
    (cond ((or (and (< dens 0) (< nums 0)) (and (< dens 0) (> nums 0)))
           (setq nums (* nums -1))
           (setq dens (* dens -1))
          )
    )
    (list nums dens)
  )
)

(define (+f frac1 frac2 redux)
  (local (num den n1 d1 n2 d2)
    (setq n1 (first frac1))
    (setq d1 (last frac1))
    (setq n2 (first frac2))
    (setq d2 (last frac2))
    (setq num (+ (* n1 d2) (* n2 d1)))
    (setq den (* d1 d2))
    (if redux (list num den)
          (semplifica (list num den))
    )
  )
)

(define (-f frac1 frac2 redux)
  (local (num den n1 d1 n2 d2)
    (setq n1 (first frac1))
    (setq d1 (last frac1))
    (setq n2 (first frac2))
    (setq d2 (last frac2))
    (setq num (- (* n1 d2) (* n2 d1)))
    (setq den (* d1 d2))
    (if redux (list num den)
          (semplifica (list num den))
    )
  )
)

(define (*f frac1 frac2 redux)
  (local (num den n1 d1 n2 d2)
    (setq n1 (first frac1))
    (setq d1 (last frac1))
    (setq n2 (first frac2))
    (setq d2 (last frac2))
    (setq num (* n1 n2))
    (setq den (* d1 d2))
    (if redux (list num den)
          (semplifica (list num den))
    )
  )
)

(define (/f frac1 frac2 redux)
  (local (num den n1 d1 n2 d2)
    (setq n1 (first frac1))
    (setq d1 (last frac1))
    (setq n2 (first frac2))
    (setq d2 (last frac2))
    (setq num (* n1 d2))
    (setq den (* d1 n2))
    (if redux (list num den)
          (semplifica (list num den))
    )
  )
)


Solution (using integer math):
Code Select

(define (bank)
  (local (e balance)
    (setq e '(106246577894593683L 39085931702241241L))
    (setq balance (-f e '(1 1)))
    (for (i 1 25)
      (setq balance (-f (*f balance (list i 1)) '(1 1)))
      (println i { } balance { } (div (first balance) (last balance)))
    )
    balance
  )
)

(bank)
;-> 1 (28074714490111201L 39085931702241241L) 0.7182818284590452
;-> 2 (17063497277981161L 39085931702241241L) 0.4365636569180905
;-> 3 (12104560131702242L 39085931702241241L) 0.3096909707542714
;-> ...
;-> 16 (2433979885881703L 39085931702241241L) 0.06227253080274239
;-> 17 (2291726357747710L 39085931702241241L) 0.05863302364662064
;-> 18 (2165142737217539L 39085931702241241L) 0.05539442563917152
;-> 19 (2051780304892000L 39085931702241241L) 0.05249408714425882
;-> 20 (1949674395598759L 39085931702241241L) 0.04988174288517631
;-> 21 (1857230605332698L 39085931702241241L) 0.04751660058870241
;-> 22 (1773141615078115L 39085931702241241L) 0.04536521295145283
;-> 23 (1696325444555404L 39085931702241241L) 0.04339989788341503
;-> 24 (1625878967088455L 39085931702241241L) 0.04159754920196069
;-> 25 (1561042474970134L 39085931702241241L) 0.03993873004901714
;-> (1561042474970134L 39085931702241241L)

Now the result is correct.
#57
newLISP in the real world / Karatsuba algorithm
July 03, 2019, 06:57:24 AM
From: https://en.wikipedia.org/wiki/Karatsuba_algorithm">//https://en.wikipedia.org/wiki/Karatsuba_algorithm


Code Select
(define (potenza n m)
  (let (pot 1L) (dotimes (x m) (setq pot (* pot n))))
)

(potenza 3 6)
;-> 729L

Iterative:

(define (karatsuba num1 num2)
  (local (m m2 high1 low1 high2 low2 z0 z1 z2)
    (cond ((or (< num1 10) (< num2 10)) (* num1 num2))
          (true
            (setq m (max (length (string num1)) (length (string num2))))
            (setq m2 (/ m 2))
            (setq n1$ (string num1))
            (setq n2$ (string num2))
            (setq high1 (int (slice n1$ 0 (- (length n1$) m2))))
            (setq low1  (int (slice n1$ (- (length n1$) m2) m2)))
            (setq high2 (int (slice n2$ 0 (- (length n2$) m2))))
            (setq low2  (int (slice n2$ (- (length n2$) m2) m2)))
            ;(println high1 { } low1)
            ;(println high2 { } low2)
            (setq z0 (karatsuba low1 low2))
            (setq z1 (karatsuba (+ low1 high1) (+ low2 high2)))
            (setq z2 (karatsuba high1 high2))
            (+ (* z2 (potenza 10 (* m2 2))) (* (- z1 z2 z0) (potenza 10 m2)) z0)
          )
    )
  );local
)

(karatsuba 12 12)
;-> 144
(karatsuba 13 17)
;-> 221
(karatsuba 120 11)
;-> 1320
(karatsuba 12345 6789)
;-> 83810205
(mul 12345 6789)
;-> 83810205
(time (karatsuba 12345 6789) 10000)
;-> 359.359

Recursive:

(define (karatsuba x y)
    (karatsuba1 x y 256)  ; in generale, opportuna potenza di 2 p (x , y < 2p)
)

(define (karatsuba1 x y p)  ; x, y, p: interi non negativi, p potenza di 2
    (if (= p 1)
        (* x y)
        (let ((x1 (/ x p)) (x0 (% x p))
              (y1 (/ y p)) (y0 (% y p))
              (q (/ p 2)))
          (let ((z2 (karatsuba1 x1 y1 q))
                (z0 (karatsuba1 x0 y0 q)))
            (let ((z1 (- (karatsuba1 (+ x1 x0) (+ y1 y0) q) (+ z2 z0))))
              (+ (* z2 p p) (* z1 p) z0)
            )
          )
        )
     )
)

(karatsuba 12 12)
;-> 144
(karatsuba 12345 6789)
;-> 83810205
(time (karatsuba 12345 6789) 10000)
;-> 33347.174

big integer "L":
 
(define (karatsuba num1 num2)
  (local (len1 len2 m m2 high1 low1 high2 low2 z0 z1 z2)
    (cond ((or (< num1 10) (< num2 10)) (* num1 num2))
          (true
            (setq len1 (length (string num1)))
            (if (= (last (string num1)) "L") (-- len1))
            (setq len2 (length (string num2)))
            (if (= (last (string num1)) "L") (-- len2))            
            (setq m (max len1 len2))
            (setq m2 (/ m 2))
            (setq n1$ (string num1))
            (if (= (last n1$) "L") (setq n1$ (chop n1$)))
            (setq n2$ (string num2))
            (if (= (last n2$) "L") (setq n2$ (chop n2$)))
            (setq high1 (bigint (slice n1$ 0 (- (length n1$) m2))))
            (setq low1  (bigint (slice n1$ (- (length n1$) m2) m2)))
            (setq high2 (bigint (slice n2$ 0 (- (length n2$) m2))))
            (setq low2  (bigint (slice n2$ (- (length n2$) m2) m2)))
            ;(println high1 { } low1)
            ;(println high2 { } low2)
            (setq z0 (karatsuba low1 low2))
            (setq z1 (karatsuba (+ low1 high1) (+ low2 high2)))
            (setq z2 (karatsuba high1 high2))
            (+ (* z2 (potenza 10 (* m2 2))) (* (- z1 z2 z0) (potenza 10 m2)) z0)
          )
    )
  );local
)

(karatsuba 12345 6789)
;-> 83810205
(karatsuba 9223372036854775807 9223372036854775807)
;-> 85070591730234615847396907784232501249L
(* 9223372036854775807L 9223372036854775807L)
;-> 85070591730234615847396907784232501249L
(time (karatsuba 12345 6789) 10000)
;-> 687.468
#58
newLISP in the real world / Maze solution
June 30, 2019, 07:12:00 AM
From: https://en.wikipedia.org/wiki/Maze_solving_algorithm">//https://en.wikipedia.org/wiki/Maze_solving_algorithm

The recursive solution with newLISP:
Code Select
(define (solveMaze matrice sRow sCol eRow eCol)
  (local (maze row col visited correctPath starRow startCol endRow endCol)
    ; matrice labirinto
    (setq maze matrice)
    ; righe della matrice
    (setq row (length maze))
    ; colonne della matrice
    (setq col (length (first maze)))
    ; matrice delle celle visitate
    (setq visited (array row col '(nil)))
    ; matrice soluzione del labirinto
    (setq correctPath (array row col '(nil)))
    ; posizione iniziale: riga
    (setq startRow sRow)
    ; posizione iniziale: colonna
    (setq startCol sCol)
    ; posizione finale: riga
    (setq endRow eRow)
    ; posizione finale: colonna
    (setq endCol eCol)
    ;
    ; funzione recursive solve
    ;
    (define (recursiveSolve x y)
      (catch
        (local (return)
          ;controllo se abbiamo raggiunto la fine e non è un muro
          (if (and (= x endRow) (= y endCol) (!= (maze x y) 2))
              (throw (setf (correctPath x y) true))
          )
          ; cella muro o cella visitata
          (if (or (= (maze x y) 2) (= (visited x y) true)) (throw nil))
          ; imposta cella come visitata
          (setf (visited x y) true)
          ; controllo posizione riga 0
          (if (!= x 0)
              ; richiama la funzione una riga in basso
              (if (recursiveSolve (- x 1) y)
                  (throw (setf (correctPath x y) true))
              )
          )
          ; controllo posizione riga (row - 1)
          (if (!= x (- row 1))
              ; richiama la funzione una riga in alto
              (if (recursiveSolve (+ x 1) y)
                  (throw (setf (correctPath x y) true))
              )
          )
          ; controllo posizione colonna 0
          (if (!= y 0)
              ; richiama la funzione una colonna a sinistra
              (if (recursiveSolve x (- y 1))
                  (throw (setf (correctPath x y) true))
              )
          )
          ; controllo posizione colonna (col - 1)
          (if (!= y (- col 1))
              ; richiama la funzione una colonna a destra
              (if (recursiveSolve x (+ y 1))
                  (throw (setf (correctPath x y) true))
              )
          )
          return
        );local
      ) ;catch
    ); recursiveSolve
    ;
    ; Chiama la funzione ricorsiva di soluzione
    ; Se (recursiveSolve startRow startCol) ritorna nil,
    ; allora il labirinto non ha soluzione.
    ; Altrimenti la matrice booleana "correctPath"
    ; contiene la soluzione (valori true).
    (if (recursiveSolve startRow startCol) (showPath correctPath))
  );local
)

(define (showPath matrix)
  (local (row col)
    ; righe della matrice
    (setq row (length matrix))
    ; colonne della matrice
    (setq col (length (first matrix)))
    ; stampa
    (for (i 0 (- row 1))
      (for (j 0 (- col 1))
        (if (matrix i j) (print " 1") (print " 0"))
      )
      (println)
    )
    true
  )
)

Example:
; maze (1 = free, 2 = blocked)
 1 1 2 1 2 1 1 1 2 1 2 1 2 1 2 2 1 1 1 2
 2 1 1 1 2 2 1 1 1 1 1 2 2 1 1 1 1 1 2 2
 2 1 2 2 2 2 2 1 1 2 2 2 1 2 2 2 2 1 2 1
 2 1 1 1 1 1 2 2 2 1 1 1 1 2 2 2 1 2 1 2
 1 2 2 2 2 1 2 2 1 2 1 2 1 2 2 1 1 2 2 2
 1 2 2 2 2 1 1 1 1 2 1 2 1 2 2 1 1 2 2 2
 1 2 2 2 2 2 2 2 1 2 1 2 1 2 2 1 2 1 2 2
 1 2 2 2 2 2 2 2 1 1 1 2 1 2 2 1 1 1 2 2
 1 2 2 2 2 2 2 2 1 2 2 2 1 1 1 1 2 1 1 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1
; maze definition
; rows
(setq righe 12)
; columns
(setq colonne 20)
; maze matrix
(setq matrice (array righe colonne '(
 1 1 2 1 2 1 1 1 2 1 2 1 2 1 2 2 1 1 1 2
 2 1 1 1 2 2 1 1 1 1 1 2 2 1 1 1 1 1 2 2
 2 1 2 2 2 2 2 1 1 2 2 2 1 2 2 2 2 1 2 1
 2 1 1 1 1 1 2 2 2 1 1 1 1 2 2 2 1 2 1 2
 1 2 2 2 2 1 2 2 1 2 1 2 1 2 2 1 1 2 2 2
 1 2 2 2 2 1 1 1 1 2 1 2 1 2 2 1 1 2 2 2
 1 2 2 2 2 2 2 2 1 2 1 2 1 2 2 1 2 1 2 2
 1 2 2 2 2 2 2 2 1 1 1 2 1 2 2 1 1 1 2 2
 1 2 2 2 2 2 2 2 1 2 2 2 1 1 1 1 2 1 1 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1
 1 2 2 2 2 2 2 2 1 2 2 2 1 2 2 1 2 2 2 1)))
(solveMaze matrice 0 0 11 19)
;-> 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
;-> 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
;-> 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
;-> 0 1 1 1 1 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0
;-> 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 0
;-> 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0
;-> 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0
;-> 0 0 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 0 0
;-> 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 1
;-> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
;-> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
;-> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
;-> true
#59
newLISP in the real world / Equal and Not Equal
June 04, 2019, 05:57:37 AM
Code Select
(setq lst '((2 4) (3 1)))

(= (lst 0 0) (lst 0 0))
;-> true

(!= (lst 0 0) (lst 0 0))
;-> (nil nil)

(= (lst 0 0) (lst 1 0))
;-> (nil nil)

(= (first (first lst)) (last (first lst)))
;-> (nil nil)
I was expecting nil, instead i got (nil nil).

Where am I doing wrong?

Thanks.
#60
newLISP in the real world / Sum of digits
June 03, 2019, 12:55:27 AM
Given a number n, find the sum of its digits until sum becomes single digit.
Code Select
Example: n = 7865 = 7 + 8 + 6 + 5 = 26 ==> 2 + 6 = 8
Code Select
(define (digitSum n)
  (if (zero? n) 0
    (if (zero? (% n 9)) 9
      (% n 9))))

(digitSum 236753647864)
;-> 7
Pages 1 2 3 4