fogcreek-support-job-challenge.lisp

;; see  http://www.fogcreek.com/Jobs/SupportEngineer/

(defpackage #:fogcreek
  (:use #:cl)
  (:export #:*chars*
           #:*text*
           #:count-chars
           #:sort-chars-by-count
           #:solve))

(in-package #:fogcreek)

(defvar *chars* #. (quote (coerce "abcdefghijklmnopqrstuvwxyz_" 'list)))

(defvar *text*
  "epqiiqwdiwgyka_vsqtsujeqqicnhyivo_sigwasmkwgsih_akl_gtnkhgikgveidpmt
qybpxpnnpbxkwpisgjmdzgh_ojysbtsnsvxvuhguocp_qc_vouxqmg_cetlpmounxnvg
ldcpem_jodnmklgonocekdkjwkdoilajk_nxujykigsolengqmnqofpseqaamvpsooga
spyhoojennefwvljpvsqtgnceg_hsowqvycjkuxdtfbxfloewkphmvkftjlsasvwid_u
qcsgn_ypiqjytygiwyziqdjpxgpuunymadnclpdlmmulitsnqlwciotbmyfuummjynne
slnit_lpykdafkpydzkntbud_gigjgmu_uqjjmdzpwteodjpuzndxaqmsjdjjamnwoes
ajcffkaaoilpyydlkyxauagfcjbabapax_ndlgtpwnud_jpnkiokviqjhyopmjtgtbyo
iyfbjdhknimlah_cxfzwspqoscffiyvabtjjuc_liaqbcuomuytdqfy_xaixiiqqdpds
uuimzh_ywwcmodxhfxjplyixotjkeawauxltekptuieekpbokbanumffatbtiacnywhw
iqxebnosninpzfjmatvnyuspyeu_ziapvogconld_cxfcytkcp_bvsppz_dw_ndlpkhf
zdlxbo_vaflmailjvccgsuclyhojganjqxzmqflpze_hqhlul_ybaagtiuokbzaxhmec
olsptiexvvmhbdoelgmcffulcebhlyzd_m_qxkbfvnxykdudpxefsm_aqpqtnhxvswht
owqnbm_mgejjpyumm_mqbkiuulanbmzllmuqlfftmcxtybmijfuwaknefhekwgujpjqg
leu_sjtbszotcygiclkwcbmnvgsoqaqqkkgeaslhvfbtlgpnxgpzxp_vyjinlwwfbvtn
twogmnpxghabpxxgzlyirrrrrbbcrrrnbjpcrrrqykhrrrscarrrdnlxrrrrtudrrrr_
ntrbyrqlddbycypcccqongpgexhnabavrmebeofrxsnrilprveetxaranjyfmrisrewp
r_y_lgsrsedbn_rfrieusemhpfa_plkifjipvwaqvnenrrrzybsrbeurbhfrvrrzghr_
zpgiyrrrqsnnrrrbhvdrrrqkpdrraqvkeueszfpkj_fm_claw_oetbgurbdocb_rsnzr
cyvrvnrvaurbscimurtbriikrfdjlizribdjwkror_gnlzmshwccqcx_huaafbvituxo
ru_hohxwrrrhnbttrrriyyirrrnibricrxftrrrrvqvrrrrhjorehroldibsmquelwvy
jebkolbbnauompgqdhlbnsfbbdiudoeibwstdg_acsazhtgfufidogmyvtya_dfwihto
elucbtlcbaijlcuhfvhesgluiwttsdnqqshnoqumccyqtko_zh_fii_wlsspysdqdpad
fvfewlsojavmuaixyxpw_xcwxuatceosdqgmsbbagjmmblouvnywmqqakmmtuasfovol
_ogksdukwp_fkxuh_vfhuhfyfvvfqhqxecxsoctcqgpianhtnkbqlltwyhxotfksoewm
elxobjgwlyfaeoxsfohhguidoftbsainwovvglynsgjixon_nvuwflsfbca_xnnesvco
mceh_gigjxpllckcooagidcpbqxtnejlnlsccocuvcvge_fvjjbyqdkjceia_mkcvbzl
zwlxbdjihvpmdcvmssuvktwiqbeivtieol_bu_huumzmlxx_kd_vksmohgzl_fxwfdue
lqgfkgzxciwmuduozfbaxstxkwegescggkpxfpeenhb_whqhethcateqdvnxhpt__bja
_uiyxchmfkblmdwtyp_ktontmufw_isdflelsbgjizxvqbciuadfxxjaqbluofkgkkkh
jbvohisfla_cspbmuezqohnyijyimwgdeszutgnaoagbhku_wwdtylbbiyvbpoumgyid
w_xwg_fkogabccip_wouclnjcgdpwwxxvvvwkmmbgfeactbcksxqovqthtjfjghijwwh
ydfieyssbjtfqgqyjnmwfpesljmwapvbptucadontbobnspch_i_dxheklulncdsdnic
bnjjjedkaokw_ahcolvbcnmqtoakonpgzjufqlnn_uve_uumaufjasfvfcv_cbcuk_hd
zigkahchzfqjphjwcbjwmozyodhu_tsqtafwidgmc_snhhkleyvmzdtawdodzfmekuee
mnshz_xz")

(defun count-chars (&key (chars *chars*) (text *text*))
  "Count occurences of CHARS in TEXT."
  (let ((cmap (make-hash-table :test 'eql :size (length chars)))
        (count-list '()))
    (with-input-from-string (s text)
      (loop :for char := (read-char s nil nil)
         :while char
         :when (member char chars)
         :do (incf (gethash char cmap 0))))
    (maphash (lambda (char count) (push (cons char count) count-list)) cmap)
    count-list))

(defun sort-chars-by-count (&key (chars *chars*) (text *text*))
  "Return a sorted string of CHARS ordered by number of occurences in TEXT"
  (mapcar #'car (sort (count-chars :chars chars :text text) #'> :key #'cdr)))

(defun solve (&key (chars *chars*) (text *text*))
  "Solve the puzzle by returning the part of the sorted chars list before
   the first #\_, as a string."
  (let ((sorted-chars (sort-chars-by-count :chars chars :text text)))
    (coerce (subseq sorted-chars 0 (position #\_ sorted-chars :test #'char=))
            'string)))

An other version:

(defun count-uniq-char-in-string (&key (string *text*) (chars *chars*))
  (declare (type string string)
       (type list chars))
  (proclaim '(optimize (debug 0) (speed 3)))
  (let ((hash (make-hash-table :test 'eql :size (length chars)))
    alist)
    (loop for c across string
      when (member c chars)
      do (incf (gethash c hash 0)))
    (maphash (lambda (k v)
           (declare (type character k)
            (type integer v))
           (push (cons k v) alist))
         hash)
    (sort alist #'> :key #'cdr )))

(defun get-message (&key (string *text*) (chars *chars*))
  (declare (type string string)
       (type list chars))
  (proclaim '(optimize (debug 0) (speed 3)))
  (loop for (k . v) in (count-uniq-char-in-string :string string :chars chars)
    for underscore-seen = nil then (or underscore-seen (eql k #\_))
    unless underscore-seen
      collect k into message
    finally (return (coerce message 'string ))))