I want to print floats in a good looking way. Specifically I want to print two numbers after the decimal point, but only if these numbers are not zero.
This works if the number is not an even integer:
(let ((f 1.240))
(format t "~,2F" f))
--> 1.24
But if the number is an integer I get this:
(let ((f 1240))
(format t "~,2F" f))
-->1240.00
Is there some elegant way to do this, or do I have to check the number of decimal points manually before printing out?
I don't think this is possible with standard format directives. You could write a custom format function:
(defun my-f (stream arg &optional colon at digits)
(declare (ignore colon at))
(prin1 (cond ((= (round arg) arg) (round arg))
(digits (float (/ (round (* arg (expt 10 digits)))
(expt 10 digits))))
(t arg))
stream))
And use it like this:
CL-USER> (format t "~/my-f/" 1)
1
NIL
CL-USER> (format t "~/my-f/" 1.0)
1
NIL
CL-USER> (format t "~/my-f/" pi)
3.141592653589793D0
NIL
CL-USER> (format t "~/my-f/" 1.5)
1.5
NIL
CL-USER> (format t "~2/my-f/" 1)
1
NIL
CL-USER> (format t "~2/my-f/" 1.0)
1
NIL
CL-USER> (format t "~2/my-f/" pi)
3.14
NIL
CL-USER> (format t "~2/my-f/" 1.5)
1.5
NIL
You could use a FORMAT conditional expression:
(let ((f 1240))
(format t "~:[~,2f~;~d~]" (integerp f) f))
--> 1240
Related
I want to calculate the sum of digits of a number in Scheme. It should work like this:
>(sum-of-digits 123)
6
My idea is to transform the number 123 to string "123" and then transform it to a list '(1 2 3) and then use (apply + '(1 2 3)) to get 6.
but it's unfortunately not working like I imagined.
>(string->list(number->string 123))
'(#\1 #\2 #\3)
Apparently '(#\1 #\2 #\3) is not same as '(1 2 3)... because I'm using language racket under DrRacket, so I can not use the function like char->digit.
Can anyone help me fix this?
An alternative method would be to loop over the digits by using modulo. I'm not as used to scheme syntax, but thanks to #bearzk translating my Lisp here's a function that works for non-negative integers (and with a little work could encompass decimals and negative values):
(define (sum-of-digits x)
(if (= x 0) 0
(+ (modulo x 10)
(sum-of-digits (/ (- x (modulo x 10)) 10)))))
Something like this can do your digits thing arithmetically rather than string style:
(define (digits n)
(if (zero? n)
'()
(cons (remainder n 10) (digits2 (quotient n 10))))
Anyway, idk if its what you're doing but this question makes me think Project Euler. And if so, you're going to appreciate both of these functions in future problems.
Above is the hard part, this is the rest:
(foldr + (digits 12345) 0)
OR
(apply + (digits 1234))
EDIT - I got rid of intLength above, but in case you still want it.
(define (intLength x)
(define (intLengthP x c)
(if (zero? x)
c
(intLengthP (quotient x 10) (+ c 1))
)
)
(intLengthP x 0))
Those #\1, #\2 things are characters. I hate to RTFM you, but the Racket docs are really good here. If you highlight string->list in DrRacket and hit F1, you should get a browser window with a bunch of useful information.
So as not to keep you in the dark; I think I'd probably use the "string" function as the missing step in your solution:
(map string (list #\a #\b))
... produces
(list "a" "b")
A better idea would be to actually find the digits and sum them. 34%10 gives 4 and 3%10 gives 3. Sum is 3+4.
Here's an algorithm in F# (I'm sorry, I don't know Scheme):
let rec sumOfDigits n =
if n<10 then n
else (n%10) + sumOfDigits (n/10)
This works, it builds on your initial string->list solution, just does a conversion on the list of characters
(apply + (map (lambda (d) (- (char->integer d) (char->integer #\0)))
(string->list (number->string 123))))
The conversion function could factored out to make it a little more clear:
(define (digit->integer d)
(- (char->integer d) (char->integer #\0)))
(apply + (map digit->integer (string->list (number->string 123))))
(define (sum-of-digits num)
(if (< num 10)
num
(+ (remainder num 10) (sum-of-digits (/ (- num (remainder num 10)) 10)))))
recursive process.. terminates at n < 10 where sum-of-digits returns the input num itself.
I used string-length to get the number of characters but I am having difficulties in defining a recursive function. Should I convert the string to a list and then count the elements?
There's no useful way of doing this recursively (or even tail recursively): strings in Scheme are objects which know how long they are. There would be such an approach in a language like C where strings don't know how long they are but are delimited by some special marker. So for instance if (special-marker? s i) told you whether the i'th element of s was the special marker object, then you could write a function to know how long the string was:
(define (silly-string-length s)
(let silly-string-length-loop ([i 1])
(if (special-marker? s i)
(- i 1)
(silly-string-length-loop (+ i 1)))))
But now think about how you would implement special-marker? in Scheme: in particular here's the obvious implementation:
(define (special-marker? s i)
(= i (+ (string-length s) 1)))
And you can see that silly-string-length is now just a terrible version of string-length.
Well, if you wanted to make it look even more terrible, you could, as you suggest, convert a string to a list and then compute the length of the lists. Lists are delimited by a special marker object, () so this approach is reasonable:
(define (length-of-list l)
(let length-of-list-loop ([i 0]
[lt l])
(if (null? lt)
i
(length-of-list-loop (+ i 1) (rest lt)))))
So you could write
(define (superficially-less-silly-string-length s)
(length-of-list
(turn-string-into-list s)))
But, wait, how do you write turn-string-into-list? Well, something like this perhaps:
(define (turn-string-into-list s)
(let ([l (string-length s)])
(let loop ([i 0]
[r '()])
(if (= i l)
(reverse r)
(loop (+ i 1)
(cons (string-ref s i) r))))))
And this ... uses string-length.
What is the problem with?
(string-length string)
If the question is a puzzle "count characters in a string without using string-length",
then maybe:
(define (my-string-length s)
(define (my-string-length t n)
(if (string=? s t) n
(my-string-length
(string-append t (string (string-ref s n))) (+ n 1))))
(my-string-length "" 0))
or:
(define (my-string-length s)
(define (my-string-length n)
(define (try thunk)
(call/cc (lambda (k)
(with-exception-handler (lambda (x)
(k n))
thunk))))
(try (lambda ()
(string-ref s n)
(my-string-length (+ n 1)))))
(my-string-length 0))
(but of course string-ref will be using the base string-length or equivalent)
Problem: I have N contiguous segments numbered from 1 to N and M colors also numbered from 1 to M.
Now, there are two numbers U and V defined as:
U = color(i) + color(j)
V = color(j) + color(k)
U, V are coprime.
where 1 <= i,j,k <= N and
j = i+1, k=j+1
Problem is to find the number of ways that all N segments can be colored such that the above property holds for all i,j,k.
Is there a dynamic programming solution to this problem? What is it?
I have a recursive but non-[dynamic programming] implementation of this that should help get you pointed in the right direction. It's implemented in Common Lisp since there's no language specified.
The way to extend it to be a dynamic programming solution would be to add a cache.
count-all-coprime-triple-colorings constructs all the colorings in memory and then checks each of them for satisfying the coprime triple condition.
count-all-coprime-triple-colorings-lazy tries to aggressively prune the colorings we even consider by ruling out colorings with a prefix that doesn't satisfy the coprime condition.
This approach could be improved by noting that only the last two elements of the prefix are relevant, so you could use that to populate the cache.
(defun coprime-p (a b)
"check whether a and b are coprime"
(= (gcd a b) 1))
(defun coprime-triple-p (a b c)
"check whether (a+b) and (b+c) are coprime"
(coprime-p (+ a b) (+ b c)))
(defun coprime-triple-sequence-p (seq)
"check whether seq is a sequence of corpime triples"
(cond
;; if the length is less than 2 then
;; every triple is trivially coprime
((<= (length seq) 2) t)
(t (let
((a (nth 0 seq))
(b (nth 1 seq))
(c (nth 2 seq))
(tail (cdr seq)))
(if (coprime-triple-p a b c)
(coprime-triple-sequence-p tail)
nil)))))
(defun curry-cons (x)
"curried cons operator"
(lambda (list) (cons x list)))
(defun all-colorings (sections colors)
"generate all possible #colors-colorings of sections"
(assert (>= sections 0))
(assert (>= colors 1))
(cond
;; if there are no sections
;; then there are no colorings
((= sections 0) ())
;; when we have one section there is one coloring
;; for each color
((= sections 1) (loop for i from 1 upto colors collecting (list i)))
(t
;; wildly inefficient
(loop for i from 1 upto colors appending
(mapcar (curry-cons i) (all-colorings (1- sections) colors))))))
(defun count-all-coprime-triple-colorings (sections colors)
"count all the colorings that have coprime triples"
(loop for i in (all-colorings sections colors) counting (coprime-triple-sequence-p i)))
(defun coprime-triple-check-boundary (reversed-prefix suffix)
"prefix = [...a, b] ; suffix = [c,...] ; check
gcd(a+b, b+c) != 1"
;; if there aren't enough elements in reversed-prefix and suffix
;; then we admit the list
(if (and (nth 1 reversed-prefix) (nth 0 suffix))
(let
((b (nth 0 reversed-prefix)) (a (nth 1 reversed-prefix)) (c (nth 0 suffix)))
(coprime-triple-p a b c))
t))
(defun count-all-coprime-triple-colorings-lazy (sections colors reversed-prefix)
"count the number of sequences with coprime triples with a particular number
of sections and colors with a particular reversed-prefix."
(let
((sections-- (1- sections)))
(cond
((= sections 0) 1)
(t (loop for i from 1 upto colors summing
(if (coprime-triple-check-boundary reversed-prefix (list i))
(count-all-coprime-triple-colorings-lazy sections-- colors (cons i reversed-prefix))
0))))))
(defun summarize-coloring (i j)
"summarize the given coloring number"
(print (list "triples" i "colors" j
(count-all-coprime-triple-colorings-lazy i j nil))))
(loop for i from 1 upto 9 doing
(loop for j from 1 upto 9 doing (summarize-coloring i j)))
What is the easiest way to accomplish the following in a Mathematica clone or in any version of Lisp(any language is probably okay actually even Haskell)? It doesn't appear any lisps have a similar replace function.
Replace[{
f[{x, "[", y, "]"}],
f#f[{x, "[", y, y2, "]"}]
}
, f[{x_, "[", y__, "]"}] :> x[y],
Infinity]
and a return value of {x[y], f[x[y, y2]]}
It replaces all instances of f[{x_, "[", y__, "]"}] in args where x_ represents a single variable and y__ represents one or more variables.
In lisp the function and replacement would probably be the equivalent(forgive me I am not the best with Lisp). I'm looking for a function of the form (replace list search replace).
(replace
'(
(f (x "[" y "]"))
(f (f '(x "[" y y2 "]")))
)
'(f (x_ "[" y__ "]"))
'(x y)
)
and get a return value of ((x y) (f (x y y2))).
Let's give it another try.
First, install quicklisp and use it to fetch, install and load optima and alexandria.
(ql:quickload :optima)
(ql:quickload :alexandria)
(use-package :alexandria)
The functions from alexandria referenced below are ensure-list and last-elt. If you don't have them installed, you can use the following definitions:
(defun ensure-list (list) (if (listp list) list (list list)))
(defun last-elt (list) (car (last list)))
We define rules as functions from one form to another.
Below, the function tries to destructure the input as (f (<X> "[" <ARGS> "]"), where <ARGS> is zero or more form. If destructuring fails, we return NIL (we expect non-matching filters to return NIL hereafter).
(defun match-ugly-funcall (form)
(optima:match form
((list 'f (cons x args))
(unless (and (string= "[" (first args))
(string= "]" (last-elt args)))
(optima:fail))
`(,x ,#(cdr (butlast args))))))
(match-ugly-funcall '(f (g "[" 1 3 5 4 8 "]")))
; => (G 1 3 5 4 8)
Then, we mimic Mathematica's Replace with this function, which takes a form and a list of rules to be tried. It is possible to pass a single rule (thanks to ensure-list). If a list of list of rules is given, a list of matches should be returned (to be done).
(defun match-replace (form rules &optional (levelspec '(0)))
(setf rules (ensure-list rules))
(multiple-value-bind (match-levelspec-p recurse-levelspec-p)
(optima:ematch levelspec
((list n1 n2) (if (some #'minusp (list n1 n2))
(optima:fail)
(values (lambda (d) (<= n1 d n2))
(lambda (d) (< d n2)))))
((list n) (if (minusp n)
(optima:fail)
(values (lambda (d) (= d n))
(lambda (d) (< d n)))))
(:infinity (values (constantly t) (constantly t))))
(labels
((do-replace (form depth)
(let ((result
(and (funcall match-levelspec-p depth)
(some (lambda (r) (funcall r form)) rules))))
(cond
(result (values result t))
((and (listp form)
(funcall recurse-levelspec-p depth))
(incf depth)
(do (newlist
(e (pop form) (pop form)))
((endp form) (values form nil))
(multiple-value-bind (result matchedp) (do-replace e depth)
(if matchedp
(return (values (nconc (nreverse newlist)
(list* result form)) t))
(push e newlist)))))
(t (values form nil))))))
(do-replace form 0))))
And a test:
(match-replace '(a b (f (x "[" 1 2 3 "]")) c d)
#'match-ugly-funcall
:infinity)
; => (A B (X 1 2 3) C D)
; T
In order to replace all expressions instead of the first matching one, use this instead:
(defun match-replace-all (form rules &optional (levelspec '(0)))
(setf rules (ensure-list rules))
(multiple-value-bind (match-levelspec-p recurse-levelspec-p)
(optima:ematch levelspec
((list n1 n2) (if (some #'minusp (list n1 n2))
(optima:fail)
(values (lambda (d) (<= n1 d n2))
(lambda (d) (< d n2)))))
((list n) (if (minusp n)
(optima:fail)
(values (lambda (d) (= d n))
(lambda (d) (< d n)))))
(:infinity (values (constantly t) (constantly t))))
(labels
((do-replace (form depth)
(let ((result
(and (funcall match-levelspec-p depth)
(some (lambda (r) (funcall r form)) rules))))
(cond
(result result)
((and (listp form)
(funcall recurse-levelspec-p depth))
(incf depth)
(mapcar (lambda (e) (do-replace e depth)) form))
(t form)))))
(do-replace form 0))))
Oh boy, how Mathematica manages to obfuscate everything by applying its renown NIH approach.
Basically, you're looking for a function to perform string replacement according to some pattern. In most languages, this is accomplished with regular expressions.
For instance, in Common Lisp using the cl-ppcre library it will look something like this:
(cl-ppcre:regex-replace-all
;; regular expression you match against with groups
"f\\[{(x[^ ]*), \"\\[\", ((y[^ ]* ?)+), \"\\]\"}\\]"
;; your string
"{f[{x, \"[\", y, \"]\"}], f#f[{x, \"[\", y, y2, \"]\"}]}"
;; substitution expression using groups 1 & 2
"\\1[\\2]")
Surely, you can write a specialized 20-line function for this problem of matching and substituting subtrees using subst and recursion, but if all that you want is cases similar to the presented one you can get away with a simple regex-based approach.
I have to write a program that changes a string's vowels, consonants and other symbols into C, V respectively 0. I've done this but I wonder if there is a more efficient and elegant way to do it. Would appreciate input.
(defun string-to-list (string)
(loop for char across string collect char))
(defun is-vowel (char) (find char "aeiou" :test #'char-equal))
(defun is-consonant (char) (find char "bcdfghjklmnpqrstvwxyz" :test #'char-equal))
(defun letter-type (char)
(if (is-vowel char) "V"
(if (is-consonant char) "C"
"0")))
(defun analyze-word (word-string)
(loop for char across word-string collect (letter-type char)))
Moreover, I would like to make it a string, how could I do that? Should I define a function that would iterate through the list and make it a string or is it an easier way to do it?
(defun letter-type (char)
(cond ((find char "aeiou" :test #'char-equal) #\V)
((alpha-char-p char) #\C)
(t #\0)))
CL-USER> (map 'string #'letter-type "analyze-word")
"VCVCCCV0CVCC"
Just for the sake of the idea:
(defun multi-replace-if (sequence function &rest more-functions)
(map (type-of sequence)
(lambda (x)
(loop for f in (cons function more-functions)
for result = (funcall f x)
while (eql x result)
finally (return result)))
sequence))
(multi-replace-if "bcdfghjklmnpqrstvwxyz"
(lambda (x) (if (find x "aeiouy") #\v x))
(lambda (y) (declare (ignore y)) #\c))
"cccccccccccccccccccvc"