I want to take the infinite stream of numbers 1, 2, 3, 4 ... and filter it so that only numbers that have the prime factors of 7 and 13 are in it. (i.e. 7, 13, 49, 91, 169, 343, ...)
I have the following function started but I'm mixed up on how to properly filter out numbers with only these specific prime factors.
(define function
(stream-filter
(lambda (x)
(or
(= (/ x 7) 1)
(= (/ x 13) 1)
)
)
numbers
)
)
Where stream-filter is the same function from SICP.
Here's one idea: find the prime factors of the number and check if there are factors other than 7 and 13:
(define (factor number)
(let loop ((divisor 2) (number number))
(cond ((> (* divisor divisor) number) (list number))
((zero? (modulo number divisor))
(cons divisor (loop divisor (/ number divisor))))
(else (loop (add1 divisor) number)))))
(stream-filter
(lambda (x)
(null?
(filter (lambda (e) (not (or (= e 7) (= e 13))))
(factor x))))
numbers)
Related
How to using scheme with recursion to insert a number to a sorted number? I did an iteration as below when the number needs to insert is larger than the rest digit stop and (rest * 10^(count+1))+(insert-n * 10^count)+ result-so-far. Otherwise, (iter (quotient rest 10) (+ count 1) insert-n (+ (* (modulo rest 10) (expt 10 count)) result-so-far))))). I try many times in recursion but not work. Looks like a dynamic problem is using recursion. Did anyone have any idea about it?
(define (insert-number sorted-num insert-n)
(define (iter rest count insert-n result-so-far)
(cond ((>= insert-n (modulo rest 10))
(+ (* rest (expt 10 (+ count 1)))
(* insert-n (expt 10 count))
result-so-far))
(else (iter (quotient rest 10)
(+ count 1)
insert-n
(+ (* (modulo rest 10) (expt 10 count)) result-so-far)))))
(iter sorted-num 0 insert-n 0)
)
I think it's possible a more clever way, but this is what I could write down in 2 minutes:
(define (insert-digit sorted-num digit)
(let loop ((snl sorted-num) (snr 0) (place 1))
(let ((r (remainder snl 10)))
(if (> r digit)
(loop (quotient snl 10)
(+ snr (* place r))
(* place 10))
(+ (* snl place 10)
(* digit place)
snr)))))
How it works is that if you call it (insert-digit 123456 3) it will divide the number in left hand side and right hand side and when it has come to 123 and 456 then r will not be greater than d and thus it uses multiplications to put snl, d, and snr to one number 123456.
In our exam we had to write a procedure that display first 20 elements of sequence and a procedures that takes 2 sequences and returns one in form of procedure. I wrote an procedures for display-sequence for first 20 elements but I cannot figure out how to make the second procedure which interleave two sequences in to one. I would appreciate any ideas how it can be done.
(define (display-sequence seq)
(letrec ((iter (lambda (seq i j)
(if (= i j)
(display "...")
(begin (display (seq i))
(display ", ")
(iter seq (+ 1 i) j))))))
(iter seq 0 20)))
(define (seq-interleave seq1 seq2)
(lambda (n)
(if (even? n)
(seq1 n)
(seq2 n))))
This should be output when calling these 2 procedures
(display-sequence (seq-interleave sqr (lambda (n) 5)))
0, 5, 1, 5, 4, 5, 9, 5, 16, 5, 25, 5, 36, 5, 49, 5, 64, 5, 81, 5, ...
We just need to map the even numbers back to the corresponding number in the sequence of integers, for example: 2->1, 4->2, 6->3 and so on, doing something similar for the odd numbers. Here's how:
(define (seq-interleave seq1 seq2)
(lambda (n)
(if (even? n)
(seq1 (/ n 2))
(seq2 (/ (+ n 1) 2)))))
I am new in scheme.
How to find "amicable pais"?
(define (SumCD n)
(define s 1 )
(set! m (quotient n 2))
(while (<= i m)
(if (=(modulo n i) 0)
(set! s (+ s i)))
(set! i (+ i 1))
)
)
And in main program I want to check (if (m=SumCD n) and (n=SumCD m)) then m and n is a amicable pair.
How can I do this?
Excessive use of set! indicates an imperative style of programming, which is usually discouraged in Scheme. Here's a Racket-specific implementation of sum-of-divisors that does not use set! at all.
(define (sum-of-divisors n)
(define-values (q r) (integer-sqrt/remainder n))
(for/fold ((sum (if (and (zero? r) (> q 1)) (add1 q) 1)))
((i (in-range 2 q))
#:when (zero? (modulo n i)))
(+ sum i (quotient n i))))
Equivalent version in standard R6RS/R7RS Scheme, if you're not using Racket:
(define (sum-of-divisors n)
(define-values (q r) (exact-integer-sqrt n))
(let loop ((sum (if (and (zero? r) (> q 1)) (+ q 1) 1))
(i 2))
(cond ((>= i q) sum)
((zero? (modulo n i))
(loop (+ sum i (quotient n i)) (+ i 1)))
(else (loop sum (+ i 1))))))
Note that this is not equivalent to the set!-based version you have. What this code actually does is create an inner function, loop, that gets tail-called with new arguments each time.
Now, we can define amicable? and perfect? accordingly:
(define (amicable? n)
(define sum (sum-of-divisors n))
(and (not (= n sum))
(= n (sum-of-divisors sum))))
(define (perfect? n)
(= n (sum-of-divisors n)))
If you really want to test two numbers to see if they are an amicable pair, you can do this:
(define (amicable-pair? a b)
(and (not (= a b))
(= a (sum-of-divisors b))
(= b (sum-of-divisors a))))
Update for OP's new question about how to use this to find amicable pairs between m and n. First, let's define a variant of amicable? that returns a number's amicable "peer":
(define (amicable-peer n)
(define sum (sum-of-divisors n))
(and (not (= n sum))
(= n (sum-of-divisors sum))
sum))
If you're using Racket, use this:
(define (amicable-pairs-between m n)
(for*/list ((i (in-range m (add1 n)))
(peer (in-value (amicable-peer i)))
#:when (and peer (<= m peer n) (< i peer)))
(cons i peer)))
If you're not using Racket, use this:
(define (amicable-pairs-between m n)
(let loop ((result '())
(i n))
(if (< i m)
result
(let ((peer (amicable-peer i)))
(if (and peer (<= m peer n) (< i peer))
(loop (cons (cons i peer) result) (- i 1))
(loop result (- i 1)))))))
The way this works, is that because lists are built from right-to-left, I've decided to count downward from n through to m, keeping only numbers that have an amicable peer, and where the peer is within range. The (< i peer) check is to ensure that the amicable pair only appears once in the results.
Example:
> (amicable-pairs-between 0 10000)
((220 . 284) (1184 . 1210) (2620 . 2924) (5020 . 5564) (6232 . 6368))
More OP updates (wherein he asked what the difference between a recursive version and an accumulative version is). The version of amicable-pairs-between I wrote above is accumulative. A recursive version would look like this:
(define (amicable-pairs-between m n)
(let recur ((i m))
(if (> i n)
'()
(let ((peer (amicable-peer i)))
(if (and peer (<= m peer n) (< i peer))
(cons (cons i peer) (recur (+ i 1)))
(recur (+ i 1)))))))
Note that there is no result accumulator this time. However, it's not tail-recursive any more.
Your program doesn't work: i is never initialized. And it's very poor style; proper Scheme programs seldom use while or set!. Let's go back to the beginning.
A perfect number is equal to the sum of its proper divisors; for instance, the divisors of 28 are 1, 2, 4, 7, and 14, and 1 + 2 + 4 + 7 + 14 = 28, so 28 is a perfect number. Two numbers m and n form an amicable pair if the sum of the divisors of m equals n and the sum of the divisors of n equals m; for instance, 220 has divisors 1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110 which sum to 284, and 284 has divisors 1, 2, 4, 71, 142 which sum to 220, so 220 and 284 form an amicable pair.
A simple way to compute the divisors of a number n is try each integer from 1 to ⌊n/2⌋ and see if it divides n:
(define (divisors n)
(let loop ((i 1) (ds (list)))
(cond ((< n (+ i i)) (reverse ds))
((zero? (modulo n i))
(loop (+ i 1) (cons i ds)))
(else (loop (+ i 1) ds)))))
> (divisors 220)
(1 2 4 5 10 11 20 22 44 55 110)
> (divisors 284)
(1 2 4 71 142)
> (divisors 36)
(1 2 3 4 6 9 12 18)
Note that we are excluding n from the list of divisors of n; that's what we want when computing amicable pairs, but in some cases you might want to add n to the list of divisors of n. Instead of making a list of divisors, we can compute their sum:
(define (sum-div n)
(let loop ((i 1) (s 0))
(cond ((< n (+ i i)) s)
((zero? (modulo n i))
(loop (+ i 1) (+ s i)))
(else (loop (+ i 1) s)))))
> (sum-div 220)
284
> (sum-div 284)
220
> (sum-div 36)
55
Instead of counting up to ⌊n/2⌋, it is faster to note that divisors appear in pairs, so it is only necessary to count up to the square root of n; be careful when n is a perfect square to include exactly one instance of the square root in the sum:
(define (divisors n)
(let loop ((i 2) (ds (list 1)))
(cond ((<= n (* i i))
(sort < (if (= n (* i i)) (cons i ds) ds)))
((zero? (modulo n i))
(loop (+ i 1) (cons i (cons (/ n i) ds))))
(else (loop (+ i 1) ds)))))
(define (sum-div n)
(let loop ((i 2) (s 1))
(cond ((<= n (* i i))
(if (= n (* i i)) (+ i s) s))
((zero? (modulo n i))
(loop (+ i 1) (+ s i (/ n i))))
(else (loop (+ i 1) s)))))
> (divisors 220)
(1 2 4 5 10 11 20 22 44 55 110)
> (divisors 284)
(1 2 4 71 142)
> (divisors 36)
(1 2 3 4 6 9 12 18)
> (sum-div 220)
284
> (sum-div 284)
220
> (sum-div 36)
55
If you know the prime factorization of n, it is easy to find the divisors of n: simply take the products of the members of the powerset of the factor of n, eliminating duplicates.
(define (but-last xs)
(if (null? xs) (error 'but-last "empty list")
(reverse (cdr (reverse xs)))))
(define (unique eql? xs)
(cond ((null? xs) '())
((null? (cdr xs)) xs)
((eql? (car xs) (cadr xs)) (unique eql? (cdr xs)))
(else (cons (car xs) (unique eql? (cdr xs))))))
(define (power-set xs)
(if (null? xs) (list (list))
(let ((rest (power-set (cdr xs))))
(append (map (lambda (x) (cons (car xs) x)) rest) rest))))
(define (divisors n)
(but-last (unique = (sort <
(map (lambda (xs) (apply * xs))
(power-set (factors n)))))))
> (divisors 220)
(1 2 4 5 10 11 20 22 44 55 110)
> (divisors 284)
(1 2 4 71 142)
> (divisors 36)
(1 2 3 4 6 9 12 18)
It is even easier to find the sum of the divisors of n if you know the prime factorization of n by examining the multiplicities of the factors of n:
(define (sum-div n)
(define (div f x) (/ (- (expt f (+ x 1)) 1) (- f 1)))
(let ((fs (factors n)))
(let loop ((f (car fs)) (fs (cdr fs)) (x 1) (s 1))
(cond ((null? fs) (- (* s (div f x)) n))
((= (car fs) f) (loop f (cdr fs) (+ x 1) s))
(else (loop (car fs) (cdr fs) 1 (* s (div f x))))))))
> (sum-div 220)
284
> (sum-div 284)
220
> (sum-div 36)
55
A simple method to find the factors of a number n uses a prime wheel; this is slow if n is a large prime or semi-prime but reasonable otherwise:
(define (factors n)
(define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
(let ((wheel (cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6))))))
(let loop ((n (abs n)) (f 2) (wheel wheel) (fs (list)))
(cond ((< n (* f f)) (if (= n 1) fs (reverse (cons n fs))))
((zero? (modulo n f)) (loop (/ n f) f wheel (cons f fs)))
(else (loop n (+ f (car wheel)) (cdr wheel) fs))))))
Given all this, it is easy to determine if a number n is perfect, or if it is part of an amicable pair:
(define (perfect? n)
(= n (sum-div n)))
(define (amicable? n)
(let ((s (sum-div n)))
(and (< 1 s) (= (sum-div s) n))))
> (perfect? 6)
#t
> (perfect? 28)
#t
> (amicable? 220)
#t
> (amicable? 284)
#t
It is also easy to find the perfect numbers and amicable pairs less than some limit:
(define (perfect limit)
(let loop ((n 2) (ps (list)))
(cond ((< limit n) (reverse ps))
((= n (sum-div n))
(loop (+ n 1) (cons n ps)))
(else (loop (+ n 1) ps)))))
(define (amicable limit)
(let loop ((n 2) (as (list)))
(if (< limit n) (reverse as)
(let ((s (sum-div n)))
(if (and (< n s) (= n (sum-div s)))
(loop (+ n 1) (cons (list n s) as))
(loop (+ n 1) as))))))
> (perfect 10000)
(6 28 496 8128)
> (amicable 10000)
((220 284) (1184 1210) (2620 2924) (5020 5564) (6232 6368))
Instead of factoring each number up to a limit, it is much faster to find the sums of the divisors of all numbers up to a limit by sieving: Make a vector from 1 to the limit, each item initialized to 1. Then, for each i from 2 to the limit, add i to each multiple of i:
(define (make-sum-divs n)
(let ((s (make-vector (+ n 1) 0)))
(do ((i 1 (+ i 1))) ((< n i) s)
(do ((j (+ i i) (+ j i))) ((< n j))
(vector-set! s j (+ i (vector-ref s j)))))))
(define max-sum-div 1000)
(define sum-divs (make-sum-divs max-sum-div))
Given the sieve, it is easy to find perfect numbers and amicable pairs:
(define (perfect limit)
(when (< max-sum-div limit)
(set! max-sum-div limit)
(set! sum-divs (make-sum-divs max-sum-div)))
(let loop ((n 2) (ps (list)))
(cond ((< limit n) (reverse ps))
((= n (vector-ref sum-divs n))
(loop (+ n 1) (cons n ps)))
(else (loop (+ n 1) ps)))))
(define (pairs limit)
(when (< max-sum-div limit)
(set! max-sum-div limit)
(set! sum-divs (make-sum-divs max-sum-div)))
(let loop ((n 2) (as (list)))
(if (< limit n) (reverse as)
(let ((s (vector-ref sum-divs n)))
(if (and (< s max-sum-div) (< n s)
(= n (vector-ref sum-divs s)))
(loop (+ n 1) (cons (list n s) as))
(loop (+ n 1) as))))))
> (perfect 1000000)
(6 28 496 8128)
> (pairs 1000000)
((220 284) (1184 1210) (2620 2924) (5020 5564) (6232 6368)
(10744 10856) (12285 14595) (17296 18416) (63020 76084)
(66928 66992) (67095 71145) (69615 87633) (79750 88730)
(100485 124155) (122265 139815) (122368 123152)
(141664 153176) (142310 168730) (171856 176336)
(176272 180848) (185368 203432) (196724 202444)
(280540 365084) (308620 389924) (319550 430402)
(356408 399592) (437456 455344) (469028 486178)
(503056 514736) (522405 525915) (600392 669688)
(609928 686072) (624184 691256) (635624 712216)
(643336 652664) (667964 783556) (726104 796696)
(802725 863835) (879712 901424) (898216 980984))
The sieving method is much faster than either of the other two methods. On my computer, it takes twelve seconds to compute the amicable pairs less than a million using trial division to find the divisors, and about the same amount of time for the factoring method, but only about a second-and-a-half to sieve the divisor sums to a million and another half-a-second to find the amicable pairs, a total of two seconds.
In addition to amicable pairs, there exist amicable chains that cycle back to the start after more than two items. For instance, the numbers 12496, 14288, 15472, 14536, and 14264 form an amicable chain of length 5, since sum-div(12496) = 14288, sum-div(14288) = 15472, sum-div(15472) = 14536, sum-div(14536) = 14264, and sum-div(14264) = 12496. The program to find amicable chains is a variant of the program to find amicable pairs:
(define (chain n limit)
(when (< max-sum-div limit)
(set! max-sum-div limit)
(set! sum-divs (make-sum-divs max-sum-div)))
(let loop ((s (vector-ref sum-divs n)) (cs (list n)))
(cond ((= s n) (reverse cs))
((not (< n s limit)) (list))
((member s cs) (list))
(else (loop (vector-ref sum-divs s) (cons s cs))))))
(define (chains limit)
(when (< max-sum-div limit)
(set! max-sum-div limit)
(set! sum-divs (make-sum-divs max-sum-div)))
(let loop ((n 2) (cs (list)))
(if (< limit n) (reverse cs)
(let ((c (chain n limit)))
(if (null? c) (loop (+ n 1) cs)
(loop (+ n 1) (cons c cs)))))))
> (sort (lambda (a b) (< (length a) (length b))) (chains 1000000))
((6) (28) (496) (8128) (220 284) (1184 1210) (2620 2924)
(5020 5564) (6232 6368) (10744 10856) (12285 14595)
(17296 18416) (63020 76084) (66928 66992) (67095 71145)
(69615 87633) (79750 88730) (100485 124155) (122265 139815)
(122368 123152) (141664 153176) (142310 168730)
(171856 176336) (176272 180848) (185368 203432)
(196724 202444) (280540 365084) (308620 389924)
(319550 430402) (356408 399592) (437456 455344)
(469028 486178) (503056 514736) (522405 525915)
(600392 669688) (609928 686072) (624184 691256)
(635624 712216) (643336 652664) (667964 783556)
(726104 796696) (802725 863835) (879712 901424)
(898216 980984) (12496 14288 15472 14536 14264)
(14316 19116 31704 47616 83328 177792 295488 629072 589786
294896 358336 418904 366556 274924 275444 243760 376736
381028 285778 152990 122410 97946 48976 45946 22976 22744
19916 17716))
The four perfect numbers form amicable chains of length 1, there are 40 amicable pairs, there is an amicable chain of length 5 mentioned above, and notice the spectacular amicable chain of length 28 that starts at 14316.
I just try to find amicable pairs between M and N
(define (find-amicable-pairs M N)
(< M N)
(define i M)
(define a 0)
(do ()
[(= i N)]
(set! a (sum-of-divisors i))
(if (and(= i (sum-of-divisors a)) (< i a))
(and (display i)
(display " and ")
(display a)
(newline))
#f)
(set! i (+ i 1))))
Thanks for your thoughts on this!
This question already has answers here:
Convert number to list of digits
(4 answers)
Closed 8 years ago.
I am trying to write a function which takes a number and returns a list of the number's digits. For example:
(list-num 648)
;=> (6 4 8)
I have written some code, but it returns (8 4 6), and I can't use reverse. MY code so far:
(define (list-num n)
(if (not (equal? (quotient n 10) 0))
(cons (modulo n 10) (list-num(quotient n 10)))
(cons (modulo n 10) '())))
You can use your function as the inner function and wrap an outer function that does the reverse:
(define (list-num n)
; inner function - your initial function
(define (sub n)
(if (not (equal? (quotient n 10) 0))
(cons (modulo n 10) (sub (quotient n 10)))
(cons (modulo n 10) '())))
; call inner function
(reverse (sub n)))
then
> (list-num 648)
'(6 4 8)
You could also use a named let and an accumulator:
(define (list-num n)
(let loop ((n n) (acc '())) ; named let, acc=accumulator
(let ((q (quotient n 10)) (r (remainder n 10)))
(if (= q 0)
(cons r acc)
(loop q (cons r acc))))))
In Common Lisp:
CL-USER 21 > (map 'list #'digit-char-p (princ-to-string 648))
(6 4 8)
I am trying to write a function which takes an input number and outputs the number in reverse order.
Ie:
Input -> 25
Output -> 52
Input -> 125
Output -> 521
I am new to lisp, if its helpful here is the working function in c++
function.cpp
int revs(int rev, int n)
{
if (n <= 0)
return rev;
return revs((rev * 10) + (n % 10), n/10);
}
I have written it in Racket as follows:
(define (revs rev n)
(if (<= n 0)
rev
(revs (+ (* rev 10) (modulo n 10)) (/ n 10))))
But when I run it with (revs 0 125) I get this error:
modulo: contract violation
expected: integer?
given: 25/2
argument position: 1st
other arguments...:
10
Certainly I am doing something incorrect here, but I am unsure of what I am missing.
The division operator / doesn't do integer division, but general division, so when you call, e.g., (/ 25 2), you don't get 12 or 13, but rather the rational 25/2. I think you'd want quotient instead, about which the documentation has:
procedure (quotient n m) → integer?
n : integer?
m : integer?
Returns (truncate (/ n m)). Examples:
> (quotient 10 3)
3
> (quotient -10.0 3)
-3.0
> (quotient +inf.0 3)
quotient: contract violation
expected: integer?
given: +inf.0
argument position: 1st
other arguments...:
3
Treating the operation lexicographically:
#lang racket
(define (lexicographic-reverse x)
(string->number
(list->string
(reverse
(string->list
(number->string x))))))
Works[1] for any of Racket's numerical types.
[edit 1] "Works," I realized, is context dependent and with a bit of testing shows the implicit assumptions of the operation. My naive lexicographic approach makes a mess of negative integers, e.g. (lexicographic-reverse -47) will produce an error.
However, getting an error rather than -74 might be better when if I am reversing numbers for lexicographic reasons rather than numerical ones because it illuminates the fact that the definition of "reversing a number" is arbitrary. The reverse of 47 could just as well be -74 as 74 because reversing is not a mathematical concept - even though it might remind me of XOR permutation.
How the sign is handled is by a particular reversing function is arbitrary.
#lang racket
;; Reversing a number retains the sign
(define (arbitrary1 x)
(define (f n)
(string->number
(list->string
(reverse
(string->list
(number->string n))))))
(if (>= x 0)
(f x)
(- (f (abs x)))))
;; Reversing a number reverses the sign
(define (arbitrary2 x)
(define (f n)
(string->number
(list->string
(reverse
(string->list
(number->string n))))))
(if (>= x 0)
(- (f x))
(f (abs x))))
The same considerations extend to Racket's other numerical type notations; decisions about reversing exact, inexact, complex, are likewise arbitrary - e.g. what is the reverse of IEEE +inf.0 or +nan.0?
Here is my solution for this problem
(define (reverseInt number)
(define (loop number reversedNumber)
(if (= number 0)
reversedNumber
(let ((lastDigit (modulo number 10)))
(loop (/ (- number lastDigit) 10) (+ (* reversedNumber 10) lastDigit)))))
(loop number 0))
Each time we multiply the reversed number by 10 and add the last digit of number.
I hope it makes sense.
A R6RS version (will work with R7RS with a little effort)
#!r6rs
(import (rnrs)
(srfi :8))
(define (numeric-reverse n)
(let loop ((acc 0) (n n))
(if (zero? n)
acc
(receive (q r) (div-and-mod n 10)
(loop (+ (* acc 10) r) q)))))
A Racket implementation:
#!racket
(require srfi/8)
(define (numeric-reverse n)
(let loop ((acc 0) (n n))
(if (zero? n)
acc
(receive (q r) (quotient/remainder n 10)
(loop (+ (* acc 10) r) q)))))
With recursion, you can do something like:
#lang racket
(define (reverse-num n)
(let f ([acc 0]
[n n])
(cond
[(zero? n) acc]
[else (f (+ (* acc 10) (modulo n 10)) (quotient n 10))])))