Planet Scheme

August 22, 2014

Joe Marshall

Small puzzle solution

Before I give my solution, I'd like to describe the leftmost digit algorithm in a bit more detail.
(define (leftmost-digit base n)
  (if (< n base)
      n
      (let ((leftmost-pair (leftmost-digit (* base base) n)))
        (if (< leftmost-pair base)
            leftmost-pair
            (quotient leftmost-pair base)))))
The idea is this: if we have a one digit number, we just return it, otherwise we recursively call leftmost-digit with the square of the base. Squaring the base will mean gobbling up pairs of digits in the recursive call, so we'll get back either a one or two digit answer from the recursion. If it is one digit, we return it, otherwise it's two digits and we divide by the base to get the left one.

For example, if our number is 12345678 and the base is 10, we'll make a recursive call with base 100. The recursive call will deal with number as if it were written 12 34 56 78 in base 100 and return the answer 12. Then we'll divide that by 10 to get the 1.

Since we're squaring the base, we're doubling the number of digits we're dealing with on each recursive call. This leads to the solution in O(log log n) time. If we instrument quotient, you can see:
(leftmost-digit 10 816305093398751331727331379663195459013258742431006753294691576)
816305093398751331727331379663195459013258742431006753294691576 / 100000000000000000000000000000000
8163050933987513317273313796631 / 10000000000000000
816305093398751 / 100000000
8163050 / 10000
816 / 100
A sixty-three digit number trimmed down to one digit with only five divisions.

So a simple solution to the puzzle is:
(define (leftmost-digit+ base n)
  (if (< n base)
      (values n 0)
      (call-with-values (lambda () (leftmost-digit+ (* base base) n))
        (lambda (leftmost-pair count)
          (if (< leftmost-pair base)
              (values leftmost-pair (* count 2))
              (values (quotient leftmost-pair base) (+ (* count 2) 1)))))))
The second value is the count of how many digits we discard. If the number is less than the base, we return it and we discarded nothing. Otherwise, we make the recursive call with the base squared and get back two values, the leftmost pair and the number of pairs it discarded. If the leftmost pair is a single digit, we return it, otherwise we divide by the base. The number of digits discarded is simply twice the number discarded by the recursive call, plus one more if we had to divide.

But I don't see an easy way to separate finding the digit from finding the position. At first it seemed straightforward to just count the digits being discarded, but you can't decide whether to increment the count at each stage without determining if the leftmost part of the recursive call contains one or two digits.

by Joe Marshall (noreply@blogger.com) at August 22, 2014 10:57 PM

Grant Rettke

Lexical Scope and Statistical Computing

Any paper that references SICP must be read.

It is curious how key computational ideas have propagated to one area of application exactly and one may have expected they would do so.

by Grant at August 22, 2014 02:34 PM

Programming Praxis

Patience Sorting

This sorting algorithm derives its name from the game of Patience (that’s the British name, we call it Solitaire in the United States) because it is implemented by analogy to sorting a shuffled deck of cards:

Starting with no piles, add the next card from the deck to the first pile with top card greater than the next card from the deck. If the next card from the deck is greater than the top card of all the piles, start a new pile. When the deck is exhausted, collect the cards in order by selecting the smallest visible card at each step.

For instance, consider sorting the list (4 3 9 1 5 2 7 8 6). The first stack gets 4 and 3. Since 9 is larger than 3, it starts a second stack, 1 goes on the first stack, then 5 and 2 go on the second stack. At this point the first stack (top to bottom) consists of (1 3 4), the second stack consists of (2 5 9), and the remaining deck consists of (7 8 6). Now 7 goes on a third stack, 8 goes on a fourth stack, and 6 goes on top of the 7 in the third stack. With all the cards dealt, 1 is collected from the first stack, 2 from the second stack, 3 and 4 from the first stack, 5 from the second stack, 6 and 7 from the third stack, 8 from the fourth stack, and 9 from the second stack. The algorithm has complexity O(n log n).

Your task is to implement the patience sorting algorithm. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at August 22, 2014 02:00 PM

August 21, 2014

Joe Marshall

Just a small puzzle

You can get the most significant digit (the leftmost) of a number pretty quickly this way
(define (leftmost-digit base n)
  (if (< n base)
      n
      (let ((leftmost-pair (leftmost-digit (* base base) n)))
        (if (< leftmost-pair base)
            leftmost-pair
            (quotient leftmost-pair base)))))
The puzzle is to adapt this code to return the position of the leftmost digit.

(leftmost-digit+ 10 46729885)  would return two values, 4 and 7

by Joe Marshall (noreply@blogger.com) at August 21, 2014 11:43 PM

August 19, 2014

Programming Praxis

Cracker Barrel

While I was out of town last week, I ate dinner one evening at Cracker Barrel, which provides a triangle puzzle at each table so you can amuse yourself while you are waiting for your food. When my daughter challenged me to solve the problem, I failed, but I promised her that I would write a program to solve it.

As shown in the picture at right, the puzzle is a triangle with 15 holes and 14 pegs; one hole is initially vacant. The game is played by making 13 jumps; each jump removes one peg from the triangle, so at the end of 13 jumps there is one peg remaining. A jump takes a peg from a starting hole, over an occupied hole, to an empty finishing hole, removing the intermediate peg.

Your task is to write a program that solves the Cracker Barrel puzzle; find all possible solutions that start with a corner hole vacant and end with the remaining peg in the original vacant corner. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at August 19, 2014 02:00 PM

August 18, 2014

Andy Wingo

on gnu and on hackers

Greetings, gentle hackfolk. 'Tis a lovely waning light as I write this here in Munich, Munich the green, Munich full of dogs and bikes, Munich the summer-fresh.

Last weekend was the GNU hackers meeting up in Garching, a village a few metro stops north of town. Garching is full of quiet backs and fruit trees and small gardens bursting with blooms and beans, as if an eddy of Chistopher Alexander whirled out and settled into this unlikely place. My French suburb could learn a thing or ten. We walked back from the hack each day, ate stolen apples and corn, and schemed the nights away.

The program of GHM this year was great. It started off with a bang, as GNUnet hackers Julian Kirsch and Christian Grothoff broke the story that the Five-Eyes countries (US, UK, Canada, Australia, NZ) regularly port-scan the entire internet, looking for vulnerabilities. They then proceed to exploit those vulnerabilities, in regular hack-a-thons, trying to own as many boxes in as many countries as they can. They then use them as launchpads for attacks and for exfiltration of information from other networks.

The presentation that broke this news also proposed a workaround based on port-knocking, Knock. Knock embeds the hash of a pre-shared key with some other information into the 32-bit initial sequence number of a TCP connection. Unlike previous incarnations of port-knocking, Knock also authenticates the first n payload bytes, so that the connection isn't vulnerable to hijacking (e.g. via GCHQ "quantum injection", where well-placed evil routers race the true destination server to provide the first response packet of a connection). Leaking the pwn-the-internet documents with Laura Poitras at the same time as the Knock unveiling was a pretty slick move!

I was also really impressed by Christian's presentation on the GNU name system. GNS is a replacement for DNS whose naming structure mirrors our social naming structure. For example, www.alice.gnu would be my friend Alice, and www.alice.bob.gnu would be Alice's friend Bob. With some integration, it can work on normal desktops and mobile devices. There are lots more details, so check gnunet.org/gns for more information.

Of course, a new naming system does need some operating system support. In this regard Ludovic Courtès' update on Guix was particularly impressive. Guix is a Nix-like system whose goal is reproducible, user-controlled GNU/Linux systems. A couple years ago I didn't think much of it, but now it's actually booting on raw hardware, not just under virtualization, and things seem to be rolling forth as if on rails. Guix manages to be technically innovative at the same time as being GNU-centered, so it can play a unique role in propagating GNU work like GNS.

and yet.

But now, as the dark clouds race above and the light truly goes, we arrive to the point I really wanted to discuss. GNU has a terrible problem with gender balance, and with diversity in general. Of about 70 attendees at this recent GHM, only two were women. We talk the talk about empowering users and working for freedom but, to a first approximation, it's really just a bunch of dudes that think the exact same things.

There are many reasons for this, of course. Some people like to focus on what's called the "pipeline problem" -- that there aren't as many women coming out of computer science programs as men. While true, the proportion of women CS graduates is much higher than the proportion of women at GHM events, so something must be happening in between. And indeed, the attrition rates of women in the tech industry are higher than that of men -- often because we men make it a needlessly unpleasant place for women to be. Sometimes it's even dangerous. The incidence of sexual harassment and assault in tech, especially at events, is something terrible. Scroll down in that linked page to June, July, and August 2014, and ask yourself whether that's OK. (Hint: hell no.)

And so you would think that people who consider themselves to be working for some abstract liberatory principle, as GNU is, would be happy to take a stand against this kind of asshaberdashery. There you would be wrong. Voilà a timeline of an incident.

timeline

March 2014
Someone at the FSF asks a GHM organizer to add an anti-harassment policy to GHM. The organizer does so and puts one on the web page, copying the text from Libreplanet's web site. The policy posted is:

Offensive or overly explicit sexual language or imagery is inappropriate during the event, including presentations.

Participants violating these rules may be sanctioned or expelled from the meeting at the discretion of the organizers.

Harassment includes offensive comments related to gender, sexual orientation, disability, appearance, body size, race, religion, sexual images in public spaces, deliberate intimidation, stalking, harassing photography or recording, persistent disruption of talks or other events, repeated unsolicited physical contact, or sexual attention.

Monday, 11 August 2014
The first mention of the policy is made on the mailing list, in a mail with details about the event that also includes the line:

An anti-harrasment policy applies at GHM: http://gnu.org/ghm/policy.html

Monday, 11 August 2014
A speaker writes the list to say:

Since I do not desire to be denounced, prosecuted and finally sanctioned or expelled from the event (especially considering the physical pain and inconvenience of attending due to my very recent accident) I withdraw my intention to lecture "Introducing GNU Posh" at the GHM, as it is not compliant with the policy described in the page above.

Please remove the talk from the official schedule. Thanks.

PS: for those interested, I may perform the talk off-event in case we find a suitable place, we will see..

The resulting thread goes totes clownshoes and rages on up until the event itself.
Friday, 15 August 2014
Sheepish looks between people that flamed each other over the internet. Hallway-track discussion starts up quickly though. Disagreeing people are not rational enough to have a conversation though (myself included).
Saturday, 16 August 2014
In the morning and lunch break, people start to really discuss the issues (spontaneously). It turns out that the original mail that sparked the thread was based, to an extent, on a misunderstanding: that "offensive or overly explicit sexual language or imagery" was parsed (by a few non-native English speakers) as "offensive language or ...", which people thought was too broad. Once this misunderstanding was removed, there were still people that thought that any policy at all was unneeded, and others that were concerned that someone could say something without intending offense, but then be kicked out of the event. Arguments back and forth. Some people wonder why others can be hurt by "just words". Some discussion of rape culture as continuum between physical violence and cultural tropes. One of the presentations after lunch is by a GNU hacker. He starts his talk by stating his hope that he won't be seen as "offensive or part of rape culture or something". His microphone wasn't on, so once he gets it on he repeats the joke. I stomp out, slam the door, and tweet a few angry things. Later in the evening the presenter and I discuss the issue. He apologizes to me.
Sunday, 17 August 2014
A closed meeting for GNU maintainers to round up the state of GNU and GHM. No women present. After dealing with a number of banalities, we finally broach the topic of the harassment policy. More opposition to the policy Sunday than Saturday lunch. Eventually a proposal is made to replace "offensive" with "disparaging", and people start to consent to that. We run out of time and have to leave; resolution unclear.
Monday, 18 August 2014
GHM organizer updates the policy to remove the words "offensive or" from the beginning of the harassment policy.

I think anyone involved would agree on this timeline.

thoughts

The problems seen over the last week with this anti-harassment policy are entirely to do with the men. It was a man who decided that he should withdraw his presentation because he found it offensive that he could be perceived as offensive. It was men who willfully misread the policy, comparing it to such examples as "I should have the right to offend Microsoft supporters", "if I say the wrong word I will go to jail", and who raised the ignorant, vacuous spectre of "political correctness" to argue that they should be able to say what they want, in a GNU conference, no matter who they hurt, no matter what the effects. That they are able to argue this position from a status-quo perspective is the definition of privilege.

Now, there is ignorance, and there is malice. Both must be opposed, but the former may find a cure. Although I didn't begin my contribution to the discussion in the smoothest way, linking to a an amusing article on the alchemy of intent that is probably misunderstood, it ended up that one of the main points was about intent. I know Ralph (say) and Ralph is a great person and so how could it be that anything Ralph would say could be a slur? You know he wouldn't mean it like that!

To that, we of course have to say that as GNU grows, not everyone knows that Ralph is a great person. In the end what would it mean for someone to be anti-racist but who says racist things all the time? You would have to call them racist, right? Or if you just said something one time, but refused to own up to your error, and instead persisted in repeating a really racist slur -- you would be racist right? But I know you... But the thing that you said...

But then to be honest I wonder sometimes. If someone repeats a joke trivializing rape culture, after making sure that the microphone is picking up his words -- I mean, that's a misogynist action, right? Put aside the question of whether the person is, in essence, misogynist or not. They are doing misogynist things. How do I know that this person isn't going to do it again, private apology or not?

And how do I know that this community isn't going to permit it again? That remark was made to a room of 40 dudes or so. Not one woman was present. Although there was some discussion afterwards, if people left because of the phrase, it was only two or three. How can we then say that GNU is not a misogynist community -- is not a community that tolerates misogyny?

Given all of this, what do you expect? Do you expect to grow GNU into a larger organization in the future, rich and strong and diverse? If that's not your goal, you are not my colleague. And if it is your goal, why do you put up with this kind of behavior?

The discussion on intent and offense seems to have had its effect in the removal of "offensive or" from the anti-harassment policy language. I think it's terrible, though -- if you don't trust someone who says they were offended by sexual language or imagery, why would you trust them when they report sexual harassment or assault? I can only imagine this leading to some sort of argument where the person who has had the courage to report such an incident finds himself or herself in a public witness box, justifying that the incident was offensive. "I'm sorry my words offended you, but that was not my intent, and anyway the words were not offensive." Lolnope.

There were so many other wrong things about this -- a suggestion that we the GNU cabal (lamentably, a bunch of dudes) should form a committee to make the wording less threatening to us; that we're just friends anyway; that illegal things are illegal anyway... it's as if the Code of Conduct FAQ that Ashe Dryden assembled were a Bingo card and we all lost.

Finally I don't think I trusted the organizers enough with this policy. Both organizers expressed skepticism about the policy in such terms that if I personally hadn't won the privilege lottery (white male "western" hetero already-established GNU maintainer) I wouldn't feel comfortable bringing up a concern to them.

In the future I will not be attending any conferences without strong, consciously applied codes of conduct, and I enjoin you to do the same.

conclusion


Propagandhi, "Refusing to Be a Man", Less Talk, More Rock (1996)

There is no conclusion yet -- working for the better world we all know is possible is a process, as people and as a community.

To outsiders, to outsiders everywhere, please keep up the vocal criticisms. Thank you for telling your story.

To insiders, to insiders everywhere, this is your problem. The problem is you. Own it.

by Andy Wingo at August 18, 2014 09:07 PM

August 12, 2014

Programming Praxis

Vacation

I am out of town with family. Blogging will resume next week.


by programmingpraxis at August 12, 2014 09:00 AM

August 08, 2014

Joe Marshall

Mini regex golf 3: set cover

I'm computing the set cover by incrementally adding items to be covered. Naturally, the order in which you add items changes the way the program progresses. I added code that picks an item to be added each iteration rather than just pulling the car off the front of a list.
(define (cover8 value->keys-table better-solution)

  (define (add-v-k-entry solution-set v-k-entry)
    (let ((value (car v-k-entry))
          (keys  (cdr v-k-entry)))

      (write-string "Adding value ") (write value) (newline)
      (write-string "   with keys ") (write keys) (newline)
      (write-string "   to ") (write (length solution-set))
      (write-string " partial solutions.") (newline)

      (let ((new-solutions
             (map make-new-solution (cartesian-product solution-set keys))))

        (let ((trimmed-solutions 
                (trim-partial-solutions value->keys-table new-solutions)))

          (write-string "Returning ") (write (length trimmed-solutions))
          (write-string " of ") (write (length new-solutions))
          (write-string " new partial solutions.") (newline)

          trimmed-solutions))))

  (define (cover v-k-entries)
    (cond ((pair? v-k-entries)
           (pick-v-k-entry value->keys-table v-k-entries
                           (lambda (selected remaining)
                             (add-v-k-entry (cover remaining) selected))))
          ((null? v-k-entries)
           (list '()))
          (else (improper-list-error 'cover v-k-entries))))

  (let ((minimized (minimize-vktable value->keys-table better-solution)))
    (least-elements (cover minimized) better-solution)))

(define (pick-v-k-entry value->keys-table v-k-entries receiver)
  (define (score v-k-entry)
    (let* ((matched-all 
     (count-matching-items value->keys-table
      (lambda (other)
        (there-exists? (cdr v-k-entry)
                 (lambda (key) (member key (cdr other)))))))
           (matched-remaining
            (count-matching-items v-k-entries
                                  (lambda (other)
                                    (there-exists? (cdr v-k-entry)
                                       (lambda (key) (member key (cdr other)))))))
           (matched-forward (- matched-all matched-remaining)))
      (cons matched-remaining matched-forward)))

  (let ((scored (map (lambda (v-k-entry) (cons (score v-k-entry) v-k-entry))
                      v-k-entries)))

    (let ((picked 
    (cdar
     (least-elements scored
       (lambda (left right)
         (let* ((len-l (length (cdr left)))
         (len-r (length (cdr right)))
         (lmr (caar left))
         (lmf (cdar left))
         (rmr (caar right))
         (rmf (cdar right)))
    (or (> len-l len-r)
        (and (= len-l len-r)
      (or (> lmf rmf)
          (and (= lmf rmf)
        (< lmr rmr)))))
    ))))))

      (display "Picking ") (write picked) (newline)
      (receiver picked (delete picked v-k-entries)))))

(define (trim-partial-solutions value->keys-table partial-solutions)
    (let ((equivalent-solutions
           (map (lambda (entry) (cons (cdr entry) (car entry)))
                (collect-equivalent-partial-solutions value->keys-table
                                                      partial-solutions))))
      (write-string "  Deleting ")
      (write (- (length partial-solutions) (length equivalent-solutions)))
      (write-string " equivalent partial solutions.")
      (newline)

      (remove-dominated-solutions value->keys-table
                                  (map lowest-scoring-equivalent-partial-solution
                                       equivalent-solutions))))
Finally, it turns out that computing dominating partial solutions is expensive, so I changed the set operations to use a bitmap representation:
(define (remove-dominated-solutions value->keys-table partial-solutions)
  (let ((before-length (length partial-solutions))
        (all-values (get-values value->keys-table))) 
    (let ((table
           ;; put the long ones in first
           (sort
            (map (lambda (partial-solution)
                   (cons partial-solution
                     (lset->bset all-values 
                       (map car (partial-solution-matches value->keys-table 
                                                          partial-solution)))))
                 partial-solutions)
            (lambda (left right)
              (> (length (bset->lset all-values (cdr left)))
                 (length (bset->lset all-values (cdr right))))))))

      (let ((answer (map car
                         (fold-left (lambda (answer solution)
                                      (if (there-exists? answer 
                                                         (dominates-solution? solution))
                                          answer
                                          (cons solution answer)))
                                    '()
                                    table))))
        (let ((after-length (length answer)))
          (write-string "  Removing ") (write (- before-length after-length))
          (write-string " dominated solutions.")
          (newline)
          answer)))))

(define (dominates-solution? solution)
  (let* ((partial-solution (car solution))
         (partial-solution-score (score partial-solution))
         (solution-matches-raw (cdr solution)))
    (lambda (other-solution)
      (let* ((other-partial-solution (car other-solution))
             (other-matches-raw (cdr other-solution)))
        (and
         (bset-superset? other-matches-raw solution-matches-raw)
         (<= (score other-partial-solution) partial-solution-score))))))

(define (get-values v-k-table)
  (fold-left (lambda (answer entry) (lset-adjoin equal? answer (car entry)))
             '()
             v-k-table))

(define (bset-element->bit universe element)
  (cond ((null? element) 0)
        (else (expt 2 (list-index (lambda (item) (eq? item element)) universe)))))

(define (bset-adjoin universe bset element)
  (bset-union bset (bset-element->bit universe element)))

(define (lset->bset universe lset)
  (fold-left (lambda (answer element)
               (bset-adjoin universe answer element))
             0
             lset))

(define (bset->lset universe bset)
  (cond ((zero? bset) '())
        ((even? bset) (bset->lset (cdr universe) (/ bset 2)))
        (else (cons (car universe) (bset->lset (cdr universe) (/ (- bset 1) 2))))))

(define (bset-union left right) (bitwise-ior left right))

(define (bset-superset? bigger smaller)
  ;; Is every element of smaller in bigger?
  (zero? (bitwise-andc2 smaller bigger)))
This code can now find the shortest regular expression consisting of letters and dots (and ^$) that matches one set of strings but not another.

Depending on the strings, this can take quite a bit of time to run. Dotted expressions cause a combinatorical explosion in matching regexps (or substrings), but what makes it worse is that the dotted expressions tend to span different sets of strings. If two different dotted expressions, each with different matching sets of strings, appear in a single string, then the number of partial solutions will be multiplied by two as we try each different dotted expression.

It is characteristic of NP problems that it is easy to determine if you have a good solution, but quite hard to find it among a huge number of other, poor solutions. This problem exhibits this characteristic, but there is a bit more structure in the problem that we are exploiting. The word lists are drawn from the English language. This makes some bigrams, trigrams, etc. far, far, more likely to appear than others.

Short words are much easier to process than longer ones because they simply contain fewer things to match. On the other hand, longer words tend to be dominated by shorter ones anyway.

To be continued...

by Joe Marshall (noreply@blogger.com) at August 08, 2014 09:56 PM

Programming Praxis

Big Modular Exponentiation

Today’s exercise is a frequent source of questions at places like Stack Overflow and /r/learnprogramming; it must come from one of the competitive programming sites like SPOJ or UVA. The most common statement of the problem is something like this:

You are given two positive integers P and Q, either of which can be quite large, up to a million digits. Compute PQ, that is, P raised to the Q power. For your convenience, give the result modulo 109 + 7. For instance, with P = 34534985349875439875439875349875 and Q = 93475349759384754395743975349573495, the expected result is 735851262.

The phrase “for your convenience” is a giveaway that the modulo computation is a trick; that kind of contest site never does anything for your convenience. In fact, due to a corollary of Fermat’s little theorem, PQ (mod m) ≡ pq (mod m) where p = P (mod m) and q = Q (mod m − 1). That makes it easy. Compute p and q. Both will be less than 232, so we can use the Montgomery multiplication algorithm of a previous exercise to make the computation.

Your task is to write a program to perform the big modular exponentiations described above. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at August 08, 2014 09:00 AM

August 07, 2014

Joe Marshall

Mini regex golf 2: adding regular expressions

It wasn't too hard to add regular expressions to the substring version. What took a while was just tinkering with the code, breaking it, fixing it again, noticing an optimization, tinkering, etc. etc. In any case it works and here is some of it.
(define (make-extended-ngram-table winners losers)
  (let* ((initial-ngrams (generate-ngrams winners losers)))
    (write-string "Initial ngrams: ") (write (length initial-ngrams))
    (newline)
    (map (lambda (winner)
           (cons winner
                 (keep-matching-items initial-ngrams
                    (lambda (ngram) (re-string-search-forward ngram winner)))))
         winners)))

(define (generate-ngrams winners losers)
  (write-string "Generating ngrams...")(newline)
  (let ((losing-ngram? (string-list-matcher losers)))
    (fold-left (lambda (answer winner)
                 (lset-union equal? answer (extended-ngrams losing-ngram? winner)))
               '()
               winners)))

(define (string-list-matcher string-list)
  (lambda (test-ngram)
    (there-exists? string-list
                   (lambda (string)
                     (re-string-search-forward test-ngram string)))))

(define *dotification-limit* 4)
(define *generate-ends-of-words* #t)
(define *generate-dotted* #t)

(define (ngrams-of-length n string)
  (do ((start    0 (1+ start))
       (end      n (1+ end))
       (answer '() (lset-adjoin string=? answer (substring string start end))))
      ((> end (string-length string)) answer)))

(define (generate-dotted answer losing-ngram?)
  (do ((tail answer (cdr tail))
       (answer '() (let ((item (car tail)))
                     (fold-left (lambda (answer dotted)
                                  (if (losing-ngram? dotted)
                                      answer
                                      (lset-adjoin string=? answer dotted)))
                                answer
                                (dotify item)))))
      ((not (pair? tail))
       (if (null? tail)
           answer
           (improper-list-error 'generate-dotted tail)))))

(define (dotify word)
  (cond ((string=? word "") (list ""))
        ((> (string-length word) *dotification-limit*) (list word))
        (else
         (fold-left (lambda (answer dotified)
                      (fold-left (lambda (answer replacement)
                                   (lset-adjoin equal? answer 
                                        (string-append replacement dotified)))
                                 answer
                                 (replacements (substring word 0 1))))
                    '()
                    (dotify (substring word 1 (string-length word)))))))

(define (replacements string)
  (if (or (string=? string "^")
          (string=? string "$"))
      (list string)
      (list string ".")))

(define (extended-ngrams losing-ngram? string)
  (let ((string (if *generate-ends-of-words*
                    (string-append "^" string "$")
                    string)))
    (do ((n 1    (+ n 1))
         (answer '() (lset-union
                      string=? answer
                      (delete-matching-items (ngrams-of-length n string)
                                             losing-ngram?))))
        ((> n (string-length string))
         (if *generate-dotted*
             (generate-dotted answer losing-ngram?)
             answer)))))
Adding the dotification greatly increases the number of ways to match words:
1 ]=> (extended-ngrams (string-list-matcher losers) "lincoln")

;Value 15: ("li" "ln" "ln$" "oln" ".ln" "col" "lin" "li." "^li" "o.n$" "oln$" ".ln$" "col." "c.ln" "..ln" "coln" ".oln" "co.n" "n.ol" "..ol" "ncol" ".col" "nc.l" "i.co" "inco" "i..o" "in.o" "lin." "li.." "l.nc" "linc" "l..c" "li.c" "^li." "^lin" "coln$" "ncoln" "incol" "linco" "^linc" "ncoln$" "incoln" "lincol" "^linco" "incoln$" "lincoln" "^lincol" "lincoln$" "^lincoln" "^lincoln$")
The table that maps words to their extended ngrams is quite large, but it can be reduced in size without affecting the solution to the set cover problem. If two regexps match exactly the same set of winning strings, then one can be substituted for the other in any solution, so we can discard all but the shortest of these. If a regexp matches a proper superset of another regexp, and the other regexp is at least the same length or longer, then the first regexp dominates the second one, so we can discard the second one.
(define (minimize-keys value->keys-table better-solution)
  (let* ((all-keys (get-keys value->keys-table))
         (equivalents (collect-equivalent-partial-solutions value->keys-table
                         (map list all-keys)))
         (reduced (map (lambda (equivalent)
                         (cons (car equivalent)
                               (car (least-elements (cdr equivalent)
                                                    better-solution))))
                       equivalents))
         (dominants (collect-dominant-partial-solutions reduced better-solution))
         (good-keys (fold-left (lambda (answer candidate)
                                 (lset-adjoin equal? answer (cadr candidate)))
                               '()
                               dominants)))

    (define (rebuild-entry entry)
      (cons (car entry) (keep-matching-items (cdr entry)
                             (lambda (item) (member item good-keys)))))

    (write-string "Deleting ") (write (- (length all-keys) (length good-keys)))
    (write-string " of ") (write (length all-keys)) (write-string " keys.  ")
    (write (length good-keys)) (write-string " keys remain.")(newline)
    (map rebuild-entry value->keys-table)))

(define (partial-solution-matches value->keys-table partial-solution)
  (keep-matching-items
   value->keys-table
   (lambda (entry)
     (there-exists? partial-solution (lambda (key) (member key (cdr entry)))))))

(define (collect-equivalent-partial-solutions value->keys-table partial-solutions)
  (let ((answer-table (make-equal-hash-table)))

    (for-each (lambda (partial-solution)
                (hash-table/modify! answer-table
                                   (map car (partial-solution-matches 
                                               value->keys-table 
                                               partial-solution))
                                    (list)
                                    (lambda (other)
                                      (lset-adjoin equal? other partial-solution))))
              partial-solutions)

    (hash-table->alist answer-table)))

(define (collect-dominant-partial-solutions equivalents better-solution)
  (define (dominates? left right)
    (and (superset? (car left) (car right))
         (not (better-solution (cdr right) (cdr left)))))

  (let ((sorted (sort equivalents 
                      (lambda (l r) (> (length (car l)) (length (car r)))))))
    (fold-left (lambda (answer candidate)
                 (if (there-exists? answer (lambda (a) (dominates? a candidate)))
                     answer
                     (lset-adjoin equal? answer candidate)))
               '()
               sorted)))
We can minimize the value->key-table in another way. If two values in the table are matched by the exact same set of keys, then we can delete one without changing the solution. If a value is matched by a small set of keys, and if another values is matched by a superset of these keys, then we can delete the larger one because if the smaller one matches, the larger one must match as well.
(define (minimize-values v-k-table)
  (let ((size-before (length v-k-table)))

    (define (dominated-value? entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? v-k-table
          (lambda (other-entry)
            (and (not (eq? entry other-entry))
                 (let ((other-value (car other-entry))
                       (other-keylist (cdr other-entry)))
                   (let ((result (and (superset? entry-keylist other-keylist)
                                      (not (superset? other-keylist entry-keylist)))))
                     (if result
                         (begin (display "Removing ")
                                (write entry-value)
                                (display " dominated by ")
                                (write other-value)
                                (display ".")
                                (newline)
                                ))
                     result)))))))

    (define (equivalent-value-in-answer? answer entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? answer
          (lambda (other-entry)
            (let ((other-value (car other-entry))
                  (other-keylist (cdr other-entry)))
              (let ((result (equal? entry-keylist other-keylist)))
                (if result
                    (begin (display "Removing ")
                           (write entry-value)
                           (display " equivalent to ")
                           (write other-value)
                           (display ".")
                           (newline)
                           ))
                result))))))

    (define (add-entry answer entry)
      (if (or (equivalent-value-in-answer? answer entry)
              (dominated-value? entry))
          answer
          (cons entry answer)))

    (let ((answer (fold-left add-entry '() v-k-table)))
      (write-string "Removed ") (write (- size-before (length answer)))
      (write-string " dominated and equivalent values.")
      (newline)
      answer)))
Each time we remove values or keys, we might make more keys and values equivalent or dominated, so we iterate until we can no longer remove anything.
(define (minimize-vktable value->keys-table better-solution)
  (let* ((before-size (fold-left + 0 (map length value->keys-table)))
         (new-table
          (minimize-values
           (minimize-keys value->keys-table better-solution)))
         (after-size (fold-left + 0 (map length new-table))))
    (if (= before-size after-size)
        value->keys-table
        (minimize-vktable new-table better-solution))))
The minimized table for the presidents looks like this:
(("washington" "sh" "g..n" "n..o" ".h.n" "a..i")
 ("adams" "a.a" "am" "ad")
 ("madison" "m..i" "i..n" "is." "i.o" "di" "ma" "ad")
 ("monroe" "r.e$" "oe")
 ("van-buren" "u..n" "r.n" ".b" "bu" "-")
 ("harrison" "r..s" "r.i" "i..n" "is." "i.o" "a..i")
 ("polk" "po")
 ("taylor" "ay." "ta")
 ("pierce" "ie." "rc" "r.e$")
 ("buchanan" "bu" "a.a" ".h.n")
 ("lincoln" "i..o" "li")
 ("grant" "an.$" "a.t" "ra" "r.n" "g..n")
 ("hayes" "h..e" "ye" "ay.")
 ("garfield" "el.$" "i.l" "ga" "ie." "r.i" ".f" "a..i")
 ("cleveland" "v.l" "an.$")
 ("mckinley" "n.e" "nl" "i.l" "m..i")
 ("roosevelt" ".se" "oo" "v.l" "el.$" "r..s")
 ("taft" "a.t" "ta" ".f")
 ("wilson" "ls" "i..o")
 ("harding" "r.i" "di" "a..i")
 ("coolidge" "oo" "li")
 ("hoover" "ho" "oo")
 ("truman" "u..n" "ma")
 ("eisenhower" "ho" ".se" "h..e" "i..n" "is.")
 ("kennedy" "nn" "n.e")
 ("johnson" "j")
 ("nixon" "^n" "i..n" "i.o" "n..o")
 ("carter" "rt" "a.t")
 ("reagan" "ga" "a.a")
 ("bush" "bu" "sh")
 ("obama" ".b" "ma" "a.a" "am"))
As you can see, we have reduced the original 2091 matching regexps to fifty.

Changes to the set-cover code coming soon....

by Joe Marshall (noreply@blogger.com) at August 07, 2014 04:43 PM

August 05, 2014

Programming Praxis

Minimal Palindromic Base

We have a simple little problem today: Given an integer n > 2, find the minimum b > 1 for which n base b is a palindrome. For instance, n = 15 = 11112 = 1203 = 334 = 305 = 236 = 217 = 178 = 169 = 1510 = 1411 = 1312 = 1213 = 1114; of those, bases 2, 4 and 14 form palindromes, and the least of those is 2, so the correct answer is 2.

Your task is to write a program that calculates the smallest base for which a number n is a palindrome. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at August 05, 2014 09:00 AM

August 02, 2014

The Racket Blog

Racket v6.1

PLT Design Inc. announces the release of Racket version 6.1 at

http://racket-lang.org/

The major innovation concerns local recursive variable definitions. Instead of initializing variables with an undefined value, Racket raises an exception when such a variable is used before its definition. (Thanks to Claire Alvis for adapting Dybvig's "Fixing Letrec" work.)

Since programs are rarely intended to produce #<undefined>, raising an exception provides early and improved feedback. Module-level variables have always triggered such an exception when used too early, and this change finally gives local bindings — including class fields — the same meaning.

This change is backwards-incompatible with prior releases of Racket. Aside from exposing a few bugs, the change will mainly affect programs that include

(define undefined (letrec ([x x]) x))

to obtain the #<undefined> value. In its stead, Racket provides the same value via the racket/undefined library (which was introduced in the previous release). Programmers are encouraged to use it in place of the pattern above to obtain the "undefined" value.

The release also includes the following small changes:
  • Plumbers generalize the flush-on-exit capability of primitive output ports to enable arbitrary flushing actions and to give programmers control over the timing of flushes (i.e., a composable atexit). New functions include current-plumber, plumber-add-flush!, and plumber-flush-all.
  • Contracts: the contract system's random testing facility has been strengthened so that it can easily find simple mistakes in contracted data structure implementations (e.g. an accidental reverse of a conditional in a heap invariant check).
  • Redex: the semantics of mis-match patterns (variables followed by _!_) inside ellipses has changed in a backwards-incompatible way. This change simplifies the patterns' semantics and increases the usefulness of these patterns.
  • Teaching languages: check-random is an addition to the preferred unit testing framework in the teaching languages. It enables the testing of students' functions that use random-number generation. (Thanks to David Van Horn (UMaryland) for proposing this idea.)
  • Upgraded and normalized versions of graphics libraries and dependencies (Pango, Cairo, GLib, etc.) that are bundled with Racket on Windows and Mac OS X. For example, FreeType support is consistently enabled.
  • Typed Racket: its standard library includes contracted exports from the Racket standard library, such as the formatting combinators of racket/format. It also supports Racket's asynchronous channels; see the typed/racket/async-channel library.
  • SSL: The openssl library supports forward secrecy via DHE and ECDHE cipher suites (thanks to Edward Lee) and Server Name Indication (thanks to Jay Kominek).
  • The mzlib/class100 library has been removed. Use racket/class instead.

by Ryan Culpepper (noreply@blogger.com) at August 02, 2014 06:31 PM

August 01, 2014

Joe Marshall

Mini regex golf

I was intrigued by Peter Norvig's articles about regex golf.

To make things easier to think about, I decided to start with the simpler problem of looking for substrings. Here's code to extract the ngrams of a string:
(define (ngrams-of-length n string)
  (do ((start    0 (1+ start))
       (end      n (1+ end))
       (answer '() (lset-adjoin string=? answer (substring string start end))))
      ((> end (string-length string)) answer)))

(define (ngrams string)
  (do ((n 1 (+ n 1))
       (answer '() (append (ngrams-of-length n string) answer)))
      ((> n (string-length string)) answer)))
A solution is simply a list of ngrams. (Although not every list of ngrams is a solution!)
(define (solution? solution winners losers)
  (let ((matches-solution? (ngram-list-matcher solution)))
    (and (for-all? winners matches-solution?)
         (not (there-exists? losers matches-solution?)))))

(define (ngram-list-matcher ngram-list)
  (lambda (test-string)
    (there-exists? ngram-list 
     (lambda (ngram)
       (string-search-forward ngram test-string)))))
We also want to know if an ngram appears in a given list of strings.
(define (string-list-matcher string-list)
  (lambda (test-ngram)
    (there-exists? string-list
     (lambda (string)
       (string-search-forward test-ngram string)))))

(fluid-let ((*unparser-list-breadth-limit* 10))
    (let ((matches-loser? (string-list-matcher losers)))
      (for-each
       (lambda (winner) (write-string winner) (write-string ": ") 
        (write (reverse (delete-matching-items (ngrams winner) matches-loser?)))
        (newline))
       winners)))

washington: ("sh" "hi" "gt" "to" "was" "ash" "shi" "hin" "ngt" "gto" ...)
adams: ("ad" "am" "ms" "ada" "dam" "ams" "adam" "dams" "adams")
jefferson: ("j" "je" "ef" "ff" "fe" "rs" "jef" "eff" "ffe" "fer" ...)
madison: ("ma" "ad" "di" "mad" "adi" "dis" "iso" "madi" "adis" "diso" ...)
monroe: ("oe" "onr" "nro" "roe" "monr" "onro" "nroe" "monro" "onroe" "monroe")
jackson: ("j" "ja" "ac" "ks" "jac" "ack" "cks" "kso" "jack" "acks" ...)
van-buren: ("-" "va" "n-" "-b" "bu" "van" "an-" "n-b" "-bu" "bur" ...)
harrison: ("har" "arr" "rri" "ris" "iso" "harr" "arri" "rris" "riso" "ison" ...)
polk: ("po" "pol" "olk" "polk")
taylor: ("ta" "yl" "lo" "tay" "ayl" "ylo" "lor" "tayl" "aylo" "ylor" ...)
pierce: ("rc" "ce" "pie" "ier" "erc" "rce" "pier" "ierc" "erce" "pierc" ...)
buchanan: ("bu" "uc" "ch" "na" "buc" "uch" "cha" "ana" "nan" "buch" ...)
lincoln: ("li" "ln" "lin" "col" "oln" "linc" "inco" "ncol" "coln" "linco" ...)
grant: ("ra" "gra" "ran" "ant" "gran" "rant" "grant")
hayes: ("ye" "hay" "aye" "yes" "haye" "ayes" "hayes")
garfield: ("ga" "rf" "fi" "gar" "arf" "rfi" "fie" "iel" "eld" "garf" ...)
cleveland: ("lev" "vel" "ela" "clev" "leve" "evel" "vela" "elan" "cleve" "level" ...)
mckinley: ("nl" "mck" "inl" "nle" "mcki" "kinl" "inle" "nley" "mckin" "ckinl" ...)
roosevelt: ("oo" "os" "lt" "roo" "oos" "ose" "sev" "vel" "elt" "roos" ...)
taft: ("ta" "af" "ft" "taf" "aft" "taft")
wilson: ("ls" "ils" "lso" "wils" "ilso" "lson" "wilso" "ilson" "wilson")
harding: ("di" "har" "ard" "rdi" "din" "hard" "ardi" "rdin" "ding" "hardi" ...)
coolidge: ("oo" "li" "coo" "ool" "oli" "lid" "cool" "ooli" "olid" "lidg" ...)
hoover: ("ho" "oo" "hoo" "oov" "hoov" "oove" "hoove" "oover" "hoover")
truman: ("tr" "ru" "ma" "tru" "rum" "uma" "man" "trum" "ruma" "uman" ...)
eisenhower: ("ei" "nh" "ho" "ow" "eis" "ise" "sen" "enh" "nho" "how" ...)
kennedy: ("nn" "ed" "dy" "ken" "enn" "nne" "ned" "edy" "kenn" "enne" ...)
johnson: ("j" "jo" "oh" "hn" "joh" "ohn" "hns" "john" "ohns" "hnso" ...)
nixon: ("ni" "ix" "xo" "nix" "ixo" "xon" "nixo" "ixon" "nixon")
carter: ("rt" "car" "art" "rte" "cart" "arte" "rter" "carte" "arter" "carter")
reagan: ("ea" "ag" "ga" "rea" "eag" "aga" "gan" "reag" "eaga" "agan" ...)
bush: ("bu" "us" "sh" "bus" "ush" "bush")
clinton: ("li" "to" "cli" "lin" "int" "nto" "ton" "clin" "lint" "into" ...)
obama: ("ob" "ba" "am" "ma" "oba" "bam" "ama" "obam" "bama" "obama")
We can discard ngrams like "shi" because the shorter ngram "sh" will also match.
(define (dominant-ngrams string losing-ngram?)
  (do ((n 1 (+ n 1))
       (answer '() (append
                     (delete-matching-items
                      (ngrams-of-length n string)
                      (lambda (item)
                        (or (there-exists? answer
                                           (lambda (ngram)
                                             (string-search-forward ngram item)))
                            (losing-ngram? item))))
                    answer)))
      ((> n (string-length string)) answer)))


(fluid-let ((*unparser-list-breadth-limit* 10))
    (let ((matches-loser? (string-list-matcher losers)))
      (for-each
       (lambda (winner) (write-string winner) (write-string ": ") 
        (write (dominant-ngrams winner matches-loser?))
        (newline))
       winners)))

washington: ("was" "to" "gt" "hi" "sh")
adams: ("ms" "am" "ad")
jefferson: ("rs" "fe" "ff" "ef" "j")
madison: ("iso" "di" "ad" "ma")
monroe: ("nro" "onr" "oe")
jackson: ("ks" "ac" "j")
van-buren: ("ren" "ure" "bu" "va" "-")
harrison: ("iso" "ris" "rri" "arr" "har")
polk: ("olk" "po")
taylor: ("lo" "yl" "ta")
pierce: ("ier" "pie" "ce" "rc")
buchanan: ("na" "ch" "uc" "bu")
lincoln: ("inco" "col" "ln" "li")
grant: ("ant" "ra")
hayes: ("hay" "ye")
garfield: ("eld" "iel" "fi" "rf" "ga")
cleveland: ("ela" "vel" "lev")
mckinley: ("mck" "nl")
roosevelt: ("vel" "sev" "lt" "os" "oo")
taft: ("ft" "af" "ta")
wilson: ("ls")
harding: ("ard" "har" "di")
coolidge: ("li" "oo")
hoover: ("oo" "ho")
truman: ("ma" "ru" "tr")
eisenhower: ("wer" "sen" "ise" "ow" "ho" "nh" "ei")
kennedy: ("ken" "dy" "ed" "nn")
johnson: ("hn" "oh" "j")
nixon: ("xo" "ix" "ni")
carter: ("car" "rt")
reagan: ("ga" "ag" "ea")
bush: ("sh" "us" "bu")
clinton: ("int" "to" "li")
obama: ("ma" "am" "ba" "ob")
It's time to tackle the set cover problem. We want a set of ngrams that match all the strings. Obviously, if we pick an ngram from each of the strings we want to cover, we'll have a solution. For instance,
(let ((matches-loser? (string-list-matcher losers)))
  (solution? (delete-duplicates
                 (map
                    (lambda (winner) (car (dominant-ngrams winner matches-loser?)))
                    winners))
                winners losers))
;Value: #t
We can cycle through all the possible solutions and then select the best one.
(define (mini-golf0 winners losers)
  (lowest-scoring
   (cover0 (make-dominant-ngram-table
            winners
            (delete-losing-superstrings winners losers)))))

(define (delete-losing-superstrings winners losers)
  (delete-matching-items
   losers
   (lambda (loser)
     (there-exists? winners
                    (lambda (winner)
                      (string-search-forward winner loser))))))

(define (make-dominant-ngram-table winners losers)
  (let ((losing-ngram? (string-list-matcher losers)))
    (map (lambda (winner)
           (cons winner (dominant-ngrams winner losing-ngram?)))
         winners)))

(define (cover0 v-k-table)
  (let ((empty-solution-set (list '())))
    (fold-left add-v-k-entry0 empty-solution-set v-k-table)))

(define (add-v-k-entry0 solution-set v-k-entry)
  (let ((value (car v-k-entry))
        (keys  (cdr v-k-entry)))

    (write-string "Adding value ") (write value) (newline)
    (write-string "   with keys ") (write keys) (newline)
    (write-string "   to ") (write (length solution-set))
    (write-string " partial solutions.") (newline)

    (let ((new-solutions
           (map make-new-solution (cartesian-product solution-set keys))))

      (write-string "Returning ") (write (length new-solutions))
      (write-string " new partial solutions.") (newline)

      new-solutions)))

(define (lowest-scoring list)
  (least-elements list (lambda (l r) (< (score l) (score r)))))

(define (cartesian-product left-list right-list)
  (fold-left (lambda (answer left)
               (fold-left (lambda (answer right)
                            (cons (cons left right) answer))
                          answer
                          right-list))
             '()
             left-list))

(define (make-new-solution cp-term)
  (let ((solution (car cp-term))
        (key (cdr cp-term)))
    (lset-adjoin equal? solution key)))

(define (improper-list-error procedure thing)
  (error (string-append "Improper list found by " procedure ": ") thing))

(define (least-elements list <)
  (define (accumulate-least answer item)
    (cond ((< (car answer) item) answer)
          ((< item (car answer)) (cons item '()))
          (else (cons item answer))))

  (cond ((pair? list) (fold-left accumulate-least
                                 (cons (car list) '())
                                 (cdr list)))
        ((null? list) (error "List must have at least one element." list))
        (else (improper-list-error 'LEAST-ELEMENTS list))))

(define (score solution)
  (do ((tail solution (cdr tail))
       (score -1      (+ score (string-length (car tail)) 1)))
      ((not (pair? tail))
       (if (null? tail)
           score
           (improper-list-error 'score solution)))))
This works for small sets:
1 ]=> (mini-golf0 boys girls)
Adding value "jacob"
   with keys ("ob" "c" "j")
   to 1 partial solutions.
Returning 3 new partial solutions.
Adding value "mason"
   with keys ("as")
   to 3 partial solutions.
Returning 3 new partial solutions.
Adding value "ethan"
   with keys ("an" "ha")
   to 3 partial solutions.
Returning 6 new partial solutions.
Adding value "noah"
   with keys ("ah" "oa" "no")
   to 6 partial solutions.
Returning 18 new partial solutions.
Adding value "william"
   with keys ("lia" "lli" "ill" "am" "w")
   to 18 partial solutions.
Returning 90 new partial solutions.
Adding value "liam"
   with keys ("lia" "am")
   to 90 partial solutions.
Returning 180 new partial solutions.
Adding value "jayden"
   with keys ("en" "de" "yd" "ay" "j")
   to 180 partial solutions.
Returning 900 new partial solutions.
Adding value "michael"
   with keys ("ae" "ha" "c")
   to 900 partial solutions.
Returning 2700 new partial solutions.
Adding value "alexander"
   with keys ("de" "nd" "an" "le" "al" "r" "x")
   to 2700 partial solutions.
Returning 18900 new partial solutions.
Adding value "aiden"
   with keys ("en" "de" "id")
   to 18900 partial solutions.
Returning 56700 new partial solutions.
;Value 41: (("de" "am" "ah" "ha" "as" "j")
            ("de" "am" "ah" "ha" "as" "j")
            ("de" "am" "oa" "ha" "as" "j")
            ("de" "am" "oa" "ha" "as" "j")
            ("de" "am" "no" "ha" "as" "j")
            ("de" "am" "no" "ha" "as" "j")
            ("de" "am" "ah" "ha" "as" "c")
            ("de" "am" "ah" "ha" "as" "c")
            ("de" "am" "oa" "ha" "as" "c")
            ("de" "am" "oa" "ha" "as" "c")
            ("de" "am" "no" "ha" "as" "c")
            ("de" "am" "no" "ha" "as" "c")
            ("de" "am" "ah" "an" "as" "c")
            ("de" "am" "ah" "an" "as" "c")
            ("en" "am" "ah" "an" "as" "c")
            ("de" "am" "oa" "an" "as" "c")
            ("de" "am" "oa" "an" "as" "c")
            ("en" "am" "oa" "an" "as" "c")
            ("de" "am" "no" "an" "as" "c")
            ("de" "am" "no" "an" "as" "c")
            ("en" "am" "no" "an" "as" "c"))
But you can see that we won't be able to go much beyond this because there are just too many combinations. We can cut down on the intermediate partial solutions by noticing that many of them are redundant. We don't need to keep partial solutions that cannot possibly lead to a shortest final solution. The various partial solutions each (potentially) match different sets of words. We only need keep the shortest solution for each different set of matched words. Furthermore, if a solution's matches are a superset of another's matches, and the other is the same length or longer, then the solution is dominated by the other and will always be at least the length of the longer.
(define (mini-golf1 winners losers)
  (cover1
   (make-dominant-ngram-table winners (delete-losing-superstrings winners losers))
   lowest-scoring))

(define (cover1 v-k-table lowest-scoring)
  (let ((empty-solution-set (list '())))

    (define (add-v-k-entry solution-set v-k-entry)
      (let ((value (car v-k-entry))
            (keys  (cdr v-k-entry)))

        (write-string "Adding value ") (write value) (newline)
        (write-string "   with keys ") (write keys) (newline)
        (write-string "   to ") (write (length solution-set))
        (write-string " partial solutions.") (newline)

        (let ((new-solutions
               (map make-new-solution (cartesian-product solution-set keys))))

          (let ((trimmed-solutions (trim-partial-solutions new-solutions)))

            (write-string "Returning ") (write (length trimmed-solutions))
            (write-string " of ") (write (length new-solutions))
            (write-string " new partial solutions.") (newline)

            trimmed-solutions))))

    (define (trim-partial-solutions partial-solutions)
      (let ((equivalent-solutions (collect-equivalent-partial-solutions partial-solutions)))
        (write-string "  Deleting ")
        (write (- (length partial-solutions) (length equivalent-solutions)))
        (write-string " equivalent partial solutions.")
        (newline)

        (remove-dominated-solutions
         (map lowest-scoring-equivalent-partial-solution equivalent-solutions))))

    (define (lowest-scoring-equivalent-partial-solution entry)
      (first (lowest-scoring (car entry))))

    (define (collect-equivalent-partial-solutions alist)
      ;; Add each entry in turn.
      (fold-left (lambda (equivalents partial-solution)
                   (add-equivalent-partial-solution
                    partial-solution
                    (partial-solution-matches partial-solution)
                    equivalents))
                 '() alist))

    (define (partial-solution-matches partial-solution)
      (keep-matching-items v-k-table
        (lambda (entry)
          (there-exists? partial-solution
                         (lambda (key) (member key (cdr entry)))))))

    (define (remove-dominated-solutions partial-solutions)
      (let ((before-length (length partial-solutions)))
        (let ((answer  (map car (fold-left (lambda (answer solution)
                                             (if (there-exists? answer (dominates-solution? solution))
                                                 answer
                                                 (cons solution answer)))
                                           '()
                                           (map (lambda (partial-solution)
                                                  (cons partial-solution (partial-solution-matches partial-solution)))
                                                partial-solutions)))))
          (let ((after-length (length answer)))
            (write-string "  Deleting ") (write (- before-length after-length))
            (write-string " dominated solutions.")
            (newline)
            answer))))

    (lowest-scoring
     (fold-left add-v-k-entry empty-solution-set v-k-table))))

(define (dominates-solution? solution)
  (let ((partial-solution (car solution))
        (solution-matches (cdr solution)))
    (lambda (other-solution)
      (let ((other-partial-solution (car other-solution))
            (other-matches (cdr other-solution)))
        (and (not (equal? solution-matches other-matches))
             (superset? other-matches solution-matches)
             (<= (score other-partial-solution) (score partial-solution)))))))

(define (add-equivalent-partial-solution solution value alist)
  (cond ((pair? alist)
         (let ((entry (car alist))
               (tail (cdr alist)))
           (let ((entry-solutions (car entry))
                 (entry-value (cdr entry)))
             (if (equal? value entry-value)
                 (if (member solution entry-solutions)
                     alist
                     (cons (cons (cons solution entry-solutions) value)
                           tail))
                 (cons entry (add-equivalent-partial-solution solution value tail))))))
        ((null? alist) (list (cons (list solution) value)))
        (else (improper-list-error 'collect-equivalents alist))))
1 ]=> (mini-golf1 winners losers)
Adding value "washington"
   with keys ("was" "to" "gt" "hi" "sh")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 1 dominated solutions.
Returning 2 of 5 new partial solutions.
Adding value "adams"
   with keys ("ms" "am" "ad")
   to 2 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 4 of 6 new partial solutions.
Adding value "jefferson"
   with keys ("rs" "fe" "ff" "ef" "j")
   to 4 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 4 dominated solutions.
Returning 4 of 20 new partial solutions.
Adding value "madison"
   with keys ("iso" "di" "ad" "ma")
   to 4 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 12 of 16 new partial solutions.
Adding value "monroe"
   with keys ("nro" "onr" "oe")
   to 12 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "jackson"
   with keys ("ks" "ac" "j")
   to 12 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "van-buren"
   with keys ("ren" "ure" "bu" "va" "-")
   to 12 partial solutions.
  Deleting 36 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 24 of 60 new partial solutions.
Adding value "harrison"
   with keys ("iso" "ris" "rri" "arr" "har")
   to 24 partial solutions.
  Deleting 96 equivalent partial solutions.
  Removing 12 dominated solutions.
Returning 12 of 120 new partial solutions.
Adding value "polk"
   with keys ("olk" "po")
   to 12 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 24 new partial solutions.
Adding value "taylor"
   with keys ("lo" "yl" "ta")
   to 12 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 12 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "pierce"
   with keys ("ier" "pie" "ce" "rc")
   to 12 partial solutions.
  Deleting 36 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 48 new partial solutions.
Adding value "buchanan"
   with keys ("na" "ch" "uc" "bu")
   to 12 partial solutions.
  Deleting 39 equivalent partial solutions.
  Removing 3 dominated solutions.
Returning 6 of 48 new partial solutions.
Adding value "lincoln"
   with keys ("inco" "col" "ln" "li")
   to 6 partial solutions.
  Deleting 15 equivalent partial solutions.
  Removing 6 dominated solutions.
Returning 3 of 24 new partial solutions.
Adding value "grant"
   with keys ("ant" "ra")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 6 new partial solutions.
Adding value "hayes"
   with keys ("hay" "ye")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 6 new partial solutions.
Adding value "garfield"
   with keys ("eld" "iel" "fi" "rf" "ga")
   to 3 partial solutions.
  Deleting 9 equivalent partial solutions.
  Removing 3 dominated solutions.
Returning 3 of 15 new partial solutions.
Adding value "cleveland"
   with keys ("ela" "vel" "lev")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 9 new partial solutions.
Adding value "mckinley"
   with keys ("mck" "nl")
   to 6 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 12 new partial solutions.
Adding value "roosevelt"
   with keys ("vel" "sev" "lt" "os" "oo")
   to 6 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 30 new partial solutions.
Adding value "taft"
   with keys ("ft" "af" "ta")
   to 6 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 18 new partial solutions.
Adding value "wilson"
   with keys ("ls")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "harding"
   with keys ("ard" "har" "di")
   to 6 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 4 of 18 new partial solutions.
Adding value "coolidge"
   with keys ("li" "oo")
   to 4 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 4 of 8 new partial solutions.
Adding value "hoover"
   with keys ("oo" "ho")
   to 4 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 2 of 8 new partial solutions.
Adding value "truman"
   with keys ("ma" "ru" "tr")
   to 2 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 1 dominated solutions.
Returning 1 of 6 new partial solutions.
Adding value "eisenhower"
   with keys ("wer" "sen" "ise" "ow" "ho" "nh" "ei")
   to 1 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 7 new partial solutions.
Adding value "kennedy"
   with keys ("ken" "dy" "ed" "nn")
   to 1 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
Adding value "johnson"
   with keys ("hn" "oh" "j")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "nixon"
   with keys ("xo" "ix" "ni")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "carter"
   with keys ("car" "rt")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "reagan"
   with keys ("ga" "ag" "ea")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "bush"
   with keys ("sh" "us" "bu")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "clinton"
   with keys ("int" "to" "li")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "obama"
   with keys ("ma" "am" "ba" "ob")
   to 1 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
;Value 47: (("rt" "ni" "nn" "ho" "ls" "nl" "vel" "ga" "ye" "ra" "li" "rc" "ta" "po" "har" "bu" "oe" "ma" "j" "ad" "sh"))
The cover procedure takes a table that maps values to the keys that cover them. If we can reduce the size of that table without changing the solution, we'll run faster. If there are two entries in the table such that the keys of one are a superset of the keys of the other, we can discard the superset: the smaller of the two entries will be in the solution, and any key that matches the smaller one will automatically match the larger one as well. Also, if two values have the same set of keys that match them, we need only include one of the values in the table.
(define (delete-dominated-values v-k-table)
  (let ((size-before (length v-k-table)))

    (define (dominated-value? entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? v-k-table
          (lambda (other-entry)
            (and (not (eq? entry other-entry))
                 (let ((other-value (car other-entry))
                       (other-keylist (cdr other-entry)))
                   (and (superset? entry-keylist other-keylist)
                        (not (equal? other-keylist entry-keylist)))))))))

    (define (equivalent-value-in-answer? answer entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? answer
          (lambda (other-entry)
            (let ((other-value (car other-entry))
                  (other-keylist (cdr other-entry)))
              (equal? entry-keylist other-keylist))))))

    (define (add-entry answer entry)
      (if (or (equivalent-value-in-answer? answer entry)
              (dominated-value? entry))
          answer
          (cons entry answer)))

    (let ((answer (fold-left add-entry '() v-k-table)))
      (write-string "Removed ") (write (- size-before (length answer)))
      (write-string " dominated and equivalent values.")
      (newline)
      answer)))

(define (superset? bigger smaller)
  (for-all? smaller (lambda (s) (member s bigger))))

(define (mini-golf2 winners losers)
  (cover1
   (delete-dominated-values
    (make-dominant-ngram-table winners (delete-losing-superstrings winners losers)))
   lowest-scoring))

;;;;;;;;
;; Delete dominated keys from the keylists.

(define (mini-golf3 winners losers)
  (cover1
   (delete-dominated-keys-and-values
    (make-dominant-ngram-table winners (delete-losing-superstrings winners losers))
    (lambda (left right)
      (or (< (string-length left) (string-length right))
          (and (= (string-length left) (string-length right))
               (string<? left right)))))
   lowest-scoring))

(define (delete-dominated-keys-and-values v-k-table better-key)
  (let ((before-size (fold-left * 1 (map length v-k-table))))
    (let ((new-table (delete-dominated-values
                      (delete-dominated-keys v-k-table better-key))))
      (let ((after-size (fold-left * 1 (map length new-table))))
        (if (= before-size after-size)
            v-k-table
            (delete-dominated-keys-and-values new-table better-key))))))

(define (delete-dominated-keys v-k-table better-key)
  (let ((all-keys (get-all-keys v-k-table)))

    (define (lookup-key key)
      (cons key
            (map car
                 (keep-matching-items v-k-table
                                      (lambda (v-k-entry)
                                        (member key (cdr v-k-entry)))))))

    (let ((k-v-table (map lookup-key all-keys)))

      (define (dominated-key? key)
        (let ((values (cdr (assoc key k-v-table))))
          (there-exists? k-v-table
                         (lambda (entry)
                           (let ((entry-key (car entry))
                                 (entry-values (cdr entry)))
                             (and (superset? entry-values values)
                                  (not (equal? values entry-values))
                                  (or (< (string-length entry-key) (string-length key))
                                      (and (= (string-length entry-key) (string-length key))
                                           (string<? entry-key key)))))))))

      (define (equivalent-key-in-answer? answer key)
        (let ((values (cdr (assoc key k-v-table))))
          (there-exists? answer
                         (lambda (entry-key)
                           (let ((entry-values (cdr (lookup-key entry-key))))
                             (equal? values entry-values))))))

      (define (add-keys answer key)
        (if (or (dominated-key? key)
                (equivalent-key-in-answer? answer key))
            answer
            (cons key answer)))

      (let ((good-keys (fold-left add-keys '() (sort all-keys better-key))))
        (write-string "Removed ") (write (- (length all-keys) (length good-keys)))
        (write-string " of ") (write (length all-keys)) (write-string " keys.")(newline)

        (map (lambda (entry)
               (cons (car entry)
                     (keep-matching-items (cdr entry) (lambda (key) (member key good-keys)))))
             v-k-table)))))

(define (get-all-keys v-k-table)
  (fold-left (lambda (answer entry)
               (fold-left (lambda (answer key)
                            (lset-adjoin equal? answer key))
                          answer
                          (cdr entry)))
             '()
             v-k-table))
Trimming the table this way helps a lot. We can now compute the dogs vs. cats.
1 ]=> (mini-golf3 dogs cats)

Removed 294 of 405 keys.
Removed 44 dominated and equivalent values.
Removed 25 of 93 keys.
Removed 15 dominated and equivalent values.
Removed 7 of 62 keys.
Removed 0 dominated and equivalent values.
Removed 0 of 55 keys.
Removed 0 dominated and equivalent values.
Adding value "BORZOIS"
   with keys ("OIS" "BOR" "RZ")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 3 new partial solutions.
Adding value "GIANT SCHNAUZERS"
   with keys ("SCH" "HN")
   to 3 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "BASENJIS"
   with keys ("JI")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "ENGLISH SETTERS"
   with keys ("TERS" "ETT")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 12 new partial solutions.
Adding value "JAPANESE CHIN"
   with keys ("CHI")
   to 12 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 12 new partial solutions.
Adding value "BOUVIERS DES FLANDRES"
   with keys ("S F" "DES" " DE" "IER" "FL" "VI")
   to 12 partial solutions.
  Deleting 8 equivalent partial solutions.
  Removing 8 dominated solutions.
Returning 56 of 72 new partial solutions.
Adding value "PEKINGESE"
   with keys ("EKI")
   to 56 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 56 of 56 new partial solutions.
Adding value "BELGIAN MALINOIS"
   with keys (" MAL" "OIS" "LG")
   to 56 partial solutions.
  Deleting 96 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 72 of 168 new partial solutions.
Adding value "GERMAN WIREHAIRED POINTERS"
   with keys ("TERS" "D P")
   to 72 partial solutions.
  Deleting 108 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 144 new partial solutions.
Adding value "CHOW CHOWS"
   with keys ("W ")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "SAMOYEDS"
   with keys ("DS")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "DOGUES DE BORDEAUX"
   with keys ("BOR" " DE" "GU")
   to 36 partial solutions.
  Deleting 88 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 18 of 108 new partial solutions.
Adding value "DALMATIANS"
   with keys ("ANS" "LM")
   to 18 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "LHASA APSOS"
   with keys ("LH")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "CANE CORSO"
   with keys (" COR" "ORS")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 72 of 72 new partial solutions.
Adding value "ALASKAN MALAMUTES"
   with keys (" MAL" "TES" "LAS" "KA")
   to 72 partial solutions.
  Deleting 184 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 104 of 288 new partial solutions.
Adding value "WHIPPETS"
   with keys ("IP")
   to 104 partial solutions.
  Deleting 0 equivalent partial solutions.
;GC #199: took:   0.20   (1%) CPU time,   0.10   (1%) real time; free: 16754359
  Removing 0 dominated solutions.
Returning 104 of 104 new partial solutions.
Adding value "SHIBA INU"
   with keys ("SHI" " I")
   to 104 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 208 of 208 new partial solutions.
Adding value "AKITAS"
   with keys ("AK")
   to 208 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 208 of 208 new partial solutions.
Adding value "RHODESIAN RIDGEBACKS"
   with keys ("DES" "DG" "OD")
   to 208 partial solutions.
  Deleting 304 equivalent partial solutions.
  Removing 144 dominated solutions.
Returning 176 of 624 new partial solutions.
Adding value "BICHONS FRISES"
   with keys ("S F" "FR")
   to 176 partial solutions.
  Deleting 224 equivalent partial solutions.
  Removing 16 dominated solutions.
Returning 112 of 352 new partial solutions.
Adding value "PAPILLONS"
   with keys ("API")
   to 112 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 112 of 112 new partial solutions.
Adding value "COLLIES"
   with keys ("IES")
   to 112 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 112 of 112 new partial solutions.
Adding value "VIZSLAS"
   with keys ("LAS" "IZ" "VI")
   to 112 partial solutions.
;GC #200: took:   0.10   (0%) CPU time,   0.10   (1%) real time; free: 16757322
  Deleting 272 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 336 new partial solutions.
Adding value "BRITTANYS"
   with keys ("ITT")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "PUGS"
   with keys ("GS")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "HAVANESE"
   with keys ("HAVANE")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "COCKER SPANIELS"
   with keys ("ANI" "LS")
   to 64 partial solutions.
  Deleting 80 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 48 of 128 new partial solutions.
Adding value "MASTIFFS"
   with keys ("FS")
   to 48 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 48 of 48 new partial solutions.
Adding value "MALTESE"
   with keys ("TES" "LT")
   to 48 partial solutions.
  Deleting 72 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 24 of 96 new partial solutions.
Adding value "PEMBROKE WELSH CORGIS"
   with keys (" COR" "LS")
   to 24 partial solutions.
  Deleting 32 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 16 of 48 new partial solutions.
Adding value "BOSTON TERRIERS"
   with keys ("IER" " T")
   to 16 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 4 dominated solutions.
Returning 4 of 32 new partial solutions.
Adding value "POMERANIANS"
   with keys ("ANS" "ANI")
   to 4 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 2 of 8 new partial solutions.
Adding value "GREAT DANES"
   with keys ("GR")
   to 2 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 2 of 2 new partial solutions.
Adding value "DOBERMAN PINSCHERS"
   with keys ("SCH" " PI")
   to 2 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
Adding value "SHIH TZU"
   with keys ("SHI" " T")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "ROTTWEILERS"
   with keys ("EI")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "POODLES"
   with keys ("DL" "OD")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "BOXERS"
   with keys ("OX")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "BEAGLES"
   with keys ("AGL")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "LABRADOR RETRIEVERS"
   with keys ("VE")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
;Value 50: (("VE" "AGL" "OX" "EI" "GR" " T" "FS" "LS" "HAVANE" "GS" "ITT" "IES" "API" "FR" "OD" "AK" " I" "IP" "TES" "ORS" "LH" "ANS" "GU" "DS" "W " "EKI" "VI" "CHI" "TERS" "JI" "SCH" "OIS"))
We appear to have the substring version of regex golf under control. Can we extend it to actual regular expressions? Of course we can. In the next installment...

by Joe Marshall (noreply@blogger.com) at August 01, 2014 04:49 PM

Programming Praxis

K’th Largest Item

Today’s exercise is a common interview question, and also interesting in its own right:

Find the kth largest integer in a file of n integers, where n is large (defined as too large to fit into memory all at once) and k is small (defined as small enough to all fit in memory).

Your task is to write the program described above. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at August 01, 2014 09:00 AM

July 29, 2014

Programming Praxis

Montgomery Multiplication

[ Does anybody know the proper method for writing a-bar and b-bar in plain HTML? The LaTeX symbols are \={a} and \={b}, but WordPress renders LaTeX poorly, and I prefer plain HTML. FIXED! Thanks to Jussi, who suggests writing a amp hash x304 semicolon and b amp hash x304 semicolon. ]

Montgomery multiplication is a method of computing ab mod m for positive integers a, b and m, designed for situations where there are many multiplications to be performed mod m with a small number of multipliers; in particular, it is valuable for computing xy mod m for large y. Montgomery multiplication was invented by Peter Montgomery in a 1985 article. Our exercise today will implement modular multiplication and exponentiation using Montgomery’s method.

The basic idea of Montgomery multiplication is to eliminate the division inherent in the modulo operation by translating the modulus m to a larger modulus r, with gcd(r, m) = 1, where r is a power of 2; thus, the division is rendered as a bit mask. Since r is a power of 2, the modulus m must be odd to satisfy the gcd requirement; we also require the two multipliers a and b be less than m. Then the Montgomery algorithm is as follows:

  1. Find two integers r−1 and m′ such that r r−1 m m′ = 1 by the extended Euclidean algorithm. In particular, the algorithm used is a binary version of the algorithm that performs no divisions.
  2. Translate the multipliers to “Montgomery space” by multiplying them by r (using left shifts) and reducing the product modulo m. Thus, ā = a r mod m and b̄ = b r mod m. These operations are expensive, but they are performed only once for each multiplier in a chain of multiplications.
  3. Perform the Montgomery multiplication: calculate u = a b r mod m by the sequence of operations

    t = ā * b̄
    u = (t + (t * m′ mod r) * m) / r
    if (um) then subtract m from u

    The only division is a right-shift; the final result uses subtraction instead of division because it is known that the product is less than 2m.

  4. Translate the result back from Montgomery space to an ordinary integer by ab = u r−1 mod m.

Montgomery exponentiation is similar. To compute xy mod m, select r, compute r−1 and m′, translate x to Montgomery space, use the square-and-multiply method with Montgomery multiplications to perform the exponentiation starting from 1 in Montgomery space, then translate the result back from Montgomery space. This is much faster than the calculation without Montgomery multiplication, because the cost of initializing the Montgomery space is amortized over several multiplications, each of which avoids the inherent division of the modulo operator.

Your task is to write functions that perform Montgomery multiplication and exponentiation. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


by programmingpraxis at July 29, 2014 09:00 AM