Topics - cameyo

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 / List of user symbols

July 09, 2020, 09:12:16 AM

A function to list the user symbols:

Code Select Expand
(define (user-symbols)
  (local (_func _other)
    (setq _func '())
    (setq _other '())
    (dolist (_el (symbols))
      (if (and (lambda? (eval _el))  
               (not (= _el 'user-symbols)))
          (push _el _func -1))
      (if (and (not (lambda? (eval _el)))
               (not (primitive? (eval _el)))
               (not (protected? _el))
               (not (global? _el))
               (not (= _el '_func))
               (not (= _el '_other))
               (not (= _el '_el)))
          (push _el _other -1))
    )
    (list _func _other)
  )
)

; from a fresh REPL of newLISP
(user-symbols)
;-> ((module) ())

cameyo

#42

newLISP in the real world / Sum of integers in a string

June 30, 2020, 08:37:02 AM

A string consist of digits and non-digit characters. The digits contains a series of positive integers. For instance, the string "abc22zit62de0f" contains the integers 22, 62 and 0.

Write a function to calculate the sum of the integers inside a string (es. 22 + 62 + 0 = 84)

#43

newLISP in the real world / Sorting nil and true

June 16, 2020, 02:10:39 AM

How to sort a list containing nil and true symbols?

Code Select Expand
(setq a '(nil true b a))
(sort a)
;-> (nil true a b)

Thanks

#44

newLISP in the real world / From "The Little Schemer" to newLISP

May 25, 2020, 02:15:13 AM

I am reading the book "The Little Schemer" (yes, i know newLISP is different from Scheme...but i'm learning)

Until chapter 8 i had no problem to translate the code in newLISP.

But now i have the following function:

Code Select Expand
(define (rember-f test?)
    (lambda (a l)
      (cond
       ((null? l) '())
       ((test? (first l) a) (rest l))
       (true (cons (first l) ((rember-f test?) a (rest l)))))))

Calling it in the following way:

Code Select Expand
((rember-f =) 'tuna '(shrimp salad and tuna salad))

I got an error:

Code Select Expand
ERR: invalid function : (test? (first l) a)

Instead the correct output should be:

Code Select Expand
(shrimp salad and salad)

Can you help me to solve this problem?

Thanks

cameyo

#45

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

#46

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 Expand
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 :-)

#47

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 Expand
(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 Expand
2, 15, 825, 725, 1925, 2275, 425, 390, 330, 290, 770, ...

After 2, this sequence contains the following powers of 2:

Code Select Expand
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 Expand
(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 Expand
(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 Expand
(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 Expand
(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 Expand
(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 Expand
  (= 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 Expand
(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 Expand
(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 :-)

#48

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

#49

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

#50

So, what can you actually DO with newLISP? / Quine

September 26, 2019, 03:56:45 AM

A Quine on REPL:

Code Select Expand
ERR: context expected : ERR:
;-> ERR: context expected : ERR:

Have a nice day

#51

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 Expand
(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 Expand
(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 Expand
(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 Expand
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 1751.43

Timing again:

Code Select Expand
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 2234.945

and again:

Code Select Expand
(time (merge (sequence 1 500) (sequence 1 200) <) 500)
;-> 2672.319:

and again:

Code Select Expand
(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 Expand
and again:
;-> and@4098B4
;-> ERR: symbol expected : " again:"

Now timing the function will restart the problem:

Code Select Expand
(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

#52

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

#53

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 Expand
(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 Expand
(= (map factorbig (sequence 2 1e6)) (map factor (sequence 2 1e6)))
;-> true

Let's try a 20-digit number:

Code Select Expand
(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 Expand
(time (println (factorbig 1013557366687338001L)))
;-> (1013557366687338001L)
;-> 179855.465 ; 3 min

Instead in the following example the calculation is immediate:

Code Select Expand
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 Expand
(define (coprimi? a b) (= (gcd a b) 1))

Function that checks if a number belongs to the wheel:

Code Select Expand
(define (wheel7 n) (and (coprimi? n 2) (coprimi? n 3) (coprimi? n 5) (coprimi? n 7)))

Function that creates the number wheel:

Code Select Expand
(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 Expand
(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?

#54

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

#55

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 Expand
(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.

#56

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 Expand
(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 :-)

#57

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 Expand
(define (poly x)
  (+ 5 (mul 7 x) (mul 3 (pow x 2))))

(poly 0)
;-> 5

And then to get the searched values:

Code Select Expand
(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 Expand
  y(x) = 4*x^3 + 5*x^2 + 7*x + 10

is represented by the function:

Code Select Expand
  (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 Expand
(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 Expand
(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 Expand
(poly 0)
;-> 10

And to get the values:

Code Select Expand
(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?

#58

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 Expand
(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 Expand
(setq f inc)
(setq x 0)
(zero f x)
;-> 0
(sei f x)
;-> 6

I have defined the successor function:

Code Select Expand
(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 Expand
(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 :-)

#59

Whither newLISP? / pseudo-random number generator

July 13, 2019, 08:12:49 AM

Which type of pseudo-random number generator uses newLISP?

Thanks.

#60

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 Expand

(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 Expand
e = 106246577894593683/39085931702241241

The functions to use the four operations of the fractions are the following:

Code Select Expand

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

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

Pages 1 2 3 4

newLISP Fan Club

News:

Show posts

Topics - cameyo

newLISP in the real world / List of user symbols

newLISP in the real world / Sum of integers in a string

newLISP in the real world / Sorting nil and true

newLISP in the real world / From "The Little Schemer" to newLISP

newLISP in the real world / Parallel assignment

newLISP in the real world / Puzzle

newLISP in the real world / Fractran language

newLISP in the real world / Tree structure

newLISP in the real world / newLISP at the University of Utah

So, what can you actually DO with newLISP? / Quine

newLISP in the real world / Timing function problem

newLISP in the real world / Check if a number is a perfect power

newLISP in the real world / Wheel factorization for big integer

newLISP in the real world / Carmichael numbers

newLISP in the real world / Every odd integer is the difference of 2 squares

newLISP in the real world / Twin primes

newLISP in the real world / Create polynomials

newLISP in the real world / Church encoding

Whither newLISP? / pseudo-random number generator

newLISP in the real world / Pathological floating point problems