On this page:
Geneste Lijsten
11.1 Recursie/  iteratie op geneste lijsten:   modeloplossing
11.2 Diepte en bladeren van een boom
11.2.1 Aantal elementen van een boom
11.2.2 Diepte van een boom
11.2.3 Diepte en aantal elementen van een boom
11.3 fringe
11.4 Structuur vergelijken
11.5 Hogere Orde:   deep-combine en deep-map
11.5.1 Deep-combine
11.5.2 Deep-map
11.5.3 Deep-change
11.5.4 Deep-atom-member?
11.5.5 Count-atoms
11.6 Examen Informatica Partieel januari 1995
11.6.1 Tel bladeren
11.6.2 Zoek alle appels
11.6.3 Geef de verschillende soorten appels
11.6.4 Procedure om de boom te bewerken
11.6.5 Tel bladeren (hogere orde)
11.6.6 Geef alle appels (hogere orde)
11.6.7 Geef de verschillende soorten appels (hogere orde)
11.7 Circulaire Datastructuren:   cycles?
11.8 Oefening 3.16 uit Abelson&Sussman
11.9 Correcte versie count-pairs
11.10 Geneste Lijsten:   Extra Oefeningen
11.10.1 unfringe
11.10.2 Hogere Orde:   tree-accumulate
11.10.2.1 Implementeer
11.10.2.2 Hergebruik
11.10.3 Mobiles
11.10.3.1 Constructor en selectoren
11.10.3.2 Gewicht van een mobile
11.10.3.3 Gebalanceerd?
Familiebomen & Hiërarchische Relaties
11.11 Familieboompatroon:   modeloplossing
11.12 Examen Informatica 2e  Zit 1995
11.12.1 Bazen
11.12.2 Hiërarchisch?
11.12.3 Collega’s
11.13 Examen Informatica januari 2010
11.13.1 Print-vanaf
11.13.2 Print-tot
11.14 Examen Informatica januari 2008:   Boom vraag
11.14.1 Verdeel democratisch
11.14.2 Bereken budget
11.14.3 Verdeel budget onder nakomelingen zonder kinderen
11.15 Familiebomen & HiĆ«rarchische Relaties:   Extra Oefeningen
11.15.1 Examen Informatica tweede zit 1999:   Boom vraag
11.15.1.1 Tel-knallen
11.15.1.2 Tel-einde
11.15.1.3 Ster?
11.15.2 Examen Informatica augustus 2009
11.15.2.1 Abstract Data Type
11.15.2.2 Geef alle soorten
11.15.2.3 Verifieer eigenschap
11.15.3 Examen Informatica augustus 2006
11.15.3.1 Abstract Data Type
11.15.3.2 Tel fruit en bladeren
11.15.3.3 Normale tak?
11.15.4 Examen Informatica augustus 2008
11.15.4.1 Bereken omzet
11.15.4.2 Verdeel budget democratisch
11.15.4.3 Onafhankelijke verdeling van het budget
11.15.5 Examen Informatica januari 2005
11.15.5.1 Laat ondersteunde artiesten springen
11.15.5.2 Laat een artiest uit de piramide vallen
7.8

11 Bomen

Geneste Lijsten

11.1 Recursie/iteratie op geneste lijsten: modeloplossing

Het volgende stukje "pseudo-code" beschrijft een standaardpatroon van een boomrecursieve procedure. Bijna elke boomrecursieve procedure zal geschreven zijn volgens dit patroon, of een zeer sterk gelijkend patroon.

(define (atom? x)
  (not (pair? x)))
 
(define (tree-procedure-rec lst)
  (cond ((null? lst) base-result)
        ((atom? lst) atom-result)
        (else (combine-branches (tree-procedure-rec (car lst))
                                (tree-procedure-rec (cdr lst))))))

11.2 Diepte en bladeren van een boom

We weten dat we een boom kunnen voorstellen d.m.v. een geneste lijst.

11.2.1 Aantal elementen van een boom

Schrijf een procedure (leaf-count tree) die het aantal elementen (= bladeren) in zo’n boom telt.

(define (leaf-count tree)
  (cond
    ((null? tree) 0)
    ((atom? tree) 1)
    (else (+ (leaf-count (car tree))
             (leaf-count (cdr tree))))))

 

> (leaf-count '((1 2) ((3 4) 5) (6 7)))

7

11.2.2 Diepte van een boom

Schrijf een procedure depth die de nesting-diepte van een boom berekent. M.a.w. hoeveel haakjes staan er rond het meest geneste element van de boom?

(define (depth tree)
  (cond ((null? tree) 0)
        ((atom? tree) 0)
        (else (max (+ 1 (depth (car tree)))
                   (depth (cdr tree))))))

 

> (depth '((1 2) ((3 4) 5) (6 7)))

3

11.2.3 Diepte en aantal elementen van een boom

Schrijf een procedure die (a) en (b) combineert, maar zo efficiënt mogelijk. D.w.z. de boom mag maar 1 enkele keer volledig doorlopen worden.

(define (depth-and-leaf-count tree)
  (define make-res cons)
  (define depth car)
  (define leaf-count cdr)
 
  (cond
    ((null? tree) (make-res 0 0))
    ((atom? tree) (make-res 0 1))
    (else (let ((res-car (depth-and-leaf-count (car tree)))
                (res-cdr (depth-and-leaf-count (cdr tree))))
            (make-res (max (+ 1 (depth res-car))
                           (depth res-cdr))
                      (+ (leaf-count res-car)
                         (leaf-count res-cdr)))))))

 

> (depth-and-leaf-count '((1 2) ((3 4) 5) (6 7)))

(3 . 7)

11.3 fringe

Deze oefening is gebaseerd op oefening 2.28 van Structure and Interpretation of Computer Programs

Definieer de procedure (fringe l) die een lijst teruggeeft met alle atomen van een diepgeneste lijst.

(define (fringe l)
  (cond ((null? l) '())
        ((atom? l) (list l))
        (else (append (fringe (car l))
                      (fringe (cdr l))))))

 

> (fringe '((1) ((((2)))) (3 (4 5) 6) ((7) 8 9)))

(1 2 3 4 5 6 7 8 9)

11.4 Structuur vergelijken

Definieer het predicaat (same-structure? l1 l2), dat nagaat of twee lijsten op de atomen na dezelfde structuur hebben. Hou rekening met dotted-pairs.

(define (same-structure? l1 l2)
  (cond ((and (null? l1) (null? l2)) #t)
        ((or  (null? l1) (null? l2)) #f)
        ((and (atom? l1) (atom? l2)) #t)
        ((or  (atom? l1) (atom? l2)) #f)
        (else (and (same-structure? (car l1) (car l2))
                   (same-structure? (cdr l1) (cdr l2))))))
 
(define (same-structure?-or l1 l2)
  (or (and (null? l1) (null? l2))
      (and (atom? l1) (atom? l2))
      (and (pair? l1)
           (pair? l2)
           (same-structure?-or (car l1) (car l2))
           (same-structure?-or (cdr l1) (cdr l2)))))

 

> (same-structure? '((1 2) ((3 . 4) ((5 6) ((7 8) (9)))))
                   '((a b) ((c . d) ((e f) ((g h) (i))))))

#t

> (same-structure? '((1 2) ((3 4) ((5 6) ((7 8) (9)))))
                   '((((1 2) (3 4)) ((5 6) (7 8))) 9))

#f

11.5 Hogere Orde: deep-combine en deep-map

11.5.1 Deep-combine

Definieer de functie (deep-combine combiner null-value l), die alle atomen van een (eventueel geneste) lijst combineert.

(define (deep-combine combiner null-value l)
  (cond ((null? l) null-value)
        ((atom? l) l)
        (else (combiner (deep-combine combiner
                                      null-value
                                      (car l))
                        (deep-combine combiner
                                      null-value
                                      (cdr l))))))

 

> (deep-combine + 0 '((((1 2) (3 4)) ((5 6) (7 8))) 9))

45

11.5.2 Deep-map

Definieer de functie (deep-map f l), die als resultaat een lijst teruggeeft met dezelfde structuur als l, maar waarin alle atomen vervangen zijn door het resultaat van f op het atoom.

(define (deep-map f l)
  (cond
    ((null? l) '())
    ((atom? l) (f l))
    (else (cons (deep-map f (car l))
                (deep-map f (cdr l))))))

 

> (deep-map (lambda (x) (* x x))
            '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9))

((((1 . 4) (9 16)) ((25 36) (49 64))) . 81)

11.5.3 Deep-change

Definieer (deep-change e1 e2 l), aan de hand van deep-map en/of deep-combine, die een lijst terug met dezelfde structuur als l, maar alle atomen e1 verandert in e2.

(define (deep-change e1 e2 l)
  (deep-map (lambda (e) (if (eq? e e1) e2 e)) l))

 

> (deep-change 3 999 '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9))

((((1 . 2) (999 4)) ((5 6) (7 8))) . 9)

11.5.4 Deep-atom-member?

Definieer (deep-atom-member? e l), aan de hand van deep-map en/of deep-combine, die kijkt of e (een atoom) ergens in een geneste lijst voorkomt.

(define (deep-atom-member? e l)
  (deep-combine (lambda (car cdr) (or car cdr))
                #f
                (deep-map (lambda (x) (eq? e x)) l)))

 

> (deep-atom-member? 3 '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9))

#t

> (deep-atom-member? 999 '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9))

#f

11.5.5 Count-atoms

Definieer (count-atoms l), aan de hand van deep-map en/of deep-combine, die het aantal atomen in een lijst telt.

(define (count-atoms l)
  (deep-combine + 0 (deep-map (lambda (x) 1) l)))

 

> (count-atoms '((((1 . 2) (3 4)) ((5 6) (7 8))) . 9))

9

11.6 Examen Informatica Partieel januari 1995

Het laboratorium voor biotechnologie aan de VUB probeert een soort hybride appelboom te ontwikkelen waarop verschillende soorten appels kunnen groeien. Elke tak van zo’n boom kan vertakken in een nieuwe tak, maar er kunnen ook 1 of meerdere bladeren en/of appels aan hangen. Hieronder vind je een voorbeeld van zo’n boom.

Om de biologische eigenschappen van deze nieuwe boomsoort te voorspellen contacteren de onderzoekers het departement informatica om er een computermodel voor te ontwikkelen. In dit model zal de appelboom worden voorgesteld als een diepgeneste lijst. De bovenstaande boom ziet er in het model bijvoorbeeld als volgt uit:

(define boom
  '((blad (appel . golden))
    (blad (appel . granny))
    (((appel . golden) blad) blad (appel . cox))))

 

11.6.1 Tel bladeren

Schrijf een procedure (leafs boom) die het aantal bladeren in zo’n appelboom kan tellen.
(define (blad? boom)
  (eq? boom 'blad))
 
(define (appel? boom)
  (and (pair? boom) (eq? (car boom) 'appel)))
 
(define (type appel) (cdr appel))
 
(define (leafs boom)
  (cond  ((null? boom) 0)
         ((blad? boom) 1)
         ((appel? boom) 0)
         (else (+ (leafs (car boom))
                  (leafs (cdr boom))))))

 

> (leafs boom)

4

11.6.2 Zoek alle appels

Schrijf een procedure (all-apples boom) die een lijstje maakt van alle appels die in een gegeven appelboom voorkomen.
(define (all-apples boom)
  (cond ((null? boom) '())
        ((blad? boom) '())
        ((appel? boom) (list (type boom)))
        (else (append (all-apples (car boom))
                      (all-apples (cdr boom))))))

 

> (all-apples boom)

(golden granny golden cox)

11.6.3 Geef de verschillende soorten appels

Schrijf een procedure (apple-types boom) die een lijstje maakt van alle soorten appels die in een gegeven appelboom voorkomen. Het verschil met (all-apples boom) zit hem in het feit dat je nu geen dubbels in de resultaatlijst wil.

Hint: beschouw de lijsten als verzamelingen zoals je deze kent uit de wiskunde.

(define (union l1 l2)
  (cond
    ((null? l1) l2)
    ((member (car l1) l2) (union (cdr l1) l2))
    (else (cons (car l1) (union (cdr l1) l2)))))
 
(define (apple-types boom)
  (cond ((null? boom) '())
        ((blad? boom) '())
        ((appel? boom) (list (type boom)))
        (else (union (apple-types (car boom))
                     (apple-types (cdr boom))))))

 

> (apple-types boom)

(granny golden cox)

11.6.4 Procedure om de boom te bewerken

Schrijf een hogere-orde procedure (bewerk-boom boom doe-blad doe-appel combiner init) die je in het algemeen kan gebruiken om een appelboom te bewerken.
(define (bewerk-boom boom doe-blad doe-appel combiner init)
  (cond
    ((null? boom) init)
    ((blad? boom) (doe-blad boom))
    ((appel? boom) (doe-appel boom))
    (else (combiner
           (bewerk-boom (car boom) doe-blad doe-appel combiner init)
           (bewerk-boom (cdr boom) doe-blad doe-appel combiner init)))))

 

11.6.5 Tel bladeren (hogere orde)

Herschrijf (leafs boom) d.m.v. bewerk-boom. Noem deze versie (leafs-dmv-bewerk boom).
(define (leafs-dmv-bewerk boom)
  (bewerk-boom boom
               (lambda (blad) 1)
               (lambda (appel) 0)
               +
               0))

 

> (leafs-dmv-bewerk boom)

4

11.6.6 Geef alle appels (hogere orde)

Herschrijf all-apples d.m.v. bewerk-boom. Noem deze versie (all-apples-dmv-bewerk boom).
(define (all-apples-dmv-bewerk boom)
  (bewerk-boom boom
               (lambda(blad) '())
               (lambda(appel) (list (type appel)))
               append
               '()))

 

> (all-apples-dmv-bewerk boom)

(golden granny golden cox)

11.6.7 Geef de verschillende soorten appels (hogere orde)

Herschrijf apple-types d.m.v. bewerk-boom. Noem deze versie (all-types-dmv-bewerk boom).
(define (apple-types-dmv-bewerk boom)
  (bewerk-boom boom
               (lambda(blad) '())
               (lambda(appel) (list(type  appel)))
               union
               '()))

 

> (apple-types-dmv-bewerk boom)

(granny golden cox)

11.7 Circulaire Datastructuren: cycles?

Deze oefening is gebaseerd op oefening 3.18 van Structure and Interpretation of Computer Programs

Schrijf een predicaat (cycles? r) dat zegt of r een cyclus bevat (d.w.z. dat het aflopen van de lijst door opeenvolgende cdr’s in een oneindige loop raakt).

(define (cycles? lst)
  (define (find-cycles? current path)
    (cond
      ((null? current) #f)
      ((memq current path) #t)
      (else (find-cycles? (cdr current)
                          (cons current path)))))
  (find-cycles? lst '()))

 

> (cycles? '())

#f

> (cycles? '(1 2 3))

#f

> (define car-loop
    (let ((first (cons 'a '())))
      (set-car! first first)
      first))
> (cycles? car-loop)

#f

> (define ring
    (let* ((last (cons '3 '()))
           (list (cons 1 (cons 2 last))))
      (set-cdr! last list)
      list))
> (cycles? ring)

#t

11.8 Oefening 3.16 uit Abelson&Sussman

Je wil een functie schrijven die het aantal cons-cellen in een structuur telt. Toon aan dat onderstaande procedure count-pairs niet het gewenste resultaat geeft door box-pointer diagrammen met 3 cellen te tekenen, waarvoor het resultaat van count-pairs respectievelijk resulteert in 3, 4, 7 en een oneindige lus. Schrijf expressies om die structuren te maken.

(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
         1)))

 

  1. (define ret3 (cons 'a (cons 'b (cons 'c '()))))

     

    > (count-pairs ret3)

    3

  2. (define ret4
      (let ((last (cons 'c '())))
        (cons last (cons 'b last))))

     

    > (count-pairs ret4)

    4

  3. (define ret7
      (let* ((last (cons 'c '()))
             (middle (cons last last)))
        (cons middle middle)))

     

    > (count-pairs ret7)

    7

  4. (define retno
      (let* ((last (cons 'c '()))
             (lst (cons 'a (cons 'b last))))
        (set-cdr! last lst)
        lst))

     

    Geen resultaat; oneindige lus

11.9 Correcte versie count-pairs

Schrijf een correcte versie van de procedure count-pairs die het aantal verschillende cons-cellen teruggeeft.

Hint: hou een extra lijst bij van reeds getelde cons-cellen.

(define (count-pairs lst)
  (let ((path '()))
    (define (count current)
      (cond
        ((null? current) 0)
        ((not (pair? current)) 0)
        ((memq current path) 0)
        (else
         (set! path (cons current path))
         (+ 1 (count (car current))
            (count (cdr current))))))
    (count lst)))

 

> (define ret3 (cons 'a (cons 'b (cons 'c '()))))
> (count-pairs ret3)

3

> (define ret4
    (let ((last (cons 'c '())))
      (cons last (cons 'b last))))
> (count-pairs ret4)

3

> (define ret7
    (let* ((last (cons 'c '()))
           (middle (cons last last)))
      (cons middle middle)))
> (count-pairs ret7)

3

> (define retno
    (let* ((last (cons 'c '()))
           (lst (cons 'a (cons 'b last))))
      (set-cdr! last lst)
      lst))
> (count-pairs retno)

3

11.10 Geneste Lijsten: Extra Oefeningen

11.10.1 unfringe

Definieer de procedure (unfringe l) die een platte lijst als argument neemt en een lijst teruggeeft die, net als al haar sublijsten, maximaal 2 elementen telt en terug l geeft als je er fringe (uit vraag 3) op los laat.

Vermits verschillende lijsten hetzelfde resultaat kunnen opleveren met fringe, is het resultaat van unfringe niet eenduidig bepaald. Wij geven twee opties, die we unfringe-1 en unfringe-2 hebben genoemd. Implementeer één van de twee opties, maar definieer uw procedure als (unfringe l). Dit is belangrijk voor het automatisch testen.

Eerste manier:
(define (unfringe-1 l)
  (cond ((null? l) '())
        ((null? (cdr l)) (list (car l)))
        (else (list (car l)
                    (unfringe-1 (cdr l))))))

 

Tweede manier:
(define (unfringe-2 l)
  (define (pair l)
    (cond ((null? l) '())
          ((null? (cdr l)) (list l))
          (else (cons (list (car l) (cadr l))
                      (pair (cddr l))))))
 
  (let loop ((l l))
    (if (or (null? l)
            (null? (cdr l)))
        l
        (loop (pair l)))))

 

> (unfringe-1 '(1 2 3 4 5 6 7 8 9))

(1 (2 (3 (4 (5 (6 (7 (8 (9)))))))))

> (unfringe-2 '(1 2 3 4 5 6 7 8 9))

(((((1 2) (3 4)) ((5 6) (7 8))) (((9)))))

11.10.2 Hogere Orde: tree-accumulate
11.10.2.1 Implementeer

Definieer de hogere orde functie (tree-accumulate tree term combiner null-value), die werkt zoals accumulate uit reeks 4. De tree-accumulate procedure past de procedure term enkel toe op atomen, en gebruikt de combiner procedure om de accumulatie van de deellijsten te combineren.

(define (tree-accumulate tree term combiner null-value)
  (cond ((null? tree) null-value)
        ((atom? tree) (term tree))
        (else (combiner (tree-accumulate (car tree)
                                         term
                                         combiner
                                         null-value)
                        (tree-accumulate (cdr tree)
                                         term
                                         combiner
                                         null-value)))))

 

> (tree-accumulate '(9 ((9 9)) (((9 9))) (9))
                   (lambda (x) 1)
                   +
                   0)

6

11.10.2.2 Hergebruik

Definieer fringe, deep-combine en deep-map aan de hand van tree-accumulate.

(define (fringe l)
  (tree-accumulate l list append '()))
 
(define (deep-combine combiner null-value l)
  (tree-accumulate l
                   (lambda (x) x)
                   combiner
                   null-value))
 
(define (deep-map f l)
  (tree-accumulate l f cons '()))

 

11.10.3 Mobiles

Deze oefening is gebaseerd op oefening 2.29 van Structure and Interpretation of Computer Programs

Een mobile (zo’n ding dat je aan het plafond hangt en dat met de tocht beweegt), is ofwel een dom gewicht (getal), ofwel een koppel van twee armen, die elk een bepaalde lengte hebben en waaraan weer een mobile hangt. Je kan een mobile construeren door (make-mobile length1 weight1 length2 weight2), waarbij weight1 en weight2 ofwel getallen zijn (gewichten), ofwel weer mobielen.

11.10.3.1 Constructor en selectoren

Definieer deze constructor en de selectoren (length1 mobile), (weight1 mobile), (length2 mobile), (weight2 mobile).

(define (make-mobile length1 weight1 length2 weight2)
  (list length1 weight1 length2 weight2))
 
(define (length1 mobile) (list-ref mobile 0))
 
(define (weight1 mobile) (list-ref mobile 1))
 
(define (length2 mobile) (list-ref mobile 2))
 
(define (weight2 mobile) (list-ref mobile 3))

 

> (define inner-mobile1 (make-mobile 0 2 0 4))
> (define inner-mobile2 (make-mobile 0 4 0 8))
> (make-mobile 1 inner-mobile1 2 inner-mobile2)

(1 (0 2 0 4) 2 (0 4 0 8))

11.10.3.2 Gewicht van een mobile

Definieer (mobile-weight m), die het totaal gewicht van het mobile teruggeeft (het gewicht van de takken is verwaarloosbaar).

(define (mobile-weight mobile)
  (if (atom? mobile)
      mobile
      (+ (mobile-weight (weight1 mobile))
         (mobile-weight (weight2 mobile)))))

 

> (define inner-mobile1 (make-mobile 0 2 0 4))
> (define inner-mobile2 (make-mobile 0 4 0 8))
> (define mobile (make-mobile 1 inner-mobile1 2 inner-mobile2))
> (mobile-weight mobile)

18

11.10.3.3 Gebalanceerd?

Een mobile is in evenwicht wanneer het gewicht van tak 1 vermenigvuldigd met de lengte van tak 1 gelijk is aan het gewicht van tak 2 vermenigvuldigd met de lengte van tak 2, en wanneer deze conditie geldt voor alle sub-mobiles. Definieer het predicaat (balanced? m), dat zegt of mobiel m gebalanceerd is.

(define (relative-weigth1 mobile)
  (* (length1 mobile)
     (mobile-weight (weight1 mobile))))
 
(define (relative-weigth2 mobile)
  (* (length2 mobile)
     (mobile-weight (weight2 mobile))))
 
(define (balanced? mobile)
  (or (atom? mobile)
      (and (= (relative-weigth1 mobile)
              (relative-weigth2 mobile))
           (balanced? (weight1 mobile))
           (balanced? (weight2 mobile)))))

 

> (define inner-mobile1 (make-mobile 0 2 0 4))
> (define inner-mobile2 (make-mobile 0 4 0 8))
> (define mobile (make-mobile 1 inner-mobile1 2 inner-mobile2))
> (balanced? mobile)

#f

> (define inner-mobile1 (make-mobile 0 2 0 4))
> (define inner-mobile2 (make-mobile 0 4 0 8))
> (define mobile (make-mobile 2 inner-mobile1 1 inner-mobile2))
> (balanced? mobile)

#t

Familiebomen & Hiërarchische Relaties

11.11 Familieboompatroon: modeloplossing

Het volgende stukje "code" beschrijft een standaardpatroon voor een familieboom.

(define (parent tree)   ...)
(define (children tree) ...)
 
(define (tree-proc tree ...)
  (cond ((test-parent (parent tree)) ...)
        (else (tree-proc-in (children tree) ...))))
 
(define (tree-proc-in lst ...)
  (cond ((null? lst) ...)
        (else (combine-res (tree-proc (car lst) ...)
                           (tree-proc-in (cdr lst) ...)))))

11.12 Examen Informatica 2eZit 1995

Beschouw het organigram van een bedrijf. De meest voor de hand liggende representatie van zo’n organigram is de boomstructuur. Hieronder vind je een voorbeeld van zo een bedrijf.

Bovenstaande boomstructuur kunnen we in Scheme gemakkelijk voorstellen d.m.v. geneste lijsten:
(define organigram
  '(directeur
    (hoofd-verkoop (verkoopsleider-vlaanderen)
                   (verkoopsleider-brussel))
    (hoofd-productie (hoofd-inkoop (bediende1)
                                   (bediende2)
                                   (bediende3))
                     (hoofd-fakturen))
    (hoofd-administratie (hoofd-personeel)
                         (hoofd-boekhouding))))

 

> (define (baas organigram) (car organigram))
> (define (sub-organigrammen organigram) (cdr organigram))
11.12.1 Bazen

Schrijf een procedure (bazen-van organigram p) die een lijst teruggeeft van alle bazen die in een "rechte lijn" boven een personeelslid p staan. Met andere woorden moet je een pad vinden van de directeur tot aan het personeelslid p.

(define (bazen-van organigram p)
  (define (bazen-van organigram path)
    (if (eq? (baas organigram) p)
        path
        (bazen-van-in (sub-organigrammen organigram)
                      (cons (baas organigram) path))))
  (define (bazen-van-in organigrammen path)
    (if (null? organigrammen)
        #f
        (or (bazen-van (car organigrammen) path)
            (bazen-van-in (cdr organigrammen) path))))
  (bazen-van organigram '()))

 

> (bazen-van organigram 'bediende2)

(hoofd-inkoop hoofd-productie directeur)

11.12.2 Hiërarchisch?

Schrijf een predicaat (hierarchisch? p1 p2 organigram), dat nagaat of er een hiërarchische relatie bestaat tussen 2 personeelsleden. (D.w.z. liggen ze op eenzelfde pad in de boom?)

(define (hierarchisch? p1 p2 organigram)
  (define (hierarchisch?-in path organigrammen)
    (if (null? organigrammen)
        #f
        (or (hierarchisch? path (car organigrammen))
            (hierarchisch?-in path (cdr organigrammen)))))
 
  (define (hierarchisch? path organigram)
    (cond
      ((and (eq? p1 (baas organigram)) (member p2 path)) #t)
      ((and (eq? p2 (baas organigram)) (member p1 path)) #t)
      (else (hierarchisch?-in (cons (baas organigram) path)
                              (sub-organigrammen organigram)))))
  (hierarchisch? '() organigram))

 

> (hierarchisch? 'directeur 'verkoopsleider-brussel organigram)

#t

> (hierarchisch? 'bediende1 'hoofd-productie organigram)

#t

> (hierarchisch? 'hoofd-personeel 'bediende3 organigram)

#f

11.12.3 Collega’s

Eén van de personeelsleden krijgt binnenkort een dochtertje. Volgens de bedrijfstraditie moet hij daarom doopsuiker sturen naar al de personeelsleden waarvan hij het (rechtstreekse of onrechtstreekse) hoofd is, evenals naar al zijn oversten. Schrijf een procedure (collegas p organigram) die een lijstje met al deze personen opstelt.

(define (collegas p organigram)
  (define (collegas-in oversten organigrammen)
    (if (null? organigrammen)
        #f
        (or (collegas oversten (car organigrammen))
            (collegas-in oversten (cdr organigrammen)))))
 
  (define (werknemers-in organigrammen)
    (if (null? organigrammen)
        '()
        (append (werknemers (car organigrammen))
                (werknemers-in (cdr organigrammen)))))
 
  (define (werknemers organigram)
    (cons (baas organigram)
          (werknemers-in (sub-organigrammen organigram))))
 
  (define (collegas oversten organigram)
    (if (eq? p (baas organigram))
        (append oversten
                (werknemers-in (sub-organigrammen organigram)))
        (collegas-in (cons (baas organigram) oversten)
                     (sub-organigrammen organigram))))
(collegas '() organigram))

 

> (collegas 'hoofd-inkoop organigram)

(hoofd-productie directeur bediende1 bediende2 bediende3)

11.13 Examen Informatica januari 2010

Onderstaande boomstructuur geeft een stukje weer van het organigram van de VUB. De VUB organisatie kan onderverdeeld worden in een academisch stuk en in een administratief stuk. De adminstratie kan op haar beurt onderverdeeld worden in personeel, financiën, etc. Elke dienst kan dan nog verder opgedeeld worden. De academische organisatie bestaat uit het rectoraat en de faculteiten. De faculteiten zijn bvb. Rechten, Economie en Wetenschappen. (Er zijn nog andere faculteiten maar deze hebben we niet op het organigram aangeduid).

Elke faculteit heeft diverse bachelorprogramma’s en masterprogramma’s. Let op, je oplossingen voor de vragen hieronder moeten algemeen zijn; dus kunnen werken in situaties waar er nog een verder opdeling is van het rectoraat, van de richtingen, etc.

(define VUBOrganigram
  '(VUB (academisch (rectoraat)
                    (faculteiten
                     (rechten (bachelor (ba-rechten)
                                        (ba-criminologie))
                              (master (ma-rechten)
                                      (ma-criminologie)))
                     (economie)
                     (wetenschappen (bachelor (ba-wiskunde)
                                              (ba-fysica)
                                              (ba-cw))
                                    (master (ma-wiskunde)
                                            (ma-fysica)
                                            (ma-cw)))))
        (administratief (personeel) (financien))))

 

Maw de diepte van de boom ligt niet vast.

Veronderstel dat een procedure (print-lijn aantalblanco tekst) gegeven is die als input een getal neemt en een tekst en die de tekst afprint op 1 lijn met het gegeven aantal blanco’s ervoor.
(define (display-n n d)
  (cond ((> n 0) (display d)
                 (display-n (- n 1) d))))
 
(define (print-lijn aantalblanco tekst)
  (display-n aantalblanco " ")
  (display tekst)
  (newline))

 

(define (label organigram)  (car organigram))
(define (takken organigram) (cdr organigram))

 

11.13.1 Print-vanaf

Schrijf een procedure (print-vanaf organigram label) die de organisatiestructuur weergeeft van een gegeven onderdeel binnen een gegeven organigram en dit op een geïndenteerde manier. Een voorbeeld (VUBOrganigram verwijst naar bovenstaande boomstructuur):

(define (organigram-member-in een-label organigrammen)
  (if (null? organigrammen)
      #f
      (or (organigram-member een-label (car organigrammen))
          (organigram-member-in een-label (cdr organigrammen)))))
 
(define (organigram-member een-label organigram)
  (if (eq? een-label (label organigram))
      organigram
      (organigram-member-in een-label (takken organigram))))
 
(define (print organigram)
  (define (print diepte organigram)
    (print-lijn diepte (label organigram))
    (for-each (lambda (organigram)
                (print (+ diepte 1) organigram))
              (takken organigram)))
  (print 0 organigram))
 
(define (print-vanaf organigram label)
  (let ((res (organigram-member label organigram)))
    (if res
        (print res)
        #f)))

 

> (print-vanaf VUBOrganigram 'rechten)

rechten

 bachelor

  ba-rechten

  ba-criminologie

 master

  ma-rechten

  ma-criminologie

11.13.2 Print-tot

Schrijf een procedure (print-tot organigram niveau) die het organigram afprint tot op een bepaald niveau en dit terug geïndenteerd.

(define (print-tot organigram niveau)
  (define (print organigram huidig-niveau)
    (cond ((<= huidig-niveau niveau)
           (print-lijn huidig-niveau (label organigram))
           (print-in (takken organigram) (+ huidig-niveau 1)))))
  (define (print-in organigrammen huidig-niveau)
    (cond ((not (null? organigrammen))
           (print (car organigrammen) huidig-niveau)
           (print-in (cdr organigrammen) huidig-niveau))))
  (print organigram 0))

 

Dit kunnen we ietwat vereenvoudigen door gebruik te maken van for-each.

(define (print-tot organigram niveau)
  (define (print-tot organigram huidig-niveau)
    (cond ((<= huidig-niveau niveau)
           (print-lijn huidig-niveau (label organigram))
           (for-each
            (lambda (organigram)
              (print-tot organigram (+ huidig-niveau 1)))
            (takken organigram)))))
  (print-tot organigram 0))

 

> (print-tot VUBOrganigram 2)

VUB

 academisch

  rectoraat

  faculteiten

 administratief

  personeel

  financien

11.14 Examen Informatica januari 2008: Boom vraag

Traditiegetrouw geven (bet)(over)grootouders met Nieuwjaar nieuwjaarsgeld aan hun nakomelingen. Veronderstel dat de nakomelingen in Scheme voorgesteld worden als een familieboom. Bvb. beschouw de volgende familieboom, waarbij Jan de grootouder is en nieuwjaarsgeld uitdeelt aan zijn nakomelingen. Dit kan echter op verschillende manieren gebeuren.

(define familieboom '(jan (piet (frans (tom)
                                       (roel))
                                (mie))
                          (bram (inge (bert (ina)
                                            (ilse))
                                      (bart))
                                (iris))
                          (joost (els (ilse)))))

 

(define (familiehoofd fam) (car fam))
(define (kinderen fam) (cdr fam))
(define (laatste-nakomeling? fam)
  (null? (kinderen fam)))

 

11.14.1 Verdeel democratisch

Gegeven een budget, beslist een grootouder om iedereen evenveel geld te geven. Schrijf een procedure verdeel-democratisch die gegeven een familieboom en een budget, berekent hoeveel elk familielid krijgt.

(define (verdeel-democratisch boom budget)
  (define (verdeel boom)
    (if (laatste-nakomeling? boom)
        1
        (+ 1 (verdeel-in (kinderen boom)))))
 
  (define (verdeel-in lst)
    (if (null? lst)
        0
        (+ (verdeel (car lst))
           (verdeel-in (cdr lst)))))
  (/ budget (verdeel-in (kinderen boom))))

 

> (verdeel-democratisch familieboom 1500)

100

11.14.2 Bereken budget

Andere grootouders beslissen om aan hun kinderen elk 100 euro te geven, aan hun kleinkinderen 50 euro en aan hun achterkleinkinderen 20 euro. Schrijf een procedure budget die het budget dat de grootouders nodig hebben, berekent.

(define (budget boom budget-list)
  (define (budget-hulp boom budget-list)
    (if (null? budget-list)
        0
        (+ (car budget-list)
           (budget-hulp-in (kinderen boom) (cdr budget-list)))))
 
  (define (budget-hulp-in bomen budget-list)
    (if (null? bomen)
        0
        (+ (budget-hulp    (car bomen) budget-list)
           (budget-hulp-in (cdr bomen) budget-list))))
  (budget-hulp-in (kinderen boom) budget-list))

 

> (budget familieboom '(100 50 20))

650

11.14.3 Verdeel budget onder nakomelingen zonder kinderen

Nog andere grootouders beslissen om enkel aan de nakomelingen die geen kinderen hebben nieuwjaarsgeld te geven. Ze doen dit volgens het volgende principe: hun budget wordt gelijk verdeeld over hun aantal kinderen, het budget van elk kind wordt terug gelijk verdeeld over dat kind zijn kinderen, enz. Schrijf een procedure verdeel die, gegeven een familieboom en een budget, een lijstje teruggeeft waarvan elk element terug een lijstje is met de naam van de nakomeling (die zelf geen kinderen meer heeft) en het bedrag dat deze krijgt.

(define (verdeel boom budget)
  (cond ((laatste-nakomeling? boom)
         (list (list (familiehoofd boom) budget)))
        (else (let* ((rest (kinderen boom))
                     (new-budget (/ budget (length rest))))
                (verdeel-in rest new-budget)))))
 
(define (verdeel-in bomen budget)
  (if (null? bomen)
      '()
      (append (verdeel    (car bomen) budget)
              (verdeel-in (cdr bomen) budget))))

 

> (verdeel familieboom 3000)

((tom 250)

 (roel 250)

 (mie 500)

 (ina 125)

 (ilse 125)

 (bart 250)

 (iris 500)

 (ilse 1000))

11.15 Familiebomen & Hiërarchische Relaties: Extra Oefeningen

11.15.1 Examen Informatica tweede zit 1999: Boom vraag

Naar aanleiding van het komende millenniumfeest wordt door de overheid een steekproef gedaan naar de kwaliteit van het vuurwerk geleverd door verschillende leveranciers. Een computermodel van een afgevuurd vuurwerkstuk werd opgesteld in Scheme. Het ziet er als volgt uit:

Een vuurwerk spat uit elkaar in opeenvolgende knallen. Elke knal heeft een kleur en een aantal vertakkingen in die kleur. Een vertakking kan, indien er nog genoeg energie is opnieuw knallen en dit eventueel in een andere kleur. Dit geeft volgende lijstvoorstelling voor bovenstaand voorbeeld:

(define mijn-vuurwerk '(groen ((blauw (X (blauw (X X)) X X))
                               (rood ((groen (X X)) X))
                               X
                               (geel (X X)))))

 

Een vertakking die eindigt zonder of met te weinig energie zal niet meer verder knallen. Dit wordt in het model aangeduid met een 'X.

We kunnen nu enkele testen implementeren:

(define (kleur vuurwerk) (car vuurwerk))
(define (takken vuurwerk) (cadr vuurwerk))
(define (low-energy? vuurwerk) (eq? vuurwerk 'X))

 

> (kleur mijn-vuurwerk)

groen

> (takken mijn-vuurwerk)

((blauw (X (blauw (X X)) X X)) (rood ((groen (X X)) X)) X (geel (X X)))

> (low-energy? mijn-vuurwerk)

#f

> (low-energy? 'X)

#t

11.15.1.1 Tel-knallen

Schrijf een procedure (tel-knallen vuurwerk) die het totaal aantal knallen van het gegeven vuurwerkstuk telt.

(define (tel-knallen vuurwerk)
  (define (tel-knallen vuurwerk)
    (if (low-energy? vuurwerk)
        0
        (+ 1 (tel-knallen-in (takken vuurwerk)))))
  (define (tel-knallen-in takken)
    (if (null? takken)
        0
        (+ (tel-knallen (car takken))
           (tel-knallen-in (cdr takken)))))
  (tel-knallen vuurwerk))

 

> (tel-knallen mijn-vuurwerk)

6

11.15.1.2 Tel-einde

Schrijf een procedure (tel-einde vuurwerk kleur) die het aantal vertakkingen van een bepaalde kleur telt, waarvan de energie te laag is om verder te knallen.

(define (tel-low-energies vuurwerk)
  (define (tel vuurwerk)
    (if (low-energy? vuurwerk)
        1
        (tel-in (takken vuurwerk))))
  (define (tel-in takken)
    (if (null? takken)
        0
        (+ (tel (car takken)) (tel-in (cdr takken)))))
  (tel vuurwerk))
 
(define (tel-einde vuurwerk een-kleur)
  (define (tel-einde vuurwerk)
    (cond ((low-energy? vuurwerk) 0)
          ((eq? (kleur vuurwerk) een-kleur) (tel-low-energies vuurwerk))
          (else (tel-einde-in (takken vuurwerk)))))
  (define (tel-einde-in takken)
    (if (null? takken)
        0
        (+ (tel-einde (car takken))
           (tel-einde-in (cdr takken)))))
  (tel-einde vuurwerk))

 

> (tel-einde mijn-vuurwerk 'blauw)

5

11.15.1.3 Ster?

Schrijf een procedure (ster? vuurwerk) die nagaat of een vuurwerkstuk voldoet aan volgende eis: na de eerste knal heeft elke vertakking nog voldoende energie om zelf ook te knallen. Bovendien moeten ze dit doen met elk evenveel vertakkingen.
(define (ster? vuurwerk)
  (define (aantal-takken vuurwerk)
    (length (takken vuurwerk)))
  (define (bekijk-takken takken prev-length)
    (cond ((null? takken) #t)
          ((low-energy? (car takken)) #f)
          ((not (= (aantal-takken (car takken)) prev-length)) #f)
          (else (bekijk-takken (cdr takken) (aantal-takken (car takken))))))
  (if (low-energy? vuurwerk)
      #f
      (bekijk-takken (takken vuurwerk) (aantal-takken (car (takken vuurwerk))))))

 

> (ster? mijn-vuurwerk)

#f

> (ster? '(groen ((blauw  (X X X))
                  (rood   (X X X))
                  (geel   (X X X))
                  (oranje (X X X))
                  (paars  (X X X)))))

#t

11.15.2 Examen Informatica augustus 2009

Een classificatieboom is een speciaal soort boom die een aantal soorten (van dieren, planten, ...) classificeert volgens een bepaalde hiërarchie. Elke knoop in de boom beschrijft een bepaalde soort, met zijn specifieke eigenschappen. Bijvoorbeeld een "dier" is een soort die "kan ademen" en "kan bewegen". Alle deelsoorten van een bepaalde soort hebben dezelfde eigenschappen als die soort, maar kunnen eventueel ook nog een aantal extra eigenschappen bezitten. Bijvoorbeeld een "landdier" is een speciaal geval van een "dier" dat een "huid heeft", "poten heeft" en "kan lopen", maar natuurlijk heeft het nog steeds de eigenschappen "kan ademen" en "kan bewegen", aangezien het een "dier" is.

Merk op dat we in de knopen die de deelsoorten beschrijven alleen de bijkomende eigenschappen opnemen. Hieronder vind je een uitgewerkt voorbeeld van zo’n classificatieboom:

11.15.2.1 Abstract Data Type

Implementeer het knoop ADT om een knoop van zo’n classificatieboom voor te stellen. Implementeer ook het boom ADT om de classificatieboom zelf voor te stellen.

ADT knoop
 
maak-dier
  ( string list -> knoop )
 
naam
  ( knoop -> string )
 
eigenschappen
  ( knoop -> list )
 
dier?
  ( any -> boolean )
ADT boom
 
maak-boom
  ( knoop pair -> boom )
 
deelbomen
  ( boom -> pair )
 
leeg?
  ( boom -> boolean )
 
boom?
  ( any -> boolean )

Gebruik dan de ADTs om de bovenstaande boom te maken. Noem het classificatieboom.

"ADT voor knoop"
(define (maak-dier naam eigenschappen)
  (list naam eigenschappen))
 
(define (naam dier) (car dier))
(define (eigenschappen dier) (cadr dier))
 
(define (dier? dier)
  (and (pair? dier)
       (atom? (naam dier))
       (pair? (eigenschappen dier))))
 
"ADT voor boom"
(define (maak-boom knoop deelbomen)
  (list 'knoop knoop deelbomen))
 
(define (knoop boom) (cadr boom))
(define (deelbomen boom) (caddr boom))
(define (leeg? boom) (null? boom))
(define (boom? boom) (and (pair? boom)
                           (eq? (car boom) 'knoop)))
 
 
(define classificatieboom
  (maak-boom (maak-dier 'dier '(kan-ademen kan-bewegen))
             (list
              (maak-boom
               (maak-dier 'vis
                          '(kan-zwemmen heeft-schubben heeft-vinnen))
               (list
                (maak-boom (maak-dier 'ballonvis
                                      '(kan-zwellen is-geel))
                           '())))
              (maak-boom
               (maak-dier 'landdier
                          '(heeft-huid kan-lopen heeft-poten))
               (list (maak-boom (maak-dier 'olifant
                                           '(is-groot))
                                '())))
              (maak-boom
               (maak-dier 'vogel
                          '(kan-vliegen heeft-vleugels heeft-veren))
               (list
                (maak-boom (maak-dier 'kanarie
                                      '(kan-zingen is-geel))
                           '())
                (maak-boom (maak-dier 'arend
                                      '(is-groot))
                           '()))))))

 

11.15.2.2 Geef alle soorten

Schrijf een functie (all-kinds cboom) die een classificatieboom cboom als invoer neemt en alle soorten uit die classificatieboom in een lijstje teruggeeft.

(define (all-kinds boom)
  (define (all-kinds boom)
    (cond ((leeg? boom) '())
          (else (cons (naam (knoop boom))
                      (all-kinds-in (deelbomen boom))))))
  (define (all-kinds-in takken)
    (if (null? takken)
        '()
        (append (all-kinds (car takken))
                (all-kinds-in (cdr takken)))))
  (all-kinds boom))

 

> (all-kinds classificatieboom)

(dier vis ballonvis landdier olifant vogel kanarie arend)

11.15.2.3 Verifieer eigenschap

Schrijf een predicaat (ask? cboom soort eigenschap) dat controleert of een bepaalde soort uit de classificatieboom een bepaalde eigenschap bezit. Hou er rekening mee dat alle eigenschappen die gelden voor een bepaalde soort in de boom, automatisch ook gelden voor al zijn deelsoorten, ook al staan ze daar niet expliciet opnieuw opgesomd. Zo heeft een ballonvis bijvoorbeeld ook vinnen, aangezien alle vissen vinnen hebben.

(define (geef-eigenschappen boom soort)
  (define (geef-eigenschappen boom eign)
    (let ((eign (append eign (eigenschappen (knoop boom)))))
      (if (eq? (naam (knoop boom)) soort)
          eign
          (geef-eigenschappen-in (deelbomen boom) eign))))
  (define (geef-eigenschappen-in takken eigenschappen)
    (if (null? takken)
        #f
        (or (geef-eigenschappen (car takken) eigenschappen)
            (geef-eigenschappen-in (cdr takken) eigenschappen))))
  (geef-eigenschappen boom '()))
 
(define (ask? boom soort eig)
  (let ((eigenschappen (geef-eigenschappen boom soort)))
    (pair? (memq eig eigenschappen))))

 

> (ask? classificatieboom 'landdier  'kan-lopen)

#t

> (ask? classificatieboom 'ballonvis 'heeft-vinnen)

#t

> (ask? classificatieboom 'olifant   'kan-vliegen)

#f

11.15.3 Examen Informatica augustus 2006

Na lang onderzoek en vele experimenten zijn landbouwers erin geslaagd om hybride fruitbomen te kweken. Onderstaand schema toont een tak uit een hybride appel/peer boom. In dit geval kan de tak een willekeurig aantal keer vertakken in nieuwe takken, bladeren, appelen of peren.

Het is wel zo dat in een normale hybride tak, een tak niet rechtstreeks kan vertakken in fruit van verschillende types. De rechtstreekse kinderen van een tak zijn dus in de hybride appel/peer boom ofwel appelen, blaadjes en takken; ofwel peren, blaadjes en takken. Onderstaand voorbeeld is een normale hybride tak.

11.15.3.1 Abstract Data Type

Implementeer de volgende ADTs dat toelaat om dit type boom voor te stellen en te gebruiken in Scheme.

ADT blad
 
maak-blad
  ( any -> blad )
 
geef-type
  ( blad -> any )
 
blad?
  ( any -> boolean )
ADT knoop
 
maak-knoop
  ( pair -> knoop )
 
geef-deelbomen
  ( knoop -> pair )
 
knoop?
  ( any -> boolean)
ADT hybride-tak
 
maak-hybride-tak
  ( pair -> hybride-tak )
 
geef-knopen
  ( hybride-tak -> pair )
 
leeg?
  ( hybride-tak -> boolean )

Gebuik dan deze operaties om de bovenstaande hybride tak voor te stellen in Scheme. Noem het hybride-tak.

(define (maak-blad type) type)
(define (geef-type blad) blad)
 
(define (maak-knoop deelbomen) deelbomen)
(define (geef-deelbomen boom) boom)
 
(define (maak-hybride-tak knopen) knopen)
(define (geef-knopen tak) tak)
 
(define (leeg? boom) (null? boom))
(define (knoop? boom) (pair? boom))
(define (blad? boom) (atom? boom))
 
(define hybride-tak
  (maak-hybride-tak
   (list
    (maak-knoop
     (list
      (maak-knoop (list (maak-blad 'appel)
                        (maak-blad 'appel)
                        (maak-blad 'blad)))
      (maak-blad 'peer)))
    (maak-knoop (list (maak-blad 'blad)
                      (maak-blad 'peer)))
    (maak-knoop (list (maak-blad 'appel)
                      (maak-knoop (list (maak-blad 'appel)
                                        (maak-blad 'blad))))))))
 
(define tak
  (maak-hybride-tak
   (list
    (maak-knoop
     (list (maak-knoop (list (maak-blad 'appel)
                             (maak-blad 'appel)
                             (maak-blad 'blad)))
           (maak-blad 'peer)))
    (maak-knoop (list (maak-blad 'blad)
                      (maak-blad 'peer)
                      (maak-blad 'appel)))
    (maak-knoop (list (maak-blad 'appel)
                      (maak-knoop (list (maak-blad 'appel)
                                        (maak-blad 'blad))))))))

 

> hybride-tak

(((appel appel blad) peer) (blad peer) (appel (appel blad)))

11.15.3.2 Tel fruit en bladeren

Schrijf een functie tel die gegeven een hybride appel/peer tak, teruggeeft hoeveel appelen, peren en blaadjes aan de tak hangen.

(define (tel boom)
  (define (combine-results l1 l2)
    (list (+ (car l1) (car l2))
          (+ (cadr l1) (cadr l2))
          (+ (caddr l1) (caddr l2))))
 
 
  (define (tel-hulp boom)
    (cond ((leeg? boom) (list 0 0 0))
          ((and (blad? boom) (eq? boom 'appel))
           (list 1 0 0))
          ((and (blad? boom) (eq? boom 'peer))
           (list 0 1 0))
          ((blad? boom) (list 0 0 1))
          (else (tel-hulp-in (geef-knopen boom)))))
 
  (define (tel-hulp-in lst)
    (if (null? lst)
        (list 0 0 0)
        (combine-results (tel-hulp (car lst))
                         (tel-hulp-in (cdr lst)))))
  (tel-hulp boom))

 

> (tel hybride-tak)

(4 2 3)

11.15.3.3 Normale tak?

Schrijf een functie check-normaal die nagaat of een gegeven hybride appel/peer tak normaal is, m.a.w. die nagaat of er geen knoop bestaat die zowel een appel als een peer als rechstreekse kinderen heeft.

(define (member? x lst)
  (pair? (memq x lst)))
 
(define (normaal? knoop)
  (let ((types (map (lambda (x) (if (pair? x) 'tak x)) knoop)))
    (not (and (member? 'appel types) (member? 'peer types)))))
 
(define (check-normaal boom)
  (cond ((leeg? boom) #t)
        ((blad? boom) #t)
        ((knoop? boom)
         (and (normaal? boom)
              (check-normaal-in (geef-knopen boom))))
        (else (check-normaal-in (geef-knopen boom)))))
 
(define (check-normaal-in lst)
  (if (null? lst)
      #t
      (and (check-normaal (car lst))
           (check-normaal-in (cdr lst)))))

 

> (check-normaal hybride-tak)

#t

11.15.4 Examen Informatica augustus 2008

Bedrijven zoals Coca-Cola, InBev, etc. hebben een uitgebreid productengamma dat onderverdeeld is in verschillende categorieën en subcategorieën die elk verschillende producten bevatten. Elk product haalt een bepaald omzetcijfer.

Beschouw bijvoorbeeld de volgende boom van het bedrijf Coca-Cola (die een gelimiteerde versie van het volledige gamma voorstelt).

(define Coca-Cola-NV
  '(Coca-Cola-NV (Frisdranken
                  (Coca-Cola
                   (Regular-Coca-Cola (Coke (10000000)))
                   (light-Coca-Cola (Coke-Light (800000))
                                    (Coke-Zero (200000))))
                  (Fanta (Fanta-Orange (800000))
                         (Fanta-Lemon (200000)))
                  (Sprite (Sprite-Zero (1000000))))
                 (Sappen
                  (Minute-Maid (Minute-Maid-Sinaas (2000000))
                               (Minute-Maid-Tomaat (1000000))))))

 

(define (deel-categorien categorie)
  (cdr categorie))
 
(define (hoofdcategorie categorie)
  (car categorie))

 

11.15.4.1 Bereken omzet

Schrijf een procedure (omzet bedrijf categorie) die de totale omzet van een gegeven categorie of product binnen het bedrijf teruggeeft.

(define (bereken lst)
  (cond ((null? lst) 0)
        ((atom? lst) 0)
        ((number? (car lst)) (car lst))
        (else (+ (bereken (car lst))
                 (bereken (cdr lst))))))
 
(define (omzet bedrijf categorie)
  (if (eq? (hoofdcategorie bedrijf) categorie)
      (bereken bedrijf)
      (omzet-in (deel-categorien bedrijf) categorie)))
 
(define (omzet-in lst categorie)
  (if (null? lst)
      #f
      (or (omzet (car lst) categorie)
          (omzet-in (cdr lst) categorie))))

 

> (omzet Coca-Cola-NV 'Coca-Cola)

11000000

> (omzet Coca-Cola-NV 'Sprite)

1000000

> (omzet Coca-Cola-NV 'Minute-Maid)

3000000

11.15.4.2 Verdeel budget democratisch

De dienst marketing van zo een bedrijf heeft een bepaald budget dat op verschillende manieren kan verdeeld worden over producten. Een eerste manier is om het gegeven marketingbudget evenredig met het omzetcijfer te verdelen over de producten.

Schrijf een procedure (verdeel-democratisch bedrijf budget) die een lijstje teruggeeft met hoeveel budget elk product van het bedrijf krijgt afhankelijk van zijn omzetcijfer.

(define (is-product? x)
  (and (pair? x)
       (pair? (cadr x))
       (number? (caadr x))))
 
(define (omzetcijfer product)
  (caadr product))
 
(define (producten bedrijf)
  (define (producten bedrijf)
    (if (is-product? bedrijf)
        (list (list (hoofdcategorie bedrijf)
                    (omzetcijfer bedrijf)))
        (producten-in (deel-categorien bedrijf))))
  (define (producten-in takken)
    (if (null? takken)
        '()
        (append (producten (car takken))
                (producten-in (cdr takken)))))
  (producten bedrijf))
 
(define (verdeel-democratisch bedrijf budget)
  (let* ((producten (producten bedrijf))
         (totaal (apply + (map cadr producten)))
         (factor (/ budget totaal)))
    (map (lambda (x) (list (car x) (* factor (cadr x))))
         producten)))

 

> (verdeel-democratisch Coca-Cola-NV 128000000)

((Coke 80000000)

 (Coke-Light 6400000)

 (Coke-Zero 1600000)

 (Fanta-Orange 6400000)

 (Fanta-Lemon 1600000)

 (Sprite-Zero 8000000)

 (Minute-Maid-Sinaas 16000000)

 (Minute-Maid-Tomaat 8000000))

11.15.4.3 Onafhankelijke verdeling van het budget

Een andere strategie is om het budget per afzonderlijk product toe te kennen onafhankelijk van het omzetzijfer van het product. Deze verdeling gebeurt dan volgens hetvolgende principe: het algemene marketingbudget wordt gelijk verdeeld over het aantal productcategorieën, het budget van elke categorie wordt terug gelijk verdeeld over die categorie zijn subcategorieën, enz.

Schrijf een procedure (verdeel bedrijf budget) die gegeven een bedrijfsboom en een budget de budgetboom teruggeeft waarbij de bladeren van de boom niet meer het omzetcijfer bevatten, maar het marketingbudget dat elk product volgens dit principe krijgt.

(define (is-product? x)
  (and (pair? x)
       (pair? (cadr x))
       (number? (caadr x))))
 
(define (verdeel bedrijf budget)
  (define (verdeel bedrijf budget)
    (if (is-product? bedrijf)
        (list (hoofdcategorie bedrijf)
              (list budget))
        (let* ((rest (deel-categorien bedrijf))
               (new-budget (/ budget (length rest))))
          (cons (hoofdcategorie bedrijf)
                (verdeel-in rest new-budget)))))
  (define (verdeel-in takken budget)
    (if (null? takken)
        '()
        (cons (verdeel (car takken) budget)
              (verdeel-in (cdr takken) budget))))
  (verdeel bedrijf budget))

 

> (verdeel Coca-Cola-NV 1200000)

(Coca-Cola-NV

 (Frisdranken

  (Coca-Cola

   (Regular-Coca-Cola (Coke (100000)))

   (light-Coca-Cola (Coke-Light (50000)) (Coke-Zero (50000))))

  (Fanta (Fanta-Orange (100000)) (Fanta-Lemon (100000)))

  (Sprite (Sprite-Zero (200000))))

 (Sappen

  (Minute-Maid (Minute-Maid-Sinaas (300000)) (Minute-Maid-Tomaat (300000)))))

11.15.5 Examen Informatica januari 2005

De beginnende circusgroep "Het grote VUB-circus" oefent volop met het bouwen van levende piramides. Een piramide kan gebouwd worden doordat 1 of meerdere artiesten een andere artiest optillen. Op zijn beurt kan de opgetilde artiest (eventueel samen met andere opgetilde artiesten op hetzelfde niveau) een andere artiest optillen. Omwille van de veiligheid kan een artiest slechts 1 artiest optillen. Onrechtstreeks steunt hij echter alle artiesten die rechtstreeks en onrechtstreeks ondersteund worden door de artiest die hij zelf mee optilt. We kunnen deze piramides voorstellen door bomen, zoals bijvoorbeeld in onderstaande figuur. De kinderen van een knoop zijn al de artiesten die de artiest in de gegeven knoop optillen.

We kunnen deze piramides in Scheme voor stellen door geneste lijsten. De geneste lijst representatie voor deze specifieke piramide is de volgende:

(define VUB-circus '(ann (mien (eef (bas)
                                    (bob))
                               (els (jan)
                                    (jos))
                               (eva (tom)
                                    (tim)))
                         (mies (ine (cas)
                                    (cor))
                               (ils (rik)
                                    (raf))
                               (ines (stef)
                                     (staf)))))

 

(define (hoofdartiest piramide) (car piramide))
(define (artiesten piramide) (cdr piramide))
(define (artiest? piramide)
  (and (pair? piramide) (atom? (car piramide))))
(define (onderaan? piramide) (null? (cdr piramide)))

 

Gegeven deze representatie, schrijf de volgende piramide bewerkingen op in Scheme:

11.15.5.1 Laat ondersteunde artiesten springen

Simuleer het feit dat een artiest zijn last niet meer kan dragen: Wanneer een artiest het te moeilijk krijft om zijn last te dragen, roept hij alle artiesten die hij rechtstreeks en onrechtstreeks steunt dat ze eraf moeten springen. Zelf doet hij dit niet. Met andere woorden, de artiest die hijzelf mee optilt moet springen alsook degene die door deze laatste mee wordt opgetild, enz.

Schrijf een Scheme functie jump, die een piramide en de naam van de artiest die roept als input neemt en die de namen van de artiesten die hierbij moeten springen teruggeeft in een lijstje.

(define (jump piramide artiest)
  (define (jump-hulp piramide pad)
    (if (and (artiest? piramide)
             (eq? (hoofdartiest piramide) artiest))
        pad
        (jump-in (artiesten piramide)
                 (cons (hoofdartiest piramide) pad))))
 
  (define (jump-in lst pad)
    (if (null? lst)
        #f
        (or (jump-hulp (car lst) pad)
            (jump-in   (cdr lst) pad))))
  (reverse (jump-hulp piramide '())))

 

> (jump VUB-circus 'eva)

(ann mien)

> (jump VUB-circus 'stef)

(ann mies ines)

11.15.5.2 Laat een artiest uit de piramide vallen

Simuleer een val van een artiest: wanneer een artiest zodanig uit evenwicht geraakt dat hij uit de piramide valt, zullen ook al de artiesten die hij rechtstreeks en onrechtstreeks ondersteunt meevallen, alsook alle artiesten die hem rechtstreeks dragen (dus alle artiesten van 1 niveau lager die hem rechtstreeks optillen, en niet degene daaronder).

Schrijf een procedure fall, die een piramide en de naam van de artiest die valt als input neemt, en die de namen van alle artiesten die vallen teruggeeft in een lijstje.

(define (fall piramide artiest)
  (define (fall-hulp piramide pad)
    (if (and (artiest? piramide)
             (eq? (hoofdartiest piramide) artiest))
        (append pad
                (list (hoofdartiest piramide))
                (map hoofdartiest (artiesten piramide)))
        (fall-in (artiesten piramide)
                 (cons (hoofdartiest piramide) pad))))
 
  (define (fall-in lst pad)
    (if (null? lst)
        #f
        (or (fall-hulp (car lst) pad)
            (fall-in (cdr lst) pad))))
  (fall-hulp piramide '()))

 

> (fall VUB-circus 'eva)

(mien ann eva tom tim)

> (fall VUB-circus 'stef)

(ines mies ann stef)

> (fall VUB-circus 'mies)

(ann mies ine ils ines)