I need a function that will check if all digits in some number on even positions are even. The least significant digit is on position 1, starting from right to left. The function need to be written in lisp.
Examples:
245 -> true, since 4 is even
238456 -> false, since 5 is odd and 8 and 2 are even
and so on...
Here`s what I got:
(defun check(number fac)
(cond
((= (/ number fac) 0) t)
((= (mod (/ number fac) 2 ) 0) (check number (* 100 fac) ) )
(nil)))
The initial value for fac is 10, we divide the number with 10, extract the second digit, check if it is even, if so proceed and divide number with 1000 to extract the 4-th digit and so on until we get over all digits, than the function returns true, meanwhile if some digit is odd the function should return nil.
But something is wrong and the function return nil all the time , when I call it like (check 22 10) for example.
Any thoughts?
Here is a non recursive solution that checks for the correctness of the parameter:
(defun check(num)
(assert (integerp num))
(loop for i = (truncate num 10) then (truncate i 100) until (zerop i)
always (evenp i)))
Just another variant. Basicly I'm converting number to list (through string though, maybe not the best way), then reverse it, select every second element and check it all for being even.
;; Helper for getting every
(defun get-all-nth (list period)
"Get all NTH element in the list"
(remove-if-not
(let ((iterator 0))
(lambda (x)
(declare (ignore x))
(= 0 (mod (incf iterator) period)))) list))
(defun check-evens (num)
"Checks if all digits in some number on even positions are even.
Goes Rigth-to-left."
(assert (integerp num))
(every #'evenp
(get-all-nth
(reverse
(map 'list #'digit-char-p
(prin1-to-string num))) 2)))
Some test cases:
CL-USER> (check-evens 123)
T
CL-USER> (check-evens 238456)
NIL
CL-USER> (check-evens 238446)
T
CL-USER> (check-evens 23844681)
T
Related
I have the following function "change" which takes a certain amount of money to be paid, the size of the bill/coin used to pay, and returns a list with the number of "coins" ($50, $20 $10 $5 $2 and $1) one would receive after completing the transaction:
(define (change total payment)
(let [(x (- payment total))]
(change-aux x '(50 20 10 5 2 1))))
(define (change-aux change coins)
(cond
[(empty? coins) empty]
[else (let [(num-coins (floor (/ change (car coins))))]
(append (list num-coins)
(change-aux (- change (* (car coins) num-coins)) (cdr coins))))]))
So, if I input these parameters:
> (change 44 200)
It returns the output:
'(3 0 0 1 0 1)
That's 200-44 = 156, which corresponds to 3 coins worth $50, 1 worth $5 and 1 worth $1.
My question would be if there's a more elegant, simplified way to write a similar procedure without relying on auxiliary functions, and rather use lambda, filter, map, foldr, foldl etc?
Thanks in advance.
Here is a solution in a different Lisp dialect which shows how to do it with a left fold (reduce) without any mutation of an accumulator variable, as a kind of functional counterpoint to the existing solution.
(defun change (amount coins)
(reduce-left (tb ((counts . rem) next-coin)
(let* ((coin-count (floor rem next-coin))
(coin-value (* coin-count next-coin)))
(cons (cons coin-count counts)
(- rem coin-value))))
coins
(cons '() amount)))
3> (change 156 '(50 20 10 5 2 1))
((1 0 1 0 0 3) . 0)
4> (change 88 '(50 20 10 5 2 1))
((1 1 1 1 1 1) . 0)
Note that the values end up reported in reverse order and wrapped in an extra cons cell; a "porcelain" function could be used around this "plumbing" to report the result in the expected form.
The idea is that we have an accumulator which looks like this: (counts . remainder). The counts part of the accumulator stored in the car is the list of coins accumulated so far. When the reduce is done, this holds the final list. The cdr field holds the remaining amount to be processed; since the last coin is 1, this will always emerge as zero.
Using this accumulator structure, we process the list of coins.
On each call to our reduce kernel function, the left argument is the accumulator, and the right argument, next-coin, is the next coin denomination value.
I used a macro called tb ("tree bind") macro, which is a kind of lambda that provides built-in destructuring, to make it look like we have three parameters.
The initial value for the reduce job is the starting accumulator, which has an empty list of coins, and the full original amount: (cons nil amount) (which I rewrote to (cons '() amount) for better Scheme compatibility).
The reduce function is very simple: greedily calculate how many of the next coin value are needed to represent the remainder, and then calculate the new remainder, packaging these up into a new accumulator cons cell that is returned, and is passed to the next invocation of the function, or returned when the list of coin values has been processed.
Hopefully this points the way to "a more elegant, simplified way to write a similar procedure without relying on auxiliary functions, and rather use lambda, filter, map, foldr, foldl etc" that you can work out in Racket. Good luck!
Sure, you can.
Final solution
(define (change total payment (coins '(50 20 10 5 2 1)))
(let ((rest-diff (- payment total)))
(map (lambda (coin)
(let ((num-coins (floor (/ rest-diff coin))))
(set! rest-diff (- rest-diff (* num-coins coin)))
num-coins))
coins)))
Step by step
First of all, using inner define, you can get rid of the auxiliary function from the global namespace.
(define (change total payment)
(define (change-aux change coins)
(cond
[(empty? coins) empty]
[else (let [(num-coins (floor (/ change (car coins))))]
(append (list num-coins)
(change-aux (- change (* (car coins) num-coins)) (cdr coins))))]))
(let [(x (- payment total))]
(change-aux x '(50 20 10 5 2 1))))
Then, you can pull some variables of the helper function's to the global function's lambda list.
(define (change total payment (coins '(50 20 10 5 2 1)))
(define (change-aux change) ;; eliminate coins in the inner lambda list
(cond
[(empty? coins) empty] ;; coins in function body looked up from outer arguments
[else (let [(num-coins (floor (/ change (car coins))))]
(append (list num-coins)
(change-aux (- change (* (car coins) num-coins)) (cdr coins))))]))
(let [(x (- payment total))]
(change-aux x))) ;; eliminate coins in the call
Then, looking at the code of change-aux, one understands this is actually
a looping through and trying to fit maximal multiples of current value
into the rest of the difference remaining - and collecting those reults. One could loop using map and use set! to mutate the rest.
(define (change total payment (coins '(50 20 10 5 2 1)))
(let ((rest-diff (- payment total)))
(map (lambda (coin)
(let ((num-coins (floor (/ rest-diff coin))))
(set! rest-diff (- rest-diff (* num-coins coin)))
num-coins))
coins)))
Then, you call like above:
(change 44 200)
;; '(3 0 0 1 0 1)
(princ "ENTER ANY NUMBER : ")
(setq n (read))
(setq flag 0)
(loop for i from 2 to n-1
(if (=(mod n i)0)
(setq flag 1)))
(if (= flag 0)
(format t "~d IS A PRIME NUMBER"n)
(format t "~d IS NOT A PRIME NUMBER"n))
It would make your code much easier for other people to read if you
would start each top-level form on a new line.
n-1 is not lisp. Try (- n 1)
You need a do in your loop. That is:
(loop for i from 2 to (- n 1) do ...
In other words:
(princ "ENTER ANY NUMBER : ")
(setq n (read))
(setq flag 0)
(loop for i from 2 to (- n 1) do
(if (= (mod n i) 0)
(setq flag 1)))
(if (= flag 0)
(format t "~d IS A PRIME NUMBER"n)
(format t "~d IS NOT A PRIME NUMBER"n))
n-1 is a symbol, and in your case it's an unbound symbol (that is, it does not have a value, as such). You probably mean one of (- n 1) or (1- n) (they both have the value of "one subtracted from n").
In general, you do not need to loop through all the numbers lower than n, only to (isqrt n) (the integer square root of the number, this is the positive square root if you're looking at a square number and is always at least as large as a factor for a non-prime number).
Instead of using flag variables and setting them, wrap your primality checker in a function and return early of you find a factor.
(defun primep (n)
(loop for i from 2 upto (isqrt n)
if (zerop (mod n i))
do (return-from primep nil))
'prime)
How would I go about coding a lotto in Lisp where the user randomly generates 6 numbers (non repetitive) between 1- 45, then input their own selection of lotto numbers to see if they match, and then tell them if they've won or not ?
(defun shuffle (list)
(let ((len (length list)))
(loop repeat len
do (rotatef (nth (random len) list)
(nth (random len) list))
finally (return list))))
(defun lottery ()
(sort (subseq (shuffle (loop for i from 1 to 49 collect i))
0 6)
#'<))
(lottery)
(The code was actually taken from other authors from this question: Get numbers for the lottery)
This outputs the random numbers I need but I'm having a lot of trouble getting the user input of 6 numbers and comparing them to these numbers to see if they have 'won'.
Let's start with getting n non repeating random numbers.
(defun get-n-rand (n)
(loop :for i = (adjoin (1+ (random 44)) i)
:when (= (length i) n) :return i))
Now if we want 6 of them is simple enough to write (get-n-rand 6)
Next we want to check if every member of one list can be found in another.
(defun check-user-guess (guess-list actual-list)
(equal (sort guess-list #'<) (sort actual-list #'<)))
Hopefully this covers the core logic. Input I will leave for now as it was covered in the other answer.
If your problem is the input this should be a (unsafe) solution:
(defun play-lotto (&aux list)
(dotimes (i 6)
(loop
(princ "Write a Integer between 0 and 50: ")
(let ((number (read)))
(if (and (integerp number) (< 0 number 50))
(if (member number list)
(progn
(princ "You can only choose a number once")
(terpri))
(progn
(push number list)
(return)))
(progn
(princ "Not a Integer between 0 and 50")
(terpri))))))
(if (equal (sort list #'<) (lottery))
(princ "You won!")
(princ "You lost...")))
i have a problem that i just cant work out,
the user enters a list ie
(total-cost
'((anItem 2 0.01)
(item 3 0.10)
(anotherItem 4 4.10)
(item 5 2.51)))
i need to add the number on the end together and then return the result
my current code returns the code after each addition. and also throws a error about unexpected type
(defun total-cost (list)
(loop with sum = 0
for x in list
collect (setf sum (+ sum (last x)))
)
)
Error: (0.01)' is not of the expected typeNUMBER'
Any help is appreciated
Thanks Dale
Using LOOP:
CL-USER 19 > (loop for (nil nil number) in '((anItem 2 0.01)
(item 3 0.10)
(anotherItem 4 4.10)
(item 5 2.51))
sum number)
6.72
REDUCE is another option:
CL-USER 20 > (reduce '+
'((anItem 2 0.01)
(item 3 0.10)
(anotherItem 4 4.10)
(item 5 2.51))
:key 'third)
6.72
Loop has a keyword sum for summing so you don't have to have an explicit variable nor use setf:
(defun total-cost (list)
(loop for x in list sum (third x)))
As Chris said, use (car (last x)) if the number you're looking for is always the last one. Or you can use (third x) as in my example if it's always the third one.
Also, note that the use of collectis wrong if your aim is to return the sum only; your example (corrected) returns
(0.01 0.11 4.21 6.7200003)
whereas mine returns
6.7200003
Note that if you want so escape the rounding errors as much as possible you need to use an exponent marker to make them double-floats for example:
(total-cost '((anItem 2 0.01D0)
(item 3 0.10D0)
(anotherItem 4 4.10D0)
(item 5 2.51D0)))
=> 6.72D0
last returns the last cons cell in the list, not its value. You need to use (car (last x)) instead.
Just in case you want the code to give you a precise result rather then being short:
(defun kahan-sum (floats)
(loop
:with sum := 0.0 :and error := 0.0
:for float :in floats
:for epsilon := (- float error)
:for corrected-sum := (+ sum epsilon) :do
(setf error (- corrected-sum sum epsilon) sum corrected-sum)
:finally (return sum)))
(defun naive-sum (floats) (loop :for float :in floats :sum float))
(let ((floats (loop :repeat 1000 :collect (- (random 1000000.0) 1000000.0))))
(format t "~&naive sum: ~f, kahan sum: ~f" (naive-sum floats) (kahan-sum floats)))
;; naive sum: -498127420.0, kahan sum: -498127600.0
Read more about why it works like this here: http://en.wikipedia.org/wiki/Kahan_summation_algorithm
Coming late to the party... How about a little lisping instead of looping? ;-)
(defun sum-3rd (xs)
(let ((sum 0))
(dolist (x xs sum)
(incf sum (nth 2 x)))))
For Project Euler Problem 8, I am told to parse through a 1000 digit number.
This is a brute-force Lisp solution, which basically goes through every 5 consecutive digits and multiplies them from start to finish, and returns the largest one at the end of the loop.
The code:
(defun pep8 ()
(labels ((product-of-5n (n)
(eval (append '(*)
(loop for x from n to (+ n 5)
collect (parse-integer
1000digits-str :start x :end (+ x 1)))))))
(let ((largestproduct 0))
(do ((currentdigit 0 (1+ currentdigit)))
((> currentdigit (- (length 1000digits-str) 6)) (return largestproduct))
(when (> (product-of-5n currentdigit) largestproduct)
(setf largestproduct (product-of-5n currentdigit)))))))
It compiles without any warnings, but upon running it I get:
no non-whitespace characters in string "73167176531330624919225119674426574742355349194934...".
[Condition of type SB-INT:SIMPLE-PARSE-ERROR]
I checked to see if the local function product-of-5n was working by writing it again as a global function:
(defun product-of-5n (n)
(eval (append '(*)
(loop for x from n to (+ n 5)
collect (parse-integer
1000digits-str :start x :end (+ x 1))))))
This compiled without warnings and upon running it, appears to operate perfectly. For example,
CL_USER> (product-of-5n 1) => 882
Which appears to be correct since the first five digits are 7, 3, 1, 6 and 7.
As for 1000digits-str, it was simply compiled with defvar, and with Emacs' longlines-show-hard-newlines, I don't think there are any white-space characters in the string, because that's what SBCL is complaining about, right?
I don't think there are any white-space characters in the string, because that's what SBCL is complaining about, right?
The error-message isn't complaining about the presence of white-space, but about the absence of non-white-space. But it's actually a bit misleading: what the message should say is that there's no non-white-space in the specific substring to be parsed. This is because you ran off the end of the string, so were parsing a zero-length substring.
Also, product-of-5n is not defined quite right. It's just happenstance that (product-of-5n 1) returns the product of the first five digits. Strings are indexed from 0, so (product-of-5n 1) starts with the second character; and the function iterates from n + 0 to n + 5, which is a total of six characters; so (product-of-5n 1) returns 3 × 1 × 6 × 7 × 1 × 7, which happens to be the same as 7 × 3 × 1 × 6 × 7 × 1.
EVAL is not a good idea.
Your loop upper bound is wrong.
Otherwise I tried it with the number string and it works.
It's also Euler 8, not 9.
This is my version:
(defun euler8 (string)
(loop for (a b c d e) on (map 'list #'digit-char-p string)
while e maximize (* a b c d e)))
since I don't know common lisp, I slightly modified your code to fit with elisp. As far as finding bugs go and besides what have been said ((product-of-5n 1) should return 126), the only comment I have is that in (pep8), do length-4 instead of -6 (otherwise you loose last 2 characters). Sorry that I don't know how to fix your parse-error (I used string-to-number instead), but here is the code in case you find it useful:
(defun product-of-5n (n) ;take 5 characters from a string "1000digits-str" starting with nth one and output their product
(let (ox) ;define ox as a local variable
(eval ;evaluate
(append '(*) ;concatenate the multiplication sign to the list of 5 numbers (that are added next)
(dotimes (x 5 ox) ;x goes from 0 to 4 (n is added later to make it go n to n+4), the output is stored in ox
(setq ox (cons ;create a list of 5 numbers and store it in ox
(string-to-number
(substring 1000digits-str (+ x n) (+ (+ x n) 1) ) ;get the (n+x)th character
) ;end convert char to number
ox ) ;end cons
) ;end setq
) ;end dotimes, returns ox outside of do, ox has the list of 5 numbers in it
) ;end append
) ;end eval
) ;end let
)
(defun pep8 () ;print the highest
(let ((currentdigit 0) (largestproduct 0)) ;initialize local variables
(while (< currentdigit (- (length 1000digits-str) 4) ) ;while currentdigit (cd from now on) is less than l(str)-4
;(print (cons "current digit" currentdigit)) ;uncomment to print cd
(when (> (product-of-5n currentdigit) largestproduct) ;when current product is greater than previous largestproduct (lp)
(setq largestproduct (product-of-5n currentdigit)) ;save lp
(print (cons "next good cd" currentdigit)) ;print cd
(print (cons "with corresponding lp" largestproduct)) ;print lp
) ;end when
(setq currentdigit (1+ currentdigit)) ;increment cd
) ;end while
(print (cons "best ever lp" largestproduct) ) ;print best ever lp
) ;end let
)
(setq 1000digits-str "73167176531330624919")
(product-of-5n 1)
(pep9)
which returns (when ran on the first 20 characters)
"73167176531330624919"
126
("next good cd" . 0)
("with corresponding lp" . 882)
("next good cd" . 3)
("with corresponding lp" . 1764)
("best ever lp" . 1764)
I've done this problem some time ago, and there's one thing you are missing in the description of the problem. You need to read consequent as starting at any offset into a sting, not only the offsets divisible by 5. Therefore the solution to the problem will be more like the following:
(defun pe-8 ()
(do ((input (remove #\Newline
"73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450"))
(tries 0 (1+ tries))
(result 0))
((= tries 5) result)
(setq result
(max result
(do ((max 0)
(i 0 (+ 5 i)))
((= i (length input)) max)
(setq max
(do ((j i (1+ j))
(current 1)
int-char)
((= j (+ 5 i)) (max current max))
(setq int-char (- (char-code (aref input j)) 48))
(case int-char
(0 (return max))
(1)
(t (setq current (* current int-char))))))))
input (concatenate 'string (subseq input 1) (subseq input 0 1)))))
It's a tad ugly, but it illustrates the idea.
EDIT sorry, I've confused two of your functions. So that like was incorrect.