nendo 0.5.0 → 0.5.1

data/test/util-combinations-test.nnd

@@ -0,0 +1,383 @@
+;;-*- mode: nendo; syntax: scheme -*-;;
+;;
+;; util-combinations-test.nnd - test suite for util.combinations
+;;  
+;;   Copyright (c) 2000-2010  Shiro Kawai  <shiro@acm.org>
+;;   
+;;   Redistribution and use in source and binary forms, with or without
+;;   modification, are permitted provided that the following conditions
+;;   are met:
+;;   
+;;   1. Redistributions of source code must retain the above copyright
+;;      notice, this list of conditions and the following disclaimer.
+;;  
+;;   2. Redistributions in binary form must reproduce the above copyright
+;;      notice, this list of conditions and the following disclaimer in the
+;;      documentation and/or other materials provided with the distribution.
+;;  
+;;   3. Neither the name of the authors nor the names of its contributors
+;;      may be used to endorse or promote products derived from this
+;;      software without specific prior written permission.
+;;  
+;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(use nendo.test)
+(use util.match)
+(test-start "util.combination")
+
+;;===================================================================
+;;-------------------------------------------------------------------
+
+
+(test-section "util.combinations")
+(use util.combinations)
+
+(test* "permutations (boundary)" '(())
+       (permutations '()))
+(test* "permutations (boundary)" '((a))
+       (permutations '(a)))
+(test* "permutations" '((a b) (b a))
+       (permutations '(a b)))
+(test* "permutations" '((a a) (a a))
+       (permutations '(a a)))
+(test* "permutations" '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
+       (permutations '(a b c)))
+(test* "permutations" '((a b c d) (a b d c) (a c b d) (a c d b)
+                        (a d b c) (a d c b) (b a c d) (b a d c)
+                        (b c a d) (b c d a) (b d a c) (b d c a)
+                        (c a b d) (c a d b) (c b a d) (c b d a)
+                        (c d a b) (c d b a) (d a b c) (d a c b)
+                        (d b a c) (d b c a) (d c a b) (d c b a))
+       (permutations '(a b c d)))
+
+(test* "permutations* (boundary)" '(())
+       (permutations* '()))
+(test* "permutations* (boundary)" '((a))
+       (permutations* '(a)))
+(test* "permutations*" '((a b) (b a))
+       (permutations* '(a b)))
+(test* "permutations*" '((a a))
+       (permutations* '(a a)))
+(test* "permutations*" '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
+       (permutations* '(a b c)))
+(test* "permutations*" '((a a b) (a b a) (b a a))
+       (permutations* '(a a b)))
+(test* "permutations*" '((a b a) (a a b) (b a a))
+       (permutations* '(a b a)))
+(test* "permutations*" '((b a a) (a b a) (a a b))
+       (permutations* '(b a a)))
+(test* "permutations*" '((a a a))
+       (permutations* '(a a a)))
+(test* "permutations*" '((a b c d) (a b d c) (a c b d) (a c d b)
+                         (a d b c) (a d c b) (b a c d) (b a d c)
+                         (b c a d) (b c d a) (b d a c) (b d c a)
+                         (c a b d) (c a d b) (c b a d) (c b d a)
+                         (c d a b) (c d b a) (d a b c) (d a c b)
+                         (d b a c) (d b c a) (d c a b) (d c b a))
+       (permutations* '(a b c d)))
+(test* "permutations*" '((a a b c) (a a c b) (a b a c) (a b c a)
+                         (a c a b) (a c b a) (b a a c) (b a c a)
+                         (b c a a) (c a a b) (c a b a) (c b a a))
+       (permutations* '(a a b c)))
+(test* "permutations*" '((a b a c) (a b c a) (a a b c) (a a c b)
+                         (a c b a) (a c a b) (b a a c) (b a c a)
+                         (b c a a) (c a b a) (c a a b) (c b a a))
+       (permutations* '(a b a c)))
+(test* "permutations*" '((a b c a) (a b a c) (a c b a) (a c a b)
+                         (a a b c) (a a c b) (b a c a) (b a a c)
+                         (b c a a) (c a b a) (c a a b) (c b a a))
+       (permutations* '(a b c a)))
+(test* "permutations*" '((a b a b) (a b b a) (a a b b)
+                         (b a a b) (b a b a) (b b a a))
+       (permutations* '(a b a b)))
+(test* "permutations*" '((a a a b) (a a b a) (a b a a) (b a a a))
+       (permutations* '(a a a b)))
+(test* "permutations*" '((a b a a) (a a b a) (a a a b) (b a a a))
+       (permutations* '(a b a a)))
+(test* "permutations*" '((a a a a))
+       (permutations* '(a a a a)))
+
+(test* "permutations*" '(("a" "b" "b" "a") ("a" "b" "a" "b") ("a" "a" "b" "b")
+                         ("b" "a" "b" "a") ("b" "a" "a" "b") ("b" "b" "a" "a"))
+       (permutations* '("a" "b" "b" "a") string=?))
+
+(test* "permutations-for-each"
+       '()
+       (let1 r '()
+         (permutations-for-each (lambda (p) (push! r p)) '())
+         (reverse r)))
+(test* "permutations-for-each"
+       '((a))
+       (let1 r '()
+         (permutations-for-each (lambda (p) (push! r p)) '(a))
+         (reverse r)))
+(test* "permutations-for-each"
+       '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
+       (let1 r '()
+         (permutations-for-each (lambda (p) (push! r p)) '(a b c))
+         (reverse r)))
+(test* "permutations-for-each"
+       '((a b c d) (a b d c) (a c b d) (a c d b)
+         (a d b c) (a d c b) (b a c d) (b a d c)
+         (b c a d) (b c d a) (b d a c) (b d c a)
+         (c a b d) (c a d b) (c b a d) (c b d a)
+         (c d a b) (c d b a) (d a b c) (d a c b)
+         (d b a c) (d b c a) (d c a b) (d c b a))
+       (let1 r '()
+         (permutations-for-each (lambda (p) (push! r p)) '(a b c d))
+         (reverse r)))
+(test* "permutations-for-each"
+       (let* ((set '(a b c d e))
+              (all-patterns
+               (append-map
+                (lambda (v1) 
+                  (append-map
+                   (lambda (v2)
+                     (append-map
+                      (lambda (v3)
+                        (append-map
+                         (lambda (v4)
+                           (map
+                            (lambda (v5)
+                              (list v1 v2 v3 v4 v5))
+                            set))
+                         set))
+                      set))
+                   set))
+                set)))
+         (filter
+          (lambda (x)
+            (eq? (length x)
+                 (length (delete-duplicates x))))
+          all-patterns))
+       (let1 r '()
+         (permutations-for-each (lambda (p) (push! r p)) '(a b c d e))
+         (reverse r)))
+(test* "permutations*-for-each"
+       '()
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '())
+         (reverse r)))
+(test* "permutations*-for-each"
+       '((a))
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '(a))
+         (reverse r)))
+(test* "permutations*-for-each"
+       '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '(a b c))
+         (reverse r)))
+(test* "permutations*-for-each"
+       '((a a b) (a b a) (b a a))
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '(a a b))
+         (reverse r)))
+(test* "permutations*-for-each"
+       '((a a a))
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '(a a a))
+         (reverse r)))
+(test* "permutations*-for-each"
+       '(("a" "a" "b") ("a" "b" "a") ("b" "a" "a"))
+       (let1 r '()
+         (permutations*-for-each (lambda (p) (push! r p)) '("a" "a" "b")
+                                 string=?)
+         (reverse r)))
+
+(test* "combinations" '(())
+       (combinations '() 0))
+(test* "combinations" '((a))
+       (combinations '(a) 1))
+(test* "combinations" '((a) (b) (c) (d))
+       (combinations '(a b c d) 1))
+(test* "combinations" '((a b) (a c) (b c))
+       (combinations '(a b c) 2))
+(test* "combinations" '((a b c))
+       (combinations '(a b c) 3))
+(test* "combinations" '((a b c) (a b d) (a c d) (b c d))
+       (combinations '(a b c d) 3))
+
+(test* "combinations*" '(())
+       (combinations* '() 0))
+(test* "combinations*" '((a))
+       (combinations* '(a) 1))
+(test* "combinations*" '((a) (b) (c) (d))
+       (combinations* '(a b c d) 1))
+(test* "combinations*" '((a b) (a c) (b c))
+       (combinations* '(a b c) 2))
+(test* "combinations*" '((a b c))
+       (combinations* '(a b c) 3))
+(test* "combinations*" '((a b c) (a b d) (a c d) (b c d))
+       (combinations* '(a b c d) 3))
+(test* "combinations*" '((a) (b))
+       (combinations* '(a a b) 1))
+(test* "combinations*" '((a a) (a b))
+       (combinations* '(a a b) 2))
+(test* "combinations*" '((a a b))
+       (combinations* '(a a b) 3))
+(test* "combinations*" '((a b) (a a))
+       (combinations* '(a b a a) 2))
+(test* "combinations*" '((a b a) (a a a))
+       (combinations* '(a b a a) 3))
+(test* "combinations*" '((a b b) (a b a))
+       (combinations* '(a b b a) 3))
+(test* "combinations*" '(("a" "b" "b") ("a" "b" "a"))
+       (combinations* '("a" "b" "b" "a") 3 string=?))
+
+(test* "combinations-for-each" '(())
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '() 0)
+         (reverse! r)))
+(test* "combinations-for-each" '((a))
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '(a) 1)
+         (reverse! r)))
+(test* "combinations-for-each" '((a) (b) (c) (d))
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '(a b c d) 1)
+         (reverse! r)))
+(test* "combinations-for-each" '((a b) (a c) (b c))
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '(a b c) 2)
+         (reverse! r)))
+(test* "combinations-for-each" '((a b c))
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '(a b c) 3)
+         (reverse! r)))
+(test* "combinations-for-each" '((a b c) (a b d) (a c d) (b c d))
+       (let1 r '()
+         (combinations-for-each (lambda (c) (push! r c)) '(a b c d) 3)
+         (reverse! r)))
+
+(test* "combinations*-for-each" '(())
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '() 0)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a) 1)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a) (b) (c) (d))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b c d) 1)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b) (a c) (b c))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b c) 2)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b c))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b c) 3)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b c) (a b d) (a c d) (b c d))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b c d) 3)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a) (b))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 1)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a a) (a b))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 2)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a a b))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 3)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b) (a a))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b a a) 2)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b a) (a a a))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b a a) 3)
+         (reverse! r)))
+(test* "combinations*-for-each" '((a b b) (a b a))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '(a b b a) 3)
+         (reverse! r)))
+(test* "combinations*-for-each" '(("a" "b" "b") ("a" "b" "a"))
+       (let1 r '()
+         (combinations*-for-each (lambda (c) (push! r c)) '("a" "b" "b" "a") 3
+                                 string=?)
+         (reverse! r)))
+
+(test* "power-set-binary" '(())
+       (power-set-binary '()))
+(test* "power-set-binary" '(() (a))
+       (power-set-binary '(a)))
+(test* "power-set-binary" '(() (c) (b) (b c) (a) (a c) (a b) (a b c))
+       (power-set-binary '(a b c)))
+
+(test* "power-set" '(())
+       (power-set '()))
+(test* "power-set" '(() (a))
+       (power-set '(a)))
+(test* "power-set" '(() (a) (b) (c) (a b) (a c) (b c) (a b c))
+       (power-set '(a b c)))
+
+(test* "power-set*" '(())
+       (power-set* '()))
+(test* "power-set*" '(() (a))
+       (power-set* '(a)))
+(test* "power-set*" '(() (a) (b) (a a) (a b) (a a b))
+       (power-set* '(a a b)))
+(test* "power-set*" '(() ("a") ("b") ("a" "a") ("a" "b") ("a" "a" "b"))
+       (power-set* '("a" "a" "b") string=?))
+
+(test* "power-set-for-each" '(())
+       (let1 r '()
+         (power-set-for-each (lambda (s) (push! r s)) '())
+         (reverse! r)))
+(test* "power-set-for-each" '(() (a))
+       (let1 r '()
+         (power-set-for-each (lambda (s) (push! r s))  '(a))
+         (reverse! r)))
+(test* "power-set-for-each" '(() (a) (b) (c) (a b) (a c) (b c) (a b c))
+       (let1 r '()
+         (power-set-for-each (lambda (s) (push! r s))  '(a b c))
+         (reverse! r)))
+
+(test* "power-set*-for-each" '(())
+       (let1 r '()
+         (power-set*-for-each (lambda (s) (push! r s)) '())
+         (reverse! r)))
+(test* "power-set*-for-each" '(() (a))
+       (let1 r '()
+         (power-set*-for-each (lambda (s) (push! r s))  '(a))
+         (reverse! r)))
+(test* "power-set*-for-each" '(() (a) (b) (a a) (a b) (a a b))
+       (let1 r '()
+         (power-set*-for-each (lambda (s) (push! r s))  '(a a b))
+         (reverse! r)))
+(test* "power-set*-for-each" '(() ("a") ("b") ("a" "a") ("a" "b") ("a" "a" "b"))
+       (let1 r '()
+         (power-set*-for-each (lambda (s) (push! r s))  '("a" "a" "b")
+                              string=?)
+         (reverse! r)))
+
+(test* "cartesian-product" '((a 0) (a 1) (b 0) (b 1) (c 0) (c 1))
+       (cartesian-product '((a b c) (0 1))))
+(test* "cartesian-product" '((a 0 0) (a 0 1) (a 1 0) (a 1 1)
+                             (b 0 0) (b 0 1) (b 1 0) (b 1 1))
+       (cartesian-product '((a b) (0 1) (0 1))))
+(test* "cartesian-product-right" '((a 0) (b 0) (c 0) (a 1) (b 1) (c 1))
+       (cartesian-product-right '((a b c) (0 1))))
+
+
+
+;;===================================================================
+(test-end)

metadata

@@ -5,8 +5,8 @@ version: !ruby/object:Gem::Version
   segments: 
   - 0
   - 5
-  - 0
-  version: 0.5.0
+  - 1
+  version: 0.5.1
 platform: ruby
 authors: 
 - Kiyoka Nishiyama
@@ -14,7 +14,7 @@ autorequire:
 bindir: bin
 cert_chain: []
 
-date: 2011-04-25 00:00:00 +09:00
+date: 2011-06-24 00:00:00 +09:00
 default_executable: nendo
 dependencies: 
 - !ruby/object:Gem::Dependency 
@@ -60,7 +60,6 @@ files:
 - example/fizzbuzz1.nnd
 - example/html-lite-sample.nnd
 - example/nqueen.nnd
-- example/scratch.nnd
 - example/twitterTL.nnd
 - lib/debug/syslog.nnd
 - lib/debug/syslog.nndc
@@ -81,9 +80,14 @@ files:
 - lib/text/html-lite.nndc
 - lib/text/tree.nnd
 - lib/text/tree.nndc
+- lib/util/combinations.nnd
+- lib/util/combinations.nndc
 - lib/util/list.nnd
 - lib/util/list.nndc
+- lib/util/match.nnd
+- lib/util/match.nndc
 - test/json-test.nnd
+- test/match-test.nnd
 - test/nendo-util-test.nnd
 - test/nendo_spec.rb
 - test/srfi-1-test.nnd
@@ -91,6 +95,7 @@ files:
 - test/srfi-26-test.nnd
 - test/syntax_spec.rb
 - test/textlib-test.nnd
+- test/util-combinations-test.nnd
 - test/util-list-test.nnd
 - README
 has_rdoc: true

data/example/scratch.nnd

@@ -1,119 +0,0 @@
-;;-*- mode: nendo; syntax: scheme -*-;;
-;; -----------------
-(enable-idebug)
-(disable-idebug)
-(exit)
-
-(debug-print-length)
-(debug-print-length 2000)
-
-(error "Error: (error) func test 1")
-(error "Error: (error) func test 1" '(r a i s e))
-
-
-(define (generic-member cmp obj lst)
-  (cond
-    ((null? lst) #f)
-    ((not (pair? lst)) #f)
-    ((cmp obj (car lst)) lst)
-    (else (generic-member cmp obj (cdr lst)))))
-
-
-(memq 'b '(a b c d))
-(memq 'a '(a b c d . e))
-
-
-
-;; :optional feature from Gauche-0.9.1 .
-
-(define %expand-define-form-lambda
-  (lambda (arg body-list)
-    ;; (define (func arg...) body)
-    (if (pair? (cdr arg))
-        (if (pair? (car (cdr arg)))
-            (error "Error: define syntax error.")))
-    (cons 'define
-          (list (car arg)
-                (%transform-optional-arguments (cdr arg) body-list)))))
-
-
-  (define (%transform-optional-arguments arg body-list)
-    (if-let1 rest-of-opts (memq :optional arg)
-             (let([opts         '()]
-                  [rest-of-opts (cdr rest-of-opts)]
-                  [_rest        (gensym)])
-               ;; arguemnt form check
-               (for-each
-                (lambda (x)
-                  (let1 syntax-is-ok  (if (pair? x)
-                                          (= 2 (length x))
-                                          #f)
-                    (unless syntax-is-ok
-                      (error "Error:  :optional format is illegal ... " arg))))
-                rest-of-opts)
-               (let loop ((arg arg))
-                 (if (eq? :optional (car arg))
-                     arg
-                     (begin
-                       (set! opts (cons (car arg) opts))
-                       (loop (cdr arg)))))
-               (let1 new-arg (apply list* (append (reverse opts) (list _rest)))
-                 (list 'lambda
-                       new-arg
-                       `(let
-                            ,rest-of-opts
-                          ,@(map
-                             (lambda (k n)
-                               `(when (< ,n (length ,_rest))
-                                  (set! ,(car k) (nth ,n ,_rest))))
-                             rest-of-opts
-                             (range (length rest-of-opts)))
-                          ,@body-list))))
-             `(lambda ,arg ,@body-list)))
-
-
-(%transform-optional-arguments '(arg1 arg2)
-                               '((begin 1 2)))
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional (arg3 #f))
-                                '((begin 1 2))))
-
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional (arg3 #f) (arg4 #t))
-                                '((begin 1 2))))
-
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional illegal-arg (arg3 #f) (arg4 #t))
-                                '((begin 1 2))))
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional (arg3 #f) (arg4 #t) illegal-arg)
-                                '((begin 1 2))))
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional (arg3 #f) illegal-arg (arg4 #t))
-                                '((begin 1 2))))
-
-(pretty-print
- (%transform-optional-arguments '(arg1 arg2 :optional (arg3 #f #f))
-                                '((begin 1 2))))
-
-
-(macroexpand
- '(define (func arg1 arg2)
-    (begin
-      1
-      2)))
-
-(pretty-print
- (macroexpand
-  '(define (func arg1 arg2 :optional (arg3 #t))
-     (print "1")
-     (print "2"))))
-
-(define (func arg1 arg2 :optional (arg3 #t))
-  (printf "[%d]" arg1)(newline)
-  (printf "[%d]" arg2)(newline)
-  (printf "[%s]" arg3)(newline))
-
-(func 1 2 'a)
-
-