Langford序列实现Haskell或C.

时间:2011-04-27 19:49:10

标签: c algorithm math haskell combinatorics

在组合数学中,Langford pairing,也称为Langford序列,是2n个数1, 1, 2, 2, ..., n, n序列的排列,其中两个分开一个单位,两个二进制数是两个单位,更常见的是每个数字k的两个副本是k个单位。

例如:

n = 3的Langford配对由序列2,3,1,2,1,3.

给出
  • haskellC
  • 中解决此问题的好方法是什么?
  • 你能建议一个算法来解决它(不想使用蛮力)?

-------------------------- EDIT ----------------- -----
我们如何定义数学规则以将@ Rafe的代码放入haskell

3 个答案:

答案 0 :(得分:7)

你想找到变量{p1,p2,...,pn}的赋值(其中pi是第一次出现'i'的位置),每个pi都有以下约束:

  • pi in 1 ..(1 + n-i)
  • 如果pi = k那么forall pj其中j!= i
  • pj!= k
  • pj!= k + i
  • pj!= k - j
  • pj!= k + i - j

您需要一个合理的搜索策略。一个很好的选择是在每个选择点选择具有最小剩余可能值的pi。

干杯!

[编辑:第二个附录。]

这是我第一次写的命令式版本的“功能主要”版本(参见下面的第一个附录)。在与搜索树中与每个顶点相关联的状态独立于所有其他状态的意义上,它主要是功能性的,因此不需要那种跟踪或机制。但是,我使用命令式代码从父域集的副本实现每个新域集的构造。

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

[编辑:第一个附录。]

我决定编写一个C#程序来解决Langford问题。它运行得非常快,直到n = 16,但此后你需要将其更改为使用long,因为它将域表示为位模式。

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;
            }
        }
    }
}

答案 1 :(得分:2)

我无法抗拒。这是我对Haskell的Rafe代码的端口:

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)]

它看起来效果很好。以下是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)

答案 2 :(得分:0)

由于Langford序列通常是为一个小整数 n 生成的,所以我在这个程序中使用了bogosort,并在每次bogosorted时都包含一个检查。检查完成后,我已经完成了。

例如, n = 3:

  • 为2n个数字创建一个数组。数组将是这样的:1 2 3 1 2 3
  • 为bogosort使用一个简单的循环,并且每次都包含一个非常简单的检查。
  • 如果检查成功,阵列将为您提供Langford序列。

这只适用于小整数,因为可能的permutaions数是 n!,这里:3 * 2 * 1 = 6.