How to improve this list algorithm?

Question

Give a list of number (character or anything else) and another random number(character or the same kind with the list), if there are two adjacent value in the list that are the same as the last one( the three value are the same), then they will be eliminated, then do it recursively.
For example
(1 5 3 3 2 2 4 3) + 2 => (1 5 3 3 2 2 4 3 2) => ( 1 5 3 3 4 3) => (1 5 4)

(1 3 3 2) + 2 => (1 3 3 2 2)

My solution is this:

a. scan the list and get the position of the first occurrence of the the two same value that is same ad the last of the list, or #f if not found.

b. remove that three value

c. recursively call a

(define scan ;; list->list (get the position)
  (lambda (lst)
    (let scan-loop ((lst lst) (n 0))
      (cond
       [(<= (length  lst) 2) #f]
       [(and (equal? (car lst) (cadr lst))
     (equal? (car lst) (last lst))) n]
       [else
     (scan-loop (cdr lst) (+ n 1))]))))

(define (Arrange lst k) ; list,k -> list (remove the value) 
   (remove-k (remove-k (remove-k lst k) k) (- (length lst) 3)))

(define (remove-k lst k)
 (let remove-loop ((init lst) (n k) (new '()))
  (cond
   [(null? init) (error "K is too big for list")]
   [(= n 0) (append new (cdr init))]
   [else
    (remove-loop (cdr init) (- n 1) (append new (list (car init)) ))])))

(define (eliminate lst) ; list ,num -> lst (the main function)
  (let ([flag (scan lst)])
     (if flag
         (eliminate (Arrange lst flag))
         lst)))

This can work. But it will become really slow when the list is long.
I have a test:

(define lst (build-list 10000 (lambda (x) (random 10))))
(eliminate lst)

In Drracket(6 GB memory， 2.3G hz cpu *4), according to the performance analysis, the mainly cost of time are these:
call remove-loop , 11517101times , cost 49283 milliseconds
call scan-loop , 2450002times, cost 121294 milliseconds
call Arrange , 747times, cost 713182 milliseconds
call eliminate, 748 times, cost 130611 milliseconds

And during the running, I found that only one cpu is almost 100% used(by turns).
Can this run by multi-threads？

And I think the main problem is that algorithm i used is inefficient. I think it can be really optimized. Maybe using dynamic algorithm, using a table to store the occurrence and update every time.
How to do that?

Thanks a lot.

Answer 1

Don't measure results in Dr Racket, because the IDE's overhead is very high. Always execute time-intensive calculations from the shell.

Here's my algorithm, which executes in less than half a second for a list of 10,000 elements (vs 9.5 minutes for your algorithm):

(define (remn lst)
  (if (null? lst)
      lst
      (let* ((rlst (reverse lst)) (last (car rlst)))
        (let loop ((left null) (curn 0) (rght (reverse (cdr rlst))))
          (if (null? rght)
              (append (reverse left) (list last))
              (let ((e (car rght)))
                (if (equal? e last)
                    (if (= curn 1)
                        (remn (append (reverse (cdr left)) (cdr rght)))
                        (loop (cons e left) (add1 curn) (cdr rght)))
                    (loop (cons e left) 0 (cdr rght)))))))))

Examples:

> (remn '(1 5 3 3 2 2 4 3 2))
'(1 5 4)
> (remn '(1 3 3 2 2))
'(1 3 3 2 2)
> (remn '(1 1 3 3 3 3 3 1))
'(3 3)