Is there a simple way to align on the decimal dot a column of floats? In other words, I would like an output like the one of (vertical bars '|' are there only for clarity purpose)
(format t "~{|~16,5f|~%~}" '(798573.467 434.543543 2.435 34443.5))
which is
| 798573.44000|
| 434.54355|
| 2.43500|
| 34443.50000|
but with trailing spaces instead of zeros, as follows:
| 798573.44 |
| 434.54355|
| 2.435 |
| 34443.5 |
I do not think that this can easily be done with format's inbuilt control characters, but you could pass your own function to it:
(defun my-f (stream arg colon at &rest args)
(declare (ignore colon at))
(destructuring-bind (width digits &optional (pad #\Space)) args
(let* ((string (format nil "~v,vf" width digits arg))
(non-zero (position #\0 string :test #'char/= :from-end t))
(dot (position #\. string :test #'char= :from-end t))
(zeroes (- (length string) non-zero (if (= non-zero dot) 2 1)))
(string (nsubstitute pad #\0 string :from-end t :count zeroes)))
(write-string string stream))))
You can use it like this:
CL-USER> (format t "~{|~16,5/my-f/|~%~}" '(798573.467 434.543543 2.435 34443.5 10))
| 798573.44 |
| 434.54355|
| 2.435 |
| 34443.5 |
| 10.0 |
NIL
The padding character defaults to #\Space, and may be given as a third argument like this: "~16,5,' /my-f/".
An alternative implementation using loop:
(defun my-f (stream arg colon at &rest args)
(declare (ignore colon at))
(loop with string = (format nil "~v,vf" (car args) (cadr args) arg)
and seen-non-zero = nil
for i from (1- (length string)) downto 0
as char = (char string i)
if (char/= char #\0) do (setq seen-non-zero t)
collect (if (and (not seen-non-zero)
(char= char #\0)
(not (char= #\. (char string (1- i)))))
(or (caddr args) #\Space)
char) into chars
finally (write-string (nreverse (coerce chars 'string)) stream)))
(Disclaimer: Maybe I overlooked something easier in the documentation of format.)
Related
I want to write a function that will return a string formatted with alternative upcase/downcase in Common Lisp. For example, entering "stackoverflow" should return the string "StAcKoVeRfLoW". Here's my attempt, but it just returns a list of cons pairs. Am I on the right track?
(defun mockify (chars)
(let ((lst (coerce chars 'list)))
(if (equal lst nil) nil
(coerce (cons
(cons (char-upcase (car lst)) (char-downcase (cadr lst)))
(mockify (cddr lst)))
'string))))
CL-USER> (mockify "meow")
((#\M . #\e) (#\O . #\w))
Using MAP: we are creating a new string, moving over the original string and upcase/downcase based on an alternating boolean variable.
CL-USER 353 > (let ((string "stackoverflow")
(upcase t))
(map (type-of string)
(lambda (element)
(prog1 (if upcase
(char-upcase element)
(char-downcase element))
(setf upcase (not upcase))))
string))
"StAcKoVeRfLoW"
(defun mockify (chars)
(let ((lst (coerce chars 'list)))
(if (equal lst nil)
;; return nil
nil
;; return a string (coerce)
(coerce
;; a list whose elements are cons-cells, but ...
(cons (cons (char-upcase (car lst))
(char-downcase (cadr lst)))
;; ... the rest is computed by calling mockify,
;; which returns either an empty list or a string
(mockify (cddr lst)))
'string))))
The types of your expressions are confusing, and in fact your example leads to an error when using SBCL:
> (mockify "meow")
The value
(#\O . #\w)
is not of type
CHARACTER
when setting an element of (ARRAY CHARACTER)
[Condition of type TYPE-ERROR]
Also, you are going to have to handle corner cases in your code, because as is, it is possible that (cadr list), i.e. (second list), is called on a list that has only one element. Then, the result would be NIL and char-downcase would fail with an error.
Using only strings
I'd suggest writing a version of the function that does not use intermediate lists:
let R be the string-downcase of the whole string
then modify every other character of R by upcasing it
So for example, one way to do it (among others) would be:
(defun mockify (chars)
(let ((chars (string-downcase chars)))
(prog1 chars
(upcasify chars 0))))
(defun upcasify (string index)
(when (< index (length string))
(setf (char string index) (char-upcase (char string index)))
(upcasify string (+ index 2))))
Using only lists
If you prefer having a recursive function that processes lists, I'd rather define it in layers:
coerce string to list
process the list recursively
eventually, coerce the resulting list back to a string
This will avoid doing conversions from strings to lists at every step, and make the code simpler at each level.
(defun mockify (chars)
(coerce (mockify-list (coerce chars 'list)) 'string))
(defun mockify-list (chars)
...)
The list version is recursive and look like what you tried to do, but take care of corner cases.
There is more than one way to do it. Here is a loop based solution:
(let ((string "StackOverflow"))
(with-output-to-string (s)
(loop :for c :across string
:for up := t :then (not up)
:do (princ (if up
(char-upcase c)
(char-downcase c))
s))))
Fun thing - I actually wrote a similar thing some time ago.
https://github.com/phoe/string-pokemonize
I am trying to modify this function in a way that when given a list it will only keep the words ending with a given letter. I have few restriction on what I am allowed to use and needs to keep char,rplacd and length to do it. I'm now having difficulties with the 'length ' part. I initially manage to do it in a way that it would keep all words starting with given letter but I am having trouble doing the opposite in line 5.
(setq liste '(have read nose art silence))
I would get the following result
(endingwith 'e liste) => (have nose silence)
(defun endingwith (x liste)
(cond
((not liste) nil)
((equal
(char (string (length (car liste))) 0)
(char (string x) 0) )
(rplacd liste (endingwith x (cdr liste))) )
(t (endingwith x (cdr liste))) ) )
Note that the task you have been given teaches a style of Lisp programming which is in the real world not used.
we need to operate of strings, which are vectors of characters
we can use the standard function remove
destructively changing a list is sometimes useful but can be avoided. See delete for a destructive version of remove
Example:
(defun keep-symbols-ending-with-char (char symbols)
"returns a sequence, where all symbols end with the given char"
(when (symbolp char)
(setf char (char (symbol-name char) 0)))
(remove char
symbols
:test-not #'eql
:key (lambda (item &aux (string (symbol-name item)))
(char string (1- (length string))))))
CL-USER> (keep-symbols-ending-with-char 'e '(have read nose art silence))
(HAVE NOSE SILENCE)
Given the limited resources you are given, this calls for a recursive solution. The value of (endingwith 'e liste) should be defined in terms of the value of calling endingwith with the rest of the list, and adding or not the first element if it matches 'e.
Further notice that in your case, length should be used with a string, so use (length (string (car liste))) instead of (string (length (car liste))).
The function would look like this:
(defun endingwith (x liste)
(cond
((not liste) nil)
((eql (char (string x) 0) (char (string (car liste)) (- (length (string (car liste))) 1)))
(cons (car liste) (endingwith x (cdr liste))) )
(t (endingwith x (cdr liste))) ))
Some points of style: don't use (not liste); instead use either (null liste) or (endp liste) which emphasize that liste is either an empty list, or that processing has reached the end of liste, respectively. Also, use '() when the intention is to represent an empty list; use nil when the intention is to represent boolean False.
The elements of liste are symbols, and x itself is a symbol; these symbols need to be converted to sequences so that the final character of the symbol can be assessed. string will do the job. But OP code has two problems here: length takes a sequence argument, so the value of (car liste) must also be converted using string; and sequences are zero-indexed in Common Lisp, so the last index of a sequence is one less than its length.
(defun endingwith (x liste)
(cond
((null liste) '())
((equal (char (string (car liste))
(- (length (string (car liste))) 1))
(char (string x) 0))
(rplacd liste (endingwith x (cdr liste))))
(t
(endingwith x (cdr liste)))))
One way to debug programs like this in Common Lisp is to get into the REPL and experiment. When you use a function and it sends you to the debugger, look for lines in that function that may have problems.
In the posted code, (char (string (length (car liste))) 0) is the first likely candidate. Try (car liste) at the REPL and see if that evaluates to 'HAVE as expected. When it does, try (length (car liste)). That will send you to the debugger again with a type error and a message like
LENGTH: HAVE is not a SEQUENCE.
This suggests that you need to use (string (car liste)) in the same way that (string x) is used in the next line of the original function definition. So, try (length (string (car liste))) at the REPL. Now you should see the expected value of 4, but it becomes apparent that the original line of code was a bit jumbled up, because char wants the first argument to be a string, and the second argument to be an index. So try again at the REPL (char (string (car liste)) (length (string (car liste)))). This again lands us in the debugger with a message like:
CHAR: index 4 should be less than the length of the string.
But that message reminds us that sequences are zero-indexed in Common Lisp, and that the last index of a string of length 4 is 3. So, once again at the REPL: (char (string (car liste)) (- (length (string (car liste))) 1)). Now we have success, with the REPL returning the expected #\E. Having worked through this problematic line at the REPL, we can now replace the line in the original function definition and see if that works. It does.
(defun ends-with-p (end s)
(string= end (subseq s (- (length s) (length end)))))
(defun keep-ending-with (end strings)
(remove-if-not #'(lambda (x) (ends-with-p end x)) strings))
I have a line like "fun,arg1,arg2" <- it is a string
I split this string into list of strings by "," separator. Then I compare "fun" with some string (e.g. "Fibonacci").
Function for splitting (works fine)
(defun split-str (string &optional (r nil))
(let ((n (position "," string
:from-end t
:test #'(lambda (x y)
(find y x :test #'string=)))))
(if n
(split-str (subseq string 0 n)
(cons (subseq string (1+ n)) r))
(cons string r))))
Test function
(defun tmp (a)
(if (string= (nth 0 a) "Fibonacci")
(progn
(setf tab '())
(dolist (n (cdr a))
(cons tab '(parse-integer n))) ; parsing works fine (checked with write)
(write tab)) ; always NIL
;(apply #'parse-integer (apply #'values a)) - doesn't work
(write "nok")))
Calling:
(tmp (split-str "Fibonacci,15,33"))
Why my tab hasn't 2 elements?
cons doesn't change anything; it returns a new list using tab.
I need a way to suppress any error messages raised when parsing code using read-from-string so that I can read from Clojure code using something like this:
(let* ((string-with-code " '(func UpperCase \"string\")")
(brace-pos (position #\( string-with-code))
(end-of-token (+ brace-pos
(position #\Space (subseq string-with-code brace-pos))))
(first-token (subseq string-with-code (incf brace-pos) end-of-token)))
(format t "Found function: '~a'"
(read-from-string first-token)))
;; ==> Found function: 'func'
It basically prints the function name from the lisp code in the string. It works Ok until you try to use the dot operator(.) as the first item in the list. Clojure uses the . both to cons and to access classes in a Java package and hence valid code like:
(defmacro chain
([x form] `(. ~x ~form))
([x form & more] `(chain (. ~x ~form) ~#more)))
would cause an error:
*** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here
if I were to walk it printing every function in the code. I want a way to ignore/suppress the error messages from read-from-string for this code to work preferably without modifying the way the lisp reader works.
EDIT :
A complete program:
(defvar string-with-code "(defmacro chain
([x form] `(d ~x ~form))
([x form & more] `(chain (. ~x ~form) ~#more)))
")
(defvar end-of-token 0)
(defvar first-token 0)
(defun functions-in-string (code)
(let ((bpos (position #\( code)))
(unless (null bpos)
(setq end-of-token (+ bpos (position #\Space (subseq code bpos))))
(setq first-token (subseq code (incf bpos) end-of-token))
(ignore-errors
(format t "Found function: '~(~A~)'~%" (read-from-string first-token)))
(functions-in-string (subseq code end-of-token)))))
;; (ignore-errors
;; (functions-in-string 0 code))
(functions-in-string string-with-code)
OUTPUT :
Found function: 'defmacro'
Found function: '[x'
Found function: 'd'
Found function: '[x'
Found function: 'chain'
;; You'll get the error below if ignore-errors wraps around the function call
;; *** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here
Not clear what you are asking, but ignoring errors simply is:
CL-USER 37 > (ignore-errors (read-from-string "(. foo bar)"))
NIL
#<CONDITIONS:SIMPLE-READER-ERROR 402000243B>
In case of an error, IGNORE-ERRORS returns NIL and as the second return value the condition.
If you want more control, you would need to write an error handler.
Here's a start for Clojure yacc parsers. This needs more attention from you to deal with special Clojure reader macros and possibly ensure some other grammar aspects, but this is already a functioning start:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun print-args (&rest args) (format nil "~{~a~^ ~}" args) ))
(defun clojure-lexer (stream)
(let ((digits '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
(translations (make-hash-table)))
(loop :for (key . value) :in
'((#\( . oparen)
(#\) . cparen)
(#\[ . obracket)
(#\] . cbracket)
(#\' . squote)
(#\` . accent)
(#\: . colon)
(#\, . comma)
(#\# . at)) :do
(setf (gethash key translations) value))
(labels ((%reverse-coerce (collected)
(coerce (nreverse collected) 'string))
(%read-token ()
(loop
:with collected := nil
:and stringp := nil
:and commentp := nil
:for token := (read-char stream nil nil) :do
(cond
((null token)
(return (and collected (%reverse-coerce collected))))
((char= token #\;)
(push token collected)
(setf commentp t))
((char= token #\")
(if commentp
(push token collected)
(if stringp
(progn
(push token collected)
(return (%reverse-coerce collected)))
(if collected
(progn
(unread-char token)
(return (%reverse-coerce collected)))
(progn
(push token collected)
(setf stringp t))))))
((gethash token translations)
(if (or stringp commentp)
(push token collected)
(if collected
(progn
(unread-char token stream)
(return (%reverse-coerce collected)))
(return (gethash token translations)))))
((member token '(#\Newline #\Rubout))
(if commentp
(return (and collected (%reverse-coerce collected)))
(if stringp
(push token collected)
(and collected (return (%reverse-coerce collected))))))
((member token '(#\Space #\Tab))
(if (or stringp commentp)
(push token collected)
(and collected (return (%reverse-coerce collected)))))
(t (push token collected))))))
(lambda ()
(let* ((key (%read-token))
(value (or (gethash key translations) key)))
(if (null key)
(values nil nil)
(let ((terminal
(cond
((member key '(oparen cparen squote colon accent
comma at obracket cbracket))
key)
((or (member (char key 0) digits)
(and (char= (char key 0) #\-)
(> (length key) 1)
(member (char key 1) digits)))
'number)
((char= (char key 0) #\") 'string)
((char= (char key 0) #\;) 'comment)
(t 'id))))
(values terminal value))))))))
(yacc:define-parser *clojure-parser*
(:start-symbol exp)
(:terminals (id oparen cparen squote colon accent
comma at obracket cbracket string number))
(exp
(oparen id exp-list cparen #'print-args)
(oparen id cparen #'print-args)
(obracket exp-list cbracket #'print-args)
(obracket cbracket #'print-args)
(comment #'print-args)
(accented-exp #'print-args)
(quoted-exp #'print-args)
(term #'print-args))
(term id string number)
(quoted-exp (quote exp))
(accented-exp (accent exp) (accent at exp))
(exp-list (exp exp-list) exp))
(defun parse-clojure (string)
(yacc:parse-with-lexer
(clojure-lexer (make-string-input-stream string)) *clojure-parser*))
(parse-clojure
"(defn str-invoke [instance method-str & args]
(clojure.lang.Reflector/invokeInstanceMethod
\"instance\" 123
method-str
(to-array args)))")
Results in:
;; "OPAREN defn (str-invoke
;; (OBRACKET (instance (method-str (& args))) CBRACKET
;; OPAREN clojure.lang.Reflector/invokeInstanceMethod (\"instance\"
;; (123
;; (method-str
;; OPAREN to-array args CPAREN))) CPAREN)) CPAREN"
Here's the BNF for the above grammar (not claiming it is the Clojure grammar, it only reflects the Lisp code above):
exp ::= '(' id exp-list ')'
| '(' id ')'
| '[' exp-list ']'
| '[' ']'
| ';' /[^\n]*/
| accented-exp
| quoted-exp
| term
term ::= id | '"' /[^"]*/ '"' | /-?[0-9][^\s]+/
quoted-exp ::= '\'' exp
accented-exp ::= '`' exp | '`' '#' exp
exp-list ::= exp exp-list | exp
id ::= /[^()[\]:,`#']+/
For simplicity, some parts are given as regular expressions, those are delimited by //.
I would like to export from Org-Mode tables to s-expressions.
| first | second | thrid |
|--------+--------+--------|
| value1 | value2 | value3 |
| value4 | value5 | value6 |
Would turn into:
((:FIRST "value1" :SECOND "value2" :THIRD "value3")
(:FIRST "value4" :SECOND "value5" :THIRD "value6"))
I plan on writing such a setup if it doesn't exist yet but figured I'd tap into the stackoverflow before I start reinventing the wheel.
This does the trick. It has minimal error checking.
The interface to use is either the programmatic interface:
(org-table-to-sexp <location-of-beginning-of-table> <location-of-end-of-table>)
In which case it'll return the sexp you requested.
If you wanted an interactive usage, you can call the following command to operate on the table in the region. So, set the mark at the beginning of the table, move to the end, and type:
M-x insert-org-table-to-sexp
That will insert the desired sexp immediately after the table in the current buffer.
Here is the code:
(defun org-table-to-sexp-parse-line ()
"Helper, returns the current line as a list of strings"
(save-excursion
(save-match-data
(let ((result nil)
(end-of-line (save-excursion (end-of-line) (point))))
(beginning-of-line)
(while (re-search-forward "\\([^|]*\\)|" end-of-line t)
(let ((match (mapconcat 'identity (split-string (match-string-no-properties 1)) " ")))
(if (< 0 (length match))
;; really want to strip spaces from front and back
(push match result))))
(reverse result)))))
(require 'cl)
(defun org-table-to-sexp (b e)
"Parse an org-mode table to sexp"
(save-excursion
(save-match-data
(goto-char b)
(let ((headers (mapcar
(lambda (str)
(make-symbol (concat ":" (upcase str))))
(org-table-to-sexp-parse-line)))
(sexp nil))
(forward-line 1) ;skip |--+--+--| line
(while (< (point) e)
(forward-line 1)
(let ((line-result nil))
(mapcar* (lambda (h e)
(push h line-result)
(push e line-result))
headers
(org-table-to-sexp-parse-line))
(if line-result
(push (reverse line-result)
sexp))))
sexp))))
(defun insert-org-table-to-sexp (b e)
"Convert the table specified by the region and insert the sexp after the table"
(interactive "r")
(goto-char (max b e))
(print (org-table-to-sexp b e) (current-buffer)))