Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Live coding session at Lisp Meet Up #8 Devide the resulst of ``ls -l'' command into 2 sets by modulo 2 of the 2nd column (hard link count field) and sum up the 5th field (byte size field) of each set. Following code is available only for SBCL because PAPPLY macro depends on SB-C package.
(defparameter *sample*
(butlast (cdr (maplist (lambda (lst)
(when (cadr lst)
(subseq (str<-textfile "sample")
(1+ (car lst))
(cadr lst))))
(cons -1 (position-list #\Newline (str<-textfile "sample")))))))
(ql:quickload :split-sequence)
(let (even-set odd-set)
(dolist (line *sample*)
(let ((aline (remove "" (split-sequence:split-sequence #\Space line) :test #'equal)))
(cond ((evenp (parse-integer (second aline)))
(push (fifth aline) even-set))
((oddp (parse-integer (second aline)))
(push (fifth aline) odd-set))
(t 'YOU-ARE-STUPID!))))
(list (reduce (papply (+ _ (parse-integer _)))
(cdr even-set)
:initial-value (parse-integer (car even-set)))
(reduce (papply (+ _ (parse-integer _)))
(cdr odd-set)
:initial-value (parse-integer (car odd-set)))))
total 400
drwxr-xr-x 11 chiku staff 374 8 12 13:19 GLES20
drwxr-xr-x 3 chiku staff 102 7 14 18:12 Haskell
drwxr-xr-x 12 chiku staff 408 7 14 18:22 L5
drwxr-xr-x 30 chiku staff 1020 7 14 18:19 OCaml
drwxr-xr-x 3 chiku staff 102 8 16 05:12 R
drwxr-xr-x 6 chiku staff 204 7 14 18:24 androidccl
drwxr-xr-x 3 chiku staff 102 7 14 18:12 clojure
drwxr-xr-x 6 chiku staff 204 7 14 18:17 completion-driver
drwxr-xr-x 12 chiku staff 408 7 14 18:17 gwt-bvh
drwxr-xr-x 3 chiku staff 102 7 14 18:12 html
drwxr-xr-x 3 chiku staff 102 7 14 18:12 javascript
drwxr-xr-x 43 chiku staff 1462 8 26 20:28 lisp
drwxr-xr-x 4 chiku staff 136 7 14 18:17 p-parser
drwxr-xr-x 3 chiku staff 102 7 14 18:12 perl
drwxr-xr-x 8 chiku staff 272 7 14 18:16 postscript
drwxr-xr-x 20 chiku staff 680 7 14 18:15 practicals-1.0.3
-rw-r--r-- 1 chiku staff 204800 12 18 2012 practicals-1.0.3.tar.gz
drwxr-xr-x 17 chiku staff 578 7 14 18:29 rlwrap-filters
drwxr-xr-x 5 chiku staff 170 8 26 20:28 scheme
drwxr-xr-x 9 chiku staff 306 7 14 18:19 screen
drwxr-xr-x 4 chiku staff 136 7 14 18:13 sh
drwxr-xr-x 6 chiku staff 204 7 15 00:04 sqlite3
drwxr-xr-x 3 chiku staff 102 8 16 10:22 vimscript
(defun concat-str (&rest strs)
(apply #'concatenate (cons 'string strs)))
(defun str<-textfile (filename &optional (omit-pred #'null))
" The parameter ``omit-pred'' is used as a predicator for line-wise
checking of taking that line or not."
(with-open-file (in filename :direction :input)
(when in
(do ((line (read-line in nil nil) (read-line in nil nil))
(str ""))
((null line) str)
(unless (funcall omit-pred line)
(setf str (concat-str str line (string #\newline))))))))
(defun position-list (item seq &key (key #'identity) (test #'eql))
(labels ((rec (s acc)
(let ((pos (position item s :key key :test test)))
(if pos
(rec (subseq s (1+ pos)) (cons (1+ pos) acc))
(nreverse (maplist #'(lambda (x) (reduce #'+ x)) acc))))))
(rest (rec seq (list -1)))))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun maptree (func tree &key (pred #'atom))
(if (funcall pred tree) (funcall func tree)
(mapcar #'(lambda (x) (maptree func x :pred pred)) tree))))
(defmacro with-tree-leaves (tree test-form result-form)
`(maptree (lambda (leaf) (if ,test-form ,result-form leaf)) ,tree))
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,@body))
(defun last1 (lst) (car (last lst)))
(defmacro dequeue! (lst)
(with-gensyms (alt-lst)
`(let ((,alt-lst ,lst))
(prog1 (last1 ,alt-lst)
(setf ,alt-lst (butlast ,alt-lst))
(setf ,lst ,alt-lst)))))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun count-underscore (tree)
(let ((c 0))
(with-tree-leaves tree (eq leaf '_) (incf c))
c)))
(defmacro papply-listup-format (fn &rest applying-args &environment env)
(let* ((gensym-lst)
(body (with-tree-leaves applying-args
(eq leaf '_)
(car (push (gensym "PARG") gensym-lst)))))
(with-gensyms (not-applied-args)
`(lambda (,@(mapcan (lambda (x)
(loop repeat (count-underscore x)
collect (dequeue! gensym-lst)))
applying-args)
&rest ,not-applied-args)
(apply
,(if (symbolp fn)
(if (member fn (sb-c::lexenv-vars env) :key #'car :test #'eq)
fn `#',fn)
fn)
,@body ,not-applied-args)))))
(defmacro papply-form-format ((op &rest applying-args))
`(papply-listup-format ,op ,@applying-args))
(defmacro papply (&rest op-and-args)
" papply (op &rest applying-args) => function ;{{{
papply op &rest applying-args => function
op : a symbol or function object.
applying-args : objects.
function : a function object.
This macro basically generates a function object by applying the first
m argument of ``op'' to ``applying-args.'' m is the number of elemetns
in ``applying-args'' except the symbol ``_''.
Special symbol ``_'' works as the place holder for not-yet-applied
arguments. The nth ``_'' is replaced by the nth argument of the result
function object. The order is from left to right. In other terminology,
depth-first-order.
Symbols are valid to be specified to ``op.'' If a symbol is given
for ``op'', then normaly it is treated as a symbol of a function.
But if the symbol is a variable which is lexically bound, then it is
treated as a variable. If you want to pass the function which is
indicated by that symbol in such a case, use function object instaed
of symbol (just put #' in front of the symbol).
This macro accepts 2 different format. One is called ``form format''
because it seems like one form:
(papply (cons (+ 1 _)))
The another format is called ``listup format'' because it list up
the function and its argument one by one:
(papply #'cons (+ 1 _))
Both of them accepts some more variations. As described above, ``op''
can be a symbol that denotes a (globally defined) function or a symbol
that is used as a lexical variable and bound to a function object.
Thus, all follwing format is the same thing.
(papply (cons (+ 1 _)))
(papply (#'cons (+ 1 _)))
(let ((- #'cons))
(papply (- (+ 1 _))))
(papply #'cons (+ 1 _))
(papply cons (+ 1 _))
(let ((- #'cons))
(papply - (+ 1 _)))
;}}}"
(cond ((or (atom (car op-and-args)) (eq (caar op-and-args) 'function))
`(papply-listup-format ,(car op-and-args) ,@(cdr op-and-args)))
(t `(papply-form-format ,@op-and-args))))
@fukamachi
Copy link

fukamachi commented Aug 30, 2013

Though I don't know how much time have you spent to write this code, this has some problems about performance.

  1. You should use CL-PPCRE for spliting columns instead for SPLIT-SEQUENCE & remove.
  2. Too many looping (dolist, remove in dolist and 2 reduces). You can choose cl:loop unless you don't like it.

I wrote it by myself. This doesn't think whether the hard link count is odd or even, but it might be helpful to you.

https://gist.github.com/fukamachi/6348230

@chiku-samugari
Copy link
Author

chiku-samugari commented Aug 30, 2013

Thanks a lot for your participation and comment. We are sorry to make an error in the announcement of the exercise.

Your opinion is pretty right and practical. The first reason why I didn't use CL-PPCRE is quite easy; I don't like to use libraries if the scene doesn't requires serious things, though I finally use SPLIT-SEQUENCE library and broke the mantra...
In addition, the first coder at the live coding session has already used regular expression and I didn't want to adopt the same approach.

.2. seems rough a little bit. REMOVE in DOLIST should be eliminated by a better algorithm (e.g. regular expression), REDUCE should be replaced by (APPLY #'+ or change the approach to sum up the value immediately. Both problems do not come from the selection of loop syntax.
I guess that the code could become more clearly when we utilize LOOP, and I believe your code shows this point.
As you mentioned, I don't like LOOP so much.

@fukamachi
Copy link

fukamachi commented Aug 30, 2013

Ah, I'd forgotten split-sequence has a keyword arg :remove-empty-subseqs. It is the exact thing we're looking for.

(split-sequence #\Space "drwxr-xr-x  11 chiku  staff     374  8 12 13:19 GLES20" :remove-empty-subseqs t)
;=> ("drwxr-xr-x" "11" "chiku" "staff" "374" "8" "12" "13:19" "GLES20")
;   54

@chiku-samugari
Copy link
Author

chiku-samugari commented Aug 30, 2013

That's it! I've never noticed that parameter.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment