Hett’s Problem 1.28

August 9, 2011

The first problem isn’t very hard. We use the standard system sort, and define a sorting algorithm that compares sublists by their length:

(define (lsort xss)
  (define (lt? a b) (< (length a) (length b)))
  (sort lt? xss))

Here is Hett’s example:

> (lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))

The second problem is a bit more involved. Hett’s solution adds a length field to each sub-list, sorts the sub-lists by length, packs sub-lists with equal lengths into sub-sub-lists, sorts those sub-sub-lists by their lengths using the solution to the first problem, flattens the sub-sub-lists back into their sub-lists, then removes the length fields. Our Standard Prelude lets us do the same:

(define (lfsort xss)
  (map cdr (mappend identity (lsort
    (group-by (lambda (a b) (= (car a) (car b)))
      (sort (lambda (a b) (< (car a) (car b)))
        (map (lambda (x) (cons (length x) x)) xss)))))))

Working from the inside out: The inner map adds a length to the beginning of each sub-list, then sort orders the sub-lists by length. The group-by brings together sub-lists of equal length into sub-sub-lists, lsort sorts those sub-sub-lists as in the first problem, and mappend identity converts the sub-sub-lists back into sub-lists (it’s similar to flatten except that it strips only one layer of nesting instead of all the layers of nesting). Finally, the outer map removes the length that the inner map added.

Our function returns the same solution as Hett’s, except that the two initial lists, each with length frequency of 1, are reversed; Hett did not specify what to do in that case, so our solution is as good as his.

> (lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
((o) (i j k l) (a b c) (f g h) (d e) (d e) (m n))

We used mappend, identity, and group-by from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/fQUYFP6u.

About these ads

Pages: 1 2

16 Responses to “Hett’s Problem 1.28”

  1. F. Carr said
    def hett1_28a(lsts):
        return sorted(lsts, key=len)
    
    from collections import defaultdict
    def hett1_28b(lsts):
        freq = defaultdict(int)
        for l in lsts:
            freq[len(l)] += 1
        return sorted(lsts, key=lambda l:freq[len(l)])
    
  2. Mike said

    Python 3 (Should work in 2.7 also).
    Basically the same as Carr’s above.

    from collections import Counter
    from functools import partial
    
    lsort = partial(sorted, key=len)
    lfsort = lambda r:sorted(r, key=lambda v:Counter(map(len,r))[len(v)])
    
  3. [...] today’s Programming Praxis, our goal is to sort a list of lists by length and by length frequency. [...]

  4. My Haskell solution (see http://bonsaicode.wordpress.com/2011/08/09/programming-praxis-hett%E2%80%99s-problem-1-28/ for a version with tests and comments):

    import qualified Data.List.Key as K
    
    byLength :: [[a]] -> [[a]]
    byLength = K.sort length
    
    byLengthFreq :: [[a]] -> [[a]]
    byLengthFreq = concat . byLength . K.group length . byLength
    
  5. Graham said

    Since there’s already a couple Python solutions, here’s my try in Common Lisp:

    (defun lsort (xss)
      (stable-sort (copy-list xss) #'< :key #'list-length))
    
    (defun lfsort (xss)
      (let ((freq (make-hash-table)))
        (progn
          (dolist (xs xss) (incf (gethash (list-length xs) freq 0)))
          (stable-sort (copy-list xss) #'<
                :key #'(lambda (xs) (gethash (list-length xs) freq))))))
    

    I used stable-sort to make sure order was preserved between elements
    that are the same by the sort’s comparison. My lfsort basically uses the
    same logic as the Python solutions above. I tried to wrap it all up in a loop,
    but was unable to get things returned properly; if there are any CL gurus out there who
    could take the time to improve my lfsort, I’d appreciate the help!

  6. slabounty said

    A ruby version …

    list = [%w[a, b, c], %w[d], %w[e, f], %w[g, h, i, j, k], %w[l], %w[m, n, o]]
    
    list_sort_length = list.sort {|a, b| a.length <=> b.length}
    p list_sort_length
    
    hist = Hash.new{|h, k| h[k] = []}
    list.each { |l| hist[l.length] << l }
    list_sort_hist = []
    hist.sort {|a,b| a.length <=> b.length}.each { |key, value| value.each {|e| list_sort_hist << e } }
    p list_sort_hist
    
  7. Mike said

    Forget my function for lfsort shown above. I don’t know what I was thinking–it recreates the Counter() for every element in the input list. O(n^2) or something like that.

    A better lfsort is a variation on F. Carr’s:

    from collections import defaultdict
    from operator import concat
    from functools import reduce
    
    def lfsort(seq):
    	d = defaultdict(list)
    	for lst in seq:
    		d[len(lst)].append(lst)
    	return reduce(concat, lsort(d.values()))
    
    

    Or if you like one-liners, you could do it thus:

    
    lfsort = lambda s:reduce(concat,lsort([list(v) for _,v in groupby(lsort(s),len)]))
    
    

    Which, I noticed, is the same as Remco’s much more elegant Haskell code.

  8. Axio said
    (defparameter *l* '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
    ;
    (defun f1 (l)
    &nbsp;&nbsp;(sort l #'(lambda (x y)
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(&lt;= (list-length x)
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(list-length y)))))
    ;
    (defun f2 (l)
    &nbsp;&nbsp;(let ((h (make-hash-table :test #'equal)))
    &nbsp;&nbsp;&nbsp;&nbsp;(loop for i in l
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;do (incf (gethash i h 0))
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;finally (let* ((r '()))
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(maphash (lambda (k v) (push (cons v k) r)) h)
    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(return (mapcar #'cdr (sort r #'&lt; :key #'car)))))))
    
  9. Axio said

    I mixed HTML and sourcecode option in the above post, and trying to repost didn’t show anything… I try again…
    @Graham: maybe something like this:

    (defparameter *l* '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
    ;
    (defun f1 (l)
      (sort l #'(lambda (x y)
                  (<= (list-length x)
                      (list-length y)))))
    ;
    (defun f2 (l)
      (let ((h (make-hash-table :test #'equal)))
        (loop for i in l
              do (incf (gethash i h 0))
              finally (let* ((r '()))
                        (maphash (lambda (k v) (push (cons v k) r)) h)
                        (return (mapcar #'cdr (sort r #'< :key #'car)))))))
    
  10. Axio said

    Oh, f2 didn’t do what was asked for…
    Correct answer is

    (defun f2 (l)
      (let ((h (make-hash-table)))
        (loop for i in l
              do (incf (gethash (list-length i) h 0))
              finally (return  (sort l #'< :key #'(lambda (x) (gethash (list-length x) h)))))))
    

    but loop is in fact quite useless here, and the code amounts to what you wrote…

  11. Graham said

    Thanks @Axio! I was trying to make it all self-contained, with the hash
    table one of the local “for” variables in the loop, but could never get it
    working. Perhaps I’m overly fond of the loop macro, and shouldn’t get
    so fixated on using it for every problem :-)

  12. Boyo said

    Perl 5 solution, making use of the Schwartzian transform.

    sub lsort {
        return
            map  { $_->[0] }
            sort { $a->[1] cmp $b->[1] }
            map  { [$_, scalar @$_] }
                @_;
    }
    
    sub lfsort {
        my %freq_of;
    
        foreach my $sublist (@_) {
            $freq_of{scalar @$sublist}++;
        }
    
        return
            map  { $_->[0] }
            sort { $a->[1] cmp $b->[1] }
            map  { [$_, $freq_of{scalar @$_}] }
                @_;
    }
    

    And a link to codepad with the original list sorted.

    http://codepad.org/BRG0YHIR

  13. Here’s my clojure solution. More details at my blog.

    ;;Hett's Problem 1.28
    
    (def test-list [[:a :b :c] [:d :e] [:f :g :h] [:d :e] [:i :j :k :l] [:m :n] [:o]])
    
    (defn sort-by-length [some-list]
      (sort-by count some-list))
    
    (defn sort-by-length-freq [some-list]
      (let [freq-map (frequencies (map count test-list))]
        (sort-by (fn [l] (freq-map (count l))) some-list)))
    
  14. #lang racket
    (define (lsort lists)
      (sort lists < #:key length))
    (define (lfsort lists)
      (let ((freq (for/fold ((h (hash))) ((l lists))
                    (dict-update h (length l) add1 0))))
        (sort lists < #:key (λ (l) (dict-ref freq (length l))))))
    
  15. wu said

    i did this in perl 5 also, with a minor variation on the lfsort posted by boyo:

    sub lfsort {
    my $length_freq;

    return map { $_->[1] }
    sort { $length_freq->{ $a->[0] } $length_freq->{ $b->[0] } }
    map { [ scalar @$_, $_ ] }
    map { $length_freq->{ scalar @$_ }++; $_ } @_

    }

  16. wu said

    oops, forgot to mention that the perl5 solution does not require schwartzian transformation on the lsort:

    sub lsort {
    return sort { scalar @{$a} scalar @{$b} } @_;
    }

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 627 other followers

%d bloggers like this: