ハスケル-ナイトII

画像






2番目の記事では、 開始されトピックを継続し、ナイトのコースでNxNの正方形を埋めるときに巡回ルートを見つける問題を検討します。 しかし、最初の記事へのコメントで、彼らは興味深いヒューリスティックを提案しました。それについては多くのコメンテーターに感謝します。もちろん、このヒントはより詳細に検討されるべきです。 この考え方は、Varnsdorfのルールとして知られており、可能な動きのリストから、まず、継続回数が最も少ない動きを選択する必要があります。 これにより、ときどきではなく、桁違いに最初のソリューションの待ち時間を短縮することができます。 さらに、接続性の追加チェックは不要になり、その2次の複雑さはプロセスを妨害し、遅くするだけです。



前の記事で説明した主な再帰は、この規則に準拠するために変更することは難しくありません。必要な基準によって可能な動きのリストをソートするだけで十分です。



knightsTo x [] = [[x]] knightsTo x xs = [x:ks | k <- ksort xs $ neighbours xs x, ks <- knightsTo k $ delete k xs]
      
      





自由な隣人を見つけることは別の機能に入れるべきです



 neighbours xs x = filter (near x) xs where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2
      
      





問題は小さく、ソート関数ksortをペイントすることです 。これは、「これらのネイバーのネイバー」の数によってネイバーのリストを編成します。 または、これを行うことができます



 ksort xs ns = map snd $ sort $ zip (map (length . neighbours xs) ns) ns
      
      





リストnsの各ネイバーについて、可能な動きのリストを見つけ、その長さを計算します。 長さを隣人の座標とペアで構成します。 通常の並べ替えは、最初の要素、つまり 長さでは、ペアの最初の要素を破棄し、2番目の要素のみを残します。



やや華やかですが、最も重要なこと-結果。 10x10-50x50とは1分もかからない! 少し待てば90x90でも。 ここでは、100x100は結果を待ちませんでした。



中間のサイズの正方形を実験することで、アルゴリズムがさらに早くつまずき始めることがわかります。 最初の問題の正方形は49x49、2番目の60x60です。次に、辺64、76、87、89、98の正方形があります。ただし、正方形のラウンドが左下隅からではなく、たとえば反対側から始まる場合、辺49、60の正方形の場合64個のソリューションが見つかりましたが、他の正方形でも問題が発生し、サイズは23x23から既に始まっています。 左上隅では、ルートを正方形76x76(および、ちなみに100x100)で見つけることができますが、問題は辺32の正方形で見つかります。



このような選択的な微妙さは少し驚くべきものであり、非論理的なように見えますが、このルールでさえ、移動を選択する際に不確実性を持っている可能性があります。 結果の最小数が同じである隣人も何らかの形で手配することが望ましい。おそらくこれらの状況は重大であることが判明するだろう。 しかし、実際、ここで答えが見つかるほど、より多くの疑問が生じます。 任意のルートを持つこのテーマでは、閉じて閉じたルートに行くことができると思います。



このタスクはより難しいと考えられており、実際、最初のセルに戻るための要件は難しいようです。 確かに、閉じたルートを構築するときは、常に抜け穴を残して戻ります。 言い換えれば、初期セルは、構築の各ステップで現在の位置からアクセス可能なままでなければなりません。 しかし、ここでも接続テストと接続解除された機能を思い出す価値があります。 未使用のセルと同じ接続要件が最初のセルにも適用されるようになったため、チェック機能を呼び出すたびに一般リストに追加する必要があります。 また、初期セル自体を別のパラメーターとして再帰に渡すことができます。



 knFromTo x _ [] = [[x]] knFromTo xs xs = [x:ks | connected [x] (s:xs), k <- ksort xs $ neighbours xs x, ks <- knFromTo ks $ delete k xs]
      
      





良い方法では、結果を保証するために、再帰データベースで、最後に占有されたセルが馬の最初の動きに接続されていることを確認することも追加する価値がありました。 ただし、ルートは最後まで2ターンだけ一意に完了するため、偶数のセルの場合、このチェックはオプションですが、奇数の閉じたルートの場合は存在しません。このオプションの場合、アルゴリズムは最後の動きまで、最後の動きがない場合にパスを閉じようとしますチェックは、残りのセルに単純に入力します。



インターフェイスを少し調整する



 knight n = head . knFromTo (1,1) (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]]
      
      





そして、少し実験して...
 *Main> knightC 6 [(1,1),(2,3),(1,5),(3,6),(5,5),(6,3),(5,1),(4,3),(3,1),(1,2),(2,4),(1,6),(3,5),(5,6),(6,4),(5,2),(4,4),(6,5),(4,6),(2,5),(1,3),(2,1),(3,3),(1,4),(2,2),(4,1),(6,2),(5,4),(6,6),(4,5),(2,6),(3,4),(4,2),(6,1),(5,3),(3,2)]
      
      





 *Main> knightC 7 [(1,1),(2,3),(1,5),(2,7),(4,6),(6,7),(7,5),(5,6),(7,7),(6,5),(5,7),(7,6),(6,4),(7,2),(5,1),(6,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(3,7),(2,5),(1,7),(3,6),(5,5),(4,3),(2,2),(1,4),(3,5),(4,7),(2,6),(3,4),(1,3),(2,1),(4,2),(6,1),(7,3),(5,4),(3,3),(4,1),(6,2),(7,4),(6,6),(4,5),(5,3),(3,2),(4,4)]
      
      





 *Main> knightC 8 [(1,1),(2,3),(1,5),(2,7),(4,8),(6,7),(8,8),(7,6),(6,8),(8,7),(7,5),(8,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(2,8),(3,6),(1,7),(3,8),(5,7),(7,8),(8,6),(7,4),(8,2),(6,1),(4,2),(2,1),(1,3),(2,5),(3,3),(1,4),(2,2),(4,1),(6,2),(8,1),(7,3),(5,4),(3,5),(4,3),(5,1),(6,3),(5,5),(4,7),(2,6),(1,8),(3,7),(4,5),(6,6),(5,8),(4,6),(3,4),(5,3),(7,2),(8,4),(6,5),(7,7),(8,5),(6,4),(5,6),(4,4),(3,2)]
      
      







偶数の正方形サイズ(および奇数の正方形は面白くない)の場合、結果は最大50x50のサイズになりますが、追加チェックの2次の複雑さは最後の結果に影響するため、すでに40分待機する必要があります。



ところで、最終目標として、最初のセルを指定する必要がないことに気付くかもしれません。 他のものを指定することができ、ルートを構築するときにアルゴリズムが熱心に努力します。 示されたセルの領域全体を埋めた後、次の移動に進むことができるという意味で努力します。 これは、前の記事で説明したように、チェーンを構築するときに使用できます。 このようにターゲットを絞った検索のおかげで、ソリューションはより高速になります。 馬の動きの特性を考慮するだけでよく、偶数のセルの場合、目標位置は最初の位置と同じチェスの色を持っている必要があります。つまり、座標の合計のパリティが一致している必要があります。 奇数のセルの場合、色とそれに応じてパリティが交互になります。



少しのコードと実験...
前の記事と同様に、今回は任意のサイズの正方形で塗りつぶす機能について説明します



 knightN n ((m,l), st, fin) = head . knFromTo st fin $ delete st [(x,y) | x <- [m..m+n-1], y <- [l..l+n-1]]
      
      





そして、与えられたパラメータに適用します



 knights10 = concatMap (knightN 5) [((1,1),(5,5),(5,6)), ((1,6),(5,6),(6,6)), ((6,6),(6,6),(6,5)), ((6,1),(6,5),(5,5))] knights4x26 = concatMap (knightN 26) [((1 , 1),(26,26),(1 ,27)), ((1 ,27),(1 ,27),(27,27)), ((27,27),(27,27),(52,26)), ((27, 1),(52,26),(26,26))] knights16x13 = concatMap (knightN 13) [((27,27),(27,27),(27,26)), ((27,14),(27,26),(27,13)), ((27, 1),(27,13),(40,13)), ((40, 1),(40,13),(40,14)), ((40,14),(40,14),(40,27)), ((40,27),(40,27),(40,40)), ((40,40),(40,40),(39,40)), ((27,40),(39,40),(26,40)), ((14,40),(26,40),(13,40)), ((1 ,40),(13,40),(13,39)), ((1 ,27),(13,39),(13,26)), ((1 ,14),(13,26),(13,13)), ((1 , 1),(13,13),(14,13)), ((14, 1),(14,13),(14,14)), ((14,14),(14,14),(14,27)), ((14,27),(14,27),(27,27))]
      
      







4つの5x5の正方形に分割された10x10の正方形がすぐに塗りつぶされます。 問題のある52x52スクエアの場合、4つの26x26スクエアの閉じたチェーンを埋めるのに5分間待機します(すでに述べたように、50x50スクエアではサイクルが40分間検索されました)。 13x13の16個の正方形への分割は、周期的に満たされ、半ダース秒で完全に満たされます。 そのため、大きなサイズの場合、この小さな領域を塗りつぶす方法は依然として有用です。



しかし、神は大きな四角で彼らを祝福します。 最後に、別の興味深い問題に触れて、特定の図グラフで閉じたパス(または、恥ずかしいことに、ハミルトニアンサイクル)の数を計算してみます。 少なくとも、今では、指定されたサイクルの数を計算することができます。これについては、インターフェイス関数でヘッドコールを削除するだけで十分です。その後、関数は最初のルートだけでなくすべての可能なルートも検索し、 長さのコールを追加してその数を計算します。 まあ、辛抱してください。



 kNCircles :: Int -> Int -> Int kNCircles mn = length . knFromTo (1,1) (1,1) $ delete (1,1) [(x,y) | x <- [1..m], y <- [1..n]]
      
      





私たちが言ったように、奇数のセルについては、そのようなサイクルは存在しません。 4つのセルの1つの辺の長さを持つ長方形の場合、それらも構築できません。これは、たとえばE. Geekの著書「Mathematics on a Chessboard」で証明されています。 サイズ5x6および3x10は有効な長方形の中で最も小さく、それぞれのプログラムは数分で16および32のオプションを見つけます。 3x12の長方形には352の巡回ルート、3x14-3,072が含まれ、6x6の正方形には既に19,724のサイクルがあります(この場合、1つのコーナーからの有向のオープンルートについては524,486が見つかります!)、計算には時間がかかりますもう半日。 すべての栄光の出展者。 大きな領域と計算には、さらに桁違いの規模が必要です。



原則として、メイン関数の検索を減らすために、デッドロックのチェックを追加できます。 現在のセルと最終セルを除くすべての空きセルには、少なくとも2つの隣接セルが必要です。 また、一定時間内に近隣を見つけた場合、接続性テストを線形の複雑さまで減らすことができます。 ただし、これを行うには、データ構造を複雑にし、たとえば、グラフを接続のリストとして正直に提示する必要があります。 しかし、第一に、私はジャングルに入りたくありません。第二に、 Wikipediaの評価によると、これらの最適化は8x8の二乗サイクル数を計算するにはまだ十分ではありません。 残念ながら、13兆のバリアントはブルートフォースではカウントされません。



そして、実験したい人のために、最新の開発を1つのモジュールに結合できます。



knights.hs
 import Data.List(delete, (\\), sort) type Cell = (Int, Int) type Pool = [Cell] type Track = [Cell] near :: Cell -> Cell -> Bool near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2 neighbours :: Pool -> Cell -> Track neighbours xs x = filter (near x) xs connected :: Track -> Pool -> Bool connected _ [] = True connected [] _ = False connected (x:xs) ws = let ns = neighbours ws x in connected (xs++ns) (ws\\ns) deadlocks :: Pool -> Track deadlocks xs = map snd . filter ((<2) . fst) $ zip (map (length . neighbours xs) xs) xs ksort :: Pool -> Track -> Track ksort xs ks = map snd . sort $ zip (map (length . neighbours xs) ks) ks knFromTo :: Cell -> Cell -> Pool -> [Track] knFromTo x _ [] = [[x]] knFromTo xs xs = [x:ks | connected [x] $ s:xs, deadlocks (x:s:xs) \\ [x,s] == [], k <- ksort xs $ neighbours xs x, ks <- knFromTo ks $ delete k xs] knightC :: Int -> Track knightC n = head . knFromTo (1,1) (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]] kNCircles :: Int -> Int -> Int kNCircles mn = length . knFromTo (1,1) (3,2) $ [(x,y) | x <- [1..m], y <- [1..n]] \\ [(1,1),(3,2)]
      
      





PSグラフ表現における生産性の高いオプション



 import Data.List(delete, sortOn) import qualified Data.Map.Lazy as M import System.Environment (getArgs) type Cell = (Int, Int) type Pool = M.Map Cell [Cell] kDel :: Cell -> Pool -> Pool kDel x xs = M.delete x $ foldr (M.adjust (delete x)) xs (xs M.! x) connected :: [Cell] -> Pool -> Bool connected [] ws = null ws connected (x:xs) ws | M.member x ws = connected (ws M.! x ++ xs) (M.delete x ws) | otherwise = connected xs ws knFromTo :: [Cell] -> Cell -> Pool -> [[Cell]] knFromTo nx s xs | M.size xs == 1 = [[s]] | otherwise = [k:ks | k <- sortOn (length . (xs M.!)) nx, k /= s, connected [k] xs, ks <- knFromTo (xs M.! k) s (kDel k xs)] knightC :: Int -> [Cell] knightC n = head $ knFromTo [(1,1)] (3,2) $ prepare $ (,) <$> [1..n] <*> [1..n] where prepare xs = M.fromList [(x, filter (near x) xs) | x <- xs] near (x1,y1) (x2,y2) = abs ((x2 - x1) * (y2 - y1)) == 2 main = do [n] <- getArgs print $ knightC (read n)
      
      





開始する

おわりに



All Articles