; google interview question
(define (fold-right op base xs)
(if (null? xs)
base
(op (car xs) (fold-right op base (cdr xs)))))
(define (cross . xss)
(define (f xs yss)
(define (g x zss)
(define (h ys uss)
(cons (cons x ys) uss))
(fold-right h zss yss))
(fold-right g '() xs))
(fold-right f (list '()) xss))
(define (intersect xs ys)
(cond ((null? xs) (list))
((member (car xs) ys)
(cons (car xs) (intersect (cdr xs) ys)))
(else (intersect (cdr xs) ys))))
(define sort #f)
(define merge #f)
(let ()
(define dosort
(lambda (pred? ls n)
(if (= n 1)
(list (car ls))
(let ((i (quotient n 2)))
(domerge pred?
(dosort pred? ls i)
(dosort pred? (list-tail ls i) (- n i)))))))
(define domerge
(lambda (pred? l1 l2)
(cond
((null? l1) l2)
((null? l2) l1)
((pred? (car l2) (car l1))
(cons (car l2) (domerge pred? l1 (cdr l2))))
(else (cons (car l1) (domerge pred? (cdr l1) l2))))))
(set! sort
(lambda (pred? l)
(if (null? l) l (dosort pred? l (length l)))))
(set! merge
(lambda (pred? l1 l2)
(domerge pred? l1 l2))))
(define (g xs)
(car
(sort
(lambda (xs ys) (> (car xs) (car ys)))
(map
(lambda (xs)
(cons (* (string-length (car xs))
(string-length (cadr xs)))
xs))
(filter
(lambda (xs)
(null?
(intersect
(string->list (car xs))
(string->list (cadr xs)))))
(cross xs xs))))))
(display (g '("ABCW" "BAZ" "FOO" "BAR" "XTFN" "ABCDEF")))