Latest comments posted by [1..100]>>=pen

[1..100]>>=pen's comment on 数独の問題数を数え上げる

極小配置問題数まで求めました。

・マスに素数を対応させ配置を４つの整数からなる組に対応させる。
・順列的交換で移り合うものは基本的に同一視する。
  （同一視が問題となる処理は filter ((/=1).(!!1).snd) の部分だけ）
  最終的には24(=4!)倍したものを問題個数とする。
・（同一視したうえでの）全解答12パターンは次の3パターン
   [[1,2,3,4],[3,4,1,2],[2,1,4,3],[4,3,2,1]]
   [[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]]
   [[1,2,3,4],[3,4,2,1],[2,1,4,3],[4,3,1,2]]
  から３行目と４行目の交換、３列目と４列目の交換で生成する。
・必要なマスだけ取り出すにはマスに対応する素数の積との
  最大公約数を使う。（例えば左上４つを取り出すには 2*3*7*11 との最大公約数）
・各問題に対してその問題の解答が１２パターンのうちのどれに
  属するか記録しておく。
・問題はその問題のヒント個数より少ないヒント個数を持つどの
  極小配置も含まなければその問題も極小配置である。
・配置Ａが配置Ｂを含むかどうかはＡとＢの解答パターンが一致し
  Ａの４つの整数の積がＢの４つの整数の積で割り切れるかどうかで
  判断できる。

手元の Windowsマシンでの実行時間は約１０秒。

この結果が正しければ極小配置2×2数独問題のヒント個数は
４個から６個ということになります。

import Data.List (group,sort,elemIndices,mapAccumL,sortBy,groupBy)
import Data.Array (accumArray,elems)
import Data.Ord (comparing)

ps = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53]
exch rows cols js = [js, [js!!(4*i+j)| i <- rows, j <- cols]]
bs = do
  as <- [[1,2,3,4,3,4,1,2,2,1,4,3,4,3,2,1],
         [1,2,3,4,3,4,1,2,2,3,4,1,4,1,2,3],
         [1,2,3,4,3,4,2,1,2,1,4,3,4,3,1,2]]
        >>= exch [0,1,3,2] [0..3] >>= exch [0..3] [0,1,3,2]
  return [product $ map (ps!!) $ elemIndices i as| i <- [1..4]]

comb 0 _ = [[]]
comb _ [] = []
comb n (x:xs) = map (x:) (comb (n-1) xs) ++ comb n xs

problem :: Int -> [(Int,[Integer])]
problem n = map head $ filter (null.tail) $ concat
  [groupBy (\a b -> snd a == snd b) $ sortBy (comparing snd)
    $ filter ((/=1).(!!1).snd) $ zip [0..]
    $ map (sort.map (gcd (product x))) bs| x <- comb n ps]

minimalProblem :: [(Int,Int,Int)]
minimalProblem = snd $ mapAccumL f (replicate 12 []) [0..16] where
  f xss n = (zipWith (++) xss zss, (n, 24*length ys,  24*length (concat zss))) where 
    ys = problem n
    zss = zipWith g xss $ elems
           $ accumArray (\a b -> product b: a) [] (0,11) ys
  g xs ys = [y| y <- ys, and [y `mod` x /= 0| x <- xs]]

main = mapM_ print minimalProblem 

{-
> main
(0,0,0)
(1,0,0)
(2,0,0)
(3,0,0)
(4,25728,25728)
(5,284160,58368)
(6,1041408,1536)
(7,2141184,0)
(8,2961024,0)
(9,2958336,0)
(10,2204928,0)
(11,1239552,0)
(12,522624,0)
(13,161280,0)
(14,34560,0)
(15,4608,0)
(16,288,0)
-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on 数独の問題数を数え上げる

数独の問題数を数え上げる (Nested Flatten)

#8180 の方法のままでは極小問題に挑むには時間がかかりすぎるので
高速化しました。[1,2,3,4]の順列的交換で移り合える配置は数独の
問題になるならないが一致するので配置を
[iが配置されているマスの素数の積 | i <- [1..4]]
をソートした４つの整数に対応させます。
３０倍くらい高速化しました。

import Data.List (group,sort,elemIndices )

ps = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53]
exch rows cols js = [js, [js!!(4*i+j)| i <- rows, j <- cols]]
bs = do
  as <- [[1,2,3,4,3,4,1,2,2,1,4,3,4,3,2,1],
         [1,2,3,4,3,4,1,2,2,3,4,1,4,1,2,3],
         [1,2,3,4,3,4,2,1,2,1,4,3,4,3,1,2]]
        >>= exch [0,1,3,2] [0..3] >>= exch [0..3] [0,1,3,2]
  return [product $ map (ps!!) $ elemIndices i as| i <- [1..4]]

comb 0 _ = [[]]
comb _ [] = []
comb n (x:xs) = map (x:) (comb (n-1) xs) ++ comb n xs

solnum n = (24*) $ length $ filter (null.tail) $ concat
  [group $ filter ((/=1).(!!1)) $ sort $
    map (sort.map (gcd (product x))) bs| x <- comb n ps]

main = mapM (¥i -> print $ (i,solnum i)) [1..15]

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on 数独の問題数を数え上げる

数独の問題数を数え上げる (Nested Flatten)

総当りで遅いですがシンプルさで勝負。
目新しいのは配置を整数に対応させて整数の演算ですましている点です。

・マスに素数を対応させ配置を整数化する。
  （例えば [[4,1,3,2],[2,3,1,4],...] は 2^4*3^1*5^3*7^2*11^2*13^3*17^1*19^4*... に整数化）
・全解答288パターンは基本3パターン
   [[1,2,3,4],[3,4,1,2],[2,1,4,3],[4,3,2,1]]
   [[1,2,3,4],[3,4,1,2],[2,3,4,1],[4,1,2,3]]
   [[1,2,3,4],[3,4,2,1],[2,1,4,3],[4,3,1,2]]
  から３行目と４行目の交換、３列目と４列目の交換、
  [1,2,3,4]の順列的交換で生成。(288 = 3*2*2*24)
・必要なマスだけ取り出すには素数の４乗の積との最大公約数を使う。
  （例えば左上４つを取り出すには (2*3*7*11)^4 との最大公約数）

import Data.List (group,sort,permutations)

ps = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53]
ps4 = map (^4) ps
perm = permutations [0..3]
exch rows cols js = [js, [js!!(4*i+j)| i <- rows, j <- cols]]
bs = do
  as <- [[0,1,2,3,2,3,0,1,1,0,3,2,3,2,1,0],
         [0,1,2,3,2,3,0,1,1,2,3,0,3,0,1,2],
         [0,1,2,3,2,3,1,0,1,0,3,2,3,2,0,1]]
         >>= exch [0,1,3,2] [0..3] >>= exch [0..3] [0,1,3,2]
  js <- perm
  return $ product $ zipWith (^) ps $ map ((1+).(js!!)) as
comb 0 _ = [[]]
comb _ [] = []
comb n (x:xs) = map (x:) (comb (n-1) xs) ++ comb n xs

solnum n = length $ filter (null.tail)
  $ group.sort.(`map` bs).gcd.product =<< comb n ps4

main = mapM (\i -> print $ (i,solnum i)) [1..15]

{-
> main
(1,0)
(2,0)
(3,0)
(4,25728)
(5,284160)
(6,1041408)
(7,2141184)
(8,2961024)
(9,2958336)
(10,2204928)
(11,1239552)
(12,522624)
(13,161280)
(14,34560)
(15,4608)
-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on 島の数をカウントする

島の数をカウントする (Nested Flatten)

#8081 を ruby で。
each を使うか inject を使うか迷う。

def conv(xs)
  d, wbs = 1, [[],[]]
  xs.scan(/(W*)(B*)/){|wb|
    [0,1].each{|i|
      m = 1<<wb[i].length
      wbs[i] << (m-1)*d if (m > 1)
      d *= m
    }
  }
  {:w => wbs[0], :b => wbs[1]}
end

def count(rows)
  zs2 = (rows.map{|xs|conv xs}+[{:w=>[],:b=>[]}]).inject(:w=>[[],0],:b=>[[],0]){|zs,xs|
    {:w => g(xs[:w],*zs[:w]), :b => g(xs[:b],*zs[:b])}
  }
  {:w => zs2[:w][1], :b => zs2[:b][1]}
end

def g(xs,ys,m)
  ys2 = ys.inject(xs){|as,y|
      bs, c = [], 0
      as.each{|z| if (z&y != 0) then c += z; else bs << z; end}
      if (c > 0) then bs << c; else m += 1; bs; end
  }
  [ys2,m]
end

p(count(["WBBW","WWBW","WBWW","WBBW"])) # => {:b=>2, :w=>2}
p(count(["WWWW","BWBW","WBWW","WWWW"])) # => {:b=>3, :w=>1}

[ Ruby ] [ download code ] ]

[1..100]>>=pen's comment on 島の数をカウントする

島の数をカウントする (Nested Flatten)

・１行ずつ処理。
・列をビットに対応させて連結情報は整数のリストで保持。
  （例えば [W,B,W,W] という行は [[1,12],[2]] に変換）
・縦に連結しているかはビット論理積が非０かで判定。
・連結は加算。（例えば [W,B,W,W] で左の１個の W と右の２個の W が
  連結していることがわかった場合は 1+12（つまり 13）で表せる）

import Data.List
import Data.Bits

data BW = B | W deriving (Eq)

conv :: [BW] -> [[Int]]
conv xs = map (map (sum.map snd).filter (not.null))
  $ transpose $ unfoldr f $ zip xs $ iterate (2*) 1  where
  f [] = Nothing 
  f zs = Just([ws,bs],zs'') where
    (ws,zs' ) = span ((==W).fst) zs
    (bs,zs'') = span ((==B).fst) zs'

count :: [[BW]] -> [Int]
count rows = map (sum.concat) $ transpose $ snd
  $ mapAccumL g [[],[]] $ (++ [[[],[]]]) $ map conv rows  where
  g yss xss = unzip $ zipWith (mapAccumL h) xss yss
  h xs y = if null cs then (ds, 1) else (sum cs: ds, 0)  where
    (cs,ds) = partition ((/=0).(y.&.)) xs

{-
> count [[W,W,W,W],[B,W,B,W],[W,B,W,W],[W,W,W,W]]
[1,3]
-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on 数値リストの圧縮

数値リストの圧縮 (Nested Flatten)

import List

compactNumberList xs = unfoldr f xs

f xs@(x:y:z:_) | x+z==2*y = Just (g (y-x) $ map fst as, map fst bs) where
  (as,bs) = span (uncurry (==)) $ zip xs [x,y..]
f (x:xs) = Just ([x], xs)
f [] = Nothing

g step xs = [head xs, last xs] ++ if step == 1 then [] else [step]

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on 2^i * 3^j * 5^k なる整数

2^i * 3^j * 5^k なる整数 (Nested Flatten)

ハミング数ですね。
anarchy golf の Hamming Numbers問題
http://golf.shinh.org/p.rb?Hamming+Numbers
のときに投稿した golf用の富豪コードです。

30のx乗 ≡ 0 (mod x) となる x がハミング数に
なることを使っています。（30 は 2,3,5 の最小公倍数）

富豪だから、け、計算量なんて気にしてないんだからね！

main = do
  n <- readLn
  mapM_ print $ take n [x| x <- [1..], mod (30^x) x == 0]

{- anarchy golf に投稿したコードはこちら

main=readLn>>=mapM print.(`take`[x|x<-[1..],mod(30^x)x<1])

-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 8 - 横向きのピラミッドを作る

LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

> [abs k..n]>>"*"
replicate(n-(abs k)+1)'*'になるんですね。うまいなあ。

> 自分の名前を忘れないでください(笑)的
[1..100]>>"orz"

[1..100]>>=pen's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

1 2	r=reverse main=readLn>>=putStrLn.f;f n\|n<4^5=show n\|1>0=(\(x,u)->let(a:b)=r$show x in r b++'.':a:[u])$last$filter((>9).fst)$scanl((,).(`div`4^5).fst)(n*10,' ')"KMT"

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 8 - 横向きのピラミッドを作る

LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

1	main=do n<-readLn;mapM(putStrLn.(`replicate`'*').(n-).abs)[-n+1..n-1]

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 3 - 13日の金曜日を数え上げる

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

１文字縮められました。

1
2
3

c=0
(Time.now..Time.gm(14)-1).step(86400){|d|p(d)if"#{d}"=~/i\D*13/&&c+=1}
p c

[ Ruby ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 3 - 13日の金曜日を数え上げる

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

c=0
(Time.now..Time.gm(14)-1).step(86400){|d|p(d)if"#{d}"=~/F.{7}13/&&c+=1}
p c

# または同サイズの

c=0
(Time.now..Time.gm(14)-1).step(86400){|d|p(d)if d.day*d.wday==65&&c+=1}
p c

[ Ruby ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 7 - バイト数を読みやすくする

LL Golf Hole 7 - バイト数を読みやすくする (Nested Flatten)

無難に。

import List
import Maybe

units = " KMGTPEZY"
k = 1024

humanReadable x
 | x < k = show x
 | otherwise = show a ++ "." ++ show b ++ [c] where
   (y,xs) = mapAccumL (\x c -> (div x k, (x,c))) (x*10) $ init units
   (z,c) = fromMaybe (y,last units) $ find ((<k*10).fst) xs
   (a,b) = divMod z 10

{-
> humanReadable 123456789012345678901234567890
"102121.0Y"
-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 6 - 10進数を2進数に基数変換する

LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

あー、そうでした、、、不覚。orz

[1..100]>>=pen's comment on LL Golf Hole 6 - 10進数を2進数に基数変換する

LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

２進数の無限リストを使って。

a="1":(a>>=(\x->[x++"0",x++"1"]))
b=(!!)$"0":a

{-
> b 10
"1010"
-}

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten)

1	main=do n<-readLn;print$filter(all(<'1').tail.show)[0..n]

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 5 - 最上位の桁を数え上げる

LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten)

1	x=[1..9]++(map(10*)x);main=readLn>>=print.fst.(`span`(0:x)).(>=)

[ Haskell ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 3 - 13日の金曜日を数え上げる

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

require'date'
i=0
Date.today.upto(Date.new(2014)-1){|d|puts d.strftime'%Y-%m-%d'if d.mday*d.wday==65&&i+=1}
puts i

[ Ruby ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする

LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする (Nested Flatten)

#6972 の ruby版。

1 2	z=gets.split // puts(z.zip([' ']+z).map{\|x,y\|y=~/\w/?x:x.upcase}.join)

[ Ruby ] [ download code ] ]

[1..100]>>=pen's comment on LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする

LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする (Nested Flatten)

#6972 を 18:09 頃に投稿したのですが
タイムスタンプが 13:09 になりました。
５時間ずれてる？