За една задача от ФМИ (част 2)

В първа част описах как разсъждавм докато решавам една задача от ФМИ. Всичко стана много стихийно, така че крайния резултат макар и да дава верни резултати не ме удовлетвори. "Моя човек" си взе изпита между другото, макар и да му се наложило да дава сложни обяснения, защо не е решил задачата :)

Пита се къде е грешката?

;; nothing to change
(define count-trace
  (lambda (a lat)
    (cond
      ((null? lat) 0)
      ((eq? a (car lat)) (+ 1 (count-trace a (cdr lat))))
      (else
       (count-trace a (cdr lat))))))

(define reduce
  (lambda (a lat)
    (cond
      ((null? lat) '())
      ((eq? (car lat) a) (reduce a (cdr lat)))
      (else
       (cons (car lat) (reduce a (cdr lat)))))))

(define revert
  (lambda (lst)
    (define revert-in
      (lambda (lat rev)
        (cond
          ((null? lat) rev)
          (else
           (revert-in (cdr lat) (cons (car lat) rev))))))
    (revert-in lst '())))

(define freq-*
  (lambda (lst func)
    (let freq-in ((lat lst ) (seen '()))
      (cond
        ((null? lat) seen)
        (else
         (let ((curr (car lat)))
           (revert (freq-in (reduce curr lat)
                            (cons (cons (func curr lat) curr) seen)))))))))

(define count-freq
  (lambda (lat)
    (freq-* lat count-trace)))
 
;; (count-freq '(a a b c)) ;; '((2 . a) (1 . b) (1 . c))

В Lisp ако не познаваш добре специалните форми и не знаеш API-то много лесно да предефинираме някои от тях. Когато някой пише на Lisp той обикновено знае няколко диалекта - Scheme, Common Lisp или Clojure и съответно пренася своите знания. Ето защо никога не би използвал името 'reduce' за име на функция, която маха елемент от лист. За справка ето какво прави reduce в Common Lisp:

(reduce #'* '(1 2 3 4 5)) =>  120

Редуцира списъка като прилага съответна функция. Затова правилното име е remove и спазвам същата сигнатура на параметрите

(define (remove elm ls)
  (cond
    ((null? ls) '())
    ((equal? (car ls) elm) (remove elm  (cdr ls)))
    (else
     (cons (car ls) (remove elm (cdr ls))))))

Това до тук е малък проблем. Защо се налага да пиша 'revert'?! Името не е ли по добре да е 'revers'?

(define (reverse seq)
  (if (null? seq)
      '()
      (cons (reverse (cdr seq)) (car seq))))

(reverse '(4 3 2 1)) ;; '((((() . 4) . 3) . 2) . 1)

'reverse' определено е много по-добре и другото е, че повлиян от 'Little Schemer' използвам във всички ситуации cond. Не е нужно. Иначе разсъжденията ми са правилни:

Поставам (2 3 4) пред 1. Поставям (3 4) пред (2 1). Поставям 4 пред (3 2 1).
Забелязах, че винаги вземам cdr като първи параметър и оставям втория да формира списъка - обединявам с cons.

Грешка е, че не съм го приложил правилно. Поставам (2 3 4) пред 1 .... Поставям (3 4)... .
Поставям, поставям .... значи рекурсия и най-накрая обединявам с cons т.е

(cons (reverse (cdr seq)) (car seq))))

е много по-правилно отколкото:

(revert-in (cdr lat) (cons (car lat) rev))

Да, ама кой да внимава! Да ме пита човек защо поставям рекурсивното извикване най-отпред. Резултата '((((() . 4) . 3) . 2) . 1) не е чак толкова обезкуражаващ. По грешен начин конкатенирам.

(define (reverse items) 
   (if (null? items) 
       '() 
       (append (reverse (cdr items)) 
               (list (car items)))))

(reverse '(1 2 3 4)) ;; (4 3 2 1)

Тука хитрината е: (list (car items)). append приема два листа затова 4 го представяме като (4) и append се превръща в агрегатор. Много често се използва.

Нещо подобно се случва и с freq-*. Пак решението е било пред мен ама съм го изпуснал. Ето какво съм предложил за алгоритъм:
Вземам първия атом и броя колко пъти се среща, записвам и редуцирам списъка като махам този атом.

Това не е много "подходящо" за рекурсия или поне не е много интуитивно. Винаги трябва да има базов случай и после рекурсия. Правилното е:
Вземам първия атом и броя колко пъти се среща и записвам резултата, повтарям за редуцирания списък

1. Вземам първия атом и броя колко пъти се среща

;; PARTIAL: only once
(define (trace-first seq)
  (list (car seq) (count-trace (car seq) seq)))

(trace-first '(a b c a)) ;; '(a 2)

2. Повтарям за редуцирания списък
"Повтарям" ни подсказва рекурсия, следователно:

(define (trace-all seq)
  (if (null? seq)
      '()
      (cons (trace-first seq) (trace-all (remove (car seq) seq)))))

(trace-all '(a a a c b e f c f g t t w w w w w g h)) ;;  '((a 3) (c 2) (b 1) (e 1) (f 2) (g 2) (t 2) (w 5) (h 1))

Може да не повярвате, но това е всичко. Следва малко шлифоване:

(define (trace-all seq)
  (letrec
      ((T (lambda (a lat)
            (cond
              ((null? lat) 0)
              ((eq? a (car lat)) (+ 1 (T a (cdr lat))))
              (else
               (T a (cdr lat)))))))
       (if (null? seq)
           '()
           (let ((first (car seq)))
             (cons (list first (T first seq))
                   (trace-all (remove first seq)))))))

(trace-all '(a a a c b e f c f g t t w w w w w g h)) ;;

и още малко за краен резултат:

(define (remove elm ls)
  (cond
    ((null? ls) '())
    ((equal? (car ls) elm) (remove elm (cdr ls)))
    (else
     (cons (car ls) (remove elm (cdr ls))))))
 
(define (freq-* seq func)
  (letrec
      ((T (lambda (a lat)
            (cond
              ((null? lat) 0)
              ((eq? a (car lat)) (+ 1 (T a (cdr lat))))
              (else
               (T a (cdr lat)))))))
       (if (null? seq)
           '()
           (let ((first (car seq)))
             (cons (list first (T first seq))
                   (freq-* (func first seq) func))))))
 
(define (freq-remove seq)
  (freq-* seq remove))
 
(freq-remove '(a a a c b e f c f g t t w w w w w g h)) ;; '((a 3) (c 2) (b 1) (e 1) (f 2) (g 2) (t 2) (w 5) (h 1))

Решението вече е много по-чисто и профисионално. 'remove' е допостимо да бъде отделна функция, вероятно ще се ползва и от други. С 'count-trace' нещата са различни, тя е помощна и твърде специализирана, за да я оставяме независима. Използвам правилото от "Seasoned Schemer":

.----------------------------------------------------------------------------.
| The thirteenth commandment                                                 |
|                                                                            |
| Use (letrec ...) to hide and to protect functions.                         |
'----------------------------------------------------------------------------'

С това мисля да сложа край на задачата. Получи се доста добър Scheme код. Ето и колекция от лекции, които са доста полезни. За Scheme гледайте от 19-23 включително. Ще разберете колко са важни 'map' и 'apply'. Ето един пример от там:

;;
;; Function: flatten-list
;; ----------------------
;; Flattens a list just like the original flatten does, but
;; it uses map, apply, and append instead of exposed car-cdr recursion.
;;
(define (flatten-list ls)
  (cond ((null? ls) '())
        ((not (list? ls)) (list ls))
        (else (apply append (map flatten-list ls)))))

(flatten-list '(1 2 (3) 4)) ;; (1 2 3 4)

Сложно е нали?