Implementacja sekwencji Langforda Haskella lub C

Question

W kombinatorycznej matematyce, Langford pairing, zwana także sekwencją Langforda, jest permutacją sekwencji 2n o numerach 1, 1, 2, 2, ..., n, n, w której te dwie części są jedną jednostką od siebie, dwie dwie są oddalone o dwie jednostki , a bardziej ogólnie, dwie kopie każdej liczby k są oddalone o k jednostek.

Na przykład:

Langford parowania dla n = 3 jest podana przez sekwencję 2,3,1,2,1,3.

• Co to jest dobry sposób, aby rozwiązać ten problem w haskell lub C
• mogą Państwo zaproponować algorytm rozwiązywać je (Nie chcesz używać brutalnej siły)?

-------------------------- EDYCJA ---------------- ------
Jak możemy zdefiniować reguły matematyczne umieścić @ kodu Rafe w Haskell

Answer 1

chcesz znaleźć zadanie do zmiennych {p1, p2, ..., pn} (gdzie pi to położenie pierwszego wystąpienia 'I') z następującymi ograniczeniami posiadających na każdym pi:

• PI 1 .. (1 + Ni)
• czy pi = k następnie forall pj gdzie j = i
• pj = k
• pj = k + i
• pj = k -!!!!! J
• pj = k + i - j

Potrzebujesz sensownej strategii wyszukiwania tutaj. Dobrym wyborem jest, aby w każdym punkcie wyboru wybrać pi z najmniejszym możliwym zestawem możliwych wartości.

Pozdrawiam!

[EDIT:. Drugi dodatek]

Jest to „przede wszystkim funkcjonalna” wersja bezwzględnej wersji po raz pierwszy napisał (patrz pierwszy załącznik poniżej). Jest on w większości funkcjonalny w tym sensie, że stan związany z każdym wierzchołkiem w drzewie wyszukiwania jest niezależny od wszystkich innych stanów, dlatego nie ma potrzeby stosowania takiego śladu czy maszyny. Jednak użyłem imperatywnego kodu do implementacji konstrukcji każdego nowego zestawu domen z kopii zestawu domeny nadrzędnej.

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:. Pierwszy dodatek]

postanowiłem napisać program C#, aby rozwiązać problemy Langford. Działa bardzo szybko aż do n = 16, ale potem trzeba go zmienić, aby używać długich, ponieważ reprezentuje domeny jako wzorce bitowe.

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<int> T = new List<int> { }; 

     // 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<int>(); 
      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; 
      } 
     } 
    } 
} 

Answer 2

Nie mogłem się oprzeć. Oto mój port kodu Rafe'a do Haskella:

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*n-i-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, k-j-1, k+i-j]) d 

pairingToList :: Int -> Pairing -> [Int] 
pairingToList n = elems . array (1, 2*n) . concatMap positions 
    where positions (i, k) = [(k, i), (k+i+1, i)] 

Wydaje się działać całkiem nieźle.Oto niektóre z synchronizacją 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) 

Answer 3

Ponieważ sekwencje Langford są zwykle generowane dla małej liczby całkowitej n używam bogosort dla tego programu i obejmować sprawdzenie za każdym razem jest bogosorted. Kiedy sprawdzanie się zakończy, skończę.

Na przykład, n = 3:

• Tworzenie tablicę liczb 2n. Tablica będzie wyglądać mniej więcej tak: 1 2 3 1 2 3
• Zatrudniać prostą pętlę dla bogosort i zawierać za każdym razem kontrolę, która jest dość łatwa.
• Jeśli kontrola się powiedzie, tablica poda ci sekwencję Langforda.

To zadziała szybko dla małych liczb całkowitych, ponieważ liczba możliwych permutacji wynosi n!, tutaj: 3 * 2 * 1 = 6.