Author Topic: Bicursion ...  (Read 18197 times)

0 Members and 1 Guest are viewing this topic.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« on: February 15, 2005, 04:54:12 PM »
Ok, so I'm making up new terminology.

Many years ago I had competed in a contest to write a function to flatten a nested list (no dotted pairs) to a non nested list.

Example:

Code: [Select]
(setq lst
   '(1 (2 (3 (4 (5 (6 (7 (8))))))))
)

(flatten lst)

=> (1 2 3 4 5 6 7 8)

The winner in my mind (based on eloquence) was one by Doug Broad, a very pretty recursive one --

Code: [Select]
(defun flatten ( lst )
    ;;  by Doug Broad
    (cond
        ((null lst) nil)
        ((atom lst) (list lst))
        ((atom (car lst)) (cons (car lst) (Flatten (cdr lst))))
        ((append (Flatten (car lst))(Flatten (cdr lst))))
    )
)

I recently had need (like yesterday) to flatten a nested list and thought I'd take a stab at writing a new one with fresh eyes. Well ... I ended up penning a funny one that is 'bicursive', that is, two functions keep calling each other until the problem is solved. While Doug's beats it when small lists are being processed, it smokes when processing larger lists (when you really need the performance) --

Code: [Select]
(defun Squish ( lst )
    ;;  © 2005 Michael Puckett
    (apply 'append
        (mapcar 'SquishEx lst)
    )
)

(defun SquishEx ( x / a )
    ;;  © 2005 Michael Puckett
    (if (listp x)
        (if (listp (setq a (car x)))
            (append (Squish a) (Squish (cdr x)))
            (cons a (Squish (cdr x)))
        )
        (list x)
    )
)

(squish lst)

=> (1 2 3 4 5 6 7 8)

Some benchmarking --

Code: [Select]
(progn

    (defun Flatten ( lst )
        ;;  by Doug Broad
        (cond
            ((null lst) nil)
            ((atom lst) (list lst))
            ((atom (car lst)) (cons (car lst) (Flatten (cdr lst))))
            ((append (Flatten (car lst))(Flatten (cdr lst))))
        )
    )
   
    (defun Squish ( lst )
        ;;  © 2005 Michael Puckett
        (apply 'append
            (mapcar 'SquishEx lst)
        )
    )

    (defun SquishEx ( x / a )
        ;;  © 2005 Michael Puckett
        (if (listp x)
            (if (listp (setq a (car x)))
                (append (Squish a) (Squish (cdr x)))
                (cons a (Squish (cdr x)))
            )
            (list x)
        )
    )

    (setq big_list
        (setq small_list
           '(1 (2 (3 (4 (5 (6 (7 (8))))))))
        )
    )
   
    (Benchmark
       '(   (flatten small_list)
            (squish small_list)
        )
    )
   
    (repeat 8
        (setq big_list
            (append big_list big_list)
        )
    )
   
    (Benchmark
       '(   (flatten big_list)
            (squish big_list)
        )
    )
   
)

Results --

Code: [Select]
Milliseconds / relative speed for 16384 iteration(s):

    (FLATTEN SMALL_LIST).....1750 / 1.36 <fastest>
    (SQUISH SMALL_LIST)......2375 / 1.00 <slowest>
   
Milliseconds / relative speed for 64 iteration(s):

    (SQUISH BIG_LIST).......1672 / 7.05 <fastest> YEOW!
    (FLATTEN BIG_LIST).....11781 / 1.00 <slowest>

Questions --

(1) Do you see any potential problems or flaws in my logic?
(2) Can you write one that has a flatter performance, i.e. performs equally well at both ends of the spectrum (small versus large lists)?

Thanks guys.

I found one problem, any nil values in the original list are removed; they should be retained.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Bicursion ...
« Reply #1 on: February 15, 2005, 05:43:11 PM »
Quote from: MP

(1) Do you see any potential problems or flaws in my logic?
(2) Can you write one that has a flatter performance, i.e. performs equally well at both ends of the spectrum (small versus large lists)?

1) Can I get back to ya on this, once I figure out your logic. <g>

2) Not likely but that's never stopped me before.

MP, that's some beautiful code man.
TheSwamp.org  (serving the CAD community since 2003)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #2 on: February 15, 2005, 06:06:57 PM »
Thank you Mark. :)

I found a problem -- squish removes nils from the original list, and it really shouldn't. Doug's flatten does not.

i.e.

Code: [Select]
(flatten '(1 nil (2 nil (3 nil))))

=> (1 nil 2 nil 3 nil)

(squish '(1 nil (2 nil (3 nil))))

=> (1 2 3)

Recoded --

Code: [Select]
(defun Squish ( lst )
    ;;  © 2005 Michael Puckett
    (apply 'append
        (mapcar 'SquishEx lst)
    )
)

(defun SquishEx ( x / a )
    ;;  © 2005 Michael Puckett
    (if x
        (if (listp x)
            (if (listp (setq a (car x)))
                (append (Squish a) (Squish (cdr x)))
                (cons a (Squish (cdr x)))
            )
            (list x)
        )
       '(nil)
    )  
)

(squish '(1 nil (2 nil (3 nil))))

=> (1 nil 2 nil 3 nil)

Nested if statements benched better than an equivalent cond structure; hmmm.

It still benches very well against flatten despite the additional if test (same data) as initial benching:

Code: [Select]
Milliseconds / relative speed for 64 iteration(s):

    (SQUISH BIG_LST).......1656 / 6.98 <fastest>
    (FLATTEN BIG_LST).....11563 / 1.00 <slowest>

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #3 on: February 15, 2005, 06:50:08 PM »
Very interesting!

Code: [Select]
(progn

    (defun Flatten ( lst )
        ;;  by Doug Broad
        (cond
            ((null lst) nil)
            ((atom lst) (list lst))
            ((atom (car lst)) (cons (car lst) (Flatten (cdr lst))))
            ((append (Flatten (car lst))(Flatten (cdr lst))))
        )
    )
   
    (defun Squish ( lst )
        ;;  © 2005 Michael Puckett
        (apply 'append
            (mapcar 'SquishEx lst)
        )
    )

    (defun SquishEx ( x / a )
        ;;  © 2005 Michael Puckett
        (if x
            (if (listp x)
                (if (listp (setq a (car x)))
                    (append (Squish a) (Squish (cdr x)))
                    (cons a (Squish (cdr x)))
                )
                (list x)
            )
           '(nil)
        )
    )

    (setq lst
       '(1 (2 (3 (4 (5 (6 (7 (8))))))))
    )
   
    (while t
   
        (princ
            (strcat
                "\nFlattened length = "
                (itoa (length (squish lst)))
                "\n"
            )
        )
   
        (Benchmark
           '(   (flatten lst)
                (squish lst)
            )
        )
       
        (setq lst (append lst lst))
       
    )
   
    (princ)
   
)

Results --
Code: [Select]

Flattened length = 8, 16384 iteration(s): Flatten performing better

    (FLATTEN LST).....1656 / 1.35 <fastest>
    (SQUISH LST)......2234 / 1.00 <slowest>

Flattened length = 16, 8192 iteration(s):

    (FLATTEN LST).....1344 / 1.37 <fastest>
    (SQUISH LST)......1843 / 1.00 <slowest>

Flattened length = 32, 4096 iteration(s):

    (FLATTEN LST).....1265 / 1.31 <fastest>
    (SQUISH LST)......1656 / 1.00 <slowest>

Flattened length = 64, 2048 iteration(s):

    (FLATTEN LST).....1360 / 1.17 <fastest>
    (SQUISH LST)......1594 / 1.00 <slowest>

Flattened length = 128, 1024 iteration(s): Squish performing better

    (SQUISH LST)......1547 / 1.03 <fastest>
    (FLATTEN LST).....1594 / 1.00 <slowest>

Flattened length = 256, 512 iteration(s):

    (SQUISH LST)......1562 / 1.35 <fastest>
    (FLATTEN LST).....2109 / 1.00 <slowest>

Flattened length = 512, 256 iteration(s):

    (SQUISH LST)......1531 / 2.09 <fastest>
    (FLATTEN LST).....3203 / 1.00 <slowest>

Flattened length = 1024, 128 iteration(s):

    (SQUISH LST)......1562 / 3.51 <fastest>
    (FLATTEN LST).....5484 / 1.00 <slowest>

Flattened length = 2048, 64 iteration(s):

    (SQUISH LST).......1562 / 6.64 <fastest>
    (FLATTEN LST).....10375 / 1.00 <slowest>

Flattened length = 4096, 32 iteration(s):

    (SQUISH LST).......1578 / 12.68 <fastest>
    (FLATTEN LST).....20016 / 1.00 <slowest>

Flattened length = 8192, 16 iteration(s):

    (SQUISH LST).......1438 / 23.54 <fastest>
    (FLATTEN LST).....33844 / 1.00 <slowest>

Flattened length = 16384, 8 iteration(s):

    (SQUISH LST).......1312 / 38.73 <fastest>
    (FLATTEN LST).....50813 / 1.00 <slowest>

Flattened length = 32768, 4 iteration(s):

    (SQUISH LST).......1265 / 72.90 <fastest>
    (FLATTEN LST).....92218 / 1.00 <slowest>

Flattened length = 65536, 2 iteration(s):

    (SQUISH LST)........1187 / 104.07 <fastest>
    (FLATTEN LST).....123532 / 1.00 <slowest>

Flattened list length = 131072

*KAFREAKINBOOM*, Hard error occurred ***

Flatten crashed when the list had grown to 131072 items (when denested) because it blew up the stack. Squish still crushed the big 'ol list down, in 1250 milliseconds (1 iteration), very reasonable! :)

Nonetheless, flatten remains an eloquent example of recursion and Doug Broad an excellent codesmith (a very nice gentlemen too I might add).
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

JohnK

  • Administrator
  • Seagull
  • Posts: 10604
Bicursion ...
« Reply #4 on: February 15, 2005, 10:22:30 PM »
*blink* *blink*  What dahell 'r ya doin'?! I cant find that logic anywhere in my book! ...'Bicurson' Pthhht!?  

Let me see this stuff.

***

Oh my head hurts. I keep getting lost. ...Im just gonna nod and go over there now. Okay?
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #5 on: February 16, 2005, 12:06:35 AM »
Final thought (I think).

Nesting the two defuns inside a wrapper defun realizes a very small performance hit for the convenience (in benchmark terms, the non nested version averages 1.02 times faster, wow). In the big picture that kind of performance difference is inconsequetial (especially considering the dramatic results above).

Anyway, this is what is going into my library:

Code: [Select]
(defun flatten ( lst / f1 f2 )
    ;;  © 2005 Michael Puckett
    (defun f1 ( lst )
        (apply 'append
            (mapcar 'f2 lst)
        )
    )
    (defun f2 ( x / a )
        (if x
            (if (listp x)
                (if (listp (setq a (car x)))
                    (append (f1 a) (f1 (cdr x)))
                    (cons a (f1 (cdr x)))
                )
                (list x)
            )
           '(nil)
        )
    )
    (f1 lst)
)

Not as pretty as Doug's but sometimes ugly has to finish the job. :)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Bicursion ...
« Reply #6 on: February 16, 2005, 07:31:29 AM »
I know this isn't a challenge and I hope you don't mind but, this is what I came up with. Mind you it doesn't handle the nil's like your does.
Code: [Select]

(setq lst
   '(1 (2 (3 (4 (5 (6 (7 (8))))))))
   )

(defun level (lst / leveled)
  (while (> (length lst) 0)
(setq leveled (cons (car lst) leveled))
(setq lst (car (vl-remove (car lst) lst)))
)
  (if leveled (reverse leveled))
  )
(setq leveled_list (level lst))
--> (1 2 3 4 5 6 7 8)
TheSwamp.org  (serving the CAD community since 2003)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #7 on: February 16, 2005, 07:47:46 AM »
Actually, I though I invited better performing, alternate algorithms. Didn't I? Regardless, they're welcome. This is the swamp isn't it? :)

Having said that, observe:

Code: [Select]
(setq lst
    '(1 nil (2 nil (3 nil (4 nil (5 nil
        (6 nil (7 nil (8 nil)))))))
     )
)

(level lst)

=> (1)

(squish lst)

=> (1 nil 2 nil 3 nil 4 nil 5 nil 6 nil 7 nil 8 nil)

Don't abandon it though, it has promise. I'd rework it for you but I know you like figuring these things out as much as I do, so I'll keep me mitts off. :)

Thanks Mark.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Mark

  • Custom Title
  • Seagull
  • Posts: 28753
Bicursion ...
« Reply #8 on: February 16, 2005, 08:00:30 AM »
I like to know how this preforms compared to yours MP but i'm not sure how to go about it.
TheSwamp.org  (serving the CAD community since 2003)

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #9 on: February 16, 2005, 08:08:33 AM »
Once it works correctly you can compare performance using this.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

SMadsen

  • Guest
Bicursion ...
« Reply #10 on: February 16, 2005, 09:08:41 AM »
MP, nice work. Bicursion? Cool, new word :)

I'm a little amazed that it doesn't bust the stack before Doug's FLATTEN routine does. Running a trace stack on both (with the list you showed in first post), yours go down 23 levels before hitting (f1 nil), while Doug's only runs 16 levels before hitting (flatten nil) and starting to rewind.
But I guess it's only recursive as long as there are atoms on each level (which means 1 recursion each on this particular list), so it will never run as deep as Doug's function will for each call.

Mark, try dotting the list manually and see what it returns:
Code: [Select]
(setq lst '(1 . (2 . (3 . (4 . (5 . (6 . (7 . (8)))))))))
=> (1 2 3 4 5 6 7 8)

That's basically what your routine does. It can be shortened into this little recursion:
Code: [Select]
(defun consem (lst)
  (if (vl-consp lst) (cons (car lst) (consem (cadr lst))))
)

It's depending on CAR element always being an atom and CADR element always being a list.

JohnK

  • Administrator
  • Seagull
  • Posts: 10604
Bicursion ...
« Reply #11 on: February 16, 2005, 09:21:34 AM »
This is a very cool subject. (Ive thought about this last night and "wow"!) Its a tough thing to get your head arround.  (Recursivly that is.)
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #12 on: February 16, 2005, 09:23:49 AM »
Code: [Select]
(defun consem (lst)
  (if (vl-consp lst) (cons (car lst) (consem (cadr lst))))
)

Stig, it's absolutely beautiful, but she no worky on the nested lists per my first post.

:(
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Bicursion ...
« Reply #13 on: February 16, 2005, 09:25:46 AM »
(Dang, off to work, see ya in a couple hours).
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

SMadsen

  • Guest
Bicursion ...
« Reply #14 on: February 16, 2005, 09:33:39 AM »
Quote from: MP
Stig, it's absolutely beautiful, but she no worky on the nested lists per my first post.

:(
It wasn't supposed to. Only supposed to explain why Mark's routine can't handle multiple atoms on same level. That's why Doug's routine had to implement multiple conditions.

Nevermind it can only handle one kind of list though, did you try to benchmark it? It's pretty fast  :D