home *** CD-ROM | disk | FTP | other *** search
/ Nautilus 1992 July / Nautilus-3-8 / Nautilus-3-8.bin / Tools & Utilities / Techy Stuff / Util ƒ / Help-Archive / Examples / Exemples < prev    next >
Encoding:
Text File  |  1990-09-20  |  6.5 KB  |  282 lines
  1. {Fibonnacci en itÄratif}
  2. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  3.  
  4. (define (fi n n1 n2)
  5.         (cond (zero? n) (+ n1 n2)
  6.               (fi (1- n) n2 (+ n1 n2))))
  7.  
  8. (define (fib n)(fi (- n 2) 1 1))
  9.  
  10. {Fibonnacci en rÄcursif}
  11. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  12.  
  13. (define (f n)
  14.   (cond (<? n 2) 1
  15.   (+ (f (1- n)) (f (- n 2)))))
  16.  
  17.  
  18. {Remove surfacique}
  19. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  20.  
  21. (define (remove a l)
  22.      (cond (null? l) ()
  23.            (eq? a (0 l)) (remove a (-1 l))
  24.            (cons (0 l) (remove a (-1 l)))))
  25.  
  26. {Compter le nombre de faìons}
  27. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  28.  
  29. (define (cat s c)
  30.        (cond (null? c) 0
  31.              (zero? s) 1
  32.              (<? s (0 c)) (cat s (-1 c))
  33.              (+ (cat s (-1 c))
  34.                       (cat (- s (0 c)) c))))
  35.  
  36. {Reverse physique}
  37. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  38.  
  39. (define (nreverse l)
  40.        (nrevaux l '()))
  41.  
  42. (define (nrevaux l p)
  43.        (cond (null? (-1 l)) (cdr=! l p)
  44.              (nrevaux (-1 l)(cdr=! l p))))
  45.  
  46. {Composition de fonctions}
  47. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  48.  
  49. (define (rond f g) 
  50.         (lambda x (f (apply g x))))
  51.  
  52. {Le MAPCAR}
  53. {ÑÑÑÑÑÑÑÑÑ}
  54.  
  55. (define (every p l)
  56.       (cond (null? l) ()
  57.             (null? (-1 l)) (p (0 l))
  58.             (p (0 l))(every p (-1 l))))
  59.             
  60. (define (any p l)
  61.       (cond (null? l) ─
  62.             (p (0 l))
  63.             (any p (-1 l))))
  64.  
  65. (define (mapcar f | l)
  66.      (cond (every cons? l) (cons (apply f (allcar l))
  67.                                  (apply mapcar (cons  f (allcdr l))))
  68.            ()))
  69.  
  70. (define (mapcar1 f l)
  71.      (cond (null? l)()
  72.            (cons (f (0 l))
  73.                  (mapcar1 f (-1 l)))))
  74.  
  75. {Les entiers naturels}
  76. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  77.  
  78. (define n (╔ 0))
  79.  
  80. {Les fibonacci}
  81. {ÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  82.  
  83. (define (fibn n1 n2) (cons n1 (fibn (+ n1 n2) n1)))
  84.  
  85. (define fibn1 (cons 1 (cons 1 (map (░ +) fibn1 (-1 fibn1)))))
  86.  
  87. {La suite bizarre}
  88. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  89.  
  90. (define (entrelace l1 l2)
  91.       (cons (0 l1) (cons (0 l2) (entrelace (-1 l1) (-1 l2)))))
  92.  
  93. (define Bord (entrelace (╔ 0) Bord))
  94.  
  95. {OpÄrations ensemble numÄriques ordonnÄs}
  96. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  97.  
  98. (define (union l1 l2)
  99.     (cond (<? (0 l1)(0 l2))(cons (0 l1) (union (-1 l1) l2))
  100.           (=? (0 l1)(0 l2))(cons (0 l1)(union (-1 l1)(-1 l2)))
  101.           (cons (0 l2) (union l1 (-1 l2)))))
  102.  
  103. (define (inter l1 l2)
  104.     (cond (<? (0 l1)(0 l2)) (inter (-1 l1) l2)
  105.           (=? (0 l1)(0 l2))(cons (0 l1)(inter (-1 l1)(-1 l2)))
  106.           (inter l1 (-1 l2))))
  107.  
  108. (define (diff l1 l2)
  109.      (cond (=? (0 l1)(0 l2)) (diff (-1 l1) l2)
  110.            (<? (0 l1)(0 l2)) (cons (0 l1) (diff (-1 l1) l2))
  111.            (diff l1 (-1 l2))))
  112.  
  113. {flot de lecture}
  114. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  115.  
  116. (define (in)(cons (read)(in)))
  117.  
  118. (define input (in))
  119.  
  120. {Factorielle CPS}
  121. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  122.  
  123. (define (fact x k)
  124.      (cond (zero? x)(k 1)
  125.      (fact (- x 1)(lambda(n)(k (* x n))))))
  126.  
  127. (define (id x) x)
  128.  
  129. (define factl (cons 1 (map (░ *) (╔ 1) factl)))
  130.  
  131. {Le crible d'ErathostÅne}
  132. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  133.  
  134. (define (erat l)
  135.      (cons (0 l)
  136.            (erat (diff (-1 l)
  137.                        (map (░ *) (░ (0 l)) l)))))
  138.  
  139. (define (erat l)
  140.   (cons (0 l) (erat (suchas (lambda(x) (not (zero?(modulo x (0 l))))) (-1 l)))))
  141.  
  142.  
  143. {Le reverse Ní2 (pt fixe)}
  144. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  145.  
  146. (define arg '(a b c d))
  147.  
  148. (define rev (cons () (map (░ cons) arg rev)))
  149.  
  150. {Hanoi}
  151. {ÑÑÑÑÑ}
  152.  
  153. (define (hanoi n dep ar etap)
  154.      (cond (=? n 1)(deplacer dep ar)
  155.            (begin (hanoi (- n 1) dep etap ar)
  156.                   (deplacer dep ar)
  157.                   (hanoi (- n 1) etap ar dep))))
  158.  
  159. (define (deplacer x y)
  160.      (prin "de ")(prin x) (prin " vers ") (print y))
  161.  
  162.  
  163. {The paradoxical combinator}
  164. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  165.  
  166. ;by Church Y0
  167. (define (Y0 g)
  168.   ((lambda(x) (G (x x)))(lambda(x)(G (x x)))))
  169.  
  170. {The fixed point for fixed point combinator}
  171. (define (G y)
  172.   (lambda(f) (f (y f))))
  173.  
  174. ;by Turing Y1=Y0 G
  175. (define Y1 
  176.   ((lambda(a)
  177.     (lambda(b) (b ((a a) b)))) (lambda(a)
  178.                                  (lambda(b) (b ((a a) b))))))
  179. ;un autre fpc dÄlirant par Klop
  180. (define ú
  181.  (lambda(a)
  182.   (lambda(b)
  183.    (lambda(c)
  184.     (lambda(d)
  185.      (lambda(e)
  186.       (lambda(f)
  187.        (lambda(g)
  188.         (lambda(h)
  189.          (lambda(i)
  190.           (lambda(j)
  191.            (lambda(k)
  192.             (lambda(l)
  193.              (lambda(m)
  194.               (lambda(n)
  195.                (lambda(o)
  196.                 (lambda(p)
  197.                  (lambda(q)
  198.                   (lambda(s)
  199.                    (lambda(t)
  200.                     (lambda(u)
  201.                      (lambda(v)
  202.                       (lambda(w)
  203.                        (lambda(x)
  204.                         (lambda(y)
  205.                          (lambda(z)
  206.                           (lambda(r)
  207. (r((((((((((((((((((((((((((t h)i)s)i)s)a)f)i)x)e)d)p)o)i)n)t)c)o)m)b)i)n)a)t)o)r)))))))))))))))))))))))))))))
  208.  
  209. (define $ (((((((((((((((((((((((((ú ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú))
  210.  
  211. ;un autre fpc dÄlirant "ê la Klop" en VF
  212. (define ú
  213.  (lambda(a)
  214.   (lambda(b)
  215.    (lambda(c)
  216.     (lambda(e)
  217.      (lambda(f)
  218.       (lambda(g)
  219.        (lambda(h)
  220.         (lambda(i)
  221.          (lambda(j)
  222.           (lambda(k)
  223.            (lambda(l)
  224.             (lambda(m)
  225.              (lambda(n)
  226.               (lambda(o)
  227.                (lambda(p)
  228.                 (lambda(q)
  229.                  (lambda(r)
  230.                   (lambda(s)
  231.                    (lambda(t)
  232.                     (lambda(u)
  233.                      (lambda(v)
  234.                       (lambda(w)
  235.                        (lambda(x)
  236.                         (lambda(y)
  237.                          (lambda(z)
  238.                           (lambda(d)
  239. (d((((((((((((((((((((((((((H e)l)p) E)s)t) T)e)r)r)i)b)l)e)m)e)n)t) F)l)e)m)m)a)r)d)))))))))))))))))))))))))))))
  240.  
  241. (define $ (((((((((((((((((((((((((ú ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú)ú))
  242.  
  243. ;la fonctionnelle associÄe ê factorielle
  244. (define (FF f)
  245.   (lambda(x)
  246.     (cond (zero? x) 1
  247.           (* (f (1- x)) x))))
  248.  
  249. {DÄcomposition en nombres premiers}
  250. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  251.  
  252. (define (dec n l)
  253.   (cond (=? n 1) ()
  254.         (zero? (modulo n (0 l))) (cons (0 l) (dec (/ n (0 l)) l))
  255.         (<? n (* (0 l)(0 l))) (list n)
  256.         (dec n (-1 l))))
  257.  
  258. {Un Quick Sort}
  259. {ÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  260.  
  261. (define (sortby f l)
  262.   (cond (null? l) ()
  263.         ((lambda(lr) 
  264.                 (append (sortby f (0 lr))
  265.                         (append (list (0 l))
  266.                                 (sortby f (-1 lr))))) (splitby f (-1 l) (0 l) '() '()))))
  267.  
  268. (define (splitby f x part l r)
  269.   (cond (null? x)(cons l r)
  270.         (<? (f (0 x))(f part)) (splitby f (-1 x) part (cons (0 x) l) r)
  271.         (splitby f (-1 x) part l (cons (0 x) r))))
  272.  
  273. {Un prouveur arriÅre propositionnel}
  274. {ÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑÑ}
  275.  
  276. (define (p a b)
  277.  (any (lambda(r) 
  278.         (if (eq? (0 r) a) (every (lambda(f) (p f b)) (-1 r)) 
  279.             ─)) 
  280.       b))
  281.  
  282.