Implementación de secuencia de Langford Haskell o C

Question

En matemáticas combinatorias, Langford pairing, también llamada secuencia de Langford, es una permutación de la secuencia de 2n números 1, 1, 2, 2, ..., n, n en la que las dos están separadas por una unidad, las dos son dos unidades separadas , y más generalmente, las dos copias de cada número k están separadas en k unidades.

Por ejemplo:

Langford emparejamiento durante n = 3 está dada por la secuencia 2,3,1,2,1,3.

• ¿Qué es un buen método para resolver esto en haskell o C
• puede sugerir un algoritmo para resolverlo (No quiero usar la fuerza bruta)?

-------------------------- EDIT ---------------- ------
¿Cómo podríamos definir las reglas matemáticas para poner @ código de Rafe en Haskell

Answer 1

Usted quiere encontrar una asignación a las variables {p1, p2, ..., pn} (donde pi es la posición de la primera aparición de 'i') con las siguientes limitaciones que llevan a cabo para cada pi:

• pi en 1 .. (1 + ni)
• si pi = k entonces forall pj donde j = i
• pj = k
• pj = k + i
• pj = k -!!!!! J
• pj = k + i - j

Necesita una estrategia de búsqueda sensata aquí. Una buena opción es seleccionar en cada punto de elección el pi con el conjunto de valores posibles más pequeño restante.

¡Salud!

[EDIT:. Segunda adenda]

Ésta es una versión "sobre todo funcional" de la versión imperativa escribí por primera vez (véase la primera adenda a continuación). Es principalmente funcional en el sentido de que el estado asociado con cada vértice en el árbol de búsqueda es independiente del resto del estado, por lo tanto, no hay necesidad de un camino o maquinaria de ese tipo. Sin embargo, he usado el código imperativo para implementar la construcción de cada nuevo conjunto de dominios a partir de una copia del conjunto de dominios padre.

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:. Primera adenda]

decidí escribir un programa en C# para resolver problemas Langford. Funciona muy rápido hasta n = 16, pero a partir de entonces debe cambiarlo para usar longs ya que representa dominios como patrones de bits.

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

No pude resistirme. Aquí está el código de mi puerto de Rafe para 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*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)] 

Parece que funciona bastante bien.Estas son algunas de temporizaciones de 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

Como las secuencias Langford normalmente se generan para un pequeño número entero n, utilizo stupid sort para este programa e incluyen un cheque cada vez que se bogosorted. Cuando se completa el control, he terminado.

Por ejemplo, con n = 3:

• crear una matriz para los números de 2n. La matriz sería algo como esto: 1 2 3 1 2 3
• Emplea un bucle simple para bogosort e incluye un control cada vez que es bastante fácil.
• Si la comprobación es correcta, la matriz sería darle la secuencia Langford.

Esto funcionará rápido solo para enteros pequeños ya que el número de permutaciones posibles es n!, aquí: 3 * 2 * 1 = 6.