DouKaku?

# coding: cp932

def solve(n):
    assert n >= 2
    if n == 2:
        print u"この文は0が11個，1が100個あります"
    else:
        print u"この文は2が2個あります"

def main():
    solve(2)
    solve(10)

if __name__ == '__main__':
    main()

<?php
for($n=2;$n<=16;++$n)
{    $str="";
    do{
        $a=count_chars($str);
        $b=array();
        for($i=0;$i<$n;++$i)
        {    $c=base_convert($i,10,$n);
            $b[]="${c}が".base_convert($a[ord($c)],10,$n)."個";
        }
        $str0=$str;
        $str=implode(",",$b);
    }while($str!=$str0);
    echo "この文は${str}あります。\n";
}
?>

def solve(n:int) = n match {
  case 2 => "0=11, 1=100"
  case n => "0=1, 1=11, 2=2, " + (List[String]() /: (3 until n)) {(s,i) => 
              Integer.toString(i,n)+"=1"::s
            }.reverse.mkString(", ")
}

module Main where
import Numeric
import Char
import System
import qualified System.IO.UTF8 as U

count pred [] = 0
count pred (x:xs) = (if pred x then 1 else 0) + count pred xs

countDigs radix k = let s = map digitToInt $ showIntAtBase radix intToDigit k $ ""
                    in map (\i -> count (==i) s) [0..(radix-1)]
countDigs' radix ks = foldl (\rs cs -> map (uncurry (+)) $ zip rs cs)
                            (replicate radix 0)
                            $ map (countDigs radix) ks

combListsM 1 lim     = [[lim]]
combListsM n lim = [x:xs | x <- [1..(lim-1)], xs <- combListsM (n-1) lim]
                   ++ [lim:xs | xs <- combListsS (n-1) lim]
                   ++ [lim:xs | xs <- combListsM (n-1) lim]
combListsS 1 lim     = [[x] | x <- [1..(lim-1)]]
combListsS n lim = [x:xs | x <- [1..(lim-1)], xs <- combListsS (n-1) lim]

combLists' n lim = combListsM n lim ++ combLists' n (lim+1)

combLists'' n = combLists' n 1

check radix (xs:xss) = let xs' = reverse xs
                           cs = map (+1) $ countDigs' radix xs'
                       in if and $ map (uncurry (==)) $ zip xs' cs
                          then xs':(check radix xss)
                          else check radix xss

solve radix = check radix $ combLists'' radix 

showResult radix xs = (foldl ct "この文は" [0..(radix-1)]) ++ "あります。"
  where ct cs i = cs ++ (if i == 0 then "" else ", ")
                     ++ show i ++ "が"
                     ++ showIntAtBase radix intToDigit (xs!!i) "個"

main = do args <- getArgs
          case args of
            [radix] -> case readDec radix of
                         (r,_):_  -> U.putStr
                                            $ unlines
                                            $ map (showResult r)
                                            $ solve r
            _       -> putStrLn "Usage: solve <radix>"

(defun bound (n) (if (= n 2) 8 (* n n)))

(defun solution-p (n &rest nums)
  (let ((s (format nil (format nil "~~{~~~DR~~}" n) nums)))
    (loop for i from 0 below n and a in nums
      unless (= (1- a) (count (digit-char i n) s)) return nil
      finally (return t))))

(defun gen-solver (n i bound chars vars)
  (if (= i n)
      `(if (solution-p ,n ,@vars)
           (format t "この文は~@?あります~%"
                   (format nil "~~@{~~Cが~~~DR個~~^，~~}" ,n)
                   ,@(apply #'nconc (mapcar #'list chars vars))))
    `(loop for ,(nth i vars) from 0 below ,bound do
       ,(gen-solver n (1+ i) bound chars vars))))

(defun solve (n)
  (let ((code (gen-solver n 0 (bound n)
                          (loop for i from 0 below n collect (digit-char i n))
                          (loop repeat n collect (gensym)))))
    ;; (eval code)
    (funcall (compile nil (eval `(lambda () ,code))))
    ))

<?php
function cmp(&$a1,&$a2)
{
    foreach($a2 as $k=>$v)
        if($a1[ord(base_convert($k,10,36))]!=$v)
            return false;
    return true;
}
function judge($a,$n)
{
    $b=array();
    for($i=0;$i<$n;++$i)
    {    $c=base_convert($i,10,$n);
        $b[]="${c}が".base_convert($a[$i],10,$n)."個";
    }
    $str=implode(",",$b);
    $a1=count_chars($str);
    if(cmp($a1,$a))
        echo "この文は${str}あります。\n";
}

function part($a,$n,$c,$s1,$s2,$m)
{
    if(!$c)
    {    $m1=min($m-$s1,$s2+1);
        for($i=$n*2-$s1;$i<=$m1;++$i)
        {    $a[$c]=$i;
            judge($a,$n);
        }
    }
    else
    {    $m1=min($m-$s1,$s2/$c+1);
        for($i=1;$i<=$m1;++$i)
        {    $a[$c]=$i;
            part($a,$n,$c-1,$s1+$i,$s2-$c*($i-1),$m);
        }
    }
}

$t=microtime(true);

for($n=2;$n<=16;++$n)
{    echo "${n}進:\n";
    $m=max($n*2+2,10);
    part(array(),$n,$n-1,0,$m,$m);
}

echo microtime(true)-$t,"sec\n";
?>

let limit radix =
   match radix with
   | 2 -> 8
   | n -> n + 2

let char_table =
   Array.map begin fun i ->
      Printf.sprintf "%x" i
   end (Array.init 16 (fun i -> i))

let lstring_of_radix_num radix num =
   let rec loop n acc =
      if n < radix then
         char_table.(n) :: acc
      else
         let rem = n mod radix in
         loop ((n - rem) / radix) (char_table.(rem) :: acc)
   in
   loop num []

let string_of_lstring str =
   List.fold_left begin fun acc ch ->
      acc ^ ch
   end "" str

let string_of_radix_num radix num =
   string_of_lstring (lstring_of_radix_num radix num)

let slist_of_alist radix alist =
   List.map begin fun i ->
      lstring_of_radix_num radix i
   end (List.flatten alist)

let count_digits radix str_list num =
   match lstring_of_radix_num radix num with
   | [ch] ->
        List.fold_left begin fun sum ch' ->
           sum + (if ch = ch' then 1 else 0)
        end 0 (List.flatten str_list)
   | _ -> failwith "unknown"

let validate radix alist =
   let str = List.flatten (slist_of_alist radix alist) in
   List.for_all begin fun pair ->
      match pair with
      | [i; num] -> begin
           match lstring_of_radix_num radix i with
           | [ch] ->
                num =
                   List.fold_left begin fun sum ch' ->
                      sum + (if ch = ch' then 1 else 0)
                   end 0 str
           | _ -> failwith "unknown"
        end
      | _ -> failwith "unknown"
   end alist

let search radix =
   let lim = limit radix in
   def search'(num, start, acc) =
      def result(alist) & wait() = reply alist to wait in
      def search''(n) =
         let acc' = [num; n] :: acc in
         match num - 1 with
         | next when next < 0 ->
              if validate radix acc'
              then result(acc')
              else 0
         | next ->
              let start' =
                 (count_digits radix (slist_of_alist radix acc') next) + 1
              in
              if start > lim then failwith "unknown";
              result(search'(next, start', acc'))
      in
      for i = start to lim do
         spawn search''(i)
      done;
      reply wait() to search'
   in
   search'(radix - 1, 1, [])

let print_result radix alist =
   let str =
      List.fold_left begin fun acc pair ->
         match List.map (string_of_radix_num radix) pair with
         | [i; n] ->
              acc ^ i ^ "が" ^ n ^ "個" ^ ", "
         | _ -> failwith "unknown"
      end "この文は" alist
   in
   let str' = (String.sub str 0 ((String.length str) - 2)) ^ "あります。" in
   print_endline str'

let main () =
   match Sys.argv with
   | [|_; radix |] ->
        let radix' = int_of_string radix in
        let result = search(radix') in
        print_result radix' result
   | _ -> print_endline "usage: command radix"

let () = if not !Sys.interactive then main ()