短期大学部・総合文化学科 │ 聖徳大学

【コラム・IT】プログラミングの理由

21.03.08

※ 現在、一般選抜・大学入学共通テスト利用選抜D日程の出願を受付中です!
Web出願の上で、直接、入学センターに書類をお持ちいただいても結構です。
※ 上の青ボタンは奨学金・特待制度のご案内ですので、合わせてぜひご覧ください!

※ 平日・土曜はいつでもキャンパス見学を受付中です!(予約はこちら
※ 3月20日(土・祝)にオープンキャンパス(来校型10:30~12:30&オンライン配信型13:00~)を開催いたします。お申込みはこちら

   *******************************   

【コラム・IT】プログラミングの理由

筆者がプログラミングをする理由は一つではありません。もちろん、研究のために必要だから、というのは重要な理由です。でもほんとうのところは、プログラミングはパズルみたいで楽しいからです。

パズル好きなら、まちがいなく、プログラミングの素質があります。

なんなら、パズルを解くプログラムを書いてみることもできます。たとえば、ニコリのペンシルパズルのひとつに「数独」というパズルがあります。

sudoku

ルールは簡単です。
1. あいているマスに、1 から 9 までの数字のどれかを入れます。
2. タテ列 (9列あります)、 ヨコ列 (9列あります)、 太線で囲まれた3×3のブロック (それぞれ9マスあるブロックが9つあります) のどれにも1から9までの数字が1つずつ入ります。

数独が得意な人には簡単かもしれませんが、PC には敵わないでしょう。

% ghci src/Sudoku.hs
>>> sudoku              -- ← 数独の問題
5 3 . . 7 . . . .
6 . . 1 9 5 . . .
. 9 8 . . . . 6 .
8 . . . 6 . . . 3
4 . . 8 . 3 . . 1
7 . . . 2 . . . 6
. 6 . . . . 2 8 .
. . . 4 1 9 . . 5
. . . . 8 . . 7 9

(0.01 secs, 723,896 bytes)
>>> head (solve sudoku) -- ← PC に解かせる
5 3 4 6 7 8 9 1 2
6 7 2 1 9 5 3 4 8
1 9 8 3 4 2 5 6 7
8 5 9 7 6 1 4 2 3
4 2 6 8 5 3 7 9 1
7 1 3 9 2 4 8 5 6
9 6 1 5 3 7 2 8 4
2 8 7 4 1 9 6 3 5
3 4 5 2 8 6 1 7 9

(0.01 secs, 2,613,576 bytes)
>>> 

一瞬でしたね。答は、

solved

です。人間が100問解くのと、プログラムを書いてPCに100問解かせるのでは、プログラムを書く時間を考えても、プログラムを書いた方が速いでしょうね。:p

Haskell で書いたプログラムは以下のとおりです。

module Sudoku where

type Matrix a = [Row a]
type Row a    = [a]

newtype Sudoku = Sudoku { unSudoku :: Grid }
type Grid     = Matrix Digit
type Digit    = Char

digits :: [Digit]
digits = ['1'..'9']

blank :: Digit -> Bool
blank = (== '.')

type Choices = [Digit]

choices :: Grid -> Matrix Choices
choices = map (map choice)

choice :: Digit -> Choices
choice d = if blank d then digits else [d]

nodups :: (Eq a) => [a] -> Bool
nodups []       = True
nodups (x : xs) = x `notElem` xs && nodups xs

rows :: Matrix a -> Matrix a
rows = id

cols :: Matrix a -> Matrix a
cols [xs]       = [ [x] | x  Matrix a
boxs = map ungroup . ungroup
     . map cols
     . group . map group

group :: [a] -> [[a]]
group [] = []
group xs = take 3 xs : group (drop 3 xs)

ungroup :: [[a]] -> [a]
ungroup = concat

prune :: Matrix Choices -> Matrix Choices
prune = pruneBy boxs . pruneBy cols . pruneBy rows

pruneRow :: Row Choices -> Row Choices
pruneRow row = map (remove fixed) row
  where
    fixed = [ d | [d]  Choices -> Choices
remove ds [x] = [x]
remove ds xs  = filter (`notElem` ds) xs

pruneBy :: (Matrix Choices -> Matrix Choices) -> Matrix Choices -> Matrix Choices
pruneBy f = f . map pruneRow . f

expand1 :: Matrix Choices -> [Matrix Choices]
expand1 rows = [ rows1 ++ [ row1 ++ [c] : row2] ++ rows2 | c  [Int]
counts = filter (/= 1) . map length . concat

complete :: Matrix Choices -> Bool
complete = all (all single)

single :: [a] -> Bool
single [_] = True
single _   = False

safe :: Matrix Choices -> Bool
safe cm = all ok (rows cm) && all ok (cols cm) && all ok (boxs cm)
  where
    ok row = nodups [ x | [x]  Grid
extract = map (map head)

search :: Matrix Choices -> [Grid]
search cm
  | not (safe pm) = []
  | complete pm   = [extract pm]
  | otherwise     = concatMap search (expand1 pm)
  where
    pm = prune cm

solve :: Sudoku -> [Sudoku]
solve = map Sudoku . search  . choices . unSudoku

sudoku :: Sudoku
sudoku = Sudoku
  [ "53..7...."
  , "6..195..."
  , ".98....6."
  , "8...6...3"
  , "4..8.3..1"
  , "7...2...6"
  , ".6....28."
  , "...419..5"
  , "....8..79"
  ]

instance Show Sudoku where
  show = unlines . map (unwords . map (:"")) . unSudoku

<お知らせ>
※ WEB上でのオープンキャンパスを開催中ですので是非ご覧ください!
 ブログ連続オープンキャンパス(Vol.1 テーマ一覧~Vol.10 Q&A))こちら
 総合文化学科のWEBオープンキャンパス特設ページこちら

※ ツイッター・インスタグラムも日々更新しています!

PAGE TOP