Intereting Posts

Выполнение последовательности Langford Haskell или C

В комбинаторной математике спаривание Лангфорда , также называемое последовательностью Лэнгфорда, представляет собой перестановку последовательности 2n чисел 1, 1, 2, 2, ..., n, n, в которой эти две единицы разделены на единицу, два две единицы разделены на две единицы, и, как правило, две копии каждого числа k составляют k единиц.

Например:

Спаривание Лэнгфорда при n = 3 задается последовательностью 2,3,1,2,1,3.

  • Что такое хороший метод для решения этой проблемы в haskell или C
  • Можете ли вы предложить алгоритм его решения (не хотите использовать грубую силу)?

————————–РЕДАКТИРОВАТЬ———————-
Как мы можем определить математические правила, чтобы поместить код @ Rafe в haskell

Вы хотите найти назначение для переменных {p1, p2, …, pn} (где pi – позиция первого вхождения «i») со следующими ограничениями, удерживающими для каждого pi:

  • pi в 1 .. (1 + ni)
  • если pi = k, то для всех pj, где j! = i
  • pj! = k
  • pj! = k + i
  • pj! = k – j
  • pj! = k + i – j

Здесь нужна разумная страtagsя поиска. Хорошим выбором является то, что в каждой точке выбора выберите pi с наименьшим оставшимся набором возможных значений.

Ура!

[EDIT: второе добавление.]

Это «в основном функциональная» версия императивной версии, которую я сначала написал (см. Первое добавление ниже). Он в основном функционирует в том смысле, что состояние, связанное с каждой вершиной в дереве поиска, не зависит от всех других состояний, поэтому нет необходимости в трейле или подобном механизме. Тем не менее, я использовал императивный код для реализации построения каждого нового набора доменов из копии родительского домена.

 using System; using System.Collections.Generic; using System.Linq; using System.Text; namespace MostlyFunctionalLangford { class Program { // An (effectively functional) program to compute Langford sequences. static void Main(string[] args) { var n = 7; var DInit = InitLangford(n); var DSoln = Search(DInit); if (DSoln != null) { Console.WriteLine(); Console.WriteLine("Solution for n = {0}:", n); WriteSolution(DSoln); } else { Console.WriteLine(); Console.WriteLine("No solution for n = {0}.", n); } Console.Read(); } // The largest integer in the Langford sequence we are looking for. // [I could infer N from the size of the domain array, but this is neater.] static int N; // ---- Integer domain manipulation. ---- // Find the least bit in a domain; return 0 if the domain is empty. private static long LeastBitInDomain(long d) { return d & ~(d - 1); } // Remove a bit from a domain. private static long RemoveBitFromDomain(long d, long b) { return d & ~b; } private static bool DomainIsEmpty(long d) { return d == 0; } private static bool DomainIsSingleton(long d) { return (d == LeastBitInDomain(d)); } // Return the size of a domain. private static int DomainSize(long d) { var size = 0; while (!DomainIsEmpty(d)) { d = RemoveBitFromDomain(d, LeastBitInDomain(d)); size++; } return size; } // Find the k with the smallest non-singleton domain D[k]. // Returns zero if none exists. private static int SmallestUndecidedDomainIndex(long[] D) { var bestK = 0; var bestKSize = int.MaxValue; for (var k = 1; k <= N && 2 < bestKSize; k++) { var kSize = DomainSize(D[k]); if (2 <= kSize && kSize < bestKSize) { bestK = k; bestKSize = kSize; } } return bestK; } // Obtain a copy of a domain. private static long[] CopyOfDomain(long[] D) { var DCopy = new long[N + 1]; for (var i = 1; i <= N; i++) DCopy[i] = D[i]; return DCopy; } // Destructively prune a domain by setting D[k] = {b}. // Returns false iff this exhausts some domain. private static bool Prune(long[] D, int k, long b) { for (var j = 1; j <= N; j++) { if (j == k) { D[j] = b; } else { var dj = D[j]; dj = RemoveBitFromDomain(dj, b); dj = RemoveBitFromDomain(dj, b << (k + 1)); dj = RemoveBitFromDomain(dj, b >> (j + 1)); dj = RemoveBitFromDomain(dj, (b << (k + 1)) >> (j + 1)); if (DomainIsEmpty(dj)) return false; if (dj != D[j] && DomainIsSingleton(dj) && !Prune(D, j, dj)) return false; } } return true; } // Search for a solution from a given set of domains. // Returns the solution domain on success. // Returns null on failure. private static long[] Search(long[] D) { var k = SmallestUndecidedDomainIndex(D); if (k == 0) return D; // Branch on k, trying each possible assignment. var dk = D[k]; while (!DomainIsEmpty(dk)) { var b = LeastBitInDomain(dk); dk = RemoveBitFromDomain(dk, b); var DKeqB = CopyOfDomain(D); if (Prune(DKeqB, k, b)) { var DSoln = Search(DKeqB); if (DSoln != null) return DSoln; } } // Search failed. return null; } // Set up the problem. private static long[] InitLangford(int n) { N = n; var D = new long[N + 1]; var bs = (1L << (N + N - 1)) - 1; for (var k = 1; k <= N; k++) { D[k] = bs & ~1; bs >>= 1; } return D; } // Print out a solution. private static void WriteSolution(long[] D) { var l = new int[N + N + 1]; for (var k = 1; k <= N; k++) { for (var i = 1; i <= N + N; i++) { if (D[k] == 1L << i) { l[i] = k; l[i + k + 1] = k; } } } for (var i = 1; i < l.Length; i++) { Console.Write("{0} ", l[i]); } Console.WriteLine(); } } } 

[EDIT: первое добавление.]

Я решил написать программу C # для решения проблем Лэнгфорда. Он работает очень быстро до n = 16, но после этого вам нужно изменить его, чтобы использовать longs, поскольку он представляет домены как битовые шаблоны.

 using System; using System.Collections.Generic; using System.Linq; using System.Text; namespace Langford { // Compute Langford sequences. A Langford sequence L(n) is a permutation of [1, 1, 2, 2, ..., n, n] such // that the pair of 1s is separated by 1 place, the pair of 2s is separated by 2 places, and so forth. // class Program { static void Main(string[] args) { var n = 16; InitLangford(n); WriteDomains(); if (FindSolution()) { Console.WriteLine(); Console.WriteLine("Solution for n = {0}:", n); WriteDomains(); } else { Console.WriteLine(); Console.WriteLine("No solution for n = {0}.", n); } Console.Read(); } // The n in L(n). private static int N; // D[k] is the set of unexcluded possible positions in the solution of the first k for each pair of ks. // Each domain is represented as a bit pattern, where bit i is set iff i is in D[k]. private static int[] D; // The trail records domain changes to undo on backtracking. T[2k] gives the element in D to undo; // T[2k+1] gives the value to which it must be restored. private static List T = new List { }; // This is the index of the next unused entry in the trail. private static int TTop; // Extend the trail to restore D[k] on backtracking. private static void TrailDomainValue(int k) { if (TTop == T.Count) { T.Add(0); T.Add(0); } T[TTop++] = k; T[TTop++] = D[k]; } // Undo the trail to some earlier point. private static void UntrailTo(int checkPoint) { //Console.WriteLine("Backtracking..."); while (TTop != checkPoint) { var d = T[--TTop]; var k = T[--TTop]; D[k] = d; } } // Find the least bit in a domain; return 0 if the domain is empty. private static int LeastBitInDomain(int d) { return d & ~(d - 1); } // Remove a bit from a domain. private static int RemoveBitFromDomain(int d, int b) { return d & ~b; } private static bool DomainIsEmpty(int d) { return d == 0; } private static bool DomainIsSingleton(int d) { return (d == LeastBitInDomain(d)); } // Return the size of a domain. private static int DomainSize(int d) { var size = 0; while (!DomainIsEmpty(d)) { d = RemoveBitFromDomain(d, LeastBitInDomain(d)); size++; } return size; } // Find the k with the smallest non-singleton domain D[k]. // Returns zero if none exists. private static int SmallestUndecidedDomainIndex() { var bestK = 0; var bestKSize = int.MaxValue; for (var k = 1; k <= N && 2 < bestKSize; k++) { var kSize = DomainSize(D[k]); if (2 <= kSize && kSize < bestKSize) { bestK = k; bestKSize = kSize; } } return bestK; } // Prune the other domains when domain k is reduced to a singleton. // Return false iff this exhausts some domain. private static bool Prune(int k) { var newSingletons = new Queue(); newSingletons.Enqueue(k); while (newSingletons.Count != 0) { k = newSingletons.Dequeue(); //Console.WriteLine("Pruning from domain {0}.", k); var b = D[k]; for (var j = 1; j <= N; j++) { if (j == k) continue; var dOrig = D[j]; var d = dOrig; d = RemoveBitFromDomain(d, b); d = RemoveBitFromDomain(d, b << (k + 1)); d = RemoveBitFromDomain(d, b >> (j + 1)); d = RemoveBitFromDomain(d, (b << (k + 1)) >> (j + 1)); if (DomainIsEmpty(d)) return false; if (d != dOrig) { TrailDomainValue(j); D[j] = d; if (DomainIsSingleton(d)) newSingletons.Enqueue(j); } } //WriteDomains(); } return true; } // Search for a solution. Return false iff one is not found. private static bool FindSolution() { var k = SmallestUndecidedDomainIndex(); if (k == 0) return true; // Branch on k, trying each possible assignment. var dOrig = D[k]; var d = dOrig; var checkPoint = TTop; while (!DomainIsEmpty(d)) { var b = LeastBitInDomain(d); d = RemoveBitFromDomain(d, b); D[k] = b; //Console.WriteLine(); //Console.WriteLine("Branching on domain {0}.", k); if (Prune(k) && FindSolution()) return true; UntrailTo(checkPoint); } D[k] = dOrig; return false; } // Print out a representation of the domains. private static void WriteDomains() { for (var k = 1; k <= N; k++) { Console.Write("D[{0,3}] = {{", k); for (var i = 1; i <= N + N; i++) { Console.Write("{0, 3}", ( (1 << i) & D[k]) != 0 ? i.ToString() : DomainIsSingleton(D[k]) && (1 << i) == (D[k] << (k + 1)) ? "x" : ""); } Console.WriteLine(" }"); } } // Set up the problem. private static void InitLangford(int n) { N = n; D = new int[N + 1]; var bs = (1 << (N + N - 1)) - 1; for (var k = 1; k <= N; k++) { D[k] = bs & ~1; bs >>= 1; } } } } 

Я не мог сопротивляться. Вот мой порт кода Рейфа в Haskell:

 module Langford where import Control.Applicative import Control.Monad import Data.Array import Data.List import Data.Ord import Data.Tuple import qualified Data.IntSet as S langford :: Int -> [[Int]] langford n | mod n 4 `elem` [0, 3] = map (pairingToList n) . search $ initial n | otherwise = [] type Variable = (Int, S.IntSet) type Assignment = (Int, Int) type Pairing = [Assignment] initial :: Int -> [Variable] initial n = [(i, S.fromList [1..(2*ni-1)]) | i <- [1..n]] search :: [Variable] -> [Pairing] search [] = return [] search vs = do let (v, vs') = choose vs a <- assignments v case prune a vs' of Just vs'' -> (a :) <$> search vs'' Nothing -> mzero choose :: [Variable] -> (Variable, [Variable]) choose vs = (v, filter (\(j, _) -> i /= j) vs) where v@(i, _) = minimumBy (comparing (S.size . snd)) vs assignments :: Variable -> [Assignment] assignments (i, d) = [(i, k) | k <- S.toList d] prune :: Assignment -> [Variable] -> Maybe [Variable] prune a = mapM (prune' a) prune' :: Assignment -> Variable -> Maybe Variable prune' (i, k) (j, d) | S.null d' = Nothing | otherwise = Just (j, d') where d' = S.filter (`notElem` [k, k+i+1, kj-1, k+ij]) d pairingToList :: Int -> Pairing -> [Int] pairingToList n = elems . array (1, 2*n) . concatMap positions where positions (i, k) = [(k, i), (k+i+1, i)] 

Кажется, он работает неплохо. Вот некоторые тайминги от GHCi:

 Prelude Langford> :set +s Prelude Langford> head $ langford 4 [4,1,3,1,2,4,3,2] (0.03 secs, 6857080 bytes) Prelude Langford> head $ langford 32 [32,28,31,23,26,29,22,24,27,15,17,11,25,10,30,5,20,2,21,19,2,5,18,11,10, ...] (0.05 secs, 15795632 bytes) Prelude Langford> head $ langford 100 [100,96,99,91,94,97,90,92,95,83,85,82,93,78,76,73,88,70,89,87,69,64,86, ...] (0.57 secs, 626084984 bytes) 

Поскольку последовательности Langford обычно генерируются для небольшого целого числа n , я использую bogosort для этой программы и каждый раз проверяю, что он богосортирован. Когда проверка завершится, я закончу.

Например, при n = 3:

  • Создайте массив для 2n чисел. Массив будет примерно таким: 1 2 3 1 2 3
  • Используйте простой цикл для bogosort и включайте проверку каждый раз, что довольно легко.
  • Если проверка выполнена успешно, массив даст вам последовательность Langford.

Это будет работать быстро для малых целых чисел только потому, что число возможных перестановок n! , здесь: 3 * 2 * 1 = 6.