fork download
copy 
  1. #!/usr/bin/env racket
  2. #lang racket
  3.  
  4. (provide unfoldTree foldTree)
  5.  
  6. (define (unfoldTree f b)
  7.   (match-let ((`(,a ,bs) (f b)))
  8.     `(,a ,(map (lambda (b)
  9.                  (unfoldTree f b)) bs))))
  10.  
  11. (define (foldTree f tree)
  12.   (define (go node)
  13.     (match-let ((`(,x ,ts) node))
  14.       (f x (map go ts))))
  15.   (go tree))
  16.  
  17. (define (buildNode x)
  18.   (if (> (add1 (* 2 x)) 7)
  19.       `(,x ())
  20.       `(,x (,(* 2 x) ,(add1 (* 2 x))))))
  21.  
  22. ;; 二分木の生成
  23. (println (unfoldTree buildNode 1))
  24.  
  25. ;; 木の値の総和
  26. (println
  27.  (foldTree (lambda (x xs)
  28.              (apply + x xs)) '(1 ((2 ()) (3 ())))))
  29. ;; 木の最大値
  30. (println
  31.  (foldTree (lambda (x xs)
  32.              (apply max x xs)) '(1 ((2 ()) (3 ())))))
  33.  
  34. ;; 木の葉の個数
  35. (println
  36.  (foldTree (lambda (x xs)
  37.              (if (null? xs)
  38.                  1
  39.                  (apply + xs))) '(1 ((2 ()) (3 ())))))
  40.  
  41. ;; 木の高さ
  42. (println
  43.  (foldTree (lambda (x xs)
  44.              (if (null? xs)
  45.                  0
  46.                  (add1 (apply max xs)))) '(1 ((2 ()) (3 ())))))
  47.  
  48. ;; フィボナッチ数列
  49. (define (fib n)
  50.   (define (g n)
  51.     (case n
  52.       ((0) '(0 ()))
  53.       ((1) '(1 ()))
  54.       (else `(,n (,(sub1 n) ,(- n 2))))))
  55.   (foldTree (lambda (x xs)
  56.               (if (null? xs)
  57.                   x
  58.                   (apply + xs))) (unfoldTree g n)))
  59.  
  60. (println (fib 5))
  61.  
Success #stdin #stdout 0.77s 94980KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/lLhGHn
language:
Racket (racket 7.0)
created:
333 days ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!