[plt-scheme] Request for comments on possible planet functions

Like most people, I've built up a small library of functions that i seem to
use over and over again, and are not specific to any individual application
that I write..  I was considering makeing a planet package out of them, but
before I do, If anyone has comments on them, I'd love to hear them.  I'm
guessing i'm not the first person to have written some of these functions.

Here are the first few that I'm considering of posting:  {examples on how to
use them follows most of the non-obvious functions}

;sexp functions
;;sexp->string
;;string->sexp

(define (sexp->string x)
  (let ((string-x (open-output-string)))
    (write x string-x)
    (get-output-string string-x)))

(define (string->sexp x) (read (open-input-string x)))





;map related functions
;;maprec
;;any-rec
;;unique
;;compose-functions-by-fold
;;make-combinations
;;make-permutations
;;flatten


;;maprec maps func to all elements of a tree, but only the elements (no
lists)
(define (maprec func tree)
  (if (not (list? tree))
      (func tree)
      (map (lambda (x) (maprec func x)) tree)))



(define (any-rec func tree)
  (if (list? tree)
      (any (lambda (x) (any-rec func x)) tree)
      (func tree)))

(register-test-case `map-related-tests
 (make-test-case  "any-rec-1"
                  (assert-equal? (any-rec even? `(2 3 9 4 (3 8 3 4 6 5 5) 1
12))
                                 #t)))



(define (unique list-in)
  (cond ((null? list-in)
         list-in)
        (#t
         (cons (first list-in)
               (unique (filter (lambda (x) (not (equal? x (first list-in))))
                               (rest list-in)))))))

(register-test-case `map-related-tests
                    (make-test-case  "unique-1"
                                     (assert-equal? (unique `(a b c r c k u
f a i b e c e gf))
                                                    `(a b c r k u f i e
gf))))




(define compose-functions-by-fold
  (lambda (list-of-functions)
    (lambda (start-value)
             (fold (lambda (x y) (x y)) start-value list-of-functions))))

(register-test-case
 `map-related-tests
 (make-test-case  "compose-functions-by-fold-1"
                  (assert-equal? [(compose-functions-by-fold (list (lambda
(i) (display "1") (+ 1 i))
                                                                   (lambda
(i) (display "2") (+ 1 i))
                                                                   (lambda
(i) (display "3") (+ 1 i))
                                                                   (lambda
(i) (display "4") (+ 1 i))))
                                  7]
                                 11)))





(define make-combinations
  (lambda (list-of-lists)
    ;(display #\newline)
    (write list-of-lists)
    (if (= 1 (length list-of-lists))
        (begin
          ;(display "tick")
          (map list (first list-of-lists)))
        (begin
          ;(mdisplay "list of lists: " list-of-lists "\nrest of
lost-of-lists: " (rest list-of-lists))
          (apply append
                 (map (lambda (element-of-first-list)
                        (map (lambda (z) (cons element-of-first-list z))
                             (make-combinations (rest list-of-lists))))
                      (first list-of-lists)))))))

(register-test-case `map-related-tests
 (make-test-case  "make-combinations-2"
                  (assert-equal? (make-combinations `[(a b c) (1 2 3) (x
y)])
                                 `((a 1 x) (a 1 y) (a 2 x) (a 2 y) (a 3 x)
(a 3 y)
                                   (b 1 x) (b 1 y) (b 2 x) (b 2 y) (b 3 x)
(b 3 y)
                                   (c 1 x) (c 1 y) (c 2 x) (c 2 y) (c 3 x)
(c 3 y)))))





(define (make-permutations list-of-elements)
  (if (= 1 (length list-of-elements))
      (list list-of-elements)
      (apply append
             (map
              (lambda (element)
                (map
                 (lambda (x) (cons element x))
                 (make-permutations (filter (lambda (z) (not (equal? element
z))) list-of-elements))))
              list-of-elements))))

(register-test-case `map-related-tests
                    (make-test-case  "make-permutations-1"
                                     (assert-equal? (make-permutations `(a
b))
                                                    `((a b) (b a)))))

(register-test-case `map-related-tests
                    (make-test-case  "make-permutations-2"
                                     (assert-equal?  (make-permutations `(a
b c))
                                                     `((a b c) (a c b) (b a
c) (b c a) (c a b) (c b a)))))




(define (flatten tree)
  (fold (lambda (item list-so-far)
          (if (not (list? item))
              (append list-so-far (list item))
              (append list-so-far (flatten item))))
        `()
        tree))

(register-test-case `map-related-tests
 (make-test-case  "flatten-1"
                  (assert-equal? (flatten `(2 (3 (9) 4) (3 (8 (3 (4 6))) 5
5) 1 12))
                                 `(2 3 9 4 3 8 3 4 6 5 5 1 12))))





Corey

-- 
((lambda (y) (y y)) (lambda (y) (y y)))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070118/71c9646b/attachment.html>