I'm writing a function that replaces every letter by the one found exactly 13 spaces later around the alphabetical circle, and leave non-letter characters unchanged. For letters A-N and a-n, I only have to add 13 to the corresponding integer and then convert it to character. This is where it confuses me - For letters N-Z and n-z, the corresponding integer after decoding should be subtracted by 13, and I don't know how to write the question-expressions. I've tried using char<=? and char>=? but there was error.
(define (rot-13 msg)
(list->string (list-rot-13 (string->list msg))))
(define (list-rot-13 loc)
(cond
[(empty? loc) empty]
[else
(cons (convert-char (first loc)) (list-rot-13 (rest loc)))]))
(define (convert-char c)
(cond
[... (integer->char (- (char->integer c) 13))]
[... (integer->char (+ (char->integer c) 13))]
[else c])
You can use char-ci>=?. Eg.
(char-ci>=? #\l #\n) ; ==> #f
(char-ci>=? #\n #\n) ; ==> #t
(char-ci>=? #\p #\n) ; ==> #t
Now char>=? is the same as >= for numbers, and (char>=? #\A #\b) ; ==> #t. ci stands for case insensitive so (char>=? #\A #\b) ; ==> #f.
PS: I think you can do with only one predicate and it would work with just if. Either it is equal or larger than #\nor it isn't. You can also do the if inside the math operation by always adding (integer->char (+ (char->integer c) (if (char-ci>=? ...) -13 13))
Related
I am trying to make my own pattern-matching system in Scheme. To begin I am making a parser for s-expressions that divides them into tokens like this:
'(1 2 b (3 4)) => '(number number symbol (number number))
It should be noted that I have not used define-syntax before in Scheme so that may be where I am messing up. Chez Scheme throws me this error:
Exception: invalid syntax classify at line 21, char 4 of pmatch.scm. Note that the line numbers won't correspond exactly to the snippet here. Does anyone know what I am doing wrong?
(define-syntax classify
(syntax-rules ()
((_ checker replacement)
((checker (car sexpr)) (cons replacement (classify-sexpr (cdr sexpr)))))))
(define (classify-sexpr sexpr)
(cond
((null? sexpr) sexpr)
(classify list? (classify-sexpr (car sexpr)))
(classify number? 'number)
(classify symbol? 'symbol)
(else
(cons 'symbol (classify-sexpr (cdr sexpr))))))
(display (classify-sexpr '(1 (b 3) (4 5) 6)))
Your code is hugely confused. In fact it's so confused I'm not sure what you're trying to do completely: I've based my answer on what you say the classifier should produce at the start of your question.
First of all your macro refers to sexpr which has no meaning in the macro, and because Scheme macros are hygienic it will definitely not refer to the sexpr which is the argument to classify-sexpr.
Secondly you don't need a macro at all here. I suspect that you may be thinking that because you are trying to write a macro you must use macros in its construction: that's not necessarily true and often a bad idea.
Thirdly the syntax of your cond is botched beyond repair: I can't work out what it's trying to do.
Finally the list classification will never be needed: if you want to classify (1 2 3 (x)) as (number number number (symbol)) then you'll simply never reach a case where you have a list which you want to classify since you must walk into it to classify its elements.
Instead just write the obvious functions do do what you want:
(define classification-rules
;; an alist of predicate / replacement which drives classigy
`((,number? number)
(,symbol? symbol)))
(define (classify thing)
;; classify thing using classification-rules
(let loop ([tail classification-rules])
(cond [(null? tail)
'something]
[((first (first tail)) thing)
(second (first tail))]
[else
(loop (rest tail))])))
(define (classify-sexpr sexpr)
;; classify a sexpr using classify.
(cond
[(null? sexpr) '()]
[(cons? sexpr) (cons (classify-sexpr (car sexpr))
(classify-sexpr (cdr sexpr)))]
[else (classify sexpr)]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(number number number (symbol number) symbol)
It may be that what you really want is something which classifies (1 2 (x 2)) as (list number number (list symbol number)) say. You can do this fairly easily:
(define atomic-classification-rules
;; an alist of predicate / replacements for non-conses
`((,number? number)
(,symbol? symbol)))
(define (classify-sexpr sexpr)
(cond
[(null? sexpr) '()]
[(list? sexpr)
`(list ,#(map classify-sexpr sexpr))]
[(cons? sexpr)
`(cons ,(classify-sexpr (car sexpr))
,(classify-sexpr (cdr sexpr)))]
[else
(let caloop ([rtail atomic-classification-rules])
(cond [(null? rtail)
'unknown]
[((first (first rtail)) sexpr)
(second (first rtail))]
[else
(caloop (rest rtail))]))]))
And now
> (classify-sexpr '(1 2 3 (x 2) y))
'(list number number number (list symbol number) symbol)
> (classify-sexpr '(1 2 3 (x 2) . y))
'(cons number (cons number (cons number (cons (list symbol number) symbol))))
I have a list of chars and integers, and I'm trying to convert them to a string.
> (define l (cons #\a (cons #\b (cons 3 null))))
I want to convert this list to the string "ab3".
Using list->string doesn't work:
> (list->string l)
list->string: contract violation
expected: (listof char?)
given: (list #\a #\b 3)
When I try that combined with integer->char, it gives this numeric value:
> (define l (cons #\a (cons #\b (cons (integer->char 3) null))))
> (list->string l)
"ab\u0003"
Using number->string doesn't work either:
> (define l (cons #\a (cons #\b (cons (number->string 3) null))))
> (list->string l)
list->string: contract violation
expected: (listof char?)
given: '(#\a #\b "3")
context...:
C:\Program Files\Racket\collects\racket\private\misc.rkt:87:7
list->string requires a list of chars, it does not accept strings.
Another try, first converting the string to a list:
> (define l (cons #\a (cons #\b (cons (string->list (number->string 123)) null))))
> (list->string l)
list->string: contract violation
expected: (listof char?)
given: '(#\a #\b (#\3))
context...:
C:\Program Files\Racket\collects\racket\private\misc.rkt:87:7
It does not accept a sub list either. How can I convert this to the string "ab3"?
You want to process a list of characters and integers, and concatenate all of them together in a single string. Try this:
(define (process lst)
(apply string-append ; append all the strings
(map (lambda (e) ; create a list of strings
(if (char? e) ; if it's a char
(string e) ; convert it to string
(number->string e))) ; same if it's a number
lst)))
For example:
(process (list #\a #\b 123 #\c))
=> "ab123c"
A char is a type that has a value. This value is defined in unicode so that 65 is a upper case A and a 66 is an upper case B. All characters has an integer value and char->integer converts from characters to the numeric unicode value and integer->char convert from unicode value to a character.
The numeric characters start at 48 (#x30) which is the zero to 57 (#x39) which is a nine. Thus (list->string (list #\a #\b (integer->number #x33))) ; ==> "ab3"
A numeric value can be converted to a string with number->string. eg. (number->string 123) => "123". This is displayed in base 10 but if you perhaps want it displayed in hex you can (number->string 123 16) ;==> "7b". Note that list->string only takes a list of chars and cannot have other elements like numbers in them.
You may join many strings together with string-append:
(string-append (list->string '(#\a #\b))
(number->string #x7b)
"c")
; ==> "ab123c"
Racket has a handy function called ~a that converts its arguments to strings as if by using display, and concatenates them all together (Plus a bunch of optional keyword arguments to control formatting, but they're not needed here). Combine it with apply to treat the elements of a list as its arguments.
> (apply ~a '(#\a #\b 3))
"ab3"
(If you're using #lang racket/base, you'll have to (require racket/format)).
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
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.
What is the exclusive or functions in scheme? I've tried xor and ^, but both give me an unbound local variable error.
Googling found nothing.
I suggest you use (not (equal? foo bar)) if not equals works. Please note that there may be faster comparators for your situiation such as eq?
As far as I can tell from the R6RS (the latest definition of scheme), there is no pre-defined exclusive-or operation. However, xor is equivalent to not equals for boolean values so it's really quite easy to define on your own if there isn't a builtin function for it.
Assuming the arguments are restricted to the scheme booleans values #f and #t,
(define (xor a b)
(not (boolean=? a b)))
will do the job.
If you mean bitwise xor of two integers, then each Scheme has it's own name (if any) since it's not in any standard. For example, PLT has these bitwise functions, including bitwise-xor.
(Uh, if you talk about booleans, then yes, not & or are it...)
Kind of a different style of answer:
(define xor
(lambda (a b)
(cond
(a (not b))
(else b))))
Reading SRFI-1 shed a new light upon my answer. Forget efficiency and simplicity concerns or even testing! This beauty does it all:
(define (xor . args)
(odd? (count (lambda (x) (eqv? x #t)) args)))
Or if you prefer:
(define (true? x) (eqv? x #t))
(define (xor . args) (odd? (count true? args)))
(define (xor a b)
(and
(not (and a b))
(or a b)))
Since xor could be used with any number of arguments, the only requirement is that the number of true occurences be odd. It could be defined roughly this way:
(define (true? x) (eqv? x #t))
(define (xor . args)
(odd? (length (filter true? args))))
No argument checking needs to be done since any number of arguments (including none) will return the right answer.
However, this simple implementation has efficiency problems: both length and filter traverse the list twice; so I thought I could remove both and also the other useless predicate procedure "true?".
The value odd? receives is the value of the accumulator (aka acc) when args has no remaining true-evaluating members. If true-evaluating members exist, repeat with acc+1 and the rest of the args starting at the next true value or evaluate to false, which will cause acc to be returned with the last count.
(define (xor . args)
(odd? (let count ([args (memv #t args)]
[acc 0])
(if args
(count (memv #t (cdr args))
(+ acc 1))
acc))))
> (define (xor a b)(not (equal? (and a #t)(and b #t))))
> (xor 'hello 'world)
$9 = #f
> (xor #f #f)
$10 = #f
> (xor (> 1 100)(< 1 100))
$11 = #t
I revised my code recently because I needed 'xor in scheme and found out it wasn't good enough...
First, my earlier definition of 'true? made the assumption that arguments had been tested under a boolean operation. So I change:
(define (true? x) (eqv? #t))
... for:
(define (true? x) (not (eqv? x #f)))
... which is more like the "true" definition of 'true? However, since 'xor returns #t if its arguments have an 'odd? number of "true" arguments, testing for an even number of false cases is equivalent. So here's my revised 'xor:
(define (xor . args)
(even? (count (lambda (x) (eqv? x #f)) args)))