Topic: split list into lists

[JohnK]

Basicly that statment means that there is still stuff to do to the stuff after the stuff has gone thru the procedure again.  ...awe crap that sounds even more confusing.  (hold on a sec.)

Read this and let me know if it helps any: http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-11.html#%_sec_1.2

[CAB]

Ugh, I'll get back to you  after i read that.

[CAB]

Running this test routine see the results below.

Code: [Select]

(defun c:test (/ lst1 level)
  (defun parselst (item lst / ll)
    (print (setq level (1+ level)))
    (while lst
      (if (eq (car lst) item)
        (setq ll  (if ll
                    (cons (reverse ll) (parselst item (cdr lst)))
                    (parselst item (cdr lst))
                  )
              lst nil
        )
        (setq ll  (cons (car lst) ll)
              lst (cdr lst)
        )
      )
    )
    (print ll)
    ll
  )

  (setq lst1 (list 32 53 54 46 48 48 32 32 55 56 32 32 56 56 32))
  (setq level 0)
  (print)
  (parselst 32 lst1)
  (princ)
)


Code: [Select]

Command: test


1
2
3
4
5
6
7
nil
((56 56))
((56 56))
((55 56) (56 56))
((55 56) (56 56))
((53 54 46 48 48) (55 56) (56 56))
((53 54 46 48 48) (55 56) (56 56))

Command:

You see the recursion is leaner. Right?

[JohnK]

No. (At least i dont think so.)

In my spare time tomorrow im gonna wrap my head around your code a bit and try to understand it better.

[CAB]

Ok, here is the code commented.
 

Code: [Select]

(defun parselst (item lst / ll)
    (print (setq level (1+ level))); debug
    (while lst  ; loop until lst is nil
      (if (eq (car lst) item) ; test if match with item in this case 32
        ;;  yes a match
        (setq ll  (if ll ; yes items were added to ll before getting to 32
                    ;; so combine the items in ll with items returned by parselst
                    (cons (reverse ll) (parselst item (cdr lst)))
                    ;; no items in ll because we got another 32 so
                    (parselst item (cdr lst)) ; don't combine, just return items returned by parselst
                  )
              lst nil ; null lst so loop will stop
        ) ; end setq
        ;;  No not a match so
        (setq ll  (cons (car lst) ll) ; add items to ll until the next 32 or end of list
              lst (cdr lst) ; remove the first item from the list
        ) ; end setq
      ) ; endif
    ) ; end while
    (print ll); debug
    ll ; return collected items in ll
  )
 
 Psudo code:
 Loop items in list
 If not 32 then add items to ll
 If 32 then send list with the first item removed back through the routine.
 combine the returned list with ll only if there are items in ll
 The fact that you need to reverse ll means you need an if statement
 

Code: [Select]

(if ll (cons (reverse ll) (parselst item (cdr lst)))
          (parselst item (cdr lst))
  )
 
 There may be a way to eliminate this IF statement but I couldn't find it.

[JohnK]

CAB, Im sorry to have to say this to you, but it appears that you have a Tree recusion procedure. Meaning that your data (each peice of information) is filtered thru a series of conditions/process and built into a final result. This is a very complex recursion concept usualy used in encoding. (Congratulations! )  I drew a picture of whats going on: (I hope it turns out in this post ...Nope, it looks like crap. So cut and paste this into notepad or a text editor to see it.)

Code: [Select]


 @@@@@  ;; Procedure start
 ( ~ )  ;; Loop
  ??    ;; Conditional
  /\    ;; ...
 Y  N   ;; Enter switch
 |  |   ;; YES Switch - Enter another contitional
??  |   ;; NO Switch  - Enter normal process
/\  |   ;;
Y N |   ;; YES Switch (YS) - Enter switch
| | |   ;;
X | |   ;; (YS) YES Switch - Process based on recursion
@ @ |   ;; (YS) NO Switch  - Recurse
    |   ;;
    X   ;; NO Switch - Continue loop/proceses
  (/~/) ;; End loop
    =   ;; Return result


No but seriously, your procedure is amazing. You should be happy. However just so you know that the method you are using in this takes is extreamly in-efficient. (It gobbles up stack memory like there's no tomorow.)

But anyways i hope my lil picture halped out a bit. If not, just forget it and know that im sorry.  

[CAB]

John,
Nice picture..

I think you have missunderstood the [Yes No] portion of my code.
It actually has nothing to do with the recrusion.
Here is what I am talking about.

Code: [Select]


(if ll
   (cons (reverse ll) (parselst item (cdr lst)))
                      (parselst item (cdr lst))
  )
It appears as if there is a branch but there is not as both calls to parselst are identical.
If ll is not nil the statement combines ll with the result of parselst
else ll is nil and the statement returns parselst only
So you see parselst is the same, there is no branch
Let me see if a can write the code another way to show the result.
OK here it is, you see there is no branch

Code: [Select]

 (defun parselst (item lst / ll tmp)
    (while lst
      (if (eq (car lst) item)
        (setq tmp (parselst item (cdr lst))
              ll  (if ll (cons (reverse ll) tmp) tmp)
              lst nil
        )
        (setq ll  (cons (car lst) ll)
              lst (cdr lst)
        )
      )
    )
   ll
 )

[JohnK]

*Phew!*  ...Im confused. (I mean my head is smokin'!)

[CAB]

LOL  I'm glad I'm not the only one..
Here is my conclusion,
 Because the routine will only call itself once and then return I think it is leaner.

[CAB]

By the way, where did Stig go? He started this.

[SMadsen]

By the way, where did Stig go? He started this.

Nah .. Mark started it, remember?
Nice work, CAB.

[CAB]

Well .. John .. that's ok but anyone making it a recursive can buy me a ticket to Orlando next year

I was refering to starting this.

Thanks Stig.

[SMadsen]

Read this and let me know if it helps any: http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-11.html#%_sec_1.2

Another good source for recursion is McCarthy's 1960 (!) publication "Recursive Functions of Symbolic Expressions and Their Computation by Machine". Link to PDF can be found here.

[JohnK]

Ohh...Dont read that to fast. (Man i have to read those paragraphs at least twice in order to catch all of it. )

Good find Stig!

[SMadsen]

Oh you can catch all of it? That must be cool

It does use some weird syntax but it's essentially the same techniques today.
Here's an effort of "translating" some of the syntax (written last night so any errors are probably due to lack of sleep):

Code: [Select]

;;; From: Recursive Functions of Symbolic Expressions
;;;       and Their Computation by Machine, Part I
;;;       John McCarthy, MIT, Cambridge, Mass.
;;;       April 1960

;;; GCD
;;; Greatest common denominator of two integers m and n
(defun mcGCD (m n)
  (cond ((> m n) (mcGCD n m))
        ((zerop (rem n m)) m)
        ((mcGCD (rem n m) m))
  )
)

;;; SQRT
;;; Newtons approximation algorithm for finding square root
;;; of a number a where x is initial approximation and e is a
;;; value that satisfies |y^2 - a| < e for y being an acceptable
;;; approximation (approximation factor).
;;; E.g.:
;;  (mcsqrt 25.0 5.4 5)     -> 5.4
;;  (mcsqrt 25.0 5.4 0.001) -> 5.0002
(defun mcSqrt (a x e)
  (cond ((or (minusp x)(zerop x)) nil)
        ((< (abs (- (* x x) a)) e) x)
        ((mcSqrt a (* 0.5 (+ x (/ a x))) e))
  )
)

;;; NULL
;;; Not recursive but a definition of the function NULL
;;; (the empty list '() is also defined as the atomic
;;; symbol nil)
(defun mcNull (x)
  (and (atom x) (eq x nil))
)

;;; SUBST
;;; Substitute all occurences of y in z with x.
(defun mcSubst (x y z)
  (cond ((atom z)(if (eq z y) x z))
        ((cons (car z)(subst x y (cdr z))))
  )
)

;;; EQUAL
;;; Returns T if x and y are identical atoms or expressions.
;;; Note: There's no fuzz factor in this definition
(defun mcEqual (x y)
  (or (and (atom x)(atom y)(eq x y))
      (and (not (atom x))(not (atom y))
           (equal (car x)(car y))
           (equal (cdr x)(cdr y))
      )
  )
)

;;; PAIR
;;; Pairs corresponding elements of x and y
;;; Note: No equivalent func in AutoLISP
;;; E.g.
;;  (pair '(1 2)'(3 4)) -> ((1 3) (2 4))
;;  (pair '(1 2 (3 4)) '(3 4 (5 6))) ->
;;    ((1 3) (2 4) ((3 4) (5 6)))
(defun pair (x y)
  (cond ((and (null x)(null y)) nil)
        ((and (not (atom x))(not (atom y)))
         (cons (list (car x)(car y))
               (pair (cdr x)(cdr y)))
        )
  )
)

;;; APPEND
;;; Appends list x to list y
;;; Note: Doesn't check if neither arguments are lists.
;;;       If y is an atom, it is appended as CDR element
;;;       within an improper list.
;;; E.g.
;;  (mcAppend '(1 2) '(3 4)) -> (1 2 3 4)
;;  (mcAppend '(1 2) 'a)     -> (1 2 . A) !!
(defun mcAppend (x y)
  (cond ((null x) y)
        ((cons (car x)(mcAppend (cdr x) y)))
  )
)

;;; AMONG
;;; Returns T if x occurs among the elements of list y.
;;; Note: This function differs from MEMBER by being a
;;;       predicate function (returning T or nil)
(defun among (x y)
  (and (not (null y))
       (or (equal x (car y))
           (among x (cdr y))
       )
  )
)

;;; ASSOC
;;; Returns item in association list y where x is the
;;; CAR item.
;;; E.g.
;;  (mcAssoc 3 '((1 2)(2 3)(3 4)(4 5))) -> (3 4)
;;  (mcAssoc 5 '((1 2)(2 3)(3 4)(4 5))) -> nil
(defun mcAssoc (x y)
  (cond ((eq (caar y) x)(cadar y))
        ((assoc x (cdr y)))
  )
)

;;; SUBLIS
;;; "Here x is assumed to have the form of a list of pairs
;;; ((u1 v1) ... (un vn)), where the u's are atomic,
;;; and y may be any S-expression.
;;; The value of sublis[x y] is the result of substituting
;;; each v for the corresponding u in y. In order to define
;;; sublis, we first define an auxiliary function."
;;; E.g.
;;  (setq alst '((1 2)(3 4)(5 6)))
;;  (sublis alst 3) -> 4
;;  (sublis alst '(3 5)) -> (4 6)
;;  (sublis alst '(3 4)) -> (4 4)
;;  (sublis alst '(1 (3 . 4)))   -> (2 (4 . 4))
;;  (sublis alst '(1 (3 5 . 4))) -> (2 (4 6 . 4))
(defun sublis (x y)
  (defun sub2 (x z)
    (cond ((null x) z)
          ((eq (caar x) z)(cadar x))
          ((sub2 (cdr x) z))
    )
  )
  (cond ((atom y)(sub2 x y))
        ((cons (sublis x (car y))(sublis x (cdr y))))
  )
)