Rearranging list into left-normal form in Racket

Question

I was going to post this to the codereview stackexchange but I saw that you should only post working code. I asked this question earlier: Reordering parentheses using associative property in Racket

In case you don't check the link basically I want to rearrrange a list of symbols so that this:

'((a + b) + c) -> '(a + (b + c))

or this:

'((a + b) + (c + d)) -> '(a + (b + (c + d)))

This is the code I've written so far:

(define (check? expr)
  (display expr)
  (newline)
  (cond ((null? expr) -1)
        ((and (atom? (car expr)) (atom? (cadr expr))) 0) ;case 0
        ((and (atom? (car expr)) (list? (cadr expr))) 1) ;case 1
        ((and (list? (car expr)) (null? (cdr expr))) (check? (car expr))) ;nested expression for example '((a b))
        ((and (list? (car expr)) (atom? (cadr expr))) 2) ;case 2
        ((and (list? (car expr)) (list? (cadr expr))) 3) ;case 3
        (else -1)))


(define (rewrite x)
  (display (check? x))
  (newline)
  (cond ((null? x))
        ((atom? x) x)
        ((= 0 (check? x))   x) ;case 0 is '(a + b)
        ((= 1 (check? x)) (cons (car x) (rewrite (cdr x)))) ;case 1 is '(a +  (b + c))
        ((= 2 (check? x)) (rewrite (list (caar x) (cons (cadar x) (cdr x))))) ;case 2 is ((b + c) + a)
        ((= 3 (check? x)) (rewrite ((list (caar x) (cons (cadar x) (cdr x))))))));case 3 is ((a + b) + (c + d))


;(rewrite '(((d c) b) a))
(rewrite '(a b))
(rewrite '(a (b c)))
(rewrite '((a b) (c d)))

Am I on the right track? If not does anyone have any pointers? Am I creating the lists wrong? If you need any more information let me know or if I should comment the code better also let me know.

In case you don't check the earlier question, this is the answer I got (which was very helpful):

var                               -> var
(var + var)                       -> (var + var)
(var + (fip1 + fpip2))            -> (var + (REWRITE (fip1 + fpip2))
((fip1 + fpip2) + var)            -> (REWRITE (fip1 + (fip2 + var))
((fip1 + fpip2) + (fip3 + fpip4)) -> (REWRITE (fip1 + (fip2 + (fip3 + fip4))))

Answer 1

The following is the grammar you have defined for your syntax:

var  ::=  a | b | c | d | e | f | g
fpip ::=  var | (fpip + fpip)

As such, we can start by defining predicates that test whether a given expression is valid or not, using the rules set above:

(define (var? e)
  (member e '(a b c d e f g)))

(define (fpip? e)
  (cond
    ((var? e) #t)
    ((or (not (pair? e))
         (null? e)
         (null? (cdr e))
         (null? (cddr e))
         (not (null? (cdddr e))))
     #f)
    (else (and (fpip? (car e))
               (equal? (cadr e) '+)
               (fpip? (caddr e))))))

Now we can say, for example:

> (fpip? 'a)
#t
> (fpip? '((a + b) + c))
#t
> (fpip? '((+(d + e) + f) + (a + (a + c))))
#f

With that in place, rewrite can be written as the right-associative form of an expression, if the expression is valid fpip, and #f otherwise:

(define (rewrite e)
  (if (not (fpip? e))
      #f
      (rewrite-fpip e)))

Next, we will define rewrite-fpip to be a procedure that accepts and transforms any valid fpip, as follows:

(define (rewrite-fpip e)
  (cond
    ((not (pair? e)) e)                                         ;; var
    ((not (pair? (car e)))
     (list (car e) '+ (rewrite-fpip (caddr e))))                ;; (var + fpip)
    (else
     (rewrite-fpip                                              ;; (fpip + fpip)
      (list (caar e) '+ (list (caddar e) '+ (caddr e)))))))

Thus we can have:

> (rewrite 'a)
'a
> (rewrite '((a + b) + c))
'(a + (b + c))
> (rewrite '((a + b) + (c + d)))
'(a + (b + (c + d)))
> (rewrite '(((d + e) + f) + (a + (a + c))))
'(d + (e + (f + (a + (a + c)))))

Answer 2

That they tell you not to use the flattening in your solution doesn't mean you can't use the flattening in the derivation of your solution.

Writing in an imaginary pattern-matching equational pseudocode (because it is much shorter and visually apparent, i.e. easier to follow),

flatten a         = flatten2 a []               ; [] is "an empty list"
flatten2 (a+b) z  = flatten2 a (flatten2 b z)   ; if it matches (a+b)
flatten2 a     [] = a                           ; if it doesn't, and the 2nd is []
flatten2 a     b  = a + b                       ; same, and the 2nd arg is not []

Oh wait, I'm not flattening it here, I am building the normalized sum expressions here!

The only problem with this approach is the needless check for [] repeated over and over when we know it will only ever be true once -- it is we who write this code after all.

Fusing this knowledge in, we get

normalize  a   = down a             ; turn EXPR ::= ATOM | EXPR + EXPR
down (a + b)   = up a (down b)
down a         = a                  ; into NormExpr ::= ATOM | ATOM + NormExpr
up   (a + b) z = up a (up b z)
up   a       b = a + b

Now all's left is to code this up in regular Scheme. Scheme also has the advantage that the test can be much simplified to just

(define (is-sum? a+b) (pair? a+b))

edit: The final function from the other answer in the same pseudocode is:

rewrite ((a + b) + c) = rewrite (a + (b + c))     ; rotate right!
rewrite (a + b)       = a + rewrite b             ; go in, if the first rule didn't match
rewrite a             = a                         ; stop, if the first two didn't match

It rearranges the + nodes' tree structure before starting the work¹, whereas the solution in this answer follows the input structure while transforming it. As the result, thanks to the nested recursion the run time stack will only be as deep as the input structure, whereas with rewrite it will always be n levels deep at the deepest point, when the list is fully linearized on the stack (in the second rule), just before the sums are assembled on the way back up.

But the first rule in rewrite is tail recursive, and the second is tail recursive modulo cons, so rewrite can be rewritten in a tail-recursive style as a whole, with few standard modifications. Which is definitely a plus.

On the other hand this new code will have to surgically modify (i.e. mutate) the + nodes (see the Wikipedia article linked above, for details), so you'll have to choose your implementation of this data type accordingly. If you use lists, this means using set-car! and/or set-cdr!; otherwise you can implement them as Racket's #:mutable structures. When the result is built, you could convert it to a regular list with an additional O(n) traversal, if needed.

---

¹ reminiscent of the old gopher trick from John McCarthy, burrowing into the input structure, with reified continuations.