From: Tel A.
Subject: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <1145770142.957764.127080@z34g2000cwc.googlegroups.com>
I've just written a solution to a Ruby Quiz
(http://www.rubyquiz.com/quiz76.html) in Lisp. I'm rather new with the
language, and atop that even I can envision fixes, but I want to see
what people think about it. I feel as though I did a lot of extra work
processing these strings.

What is stylistically tactful, or, more likely, a complete stylistic
flop? Where can I improve speed or functionality? Anything you just
hate?

Here's the code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun non-word-char-p (char)
  (some (lambda (x)
	  (eq char x))
	'(#\  #\- #\. #\, #\? #\! #\. #\( #\) #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8
#\9 #\0
	  #\~ #\` #\& ··@ #\# #\$ #\% #\^ #\* #\+ #\_)))

(defun group-word (lst &optional (acc nil))
  (let ((f (car lst))
	(r (cdr lst)))
       (cond ((or (non-word-char-p f)
		  (null f))
	      (values (nreverse acc)
		      (append (list f) r)))
	     (t (group-word (cdr lst) (cons f acc))))))

(defun group-words (lst &optional (acc nil))
  (cond ((null (car lst)) (nreverse acc))
	((non-word-char-p (car lst)) (group-words (cdr lst) (push (car lst)
acc)))
	(t (multiple-value-bind (word remains) (group-word lst)
	     (group-words remains (push word acc))))))

(defun explode-text (str)
  (group-words (coerce str 'list)))

(defun process-explosion (lst &optional (acc nil))
  (let ((f (car lst))
	(r (cdr lst)))
    (cond ((consp f)      (process-explosion r (push (mungle-list f)
acc)))
	  ((characterp f) (process-explosion r (push f acc)))
	  ((null f)       (nreverse acc))
	  (t              (error "List can only contain conses and
characters.")))))

(defun shuffle (list)

;; Shamelessly lifted from code by Paul Nielsen.
;; http://groups.google.com/group/comp.lang.lisp/browse_thread/
;;  thread/644f8d6c65e01051/5c1899db24280cca

  (let ((vector (coerce list 'simple-vector)))
    (loop for i fixnum from (length vector) downto 2
          do (rotatef (svref vector (1- i)) (svref vector (random i))))

    (coerce vector 'list)))

(defun mungle-list (lst)
  (let ((f (first lst))
	(l (last lst)))
    (concatenate 'list (list f) (shuffle (subseq lst 1 (1- (length
lst)))) l)))

(defun flatten (my-list)
  (cond ((null my-list) nil)
        ((atom my-list) (list my-list))
        (t (append (flatten (first my-list))
                   (flatten (rest my-list))))))


;; Finally

(defun mungle (str)
  (coerce (flatten (process-explosion (explode-text str))) 'string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Thanks!

From: Bill Atkins
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <874q0kojg4.fsf@rpi.edu>
"Tel A." <············@gmail.com> writes:

> I've just written a solution to a Ruby Quiz
> (http://www.rubyquiz.com/quiz76.html) in Lisp. I'm rather new with the
> language, and atop that even I can envision fixes, but I want to see
> what people think about it. I feel as though I did a lot of extra work
> processing these strings.
>
> What is stylistically tactful, or, more likely, a complete stylistic
> flop? Where can I improve speed or functionality? Anything you just
> hate?
>
> Here's the code:
>
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>
> (defun non-word-char-p (char)
>   (some (lambda (x)
> 	  (eq char x))
> 	'(#\  #\- #\. #\, #\? #\! #\. #\( #\) #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8
> #\9 #\0
> 	  #\~ #\` #\& ··@ #\# #\$ #\% #\^ #\* #\+ #\_)))

  ;; strictly speaking, using EQ above is not guaranteed work; you should use EQL or
  ;; CHAR=

  (defun non-word-char-p (char)
    (member char '(#\- .... )
            :test #'char=))

  ;; is that initial #\ a typo?

>
> (defun group-word (lst &optional (acc nil))
>   (let ((f (car lst))
> 	(r (cdr lst)))
>        (cond ((or (non-word-char-p f)
> 		  (null f))
> 	      (values (nreverse acc)
> 		      (append (list f) r)))
> 	     (t (group-word (cdr lst) (cons f acc))))))

  ;; avoid aliasing the CAR and CDR of a list; also, check for (null f)
  ;; before you check if it's a char -> (or (null f) (non-word-char-p f))

> (defun group-words (lst &optional (acc nil))
>   (cond ((null (car lst)) (nreverse acc))
> 	((non-word-char-p (car lst)) (group-words (cdr lst) (push (car lst)
> acc)))
> 	(t (multiple-value-bind (word remains) (group-word lst)
> 	     (group-words remains (push word acc))))))
>
> (defun explode-text (str)
>   (group-words (coerce str 'list)))
>
> (defun process-explosion (lst &optional (acc nil))
>   (let ((f (car lst))
> 	(r (cdr lst)))
>     (cond ((consp f)      (process-explosion r (push (mungle-list f)
> acc)))
> 	  ((characterp f) (process-explosion r (push f acc)))
> 	  ((null f)       (nreverse acc))
> 	  (t              (error "List can only contain conses and
> characters.")))))

   ;; the ETYPECASE macro will compare the type of its argument to the
   ;; clauses

   (defun process-explosion (list &optional (acc nil))
     (etypecase (car list)
       (cons (process-explosion (cdr list) (push (mungle-list f) acc)))
       (character (process-explosion r (push f acc)))))

   ;; ETYPECASE will automatically signal an error if it can't match the type

> (defun shuffle (list)
>
> ;; Shamelessly lifted from code by Paul Nielsen.
> ;; http://groups.google.com/group/comp.lang.lisp/browse_thread/
> ;;  thread/644f8d6c65e01051/5c1899db24280cca
>
>   (let ((vector (coerce list 'simple-vector)))
>     (loop for i fixnum from (length vector) downto 2
>           do (rotatef (svref vector (1- i)) (svref vector (random i))))
>
>     (coerce vector 'list)))



> (defun mungle-list (lst)
>   (let ((f (first lst))
> 	(l (last lst)))
>     (concatenate 'list (list f) (shuffle (subseq lst 1 (1- (length
> lst)))) l)))

  ;; a more descriptive name would improve this
  (defun mungle-list (lst)
    (cons (first list) (shuffle (subseq lst 1 (1- (length lst)))))

> (defun flatten (my-list)
>   (cond ((null my-list) nil)
>         ((atom my-list) (list my-list))
>         (t (append (flatten (first my-list))
>                    (flatten (rest my-list))))))

  ;; you can cut down (very) slightly on generated garbage with:
  (defun flatten (list)
    (cond ((null list) nil)
          ((consp (car list))
           (append (flatten (car list)) (flatten (cdr list))))
          (t (cons (car list) (flatten (cdr list))))))
  ;; you save one cons cell per atom  by avoiding the call to list

>
> ;; Finally
>
> (defun mungle (str)
>   (coerce (flatten (process-explosion (explode-text str))) 'string))

  ;; why is this called MUNGLE?
  (defun mungle (str)
    (princ-to-string (flatten (process-explosion (explode-text str)))))

> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>
> Thanks!
>

All code untested!

Using F and R to alias the car and cdr of a list is probably not
necessary.  Instead of coercing strings to lists, you could just use
the CHAR and SCHAR operators on the string.  Recursion is not always
the best way to solve a problem in Common Lisp.  Sometimes looping can
be clearer; the accumulator idiom could probably be wiped out, as it
takes a lot more figuring out than a LOOP.  There's no need to name
variables lst or my-list; unlike Scheme, it's acceptable and perfectly
normal to name a variable LIST.  Your code makes use of lists in ways
that probably aren't totally appropriate, so a lot of the coercions
you're using could be eliminated.  It is common when first starting to
use Lisp or Scheme to use the list structure in places where it isn't
the best possible choice.

Happy lisping!

-- 

"...and when, another time, I discovered that he considered not
unworthy of reflection in one of those mirrors of absolute truth which
were his writings a remark similar to one which I had had occasion to
make about our friend M. Legrandin, ...then it was suddenly revealed
to me that my own humble existence and the realms of the true were
less widely separated than I had supposed, that at certain points they
actually collided, and in my newfound confidence and joy, I had wept
upon his printed page as in the arms of a long-lost father."
From: Timofei Shatrov
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <444b44ed.5661360@news.readfreenews.net>
On Sun, 23 Apr 2006 03:11:07 -0400, Bill Atkins <············@rpi.edu>
tried to confuse everyone with this message:

>"Tel A." <············@gmail.com> writes:
>
>> I've just written a solution to a Ruby Quiz
>> (http://www.rubyquiz.com/quiz76.html) in Lisp. I'm rather new with the
>> language, and atop that even I can envision fixes, but I want to see
>> what people think about it. I feel as though I did a lot of extra work
>> processing these strings.
>>
>> What is stylistically tactful, or, more likely, a complete stylistic
>> flop? Where can I improve speed or functionality? Anything you just
>> hate?
>>
>> Here's the code:
>>
>> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>>
>> (defun non-word-char-p (char)
>>   (some (lambda (x)
>> 	  (eq char x))
>> 	'(#\  #\- #\. #\, #\? #\! #\. #\( #\) #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8
>> #\9 #\0
>> 	  #\~ #\` #\& ··@ #\# #\$ #\% #\^ #\* #\+ #\_)))
>
>  ;; strictly speaking, using EQ above is not guaranteed work; you should use EQL or
>  ;; CHAR=
>
>  (defun non-word-char-p (char)
>    (member char '(#\- .... )
>            :test #'char=))
>
>  ;; is that initial #\ a typo?
>

This is actually a legal representation of the space character. Of
course #\Space is much better for readability.

-- 
|WAR HAS NEVER SOLVED ANYTHING|,----- Timofei Shatrov aka Grue---------.
|(except for ending slavery,  ||mail: grue at mail.ru ================ |
|   fascism and communism)    ||============= http://grue3.tripod.com  |
|...and Saddam's dictatorship |`----------------------------------[4*72]
From: Tayssir John Gabbour
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <1145804735.560393.284110@g10g2000cwb.googlegroups.com>
Tel A. wrote:
> I've just written a solution to a Ruby Quiz
> (http://www.rubyquiz.com/quiz76.html) in Lisp. I'm rather new with the
> language, and atop that even I can envision fixes, but I want to see
> what people think about it. I feel as though I did a lot of extra work
> processing these strings.
>
> What is stylistically tactful, or, more likely, a complete stylistic
> flop? Where can I improve speed or functionality? Anything you just
> hate?

Hi Tel,

Here's one possible way to write it, sucking in words and spitting them
out scrambled. I hope this isn't too loop-heavy for you to read:

;; ---------------------------
(defun text-munger (in out)
  "Solves Ruby Quiz at http://www.rubyquiz.com/quiz76.html

IN and OUT are character streams."
  (loop while (peek-char nil in nil)
        do (write-string (read-text in (complement #'alphanumericp))
out)
        do (write-string (scramble (read-text in #'alphanumericp))
out)))

(defun read-text (in char-predicate)
  "Read characters from IN while CHAR-PREDICATE is satisfied."
  (with-output-to-string (out)
    (loop for char = (peek-char nil in nil)
          while (and char (funcall char-predicate char))
          do (read-char in nil nil)
          do (write-char char out))))

(defun scramble (word)
  (loop for i from (1- (length word)) downto 3
        do (rotatef (aref word (1- i))
                    (aref word (1+ (random (1- i)))))
        finally (return word)))
;; ---------------------------

As Duane Rettig once pointed out, we could ask, "Where do we expect to
get these strings?" Oftentimes they're from streams: maybe from a file,
*standard-input*, with-input-from-string, etc. An added bonus is the
memory consumption isn't expected to be bad on large files, unless
we're faced with malicious or otherwise messed-up data.


(defun test (text)
  (with-input-from-string (in text)
    (with-output-to-string (out)
      (text-munger in out))))

CL-USER> (test "foobar. This is perhaps a test.")
"faoobr. Tihs is perphas a test."


Tayssir
From: Tayssir John Gabbour
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <1145822917.517488.143340@g10g2000cwb.googlegroups.com>
Tayssir John Gabbour wrote:
> (defun text-munger (in out)
>   "Solves Ruby Quiz at http://www.rubyquiz.com/quiz76.html
>
> IN and OUT are character streams."
>   (loop while (peek-char nil in nil)
>         do (write-string (read-text in (complement #'alphanumericp))
>                          out)
>         do (write-string (scramble (read-text in #'alphanumericp))
>                          out)))

Excuse me, I meant alpha-char-p rather than alphanumericp.
From: Rainer Joswig
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <joswig-C6C030.08494723042006@news-europe.giganews.com>
In article <························@z34g2000cwc.googlegroups.com>,
 "Tel A." <············@gmail.com> wrote:

> I've just written a solution to a Ruby Quiz
> (http://www.rubyquiz.com/quiz76.html) in Lisp. I'm rather new with the
> language, and atop that even I can envision fixes, but I want to see
> what people think about it. I feel as though I did a lot of extra work
> processing these strings.
> 
> What is stylistically tactful, or, more likely, a complete stylistic
> flop? Where can I improve speed or functionality? Anything you just
> hate?

You should just work on strings. All this list processing is not
needed.

Your code uses recursion for processing the lists. In plain Common Lisp
this means that the stack may blow out on longer input.

APPEND in recursive calls is always a sign that something
is inefficient.

Conversion of strings to lists back and forth is also a sign
that something is wrong. For many cases the list is less
efficient than a vector (especially when the data stays
somehow in place without changing the vector's length like here).

See MEMBER instead of SOME.
See ALPHA-CHAR-P.
See DESTRUCTURING-BIND.
See LOOP.
See the chapter in the Hyperspec on sequences. The stuff works on
both vectors (say, strings) and lists.

Documentation for functions is a cool feature.
Check your input, if this would be useful.

(defun do-this-carefully-with-string (a-string)
   "This operation takes a string and does ....
It returns ...
Side effects are ...."
  (check-type a-string string)
  (assert (and (> (length a-string) 1) (char= (aref a-string 0) #\a))
          (a-string)
          "String \"~a\" does not start with the letter a." a-string)
  ...
)



> 
> Here's the code:
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> 
> (defun non-word-char-p (char)
>   (some (lambda (x)
> 	  (eq char x))
> 	'(#\  #\- #\. #\, #\? #\! #\. #\( #\) #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8
> #\9 #\0
> 	  #\~ #\` #\& ··@ #\# #\$ #\% #\^ #\* #\+ #\_)))
> 
> (defun group-word (lst &optional (acc nil))
>   (let ((f (car lst))
> 	(r (cdr lst)))
>        (cond ((or (non-word-char-p f)
> 		  (null f))
> 	      (values (nreverse acc)
> 		      (append (list f) r)))
> 	     (t (group-word (cdr lst) (cons f acc))))))
> 
> (defun group-words (lst &optional (acc nil))
>   (cond ((null (car lst)) (nreverse acc))
> 	((non-word-char-p (car lst)) (group-words (cdr lst) (push (car lst)
> acc)))
> 	(t (multiple-value-bind (word remains) (group-word lst)
> 	     (group-words remains (push word acc))))))
> 
> (defun explode-text (str)
>   (group-words (coerce str 'list)))
> 
> (defun process-explosion (lst &optional (acc nil))
>   (let ((f (car lst))
> 	(r (cdr lst)))
>     (cond ((consp f)      (process-explosion r (push (mungle-list f)
> acc)))
> 	  ((characterp f) (process-explosion r (push f acc)))
> 	  ((null f)       (nreverse acc))
> 	  (t              (error "List can only contain conses and
> characters.")))))
> 
> (defun shuffle (list)
> 
> ;; Shamelessly lifted from code by Paul Nielsen.
> ;; http://groups.google.com/group/comp.lang.lisp/browse_thread/
> ;;  thread/644f8d6c65e01051/5c1899db24280cca
> 
>   (let ((vector (coerce list 'simple-vector)))
>     (loop for i fixnum from (length vector) downto 2
>           do (rotatef (svref vector (1- i)) (svref vector (random i))))
> 
>     (coerce vector 'list)))
> 
> (defun mungle-list (lst)
>   (let ((f (first lst))
> 	(l (last lst)))
>     (concatenate 'list (list f) (shuffle (subseq lst 1 (1- (length
> lst)))) l)))
> 
> (defun flatten (my-list)
>   (cond ((null my-list) nil)
>         ((atom my-list) (list my-list))
>         (t (append (flatten (first my-list))
>                    (flatten (rest my-list))))))
> 
> 
> ;; Finally
> 
> (defun mungle (str)
>   (coerce (flatten (process-explosion (explode-text str))) 'string))
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> 
> Thanks!

-- 
http://lispm.dyndns.org/
From: Frank Buss
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <18jza0zryris7.1x9c5590u1ldo$.dlg@40tude.net>
Tel A. wrote:

> I've just written a solution to a Ruby Quiz
> (http://www.rubyquiz.com/quiz76.html) in Lisp.

You might be interested in my code for creating perfect multidimensional
mazes, too:

http://www.lispniks.com/pipermail/gardeners/2006-April/001280.html

> I feel as though I did a lot of extra work
> processing these strings.

You are right:

(defun npermutate (string &key start end)
  (loop for i from (1- end) above start
        do (rotatef (aref string i)
                    (aref string (+ start (random (- i start -1)))))))
        
(defun mix (input-text)
  (loop with text = (copy-seq input-text)
        for char across text
        for i = 0 then (1+ i)
        finally (return text)
        with state = :start and start do
        (cond ((eql state :start)
               (when (alpha-char-p char)
                 (setf start (1+ i)
                       state :in-word)))
              ((eql state :in-word)
               (if (= i (1- (length text)))
                   (npermutate text :start start :end i)
                 (unless (alpha-char-p char)
                   (npermutate text :start start :end (1- i))
                   (setf state :start)))))))

CL-USER > (mix "The goal of the Common Lisp Application Builder project is
a Lisp distribution, with a rich set of libraries, which helps to create
standard GUI applications, which are easy to install by an end user, like
other programs on the respective platforms.")

"The gaol of the Cmomon Lsip Aipopaictln Buldier pcorejt is a Lisp
diiuortistbn, wtih a rcih set of lrribeias, whcih hpels to cerate satdnrad
GUI apoacnpltiis, whcih are easy to intlasl by an end user, like other
pgmoarrs on the rspvieecte pmsftoalr."


Can anyone beat the Ruby solution?

puts gets.gsub(/\B[a-z]+\B/i){|s|l=3Ds.length
;l.times{|i|r=3Drand(l);s[i],s[r]=3Ds[r],s[i]};s}

Looks a bit like APL, J or obfuscated Perl :-)

-- 
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: David Sletten
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <j9I2g.7288$543.2348@tornado.socal.rr.com>
Frank Buss wrote:

> 
> Can anyone beat the Ruby solution?
> 
> puts gets.gsub(/\B[a-z]+\B/i){|s|l=3Ds.length
> ;l.times{|i|r=3Drand(l);s[i],s[r]=3Ds[r],s[i]};s}
> 
> Looks a bit like APL, J or obfuscated Perl :-)
> 
(defun mungle (text)
   (reduce #'(lambda (s1 s2)
               (concatenate 'string s1 " " s2))
           (mapcar #'(lambda (s)
                       (loop for j from (- (length s) 2) above 1
                             for k = (random j)
                             when (alpha-char-p (char s j))
                             do (rotatef (char s j) (char s (1+ k)))) s)
                   (cl-ppcre:all-matches-as-strings "\\b(\\w|')+\\b" 
text))))

It's not as short, but it's almost as ugly!

Unfortunately while it does handle apostrophes, it doesn't preserve 
other punctuation. And gluing the results back together with REDUCE 
probably isn't very efficient.

Aloha,
David Sletten
From: David Sletten
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <jjI2g.10899$3W1.501@tornado.socal.rr.com>
Frank Buss wrote:


> 
> Can anyone beat the Ruby solution?
> 
> puts gets.gsub(/\B[a-z]+\B/i){|s|l=3Ds.length
> ;l.times{|i|r=3Drand(l);s[i],s[r]=3Ds[r],s[i]};s}
> 
> Looks a bit like APL, J or obfuscated Perl :-)
> 

BTW, the '=3D's above are a weird representation of ISO 8859 '='s ('3D' 
-> '=')

David Sletten
From: Wade Humeniuk
Subject: Re: "Word-Mungler" or "Critique My Code"
Date: 
Message-ID: <ExP2g.1882$8E1.488@clgrps13>
Taking some of Frank's idea,

(defun scramble-text (text)
   (cl-ppcre:do-matches (start end "(\\w+)" text text)
     (let ((length (- end start 2)))
       (when (> length 1)
         (loop for i from (1+ start) below (1- end)
               do (rotatef (char text i)
                           (char text (+ 1 start (random length)))))))))

CL-USER 17 > (scramble-text "Hello Wade-ier. \"Scrambled Letters follow.\"")
"Hello Wade-ier. \"Sbaecmlrd Lrttees floolw.\""

CL-USER 18 >

Wade