I want to convert the number 8.7 to binary.
I know the commands
(format nil "~b" (rationalize 8.7)) ===>
1010111/1010
or
(format nil "~b" (/ 87 10))====> 1010111/1010
We observe if we do the quotient binary 1010111/1010 we obtain 1000.1011001100110011001100110011.
Is possible to obtain in Lisp
(8.7)_2 ~ 1000.1011001100110011001100110011?
If yes, how?
"2.718..." is equal to 2 * 10^1 + 7 * 10^-1 + 1 * 10^-2 + 8 * 10^-3... This means that you can generate the string by the reverse process of concatenating string(n / base^i) where i is the index into the string and n is the value that still needs to be converted to base. It's essentially a greedy change-making algorithm.
The following roughly works, with no guarantee that it produces the exact IEEE 754 fraction. It should be as accurate as your implementation's floats
(defun fractional-binary (fractional &optional (place 1) (result "."))
(if (zerop fractional)
result
(let ((fraction (expt 2 (- place))))
(if (<= fraction fractional)
(fractional-binary (- fractional fraction)
(1+ place)
(concatenate 'string result "1"))
(fractional-binary fractional
(1+ place)
(concatenate 'string result "0"))))))
CL-USER> (fractional-binary .7)
".101100110011001100110011"
Related
I am making a compiler for a language in LISP, and the overall aim is for the compiler to produce LISP code from the original language. Trying to measure the performance of the generated code, I found that it is severely lacking in printing strings.
In the original language, characters are byte -arithmetic- values, thus strings are arrays of bytes, and the value of the byte corresponds to the character whose value is the ascii-code of the byte. A "printable" byte array must be null-terminated. Thus, to print a byte array as a character string, I have to map the original array's elements into characters before printing it. The function that handles this is as follows:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
and it is injected into the generated code.
Running a sample code with time, I found out that the princ part results in a lot of consing during execution, which slows things down. When in the place of make-array... a static string is put, there is no slowdown and no consing, so I guess that's the part the damage is done.
While compiling, I have set flags full on speed, the byte values are declared as fixnum for now in the generated code.
Can anyone point me to a better way to print my byte array as character string while avoiding excessive consing?
I could store bytes as characters from the get-go, but that would result in the parts of the language that treat them as numbers being slower due to the need to convert.
Problems in your code
Your code:
(defun writeString (X &AUX (NPOS 0) (i 0))
(declare (type (simple-VECTOR fixnum *) x))
(declare (type fixnum NPOS i))
(SETF NPOS (POSITION 0 X))
(IF (NOT NPOS)
(SETF NPOS (LENGTH X)))
(princ (MAKE-ARRAY NPOS
:INITIAL-CONTENTS (map 'vector
#'code-char
(SUBSEQ X 0 NPOS))
:ELEMENT-TYPE 'base-char)))
There are a couple of mistakes in the code:
i is not used
the first type declaration is syntactical not valid
the declaration for NPOS is wrong. You define it as FIXNUM, but it can be NIL.
There are a bunch of programming mistakes:
there is no need to allocate any array if all you want is to output characters.
even if you want to generate an array, one can do it once
X is not a good name for a string
A simple solution:
(defun writestring (bytestring)
(loop for byte across bytestring
while (plusp byte)
do (write-char (code-char byte))))
A type declared version could be:
(defun writestring (bytestring)
(declare (vector bytestring))
(loop for byte of-type (integer 0 255) across bytestring
while (plusp byte)
do (write-char (code-char byte))))
Instead (integer 0 255) one can also use (unsigned-byte 8).
About generating vectors:
Let's also look how you try to create the array:
You create an array with make-array, using the contents from another array.
Why not tell MAP to generate the correct array?
CL-USER 46 > (map '(vector base-char) #'code-char #(102 111 111 98 97 114))
"foobar"
Now if you want to allocate arrays for some reason:
do it once
map the content into the generated array. Use map-into for that. It will stop with the shorter sequence.
Example:
CL-USER 48 > (let ((bytestring #(102 111 111 98 97 114 0 100 100 100)))
(map-into (make-array (or (position 0 bytestring)
(length bytestring))
:element-type 'base-char)
#'code-char
bytestring))
"foobar"
You could rely on write-sequence, which hopefully is optimized to write a sequence of characters or bytes. It also accepts an :end argument which is useful for delimiting the end of the written string.
I doubt you really need to use literal vectors (which are always simple-vector), but if so you maybe want to change them. You can do it at read-time:
(let ((input #.(coerce #(102 111 111 98 97 114 0 100 100 100)
'(vector (mod 256)))))
(write-sequence (map '(vector base-char)
#'code-char
input)
*standard-output*
:end (position 0 input)))
I never used something like the following, but you could also open the same file in both character and byte mode, and switch whenever necessary:
(with-open-file (out-c #P"/tmp/test"
:if-exists :supersede
:direction :output)
(with-open-file (out-8 #P"/tmp/test"
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :append)
(format out-c "Hello [")
(file-position out-8 (file-position out-c))
(write-sequence #(102 111 111 98 97 114) out-8)
(file-position out-c (file-position out-8))
(format out-c "]")))
It prints "Hello [foobar]" in /tmp/test, and it seems to work with multibyte characters, but you probably need to test that more.
I'm new to lisp, trying to understand how lisp works, and I don't know how exactly to work with a local variable inside a large function.
here I have a little exc that I send a number to a function and if it is divisible by 3, 5 and 7 I must return a list of (by3by5by7), if only by 7, return (by7) and so on....
here is my code:
(defun checknum(n)
let* (resultt '() ) (
if(not(and(plusp n ) (integerp n))) (cons nil resultt) (progn
(if (zerop (mod n 7)) (cons 'by7 resultt) (cons nil resultt))
(if (zerop (mod n 5)) (cons 'by5 resultt) (cons nil resultt))
(if (zerop (mod n 3)) (cons 'by3 resultt) (cons nil resultt) )) ))
but if i send 21 for ex, I only get nil, instead of (by3by7) I guess the local variable is not affected by my if statements and I don't know how to do it...
(cons x y) creates a new cons cell and disposes of the result. To change the value of a variable you need to use setq, setf, push or the like, for example:
(defun checknum (n)
(let ((resultt nil))
(when (and (plusp n) (integerp n))
(when (zerop (mod n 7)) (push 'by7 resultt))
(when (zerop (mod n 5)) (push 'by5 resultt))
(when (zerop (mod n 3)) (push 'by3 resultt)))
resultt))
or perhaps, more elegantly using an internal function to factor out the repetition:
(defun checknum (n)
(when (and (plusp n) (integerp n))
(labels ((sub (d nsym res)
(if (zerop (mod n d))
(cons nsym res)
res)))
(sub 7 'by7
(sub 5 'by5
(sub 3 'by3 nil)))))
Testing:
CL-USER> (checknum 12)
(BY3)
CL-USER> (checknum 15)
(BY3 BY5)
CL-USER> (checknum 105)
(BY3 BY5 BY7)
CL-USER> (checknum 21)
(BY3 BY7)
Most lisp forms/functions don't modify their arguments. The ones that do will be explicitly documented as doing so. See adjoin and pushnew, for instance, or remove and delete.
To the point of 'trying to understand how lisp works', writing the same function in various different ways helped me a lot, so you might want to think about how you can write your function without modifying a variable at all, and why and when you would want to / not want to use destructive modifications.
Something like the below makes two passes, and will be too slow if there are a large quantity of numbers you need to check, but doesn't destructively modify anything.
(defun checknum (n)
(remove nil
(mapcar #'(lambda (m sym)
(when (zerop (mod n m)) sym))
'(7 5 3)
'(by7 by5 by3))))
The above approach can be written to not require two passes, etc.
I wrote up a few little scheme functions
; Given a list, this should return the maximum value in the list.
(define (maxInt lst)
(if (empty? lst) 0 ; if the list is empty, return 0
(max(first lst) (maxInt(rest lst)))))
; ^ What this line does is recursively take the maximum of pairs in the list.
; Ex. If the list was (7 3 6 2), this line would take the max of 7 and (the max of 3 and(the max of 2 and 6)),
; returning a result of 7.
; The zip3 function. Takes three lists of integers and returns a list of ordered triples containing the first, second, or third elements of each original list(i.e. an ordered triple containing the first elements of each list, etc)
(define (zip3 lst1 lst2 lst3)
(if (or((not(= (length lst1)(length lst2))) (not(= (length lst2)(length lst3))) (not(= (length lst 1)(length lst3))))) (error "Error")
(append (map car(lst1 lst2 lst3)) (map cadr(lst1 lst2 lst3)) (map caddr(lst1 lst2 lst3)))))
; This says 'if list 1 and 2 are different lengths or list 2 and 3 are different lengths or list 1 and 3 are different lengths, return an error.
; Otherwise, append the list containing the ordered triple of the second element of each list and that containing said triple of the third element
; to the list containing the ordered triple of the first element of each list.'
; The compute function. takes a list of integers and and integer x and computes a + bx + cx^2 + etc, with a, b, c, etc being the ints in the list.
(define (compute polyLst x)
(for ([i (length polyLst)])
(+ (* (list-ref polyLst i) (expt x i)))))
; Recursion was hinted at for this one, but I found it easier to just use a for loop. This takes the sum of the products of each element of the list and
; x raised to the power of that element's index in the list.
I used the scheme notation exactly right(I thought), but none of these functions worked upon testing with a test program that called them. I'm really confused as to why these functions didn't work. It doesn't make any sense to me. I just want to know what I did wrong.
maxInt seems to work.
zip3 has a few parentheses errors, must use list and should read
(define (zip3 lst1 lst2 lst3)
(if (or (not(= (length lst1)(length lst2))) (not(= (length lst2)(length lst3))) (not(= (length lst1)(length lst3))))
(error "Error")
(append (map car (list lst1 lst2 lst3)) (map cadr (list lst1 lst2 lst3)) (map caddr (list lst1 lst2 lst3)))))
and compute needs to use for/sum:
(define (compute polyLst x)
(for/sum ([i (length polyLst)])
(* (list-ref polyLst i) (expt x i))))
Some refactoring ideas:
(define (maxInt lst)
(apply max lst))
(define (zip3 . l)
(flatten (apply map list l)))
(define (compute polyLst x)
(for/sum ([(e n) (in-indexed polyLst)])
(* e (expt x n))))
Quite often I need to replace subsequence of certain elements with another sequence of the same type, but, probably with different length. Implementation of such function is no challenge, this is what I use now:
(defun substitute* (new old where &key key (test #'eql))
(funcall (alambda (rest)
(aif (search old rest :key key :test test)
(concatenate (etypecase rest
(string 'string)
(vector 'vector)
(list 'list))
(subseq rest 0 it)
new
(self (subseq rest (+ it (length old)))))
rest))
where))
Works like this:
CL-USER> (substitute* '(x y) '(z) '(1 z 5 8 y z))
(1 X Y 5 8 Y X Y)
CL-USER> (substitute* "green button" "red button"
"here are red indicator, red button and red wire")
"here are red indicator, green button and red wire"
CL-USER> (substitute* #(4) #(2 2) #(2 2 2 2 2))
#(4 4 2)
You see, it's very handy and useful, so I've feeling that I'm reinventing wheel and it must be in the standard library, I just don't know its name (sometimes names are not obvious, you may search for filter while what you need is set-difference).
As a result of compromise between clarity and efficiency:
(defun substitute* (new old where &key key (test #'eql))
(let ((type (etypecase where
(string 'string)
(vector 'vector)
(list 'list)))
(new (coerce new 'list))
(old (coerce old 'list))
(where (coerce where 'list)))
(coerce (funcall (alambda (rest)
(aif (search old rest :key key :test test)
(append (remove-if (constantly t) rest :start it)
new
(self (nthcdr (+ it (length old)) rest)))
rest))
where)
type)))
I don't think that there's any standard function for this. It's more complicated than the standard replace family of functions. Those can operate destructively because you know in advance that you can replace element by element. Even in that case, it's still somewhat difficult to do this efficiently, because the access time for lists and vectors is very different, so general-purpose functions like subseq can be problematic. As Rainer Joswig pointed out in a comment:
It's kind of unfortunate that for many algorithms over sequences there
is no single efficient implementation. I see often that there are two
versions, one for lists and one for vectors, which then get hidden
behind a dispatching function. For a hack a simple common version is
fine, but for a library function, often there are different
implementations - like shown here.
(In fact, in doing a bit of research on whether some library contains a function for this, one of the first Google results I got was a question on Code Review, Generic sequence splitter in Common Lisp, in which Rainer and I both had some comment similar to those here.)
A version for lists
However, your implementation is rather inefficient because it makes multiple copies of the the remainders of sequences. E.g., when you replace (z) in (1 z 2 z 3 z), with (x y), you'll first make (3 x y), then copy it in making (2 x y 3 z y), and then you'll copy that in making (1 x y 2 x y 3 x y). You might be better off in doing one pass over the sequence, determining the indices of the subsequences to replace, or collecting the bits that need to don't need to be replaced, etc. You'll probably want separate implementations for lists and for other sequences. E.g., with a list, you might do:
(defun splice-replace-list (old new list)
(do ((new (coerce new 'list))
(old-len (length old))
(parts '()))
((endp list)
(reduce 'append (nreverse parts) :from-end t))
(let ((pos (search old list)))
(push (subseq list 0 pos) parts)
(cond
((null pos)
(setf list nil))
(t
(push new parts)
(setf list (nthcdr (+ old-len pos) list)))))))
There are some optimizations you could make here, if you wanted. For instance, you could implement a search-list that, rather than returning the position of the first instance of the sought sequence, could return a copy of the head up until that point and the tail beginning with the sequence as multiple values, or even the copied head, and the tail after the sequence, since that's what you're really interested in, in this case. Additionally, you could do something a bit more efficient than (reduce 'append (nreverse parts) :from-end t) by not reversing parts, but using a reversed append. E.g.,
(flet ((xappend (l2 l1)
(append l1 l2)))
(reduce #'xappend '((5 6) (x y) (3 4) (x y))))
;=> (x y 3 4 x y 5 6)
I wrote this in a somewhat imperative style, but there's no reason that you can't use a functional style if you want. Be warned that not all Lisp implementation support tail call optimization, so it might be better to use do, but you certainly don't have to. Here's a more functional version:
(defun splice-replace-list (old new list)
(let ((new-list (coerce new 'list))
(old-len (length old)))
(labels ((keep-going (list parts)
(if (endp list)
(reduce 'append (nreverse parts) :from-end t)
(let* ((pos (search old list))
(parts (list* (subseq list 0 pos) parts)))
(if (null pos)
(keep-going '() parts)
(keep-going (nthcdr (+ old-len pos) list)
(list* new-list parts)))))))
(keep-going list '()))))
A version for vectors
For non lists, this is more difficult, because you don't have the specific sequence type that you're supposed to be using for the result. This is why functions like concatenate require a result-type argument. You can use array-element-type to get an element type for the input sequence, and then use make-array to get a sequence big enough to hold the result. That's trickier code, and will be more complicated. E.g., here's a first attempt. It's more complicated, but you'll get a result that's pretty close to the original vector type:
(defun splice-replace-vector (old new vector &aux (new-len (length new)))
(flet ((assemble-result (length parts)
(let ((result (make-array length :element-type (array-element-type vector)))
(start 0))
(dolist (part parts result)
(cond
((consp part)
(destructuring-bind (begin . end) part
(replace result vector :start1 start :start2 begin :end2 end)
(incf start (- end begin))))
(t
(replace result new :start1 start)
(incf start new-len)))))))
(do ((old-len (length old))
(total-len 0)
(start 0)
(indices '()))
((null start) (assemble-result total-len (nreverse indices)))
(let ((pos (search old vector :start2 start)))
(cond
((null pos)
(let ((vlength (length vector)))
(push (cons start vlength) indices)
(incf total-len (- vlength start))
(setf start nil)))
(t
(push (cons start pos) indices)
(push t indices)
(incf total-len (- pos start))
(incf total-len new-len)
(setf start (+ pos old-len))))))))
CL-USER> (splice-replace-vector '(#\z) '(#\x #\y) "12z")
"12xy"
CL-USER> (splice-replace-vector '(z) '(x y) #(x y))
#(X Y)
CL-USER> (splice-replace-vector '(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace-vector '(#\z) #(#\x #\y) "1z2z34z")
"1xy2xy34xy"
If you only want to make one pass through the input vector, then you could use an adjustable array as the output, and append to it. An adjustable array will have a bit more overhead than a fixed size array, but it does make the code a bit simpler.
(defun splice-replace-vector (old new vector)
(do ((vlength (length vector))
(vnew (coerce new 'vector))
(nlength (length new))
(result (make-array 0
:element-type (array-element-type vector)
:adjustable t
:fill-pointer 0))
(start 0))
((eql start vlength) result)
(let ((pos (search old vector :start2 start)))
(cond
;; add the remaining elements in vector to result
((null pos)
(do () ((eql start vlength))
(vector-push-extend (aref vector start) result)
(incf start)))
;; add the elements between start and pos to the result,
;; add a copy of new to result, and increment start
;; accordingly
(t
;; the copying here could be improved with adjust-array,
;; and replace, instead of repeated calls to vector-push-extend
(do () ((eql start pos))
(vector-push-extend (aref vector start) result)
(incf start))
(loop for x across vnew
do (vector-push-extend x result))
(incf start (1- nlength)))))))
A “generic” version
Using these two functions, you could define a general splice-replace that checks the type of the original input sequence and calls the appropriate function:
(defun splice-replace (old new sequence)
(etypecase sequence
(list (splice-replace-list old new sequence))
(vector (splice-replace-vector old new sequence))))
CL-USER> (splice-replace #(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace '(z) #(x y) '(1 z 2 z 3 4 z))
(1 X Y 2 X Y 3 4 X Y)
This is related to this question: elisp functions as parameters and as return value
(defun avg-damp (n)
'(lambda(x) (/ n 2.0)))
Either
(funcall (avg-damp 6) 10)
or
((avg-damp 6) 10)
They gave errors of Symbol's value as variable is void: n and eval: Invalid function: (avg-damp 6) respectively.
The reason the first form does not work is that n is bound dynamically, not lexically:
(defun avg-damp (n)
(lexical-let ((n n))
(lambda(x) (/ x n))))
(funcall (avg-damp 3) 12)
==> 4
The reason the second form does not work is that Emacs Lisp is, like Common Lisp, a "lisp-2", not a "lisp-1"