运行 使用方案语言对列表中的符号进行长度编码

Question

我正在尝试使用方案语言查找列表中字母的频率，但我不能在 4 天内完成，并且代码必须在 repl.it

中工作

比如我们的列表是

 (a a a a b c c a a d e e e e)

我们的输出应该是

(4 a ) b ( 2 c ) ( 2 a ) d ( 4 e )

我有代码也可以在 repl.it

上运行

(define (countW list1)
  (if (null? list1) 
   '()
   (let ((reserv (list 1)))        
      (let loop ((source   reserv)       
                 (elter (car list1))
                 (counter 1) 
                 (list1 (cdr list1)))
         (if (and (not (null? list1))
                  (equal? elter (car list1)))
            (loop source elter (+ counter 1) (cdr list1))
            (begin
               (set-cdr! source 
                         (list (if (= 1 counter) 
                                   elter 
                                   (list elter counter))))
               (if (null? list1)
                  (cdr reserv)     
                  (loop (cdr source) (car list1) 1 (cdr list1)))))))))

这是我尝试的代码

Answer 1

折叠列表，以空列表作为累加器开始。对于每个项目，检查： 如果累加器为空，则添加项目（隐式计数为 1）。如果累加器前面有一个项目与此项目匹配，则将其替换为此项目的计数 2。如果累加器前面有一对与这个匹配，则将其计数加一。否则，添加项目（隐式计数 1）。

(define (count-occurrences lat)
  ; Get the results in the order of the input list
  (reverse
    (fold (lambda (item acc)
            (cond
              ; Start off by counting the first item
              ((null? acc)
               (cons item acc))
              ; If the previous item was this one, set its count to 2
              ((and (atom? (car acc))
                    (eqv? item (car acc)))
               (cons (list 2 item)
                     (cdr acc)))
              ; If there has been a run of this item, increment the count by 1
              ((and (pair? (car acc))
                    (eqv? item (cadar acc)))
               (cons (list (+ 1 (caar acc)) item)
                     (cdr acc)))
              ; The previous item was not this one, so start counting this one now
              (else
                (cons item acc))))
          '()
          lat)))

fold函数通常需要srfi-1。

Answer 2

我有同样适用于 repl.it

的代码

(define (countW list1)
  (if (null? list1) 
   '()
   (let ((reserv (list 1)))        
      (let loop ((source   reserv)       
                 (elter (car list1))
                 (counter 1) 
                 (list1 (cdr list1)))
         (if (and (not (null? list1))
                  (equal? elter (car list1)))
            (loop source elter (+ counter 1) (cdr list1))
            (begin
               (set-cdr! source (list (if (= 1 counter) elter (list elter counter))))
               (if (null? list1)
                  (cdr reserv)     
                  (loop (cdr source) (car list1) 1 (cdr list1)))))))))