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.
Related
(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)
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
I want to test this list whether it's palindrome or not by comparing first element with last element , second element with before the last element and so on
(setq l '(1 5 7 8 8 7 5 1))
(defun f (l)
(cond ((null l) 0)
((atom l) l)
(if (equal (car l) (car(cdr l))))
Is there a reason for this way of comparing them? If not, it would be easier to use the reverse function:
(defun palindrome-p (l)
(equal l (reverse l)))
The #Pascal solution reverses the entire list to check if it is palindrome, but this is not necessary. Why not reverse only half of it?
(defun palindrome-p (l)
(let* ((half (floor (length l) 2))
(secondhalf (reverse (nthcdr half l))))
(loop for x in l
for y in secondhalf
always (eq x y))))
This solution (which, I have to admit, is more “common-lispy” and less “lispy”) allocates only half of memory of the solution that reverses the entire list, and in CCL, on my laptop, for long lists uses less then half time.
Another option that conses only half the list:
(defun palindrome-p (list)
(let* ((length (length list))
;; The following lists will NOT include the middle element if length is odd
(half-length (ceiling length 2))
(tail (nthcdr half-length list))
(reversed-head (nreverse (butlast list half-length))))
(equal tail reversed-head)))
The thing about this option is that you get two lists of similar length, you don't have to worry about whether iteration stops at the smallest one, and it's easier to adapt and debug later for other purposes.
Yet another option that is usually disregarded is to copy the whole list into a vector. Most implementations take 1 or 2 architecture words (32-bit/64-bit) to represent a cons, thus the worst case for a list is:
2 × length words
These same implementations take about 1 to 2 words for the vector's header, plus 1 word per element, thus the worst case for a vector is:
2 + length words
What I mean is, you'll have about the same memory allocation cost for consing half of the list compared to copying the whole list into a vector.
The compromise is to find out when the header is no longer much of an overhead compared to consing and (n)reversing the list, or from accessing the nth element of a not-that-small list.
If this threshold is found, I'd redefine it as follows, making it accept a sequence:
;; Mere example, I did not research this on any implementation
(defconstant +list-to-vector-overhead-threshold+ 8)
(defun palindrome-p (sequence)
(if (and (consp sequence)
(not (null (nthcdr +list-to-vector-overhead-threshold+ sequence))
(palindrome-p (concatenate 'vector sequence)
(let ((length (length sequence)))
(dotimes (i (floor length 2))
(when (not (equal (elt sequence i) (elt sequence (- length i 1))))
(return nil)))
t)))
PS: Here's some implementations' object sizes found by experimentation (meaning, I might be wrong about these numbers) with 32-bit implementations:
Allegro CL
List: 2 × length words
Vector: 2 + length words, 2 words aligned (i.e. in 32-bit, 8-byte aligned)
Clozure CL
List: 2 × length words
Vector: 1 + length words, 2 words aligned (i.e. in 32-bit, 8-byte aligned)
LispWorks
List: 3 × length words
Vector: 2 + length words
SBCL
List: 2 × length words
Vector: 2 + length words
; Get the reverse of a list
(defun revList (l)
(cond
((null (cdr l)) l)
(t (append (revList (cdr l)) (list(car l) ) ))
)
)
; Check whether a given a list is a palindrome
(defun palindrome (l)
(cond ((null l) t)
((equal (car l) (car (last l)))(palindrome (cdr (revList (cdr l)))))
)
)
This implements a recursive function that returns (t) if a string (represented as a flat list of atoms) is a palindrome and (nil) otherwise. you can use the built-in "reverse" lisp function instead of "revList".
(defun palind (l1)
(if (equal l1 (reverse l1))
'palindrome
'no-palindrome))
Right now I"m working on a program that should be able to pick 3 people out of a list of 7 ( a b c d e f g) and assign them to be criminals. This "game" then picks 3 random peolpe out of the 7, tells you how many of those people are criminals and asks if you want to guess who the three criminals are, having one guess ( "two of these three are crimnals would you like to guess who the criminals are). However, I currently have a program that pulls 3 random criminals from the list, however the struggle I"m having is initially assigning who's a criminal or not ( randomly picking 3 out of a list and assigning them to values that can be recalled later ) and then being able to print that back out. This is my code so far and I was hoping somebody could point me in the right direction, I'm still very new to functional programming as a whole.
;allows us to use prompt to ask the user for input
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
;allows you to add elements in needed spots
(defun element-at (org-list pos &optional (ini 1))
(if (eql ini pos)
(car org-list)
(element-at (cdr org-list) pos (+ ini 1))))
(defun element-at (lista n)
(if (= n 1)
(first lista)
(element-at (rest lista) (1- n))))
;allows for the removal of unneeded elements
(defun remove-at (org-list pos &optional (ini 1))
(if (eql pos ini)
(cdr org-list)
(cons (car org-list) (remove-at (cdr org-list) pos (+ ini 1)))))
;returns a chosen number of random elements from a list
(defun rnd-select (org-list num &optional (selected 0))
(if (eql num selected)
nil
(let ((rand-pos (+ (random (length org-list)) 1)))
(cons (element-at org-list rand-pos) (rnd-select (remove-at org-list rand-pos) num (+ selected 1))))))
;returns 3 random criminals from a list of 7
(defun rnd-criminals ()
(rnd-select '(a b c d e f g) 3))
(defun game ()
(prompt-for-players))
;allows for the storing of number of players
(defun num-of-players(number)
(list :number number))
;prompts for the amount of players you want to play
(defun prompt-for-players ()
(num-of-players
(or (parse-integer (prompt-read "How many players are there?"
:junk-allowed t) 0))))
This is a sampling without replacement problem (since, I'd assume, you wouldn't want to "pick three criminals" by picking the same person from the list each time). There are lots of ways to do this. One way is to generate indices until you've got enough distinct ones. How about something like this:
(defun pick (sequence n)
"Return n elements chosen at random from the sequence."
(do ((len (length sequence)) ; the length of the sequence
(indices '()) ; the indices that have been used
(elements '())) ; the elements that have been selected
((zerop n) ; when there are no more elements to select,
elements) ; return the elements that were selectd.
(let ((i (random len))) ; choose an index at random
(unless (member i indices) ; unless it's been used already
(push i indices) ; add it to the list of used indices
(push (elt sequence i) elements) ; and grab the element at the index
(decf n))))) ; and decrement n.
If you're not so familiar with do, you could use a recursive approach, e.g., with a local recursive function:
(defun pick2 (sequence n &aux (len (length sequence)))
(labels ((pick2 (indices elements n)
(if (zerop n) ; if no more elements are needed,
elements ; then return elements.
(let ((i (random len))) ; Otherwise, pick an index i.
;; If it's been used before,
(if (member i indices)
;; then continue on with the same indices,
;; elements, and n.
(pick2 indices elements n)
;; else, continue with it in the list of
;; indices, add the new element to the list of
;; elements, and select one fewer elements
;; (i.e., decrease n).
(pick2 (list* i indices)
(list* (elt sequence i) elements)
(1- n)))))))
;; Start the process off with no indices, no elements, and n.
(pick2 '() '() n)))
Another approach would one based on Efficiently selecting a set of random elements from a linked list which suggests Reservoir Sampling.
I am representing sparse polynomials as lists of (coefficient, pairs). For example:
'((1 2) (3 6) (-20 48)) => x^2 + 3x^6 - 20x^48
I am new to Lisp formatting, but have come across some pretty nifty tools, such as (format nil "~:[+~;-~]" (> 0 coefficient)) to get the sign of the coefficient as text (I know, that's probably not idiomatic).
However, there are certain display problems when formatting single terms. For example, the following should all be true:
(1 0) => 1x^0 => 1 (reducible)
(1 1) => 1x^1 => x (reducible)
(1 2) => 1x^2 => x^2 (reducible)
(2 0) => 2x^0 => 2 (reducible)
(2 1) => 2x^1 => 2x (reducable)
(2 2) => 2x^2 => 2x^2 (this one is okay)
I'm wondering if there's a way to do this without a large series of if or cond macros - a way just to do this with a single format pattern. Everything works but the 'prettifying' the terms (the last line in FormatPolynomialHelper3 should do this).
(defun FormatPolynomial (p)
"Readably formats the polynomial p."
; The result of FormatPolynomialHelper1 is a list of the form (sign formatted),
; where 'sign' is the sign of the first term and 'formatted' is the rest of the
; formatted polynomial. We make this a special case so that we can print a sign
; attached to the first term if it is negative, and leave it out otherwise. So,
; we format the first term to be either '-7x^20' or '7x^20', rather than having
; the minus or plus sign separated by a space.
(destructuring-bind (sign formatted-poly) (FormatPolynomialHelper1 p)
(cond
((string= formatted-poly "") (format nil "0"))
(t (format nil "~:[~;-~]~a" (string= sign "-") formatted-poly)))))
; Helpers
(defun FormatPolynomialHelper1 (p)
(reduce #'FormatPolynomialHelper2 (mapcar #'FormatPolynomialHelper3 p) :initial-value '("" "")))
(defun FormatPolynomialHelper2 (t1 t2)
; Reduces ((sign-a term-a) (sign-b term-b)) => (sign-b "term-b sign-a term-a"). As
; noted, this accumulates the formatted term in the variable t2, beginning with an
; initial value of "", and stores the sign of the leading term in the variable t1.
; The sign of the leading term is placed directly before the accumulated formatted
; term, ensuring that the signs are placed correctly before their coefficient. The
; sign of the the leading term of the polynomial (the last term that is processed)
; is available to the caller for special-case formatting.
(list
(first t2)
(format nil "~#{~a ~}" (second t2) (first t1) (second t1))))
(defun FormatPolynomialHelper3 (tm)
; Properly formats a term in the form "ax^b", excluding parts of the form if they
; evaluate to one. For example, 1x^3 => x^3, 2x^1 => 2x, and 3x^0 => 3). The list
; is in the form (sign formatted), denoting the sign of the term, and the form of
; the term state above (the coefficient have forced absolute value).
(list
(format nil "~:[+~;-~]" (> 0 (first tm)))
(format nil "~a~#[x^~a~]" (abs (first tm)) (second tm))))
EDIT: It's correctly been stated that output should not contain logic. Perhaps I was asking too specific of a question for my problem. Here is the logic that correctly formats a polynomial - but I'm looking for something cleaner, more readable, and more lisp-idiomatic (this is only my third day writing lisp).
(defun FormatPolynomialHelper3 (tm)
; Properly formats a term in the form "ax^b", excluding parts of the form if they
; evaluate to one. For example, 1x^3 => x^3, 2x^1 => 2x, and 3x^0 => 3). The list
; is in the form (sign formatted), denoting the sign of the term, and the form of
; the term state above (the coefficient have forced absolute value).
(list
(format nil "~:[+~;-~]" (> 0 (first tm)))
(cond
((= 0 (second tm)) (format nil "~a" (abs (first tm))))
((= 1 (abs (first tm))) (cond
((= 1 (second tm)) (format nil "x"))
(t (format nil "x^~a" (second tm)))))
((= 1 (second tm)) (format nil "~ax" (abs (first tm))))
(t (format nil "~ax^~a" (abs (first tm)) (second tm))))))
Answer:
I would not put this logic into FORMAT statements. Only if you want to encrypt your code or create more maintenance work for yourself. Good Lisp code is self-documenting. FORMAT statements are never self-documenting.
Before printing I would first simplify the polynomial. For example removing every term which is multiplied by zero.
((0 10) (1 2)) -> ((1 2))
Then if the multiplier is 1 can be tested in a normal COND or CASE statement.
Also make sure that you never use CAR, CDR, FIRST, SECOND with a self-made data structure. The components of a polynomial should mostly be accessed by self-documenting functions hiding most of the implementation details.
I would write it without FORMAT:
Example code:
(defun term-m (term)
(first term))
(defun term-e (term)
(second term))
(defun simplify-polynomial (p)
(remove-if #'zerop (sort p #'> :key #'term-e)
:key #'term-m))
(defun write-term (m e start-p stream)
; sign or operator
(cond ((and (minusp m) start-p)
(princ "-" stream))
((not start-p)
(princ (if (plusp m) " + " " - ") stream)))
; m
(cond ((not (= (abs m) 1))
(princ (abs m) stream)))
(princ "x" stream)
; e
(cond ((not (= 1 e))
(princ "^" stream)
(princ e stream))))
(defun write-polynomial (p &optional (stream *standard-output*))
(loop for (m e) in (simplify-polynomial p)
for start-p = t then nil
do (write-term m e start-p stream)))
Example use:
CL-USER 14 > (write-polynomial '((1 2) (3 6) (-20 48)))
-20x^48 + 3x^6 + x^2