writing a program to list all possible solutions to a logic problem

Say you have a finite number of sets, and each set contains exactly n
items, where n is any positive number. Create a program that will
generate all of the possible solutions in which there is exactly one
element from each set, and order doesn't matter (see examples below).

So, I made this problem for myself and finished it up recently, and,
having done that, I'd like to put my solution out there in the hopes
that other schemers will post better solutions and I can learn from
them. My solution is below. Improve on it, either with better
efficiency or improved aesthetic value...


; procedure: all-solutions
;
; argument: LoC - List of Categories
; Examples of valid LoC argument (notice each category has same number
of items):
;   '((bill bob sue) (red blue yellow) (23 45 67) (plumber doctor
scientist))
;   '((1 2 3 4 5 6 7) (a b c d e f g))
;   ;((jack jill) (smith jones) (red blue) (mac windows) (berkeley
stanford)
;
; returns: a list of all possible solutions, where each solution is
itself a nested list
; (all-solutions '((brian max) (great awesome))
; --> (((brian great) (max awesome)) ((max great) (brian awesome)))
; (all-solutions '((a b)(1 2)(foo bar)))
; --> (((a 1 foo) (b 2 bar)) ((b 1 foo) (a 2 bar)) ((a 2 foo) (b 1
bar)) ((b 2 foo) (a 1 bar)))

(define (all-solutions LoC)
(if (null? (cdr LoC))
(list (map (lambda (item) (list item)) (car LoC)))
(apply append (map (lambda (solution)
(map-all-permutations-to-one-solution
(permutations (car LoC)) solution))
(all-solutions (cdr LoC))))))



(define (map-all-permutations-to-one-solution permutations solution)
(if (null? permutations) '()
(cons (map-one-permutation-to-one-solution (car permutations)
solution)
(map-all-permutations-to-one-solution (cdr permutations)
solution))))


(define (map-one-permutation-to-one-solution permutation solution)
(if (null? permutation) '()
(cons (cons (car permutation) (car solution))
(map-one-permutation-to-one-solution (cdr permutation)
(cdr solution)))))

; only slightly modified from SICP's version (why re-invent the wheel?)
(define (permutations L)
(if (null? L) '(())
(apply append (map (lambda (item)
(map (lambda (perm)
(cons item perm))
(permutations (remove item L))))
L))))

(define (remove item-to-remove L)
(cond ((null? L) '())
((equal? (car L) item-to-remove) (cdr L))
(else (cons (car L) (remove item-to-remove (cdr L))))))

"H." <hbe123@gmail.com> writes:

> Say you have a finite number of sets, and each set contains exactly n
> items, where n is any positive number. Create a program that will
> generate all of the possible solutions in which there is exactly one
> element from each set, and order doesn't matter (see examples below).
...
> ; (all-solutions '((a b)(1 2)(foo bar)))
> ; --> (((a 1 foo) (b 2 bar)) ((b 1 foo) (a 2 bar)) ((a 2 foo) (b 1
> bar)) ((b 2 foo) (a 1 bar)))
...

I was surprised at this example (as well as the other one; among other
things, you should know that I would respond even without flattery).

Based on your prose description, I would have expected the result to be

((a 1 foo)
(b 1 foo)
(a 2 foo)
(b 2 foo)
(a 1 bar)
(b 1 bar)
(a 2 bar)
(b 2 bar))

Are your examples an accurate reflection of what you really want?  (In
which case, the description might be modified.) Or, do your examples
reflect a design bug?  -max

Max Hailperin wrote:
> "H." <hbe123@gmail.com> writes:
> 
> ... 
> ...
>
> I was surprised at this example (as well as the other one; among other
> things, you should know that I would respond even without flattery).
>
> Based on your prose description, I would have expected the result to be
>
> ((a 1 foo)
>  (b 1 foo)
>  (a 2 foo)
>  (b 2 foo)
>  (a 1 bar)
>  (b 1 bar)
>  (a 2 bar)
>  (b 2 bar))
>
> Are your examples an accurate reflection of what you really want?  (In
> which case, the description might be modified.) Or, do your examples
> reflect a design bug?  -max

Well, it's just that you guys help me out a lot, and I appreciate it.

Ah, I see what you mean. Returning the full groupings is what I was
trying to do; you're right I wasn't describing it well. (This program
is the first step in writing a fuller logic program, so that I can add
some future feature that can take the full input and then hints like:
'(a is not grouped with 1), and return all of the possible full
groupings where a is not grouped with 1. Unfortunately, I'm not really
sure how to describe the problem I was trying to solve in the best
prose. Sometimes it seems harder describing the problem than doing the
problem!

The way I described it without meaning to, and the solution you have --
I think that's actually an easier problem. I'll go figure that one
out...yes it's really amazingly shorter:

(define (solutions LoC)
(if (null? (cdr LoC))
(map (lambda (element) (list element)) (car LoC))
(apply append
(map
(lambda (new-element)
(map (lambda (solution) (cons new-element solution))

(solutions (cdr LoC))))
(car LoC)))))


STk> (solutions '((scheme java c++)(inferior superior in-the-middle)))
((scheme inferior) (scheme superior) (scheme in-the-middle) (java
inferior) (java superior) (java in-the-middle) (c++ inferior) (c++
superior) (c++ in-the-middle))

Yeah, the other one is a more difficult problem :-).

"H." <hbe123@gmail.com> writes:
...
> The way I described it without meaning to, and the solution you have --
> I think that's actually an easier problem. I'll go figure that one
> out...yes it's really amazingly shorter:
>
> (define (solutions LoC)
>    (if (null? (cdr LoC))
>       (map (lambda (element) (list element)) (car LoC))
..

Two comments on tightening up this code a bit:

(1) You can always replace
(lambda (element) (list element))
by just
list

(2) In this particular case -- as in many -- there is a bigger
simplification available by pushing the recursion one step
further.  That is, stop only once the LoC is empty, rather than
when it has a single sublist.  That would reduce the base case
down to

(if (null? LoC)
'(())

Now I'll go back to trying to figure out what you really wanted, and
whether there is a better way to achieve it than the code you showed.
-max

"H." <hbe123@gmail.com> writes:

>... My solution is below. Improve on it, either with better
> efficiency or improved aesthetic value...

> (define (all-solutions LoC)
>    (if (null? (cdr LoC))
>       (list (map (lambda (item) (list item)) (car LoC)))
...

As I said with regard to your other program,
(lambda (item) (list item))
should be simplified to just
list

This transformation is known as "eta reduction," if you want a fancy
name for it.  After you get used to it, seeing the extra (lambda ...)
wrapped around something starts seeming as strange as if you saw
someone writing "(+ 0  ...)" or "(* 1 ...)" for no apparent reason.
(Another example would be (if ... #t #f) where the ... part already
will evaluate to either #t or #f.)

> (define (map-all-permutations-to-one-solution permutations solution)
...
> (define (map-one-permutation-to-one-solution permutation solution)
...

Your use of two names starting with "map" is apt, as these two
procedures fit exactly the pattern that the "map" procedure captures.
However, rather than justusing this as a naming convention, you should
actually use the map procedure itself.  For example, you can write

(map cons
permutation
solution)

in place of map-one-permutation-to-one-solution.  (Why, as you asked
elsewhere, should you reinvent the wheel?)  Once I got done making
those simplifications, your code boiled down to

(define (all-solutions LoC)
(if (null? (cdr LoC))
(list (map list (car LoC)))
(apply append
(map (lambda (solution)
(map (lambda (permutation)
(map cons
permutation
solution))
(permutations (car LoC))))
(all-solutions (cdr LoC))))))

which I find to be a lot easier to understand.  -max

H. wrote:
> Say you have a finite number of sets, and each set contains exactly n
> items, where n is any positive number. Create a program that will
> generate all of the possible solutions in which there is exactly one
> element from each set, and order doesn't matter (see examples below).
>
> So, I made this problem for myself and finished it up recently, and,
> having done that, I'd like to put my solution out there in the hopes
> that other schemers will post better solutions and I can learn from
> them. My solution is below. Improve on it, either with better
> efficiency or improved aesthetic value...
>
>
> ; procedure: all-solutions
> ;
> ; argument: LoC - List of Categories
> ; Examples of valid LoC argument (notice each category has same number
> of items):
> ;   '((bill bob sue) (red blue yellow) (23 45 67) (plumber doctor
> scientist))
> ;   '((1 2 3 4 5 6 7) (a b c d e f g))
> ;   ;((jack jill) (smith jones) (red blue) (mac windows) (berkeley
> stanford)
> ;
> ; returns: a list of all possible solutions, where each solution is
> itself a nested list
> ; (all-solutions '((brian max) (great awesome))
> ; --> (((brian great) (max awesome)) ((max great) (brian awesome)))
> ; (all-solutions '((a b)(1 2)(foo bar)))
> ; --> (((a 1 foo) (b 2 bar)) ((b 1 foo) (a 2 bar)) ((a 2 foo) (b 1
> bar)) ((b 2 foo) (a 1 bar)))
>
> (define (all-solutions LoC)
>    (if (null? (cdr LoC))
>       (list (map (lambda (item) (list item)) (car LoC)))
>       (apply append (map (lambda (solution)
>                             (map-all-permutations-to-one-solution
> (permutations (car LoC)) solution))
>                          (all-solutions (cdr LoC))))))
>
>
>
> (define (map-all-permutations-to-one-solution permutations solution)
>    (if (null? permutations) '()
>       (cons (map-one-permutation-to-one-solution (car permutations)
> solution)
>             (map-all-permutations-to-one-solution (cdr permutations)
> solution))))
>
>
> (define (map-one-permutation-to-one-solution permutation solution)
>    (if (null? permutation) '()
>        (cons (cons (car permutation) (car solution))
>              (map-one-permutation-to-one-solution (cdr permutation)
> (cdr solution)))))
>
> ; only slightly modified from SICP's version (why re-invent the wheel?)
> (define (permutations L)
>    (if (null? L) '(())
>       (apply append (map (lambda (item)
>                             (map (lambda (perm)
>                                     (cons item perm))
>                                  (permutations (remove item L))))
>                           L))))
>
> (define (remove item-to-remove L)
>    (cond ((null? L) '())
>          ((equal? (car L) item-to-remove) (cdr L))
>          (else (cons (car L) (remove item-to-remove (cdr L))))))
>

Your description looks like (UCBLogo) crossmap to me:

(define (crossmap . sets)
(letrec ((cross
(lambda (xs ys)
(if (null? ys)
'()
(let ((r (cross xs (cdr ys))))
(append
(map (lambda (x) (cons x (car ys))) xs)
r))))))
(foldr cross '(()) sets)))


Welcome to DrScheme, version 350.
Language: Textual (MzScheme, includes R5RS).
> (crossmap '(a b) '(1 2) '(foo bar))
((a 1 foo) (b 1 foo) (a 2 foo) (b 2 foo) (a 1 bar) (b 1 bar) (a 2 bar)
(b 2 bar))
>

Hrvoje Blazevic wrote:
> H. wrote: 
>
> Your description looks like (UCBLogo) crossmap to me:
>
> (define (crossmap . sets)
>   (letrec ((cross
>             (lambda (xs ys)
>               (if (null? ys)
>                   '()
>                   (let ((r (cross xs (cdr ys))))
>                     (append
>                      (map (lambda (x) (cons x (car ys))) xs)
>                      r))))))
>     (foldr cross '(()) sets)))
>
>
> Welcome to DrScheme, version 350.
> Language: Textual (MzScheme, includes R5RS). 
> ((a 1 foo) (b 1 foo) (a 2 foo) (b 2 foo) (a 1 bar) (b 1 bar) (a 2 bar)
> (b 2 bar))

Well, if this is about improving aesthetic value ...

(define (crossmap . sets)
(foldr
(lambda (xs ys)
(foldr (lambda (y r)
(append (map (lambda (x) (cons x y)) xs) r))
'() ys)) '(()) sets))


> (crossmap '(a b) '(1 2) '(foo bar))
((a 1 foo) (b 1 foo) (a 2 foo) (b 2 foo) (a 1 bar) (b 1 bar) (a 2 bar)
(b 2 bar))

-- Hrvoje

> Two comments on tightening up this code a bit:
>
[clipped]

Thanks. I see what you mean about both points.

> (define (all-solutions LoC)
>   (if (null? (cdr LoC))
>       (list (map list (car LoC)))
>       (apply append
>              (map (lambda (solution)
>                     (map (lambda (permutation)
>                            (map cons
>                                 permutation
>                                 solution))
>                          (permutations (car LoC))))
>                   (all-solutions (cdr LoC))))))
>
> which I find to be a lot easier to understand.  -max

Thanks. That *is* a lot easier to read. I forgot about that usage of
map.