I'm starting to coding in Scheme and I wan't to know if a number is "abundante". A number x is "abundante" if the sum of its dividers is greater than the double of x.
So this is my code:
#lang scheme
(define (abundante x)
(cond
((= x 0) #f)
((= x 1) #f)
((> (apply +(divisores x)) (doble x)) #t)
(else #f)
)
)
;aux functions
(define (doble x) (* x 2))
(define (divisores x)
(cond
((= x 1) '(1))
(else (cons 1 (divisores-aux x 2)))
)
)
(define (divisores-aux x y)
(cond
((= x y) '(x))
((integer? (/ x y))(cons y (divisores-aux x (+ y 1))))
(else (divisores-aux x (+ y 1)))
)
)
As you can see, I have 3 auxiliary functions:
1) Doble x: Return the double of x
2) Divisores x: Return the dividers of x
2.1) Divisores-aux x y: Check if x/y is a integer number, then goes for y+1
But I got the problem when Divisores-aux reach x = y. I want to return x because x its a divider of itself but DrRacket prints the follow error:
+: contract violation
expected: number?
given: y
argument position: 6th
other arguments...:
And indicates me that the error was produced on apply +(divisores x)
If I return null or '() everything goes fine, but obviously I don't get the correct result.
Thanks in advance
There's a bug in the base case of divisores-aux, in here:
'(x)
The above expression will return a list with the symbol x as its single member (to understand why, read about quoting in the docs). What you meant to say was this, that creates a list with the value of the x variable:
(list x)
Also, it's better to use remainder to test if a number is divided by another. This should fix the issues:
(define (divisores-aux x y)
(cond
((= x y) (list x))
((zero? (remainder x y)) (cons y (divisores-aux x (+ y 1))))
(else (divisores-aux x (+ y 1)))))
Now abundante works as expected:
(abundante 42)
=> #t
(abundante 45)
=> #f
I am trying to multiply in Scheme using recursion, and I am able to do so with positive numbers but not negatives (they get stuck in an infinite loop). I assume the problem comes in the 3rd and 4th lines, which I wrote in an attempt to be able to handle negatives. Any help would be appreciated :)
(define Multiply(lambda (x y)
(if (eq? x 0) 0 (if (eq? y 0) 0 ;if either x or y are zero, return 0
(if (> 0 x) (- 0 (+ x (Multiply x (- y 1))))
(if (> 0 y) (- 0 (+ x (Multiply x (- y 1))))
(+ x (Multiply x (- y 1)))))))))
Since multiplication is associative, you can have
x * (-1 * y) = (x * -1) * y
With this in mind, you can convert y to positive whenever it is less than zero, by multiplying both x and y with -1.
Consider the following:
(define (multiply x y)
(cond
((zero? x) 0)
((zero? y) 0)
((< y 0)
(multiply (- x) (- y)))
(else
(+ x (multiply x (sub1 y))))))
foo(x Y) is a procedure that has to solve this problem in the
Picture.
Here is my Scheme Code:
(define foo
(lambda (x y)
(if (<= y 0) (x) 0)
(if (<= x 0) (y) 0)
(if (>= x y) (+ x foo ((- x 1) (- y 2))) 0)
(if (< x y) (+ y foo ((- x 2) (- y 3))) 0)))
when it test it for (foo 5 6) => it prints the same exact numbers, instead of 12 !! I don't know why it is not going through the recursive call..
There is no recursive calls here. For it to be a call you need to have parentheses around it like (foo (- x 2) (- y 3))
Only the last if is regarded as becoming the result of the procedure. All the previous ones return a value and since it's not the last it discards the result and continues to the next. In order for several conditions to mean something they must be nested. Thus instead of the 0 you put the entire next if.
(define (foo x y)
(if (<= x 0)
x
(if (<= y 0)
y
...)))
There is also cond that makes a flatter structure that works as if-elseif-else in other languages.
(define (foo x y)
(cond
((<= x 0) x)
((<= y 0) y)
...
(else ...)))
Say I have a function recurse that takes three parameters x,y,z. y and z remain fixed, but x is iterative. I know how to generate a list of x values. How can I write code so that recurse is applied to the list of xs, but y and z remain the same?
I know map works like this but I don't know how to implement it considering it only works on lists of the same size. I do not know what the length of x will be. What I'm trying to do conceptually is call recurse on a list (x1, x2,...,xn) as such:
recurse x1 y z
recurse x2 y z
recurse xn y z
Just pass the parameters y and z unchanged:
(define (recurse x y z)
(unless (null? x)
;; … use x, y, z
;; then:
(recurse (cdr x) y z)))
Alternately you can define a helper function; made easy with 'named let`:
(define (recurse x y z)
(let recursing ((x x))
;; … use x, y, z
;; then:
(recursing (cdr x))))
An example:
(define (all-in-range? values min max)
(or (null? values)
(and (< min (car values) max)
(all-in-range? (cdr values) min max))))
You can use map:
(define (between x y z) (<= x y z))
(define (between-list xlist y z)
(map (lambda (e) (between e y z)) xlist))
> (between-list '(1 20 3 100 99 2) 5 15)
'(#t #f #t #f #f #t)
As an alternative to the lambda function used with map, in Racket you can use curryr. Also, if you just do it for side-effects, you can use for-each instead of map:
(define (between x y z) (display (<= x y z)))
(define (between-list xlist y z)
(for-each (curryr between y z) xlist))
> (between-list '(1 20 3 100 99 2) 5 15)
#t#f#t#f#f#t
You have a list '(x1 x2 … xn) and you want to apply a function recurse to each element xn as well as y and z. You haven't said what the return value will be. I will assume there is no return value.
(for-each (lambda (x) (recurse x y z)) <your list of x1, … xn>)
The lambda captures the values for y and z, takes the provided x argument and applies your recurse procedure to all three.
You either pass the same variable to the next recursion or you leave it out completely so that it is a free variable.
Eg. send it:
(define (make-list items value)
(if (zero? items)
'()
(cons value (make-list (- items 1) value))))
Have it as a free variable:
(define (make-list items value)
(let loop ((items items)(acc '()))
(if (zero? items)
acc
(loop (- items 1) (cons value acc)))))
For higher order procedures you also keep it as a free (closed over) variable:
(define (make-list items value)
(map (lambda (x) value) (range items))) ;; value exists in the anonymous functions scope
I wanted to tell sbcl that the following function will only be called with fixnum values for which the result fits in a fixnum:
(defun layer (x y z n)
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n))))
My first attempt was to do
(defun layer (x y z n)
(declare (fixnum x y z n))
(the fixnum
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n))))
But that return type declaration doesn't promise that all intermediate results will also be fixnums, as I found out by looking at the wonderfully useful compilation notes sbcl produced. So then I did this:
(defmacro fixnum+ (&rest args)
(reduce
(lambda (x y) `(the fixnum (+ ,x ,y)))
args))
(defmacro fixnum* (&rest args)
(reduce
(lambda (x y) `(the fixnum (* ,x ,y)))
args))
(defun layer (x y z n)
(declare (fixnum x y z n))
(fixnum+ (fixnum* 2 (fixnum+ (fixnum* x y) (fixnum* y z) (fixnum* x z)))
(fixnum* 4 (fixnum+ x y z n -2) (the fixnum (1- n)))))
And that worked just fine. My question is: is there an easier, more idiomatic way to do this?
For example, maybe I can redeclare the types of +, -, *, 1- to promise fixnum results? (I know that's a bad idea in general, but I might want to do it in certain programs.) CHICKEN scheme has (declare (fixnum-arithmetic)) that does what I want: it (unsafely) assumes that the results of all arithmetic operations on fixnums are fixnums.
You can declare types for functions using FTYPE.
Example:
(defun foo (a b)
(declare (ftype (function (&rest fixnum) fixnum) + * 1-)
(type fixnum a b)
(inline + * 1-)
(optimize (speed 3) (safety 0) (debug 0) (space 0)))
(+ a (* a (1- b))))
Does that make a difference?
In his book ANSI Common Lisp, Paul Graham shows the macro with-type, that wraps an expression and all its sub-expressions inthe forms, also ensuring that operators given more than two arguments are properly handled.
E.g. (with-type fixnum (+ 1 2 3)) will expand to the form
(the fixnum (+ (the fixnum (+ (the fixnum 1) (the fixnum 2)))
(the fixnum 3))
The code for the macro with helper functions is
(defmacro with-type (type expr)
`(the ,type ,(if (atom expr)
expr
(expand-call type (binarize expr)))))
(defun expand-call (type expr)
`(,(car expr) ,#(mapcar #'(lambda (a)
`(with-type ,type ,a))
(cdr expr))))
(defun binarize (expr)
(if (and (nthcdr 3 expr)
(member (car expr) '(+ - * /)))
(destructuring-bind (op a1 a2 . rest) expr
(binarize `(,op (,op ,a1 ,a2) ,#rest)))
expr))
A link to the code from the book in found at http://www.paulgraham.com/acl.html
A comment in the code states that "This code is copyright 1995 by Paul Graham, but anyone who wants
to use it is free to do so."
Try this:
(defun layer (x y z n)
(declare (optimize speed) (fixnum x y z n))
(logand most-positive-fixnum
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n)))))
See SBCL User Manual, Sec 6.3 Modular arithmetic.
Edit:
As mentioned in the comments, SBCL-1.1.9 (or later) is required for this to work. Also, it's possible to shave another ~40% time off by inlining the subroutines:
;;; From: https://gist.github.com/oantolin/6073417
(declaim (optimize (speed 3) (safety 0)))
(defmacro with-type (type expr)
(if (atom expr)
expr
(let ((op (car expr)))
(reduce
(lambda (x y)
`(the ,type
(,op ,#(if x (list x) '())
(with-type ,type ,y))))
(cdr expr)
:initial-value nil))))
(defun layer (x y z n)
(declare (fixnum x y z n))
(with-type fixnum
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n)))))
(defun cubes (n)
(declare (fixnum n))
(let ((count (make-array (+ n 1) :element-type 'fixnum)))
(loop for x of-type fixnum from 1 while (<= (layer x x x 1) n) do
(loop for y of-type fixnum from x while (<= (layer x y y 1) n) do
(loop for z of-type fixnum from y while (<= (layer x y z 1) n) do
(loop for k of-type fixnum from 1 while (<= (layer x y z k) n) do
(incf (elt count (layer x y z k)))))))
count))
(defun first-time (x)
(declare (fixnum x))
(loop for n of-type fixnum = 1000 then (* 2 n)
for k = (position x (cubes n))
until k
finally (return k)))
;;; With modarith and inlining
(defun first-time/inline (x)
(declare (fixnum x))
(labels
((layer (x y z n)
(logand #.(1- (ash 1 (integer-length most-positive-fixnum)))
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n)))))
(cubes (n)
(let ((count (make-array (+ n 1) :element-type 'fixnum)))
(loop for x of-type fixnum from 1 while (<= (layer x x x 1) n) do
(loop for y of-type fixnum from x while (<= (layer x y y 1) n) do
(loop for z of-type fixnum from y while (<= (layer x y z 1) n) do
(loop for k of-type fixnum from 1 while (<= (layer x y z k) n)
do (incf (elt count (layer x y z k)))))))
count)))
(declare (inline layer cubes))
(loop for n of-type fixnum = 1000 then (* 2 n)
thereis (position x (cubes n)))))
#+(or)
(progn
(time (print (first-time 1000)))
(time (print (first-time/inline 1000))))
;; 18522
;; Evaluation took:
;; 0.448 seconds of real time
;; 0.448028 seconds of total run time (0.448028 user, 0.000000 system)
;; 100.00% CPU
;; 1,339,234,815 processor cycles
;; 401,840 bytes consed
;;
;;
;; 18522
;; Evaluation took:
;; 0.259 seconds of real time
;; 0.260016 seconds of total run time (0.260016 user, 0.000000 system)
;; 100.39% CPU
;; 776,585,475 processor cycles
;; 381,024 bytes consed
Declaring the layer function inline results in a much faster speed even when block compilation is on.
On my Apple Air M1 with layer inlined and block compilation on it runs in 0.06 second under the Arm64 version of SBCL 2.1.2.
CL-USER> (time (first-time 1000))
Evaluation took:
0.060 seconds of real time
0.060558 seconds of total run time (0.060121 user, 0.000437 system)
101.67% CPU
303,456 bytes consed
I've just remembered that declaring the count array in cube should help as well.
(declare (type (simple-array fixnum (*)) count))
Without inlining the layer function it is around 0.2 second.
CL-USER> (time (first-time 1000))
Evaluation took:
0.201 seconds of real time
0.201049 seconds of total run time (0.200497 user, 0.000552 system)
100.00% CPU
251,488 bytes consed
Or converting the layer function to a macro makes it even faster.
(defmacro layer (x y z n)
(declare (fixnum x y z n))
`(logand #.(1- (ash 1 (integer-length most-positive-fixnum)))
(+ (* 2 (+ (* ,x ,y) (* ,y ,z) (* ,x ,z)))
(* 4 (+ ,x ,y ,z ,n -2) (1- ,n)))))
CL-USER> (time (first-time 1000))
Evaluation took:
0.047 seconds of real time
0.047032 seconds of total run time (0.046854 user, 0.000178 system)
100.00% CPU
312,576 bytes consed
Benchmarked with trivial-benchmark on average it runs just bellow 0.04 second:
CL-USER> (benchmark:with-timing (100) (first-time 1000))
- SAMPLES TOTAL MINIMUM MAXIMUM MEDIAN AVERAGE DEVIATION
REAL-TIME 100 3.985173 0.039528 0.06012 0.039595 0.039852 0.002046
RUN-TIME 100 3.985848 0.039534 0.06014 0.039605 0.039858 0.002048
USER-RUN-TIME 100 3.975407 0.039466 0.059829 0.039519 0.039754 0.002026
SYSTEM-RUN-TIME 100 0.010469 0.00005 0.000305 0.000088 0.000105 0.00005
PAGE-FAULTS 100 0 0 0 0 0 0.0
GC-RUN-TIME 100 0 0 0 0 0 0.0
BYTES-CONSED 100 50200736 273056 504320 504320 502007.38 23010.477
EVAL-CALLS 100 0 0 0 0 0 0.0