Решение упражнения 2.74 из SICP

22 February, 2008 (11:37) | Решения упражнений

Это упражнение сформулировано довольно обобщенно и допускает достаточно широкий диапазон трактовок. Я предлагаю один из вариантов по мотивам предшествующего раздела книги, который демонстрирует основные идеи.

Итак, пусть в компании Insatiable Enterprises, Inc. есть два отела: разработки (инженерный) и продаж.

В отделе разработки записи о сотрудниках содержат имена, должности и размеры окладов. Запись соединяет поля с помощью операций cons. Сами записи хранятся в списке. Для поиска записи в списке определена специальная процедура поиска.

(define (make-employee name position salary)
  (cons name (cons position salary)))
(define (get-name employee)
  (car employee))
(define (get-position employee)
  (cadr employee))
(define (get-salary employee)
  (cddr employee))
(define employees
  (list (make-employee 'Hugo 'junior 60000)
        (make-employee 'Alyssa 'senior 90000)
        (make-employee 'Eva 'lead 100000)
        (make-employee 'Ben 'senior 110000)))
(define (get-employee name)
  (define (find-employee employees)
    (cond ((null? employees) null)
          ((eq? name (get-name (car employees)))
           (car employees))
          (else (find-employee (cdr employees)))))
    (find-employee employees))

В отделе продаж работают люди опытные и творческие. Поэтому записи о сотрудниках содержат самое главное: имена, размеры окладов и стаж. Запись соединяет поля просто в список. Сами записи задаются в специальная процедуре, возвращающей соответствующую запись по ключу – имени сотрудника.

(define (make-record name salary experience)
  (list 'employee name salary experience))
(define (get-record-name record)
  (cadr employee))
(define (get-record-salary record)
  (caddr employee))
(define (get-record-experience record)
  (cadddr employee))
(define (get-salesman who)
  (cond ((eq? who 'Mike) (make-record 'Mike 200000 5))
        ((eq? who 'Jennifer) (make-record 'Jennifer 180000 3))
        ((eq? who 'Scott) (make-record 'Scott 250000 10))
        (else null)))

Как видим, структуры представления данных в записи и хранения самих записей отличаются друг от друга довольно сильно. Для того, чтобы работать с ними единообразно, мы завернем данные об отделах в пакеты и поместим операции над данными в таблицу типов. В этой таблице тип будет задаваться именем отдела, а операциями будут имена обобщенных операций, например get-record.

(define (install-engineering-department)
  (define (make-employee name position salary)
    (cons name (cons position salary)))
  (define (get-name employee)
    (car employee))
  (define (get-position employee)
    (cadr employee))
  (define (get-salary employee)
    (cddr employee))
  (define employees
    (list (make-employee 'Hugo 'junior 60000)
          (make-employee 'Alyssa 'senior 90000)
          (make-employee 'Eva 'lead 100000)
          (make-employee 'Ben 'senior 110000)))
  (define (get-employee name)
    (define (find-employee employees)
      (cond ((null? employees) null)
            ((eq? name (get-name (car employees)))
             (car employees))
            (else (find-employee (cdr employees)))))
    (find-employee employees))
  (put 'get-record 'engineering get-employee)
  (put 'get-salary 'engineering get-salary)
  'done)

(define (install-sales-department)
  (define (make-record name salary experience)
    (list 'employee name salary experience))
  (define (get-record-name record)
    (cadr employee))
  (define (get-record-salary record)
    (caddr employee))
  (define (get-record-experience record)
    (cadddr employee))
  (define (get-salesman who)
    (cond ((eq? who 'Mike) (make-record 'Mike 200000 5))
          ((eq? who 'Jennifer) (make-record 'Jennifer 180000 3))
          ((eq? who 'Scott) (make-record 'Scott 250000 10))
          (else null)))
  (put 'get-record 'sales get-salesman)
  (put 'get-salary 'sales get-record-salary)
  'done)

а. Теперь мы можем легко написать обобщенную процедуру получения записи сотрудника по его имени и отделу:

(define (get-record name department)
  ((get 'get-record department) name))

б. Для того, чтобы получить зарплату сотрудника, мы сначала добываем из таблицы операцию извлечения информации о зарплате из записи для данного отдела, а затем применяем ее к записи сотрудника, полученной обобщенной процедурой get-record:

(define (get-salary name department)
  ((get 'get-salary department)
   (get-record department name)))

в. Для поиска записи о сотруднике по всем подразделениям будем использовать описанную ниже процедуру, на вход которой достаточно будет передать имя сотрудника и список названий подразделений:

(define (find-employee-record name departments)
  (if (null? departments)
      null
      (let ((record (get-record name (car departments))))
        (if (null? record)
            (find-employee-record name (cdr departments))
            record))))

Здесь при реализации можно было бы использовать библиотечную процедуру findf.

г. Для внесения в систему информации о новых подразделениях достаточно будет установить пакет для соответствующего подразделения, в который включить специфичное для него описание данных о сотрудниках и дополнительно задать новую строку операций в таблице типов, соответствующую этому подразделению, с помощью набора вызовов put:

(define (install-new-department)
  ;; ...
  (put 'get-record 'new get-record-new)
  (put 'get-salary 'new get-salary-new)
  'done)

При этом ничего менять ни в пакетах других подразделений, ни в обобщенных процедурах get-record, get-salary и т.д. не нужно! Именно в этом и заключается наш выигрыш.

Comments

Comment from potters-owl
Date: September 23, 2010, 10:58 am

В этой и других процедурах, определенных для отдела продаж, в аргументах процедуры связана одна переменная, а в теле вместо неё используется другая.
(define (get-record-name record)
(cadr employee))

Comment from potters-owl
Date: September 23, 2010, 12:03 pm

еще несовпадение декларации и использования обобщенной процедуры get-record:
(define (get-record name department)

(get-record department name)

Comment from potters-owl
Date: September 23, 2010, 12:05 pm

А вообще, если читаете комментарии, не подумайте плохого, эти Решения – очень хорошая и объемная работа!

Comment from corund
Date: May 24, 2014, 1:02 am

Чтобы проверить упражнение, используйте реализацию Put и Get из раздела 3.3.3

Write a comment