За една задача от ФМИ

Преди два месеца ме помолиха да помгна с една задача, дадена на изпит по функционално програмиране. Ето горе-долу как изглеждаше тя:

Да се напише програма на Scheme, която да пресмята честотата на атомите в даден лист. Пример:
Вход: '(a a b c)
Изход: '((2 a) (1 b) (1 c))


Да си призная тогава отказах, защото решението трябваше да се достави в рамките на 2 часа, а аз бях несигурен. Не бях писал на Scheme поне от 4 години. Но си е предизвикателсвто, та реших да си припомня. Чел съм две книги по-темата: How to Design Programs и другата е The Little Schemer (цитатите в карето са от тази книга).

Аз ползвам Emacs за всичко освен за Java, така че беше логично да търся начин да го настроя за Scheme. Няма много избор, така че бързо си настроих Geiser. Нещата не потръгнаха, защото много неща съм забравил и се наложи да правя debug. Не става, така че на помощ идва DrRacket. Много добре, само дето не можах да му настроя key shortcuts да бъдат като на Emacs и се лиших от paredit.

Да си кажа честно не се справих в рамките на два часа със задачата. Ето и стъпките премесени с елементи на расъждение...
Реших да загрея пък и да си тествам средата като си поставих следната задача:

Да се провери дали даден атом принадлежи на даден списък. Пример:
Вход: 'a '(a b c))
Изход: #t


Не беше трудно

(define in-trace?
  (lambda (a lat)
    (cond
      ((null? lat) #f)
      ((eq? a (car lat)) #t)
      (else
       (in-trace? a (cdr lat))))))

;; (in-trace? 'a '(a b c)) ;; #t

Забележка: (define (in-trace? a lat)... е syntactic sugar на
(define in-trace? (lambda (a lat)....

The law of car:  The primitive car is defined only for non-empty lists.

The law of cdr:  The primitive cdr is defined only for non-empty lists.
                       The cdr of any non-empty list is always another list.

Scheme style:  Affix a question mark to the end of a name for a procedure whose
                      purpose is to ask a question of an object and to yield a boolean answer.
(Pronounce the question mark as if it were the isolated letter 'p'. For example, to read the fragment (PAIR? OBJECT) aloud, say: 'pair-pee object.')

Най-важното, което също подцених е самия алгоритъм, по който ще работя. Не го проиграх с лист и химикал, а писах хаотично. Притеснявах се за знанията си по Scheme, исках всичко да е много cool, исках да се докажа - това ме забави.

.----------------------------------------------------------------------------.
| The sixth commandment                                                      |
|                                                                            |
| Simplify (make it cool) only after the function is correct.                |
'----------------------------------------------------------------------------'

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

(a a b c c) -> (2 a)
(b c c)     -> (1 b)
(c c)       -> (2 c)

Бързо се справих и извадих поуки:

(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))))))
;; (count-trace 'a '(a b a a a a c)) ;; 5

.----------------------------------------------------------------------------.
| The fourth commandment: (preliminary version)                              |
|                                                                            |
| Always change at least one argument while recurring. It must be changed to |
| be closer to termination. The changing argument must be tested in the      |
| termination condition: when using cdr, test the termination with null?.    |
'----------------------------------------------------------------------------'

Рекурсията си я представям като спирала, която първоначално се навива за да дойде момента, в който проверката ((null? lat) 0) ще я спре. Тогава почва да се развива и функцията ще върне последния ред от тази спирала(функция) - там траява да се формира решението.

.----------------------------------------------------------------------------.
| The first commandment (final version)                                      |
|                                                                            |
| When recurring on a list of atoms, lat, ask two questions about it:        |
| (null? lat) and else.                                                      |
| When recurring on a number, n, ask two questions about it: (zero? n) and   |
| else.                                                                      |
| When recurring on a list of S-expressions, l, ask three questions about    |
| it: (null? l), (atom? (car l)), and else.                                  |
'----------------------------------------------------------------------------'

Следващата стъпка е да направя редуцирания списък:

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

   
;; (reduce 'a '(a b c a)) ;; '(b c)

Задавали ли сте си въпроса какво ще стане ако имаме условие в else и то не мине? Резултат не е предвидим! Затова else не трябва да пропада.
Както в Common Lisp (cond ....(else... може да се напише и така (cond ....(#t...

Веднага рефакторирам - всички проверки минават над else всичко друго остава:

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

;; (reduce 'a '(a b c a)) ;; '(b c)

Тук са три много важни правила:

.----------------------------------------------------------------------------.
| The second commandment:                                                    |
|                                                                            |
| Use cons to build lists.                                                   |
'----------------------------------------------------------------------------'

Когато четох за първи път една книга за Lisp си мислех, че cons е много лесно нещо, но се оказа, че не съм съвсем прав.
Ако си мислите и вие така, тогава защо:

> (cons '(1 2) '(3 4))
((1 2) 3 4)

Hint: How this is represented in memory?

.----------------------------------------------------------------------------.
| Golden rule of cons:                                                       |
| The second argument to cons should be a list, and every list is ended by   |
| '()                                                                        |
'----------------------------------------------------------------------------'

Ето и някои обяснения, които смятам че са полезни:
cons build pairs, not lists! Lisp interpreters uses a 'dot' to visually separate the elements in the pair. car and cdr respectively return the first and second elements of a pair.

Lists are built on top of pairs. If the cdr of a pair points to another pair, that sequence is treated as a list.
The cdr of the last pair will point to a special object called null (represented by '()) and this tells the interpreter that it has reached the end of the list.
For example, the list '(a b c) is constructed by evaluating the following expression:

(cons 'a (cons 'b (cons 'c '())))
(a b c)

The list procedure provides a shortcut for creating lists:

(list 'a 'b 'c)
(a b c)

Another way to think of sequences whose elements are sequences is as trees.
The elements of the sequence are the branches of the tree, and elements that are themselves sequences are subtrees.

.----------------------------------------------------------------------------.
| The third commandment:                                                     |
|                                                                            |
| When building lists, describe the first typical element, and then cons it  |
| onto the natural recursion.                                                |
'----------------------------------------------------------------------------'

Пояснения за последното.

(else (cons (car lat) (reduce a (cdr lat))))
            |_______| |___________________|
             typical    natural recursion (recur on the rest of lat)

Хей, май сме готови?

(define freq
  (lambda (lst)
    (define freq-in
      (lambda (lat seen)
        (cond
          ((null? lat) seen)
          (else
           (freq-in (reduce (car lat) lat)
                     (cons (cons (count-trace (car lat) lat) (car lat)) seen))))))
    (freq-in lst '())))

;; (freq '(a a a c b e f c f g t t w w w w w g h))
;; '((1 . h) (5 . w) (2 . t) (2 . g) (2 . f) (1 . e) (1 . b) (2 . c) (3 . a))

Използвам closure функция, за да премахна паразитните параметри. Not bad, dude? Може би забелязвате проблема с изхода? Подреждам символите в обратен ред - това си е доста често срещан проблем в Lisp.

(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 '())))

;; (revert '(a b c)) ;; '(c b a)
;; (revert '((1 1) (2 2) (3 3))) ;; '((3 3) (2 2) (1 1))

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

Може би ще намерите за по-подходящо следния метод - да разпишете рекурсията.
Примера е от "The Little Schemer":

;; The rember function removes the first occurrence
;; of the given atom from the given list.
(define rember
  (lambda (a lat)
    (cond
      ((null? lat) '())
      ((eq? (car lat) a) (cdr lat))
      (else (cons (car lat)
                  (rember a (cdr lat)))))))

;; (rember 'cup '(coffee mock cup tea cup hick)) ; '(coffee mock tea cup hick)

Най-труден е ред: ((eq? (car lat) a) (cdr lat)). Как да се съобрази съставянето на списъка?

(rember 'cup '(coffee mock cup tea hick))=
= (cons 'coffee (rember 'cup '(mock cup tea hick)))=
= (cons 'coffee (cons 'mock (rember 'cup '(cup tea hick)))= we hit ((eq? ...)
                                               |_______|
                                          (cdr '(cup tea hick)) and result is ready

С добро съмочувствие написвам и крайното решение като използам правилото:

.----------------------------------------------------------------------------.
| The eighth commandment                                                     |
|                                                                            |
| Use help functions to abstract from representations.                       |
'----------------------------------------------------------------------------'

(define freq-final
  (lambda (lst)
    (define freq-in
      (lambda (lat seen)
        (cond
          ((null? lat) seen)
          (else
           (revert
            (freq-in (reduce (car lat) lat)
                     (cons (cons (count-trace (car lat) lat) (car lat)) seen)))))))
    (freq-in lst '())))

;; (freq-final '(a a a c b e f c f g t t w w w w w g h))
;; '((3 . a) (2 . c) (1 . b) (1 . e) (2 . f) (2 . g) (2 . t) (5 . w) (1 . h))

;; (freq-final '(a a b c))
;; '((2 . a) (1 . b) (1 . c))

;; (freq-final '()) ;; '()

Като решение за задача на изпит е достатъчно. Въпроса е дали не можем да направим нещо допълнително. Трябва да помисля!

Това count-trace обвързващо така да се каже. Може да исаме нещо от рода на count-odd-trace.
Правя промените:

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

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

.----------------------------------------------------------------------------.
| The ninth commandment                                                      |
|                                                                            |
| Abstract common patterns with a new function.                              |
'----------------------------------------------------------------------------'

From Lambda Calculus: One thing we do know how to do is: We know how to get rid of free variables.

Think about it: Why is x free in (lambda (y) x)? Because it doesn’t look like this: (lambda (x) (lambda (y) x)). Well, if we want it to look like that, let’s just make it be that! After all, we’re not changing the value of the expression, we’re only changing the way the free variable will derive its meaning:

We’re promising to pass in the value rather than rely on the rules of lexical scoping to ascribe the right value from the static (lexically apparent) context. This process of factoring out free variables is called abstraction.

Update: След като прочетох "Seasoned Schemer", видях че е удобно да използвам let конструкцията, за да премахна повтарящите се конструкции и това "паразитно" викане на помощната функция:

(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)))))))))

.----------------------------------------------------------------------------.
| The fifteenth commandment (revised version)                                |
|                                                                            |
| Use (let ...) to name the values of repeated expressions in a function     |
| definition if they may be evaluated twice for one and the same use of the  |
| function.                                                                  |
'----------------------------------------------------------------------------'

Имайки тази абстракция много лесно мога да напиша нейни производини:

(define count-freq
  (lambda (lat)
    (freq-* lat count-trace)))

;; (count-freq '(a a b c)) ;; '((2 . a) (1 . b) (1 . c))

Дали сме за шестица? Да - ако алгоритъма, който съм избрал е правилен и с не много голяма сложност. Правилото за оценка е:

The asymptotic outlook:  Ask not which takes longer, but rather which is more rapidly taking longer as the problem size increases.

Гледам крайния резултат и не ми харесва. Написана е с лутане, макар и да е правилна. Никой Lisp програмист не би я написал по този начин. Няма ситил, просто сбор от правила. Във втора част са поправките.