Lisp Formatting Polynomial - lisp

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

Related

Get the maximum value of a list with three numbers

I'm learning Lisp now, and I'm trying to do an exercise that asks me to get the maximum value of a list, the syntax is totally different from most programming languages I've learned, so I'm having some difficulties.
My code:
(defun test(y)
(cond
((and (first y) (> (second y)) (> (third y)))
(format t "numero maximo ~d" (first y))
((and (second y) (> (first y)) (> (third y)))
(t (format t "numero maximo ~d" (second y))
((and (third y) (> (second y)) (> (first y)))
(t (format t "numero maximo ~d" (third y))
))
I'm receiving this error: incomplete s-expression in region
Your code is too complex, it tries to take elements from a list, compare them, and print something. Like in other languages, use smaller functions and, particularly with a new language, test often in order to avoid having to debug something too large.
Your code, automatically indented with Emacs, looks as follows:
(defun test(y)
(cond
((and (first y) (> (second y)) (> (third y)))
(format t "numero maximo ~d" (first y))
((and (second y) (> (first y)) (> (third y)))
(t (format t "numero maximo ~d" (second y))
((and (third y) (> (second y)) (> (first y)))
(t (format t "numero maximo ~d" (third y))
))
And the editor complains about unbalanced parentheses:
In (> (second y)), the > function is given only one argument
All your cond clauses are in fact nested inside the first clause. Using an editor that highlights matching parentheses helps a lot here. The syntax should be:
(cond
(test-1 ...)
(test-2 ...)
(t ...))
If your test involves calling predicates, then it looks like:
(cond
((and (f1 ...) (f2 ...)) ;; <-- test
... ;; <-- code
) ;; end of first clause
) ;; end of cond
But note that you do not need to put comments for closing delimiters, the indentation and the automatic highlighting of parentheses should help you avoid mistakes.
Let's try a rewrite.
First of all, you can write a function that just compares numbers, not thinking about lists or formatting; here is a very straightforward max-of-3 implementation (without cheating and calling the built-in max function):
(defun max-of-3 (x y z)
(if (> x y)
(if (> x z) x z)
(if (> y z) y z)))
Evaluate the function, and test it on multiple inputs, for example in the REPL:
CL-USER> (max-of-3 0 2 1)
2
....
Then, you can build up the other function, for your list:
(defun test (list)
(format t
"numero maximo ~d"
(max-of-3 (first list)
(second list)
(third list))))
If you need to do more error checking ahead of time, like checking that the lists is well-formed, you should probably define other auxiliary functions.
If I understood the question and answer, I might be able to provide a solution or two that returns the max, regardless of the length of the list. So, these solutions are not limited to a list of three.
This illustrates a way to test where "max-lst" is the Lisp function under test:
(defconstant test-case
(list 1 2 0 8 7 6 9 4 5))
(defun run-test ()
(max-lst test-case))
Solution 1
This solution uses recursion. If you like loops better, Lisp has several loops. The Lisp function "max" is not used:
(defun max-lst (lst-in)
(cond ((null (second lst-in))
(first lst-in))
((> (first lst-in) (second lst-in))
(max-lst
(list* (first lst-in) (rest (rest lst-in)))))
(t
(max-lst
(list* (rest lst-in))))))
Solution 2
If you have no objection to using the Lisp function "max," here is a solution using max.
Note that max is not limited to two arguments.
(max 5 6 4 7 3)
will return 7.
In this solution, the function "max" is passed to the function "reduce" as an argument. The "reduce" function takes a function and a list as arguments. The function is applied to each adjacent pair of arguments and returns the result. If you want the sum, you can pass the + argument.
(defun max-lst-using-max (lst-in)
(reduce #'max lst-in))
Alas, I fear that I provide these solutions too late to be pertinent to the original poster. But maybe someone else will have a similar question. So, perhaps this could help, after all.

Common Lisp - type checking two variables

Hi I'm a beginner in Common Lisp. I want to check if two variables are integers. If both n and m are integers I want to it to return - if it is negative, 0 if it is zero, + if it is positive and NIL if it is not an integer for both n and m. I figured out how to do this with one variable but I can't seem to figure out how to do it with two variables. Thanks.
This is the code that takes a numeric argument and returns - if it is negative, 0 if it is zero, + if it is positive and NIL if its not an integer:
(defun sign (n)
(if(typep n 'integer)
(cond ((< n 0) '-)
((= n 0) 0)
((> n 0) '+))))
The output for each case is:
CL-USER> (sign 3)
+
CL-USER> (sign -3)
-
CL-USER> (sign 0)
0
CL-USER> (sign 3.3)
NIL
This is the code I have for checking two variables which I want it to check if n and m are integers and if n and m are positive, negative or a zero:
(defun sign (n m)
(if (and (typep n 'integer) (typep m 'integer))
(cond (and ((< n 0) '-) ((< m 0) '-))
(and ((= n 0) 0) ((= m 0) 0))
(and ((> n 0) '+) ((> m 0) '+)) ))))
Remember basic Lisp syntax. Function calls and some basic expressions are written as
(operator argument-0 argument-1 ... argument-n)
Right?
open parenthesis, operator, argument-0 argument-1 ... argument-n, closing parenthesis.
Now if we have (< n 0) and (< m 0) how would an AND expressions look like?
(and (< n 0) (< m 0))
But you write:
and ((< n 0) '-) ((< m 0) '-)
You have these mistakes:
no parentheses around the AND expression.
extra parenthesis around the argument expressions.
'- mixed into the argument expressions.
Now COND expects:
(COND (testa1 forma0 forma1 ... forman)
(testb1 formb1 formb1 ... formbn)
...
(testm1 formm0 formm1 ... formmn))
So instead of
(defun sign (n m)
(if (and (typep n 'integer) (typep m 'integer))
(cond (and ((< n 0) '-) ((< m 0) '-))
(and ((= n 0) 0) ((= m 0) 0))
(and ((> n 0) '+) ((> m 0) '+)))))
Btw, there was an extra parenthesis at the end.
We write:
(defun sign (n m)
(if (and (typep n 'integer) (typep m 'integer))
(cond ((and (< n 0) (< m 0)) '-)
.... )))
It's also possible to use predicates like integerp, minusp, zerop and plusp.
You can use the already functioning and tested sign definition - which is typical for the way, lispers program. The first naive solution would be:
(defun sign-for-two (n m)
(when (eql (sign n) (sign m))
(sign n))
;; (if (condition) return-value NIL)
;; is equivalent to
;; (when (condition) return-value)
Note, in common lisp it is important,
which equality test you choose:
;; only symbols - for object identity eq
;; symbols or numbers - for object identity eql
;; (in most tests the default)
;; eql for each component? also in lists equal
;; equal not only lists but also
;; arrays (vectors, strings), structures, hash-tables
;; however case-insensitive in case of strings
;; equalp
;; mathematical number equality =
;; specifically characters char=
;; case-sensitive string equality string=
In our case, eql is sufficient.
;; to avoid `(sign n)` to be evaluated twice,
;; you could store it using `let`
;; and call from then on the stored value
;; (which is less costly).
(defun sign-for-two (n m)
(let ((x (sign n)))
(when (eql x (sign m))
x)))
Or create an equality tester (default test function: #'eql)
which returns the equally tested value
and if not equal, NIL:
(defun equality-value (x y &key (test #'eql))
(when (funcall test z y) z)))
;; and apply this general solution to our case:
(defun sign-for-two (n m)
(equality-value (sign n) (sign m)))
and you can apply the equality-value function
in future for functions where you want to
return the value when tested as "equal"
and you can give the function via :test whatever equality
function other than eql is suitable for that case, like
(equality-value string1 string2 :test #'string=)
It looks like you have the right approach and just got lost in the parentheses. Each of your cond cases looks like
(and ((< n 0) '-) ((< m 0) '-))
I think you meant
((and (< n 0) (< m 0)) '-)
and the same thing for the other two cases.
Another compact way to write sign is to use the standard function signum which
returns one of -1, 0, or 1 according to whether number is negative,
zero, or positive
The code could look like:
(defun sign (n)
(when (integerp n)
(case (signum n)
(-1 '-)
(0 0)
(1 '+))))

check even digits on even positions in number lisp

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

Assigning random values to variables one at a time and using that information in LISP

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.

Common Lisp: "no non-white-space characters in string"

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.