【问题标题】:Generate all unique directed graphs with 2 inputs to each node生成所有唯一的有向图,每个节点有 2 个输入
【发布时间】:2018-04-14 01:04:54
【问题描述】:

我正在尝试生成所有符合规范的唯一有向图:

  • 每个节点必须恰好有 2 个输入
  • 并且允许任意多个输出到图中的其他节点

我目前的解决方案很慢。例如,对于 6 个节点,算法需要 1.5 天才能到达我认为完成的位置,但可能还要再检查几天。

我的 n 节点图算法:

  1. 生成所有n 长度的0 字符串,其中一个符号是1,例如,对于n=3,[[0,0,1], [0,1,0], [1,0,0]]。这些可以被认为是单位矩阵中的行。

  2. 生成所有可能的n * n矩阵,其中每一行都是step 1. + step 1.的所有可能组合

这是连接矩阵,其中每个单元格代表从column-indexrow-index 的连接

因此,对于 n=3,这些是可能的:

  • [0,1,0] + [1,0,0] = [1,1,0]
  • [1,0,0] + [1,0,0] = [2,0,0]

这些代表节点的输入,通过将步骤 1 添加到自身,结果将始终代表 2 个输入。

例如:

     A B C     
A' [[0,1,1],
B'  [0,2,0],
C'  [1,1,0]]

所以BC 分别连接到AB -> A', C -> A'

B 连接到自己两次:B => B'

  1. 我只想要唯一的,因此对于生成的每个连接矩阵,我只能保留它,如果它不与已经看到的图同构。

这一步很昂贵。我需要通过遍历同构图的每个排列,对它们进行排序,并将第一个视为“规范形式”,将图转换为“规范形式”。

如果有人潜入测试其中的任何一个,这里是 n 节点的唯一图表计数:

2 - 6
3 - 44
4 - 475
5 - 6874
6 - 109,934 (I think, it's not done running yet but I haven't found a new graph in >24 hrs.)
7 - I really wanna know! 

可能的优化:

  1. 既然我要生成要测试的图,有没有办法在不测试的情况下排除它们,因为它们与已经看到的图同构?

  2. 有更快的图同构算法吗? 我认为这个与“Nauty”有关,我在论文中读过其他一些,但我还没有实现它们的专业知识(或带宽)。

这是一个可演示的连接矩阵,可以在 graphonline.ru 上绘制以获取乐趣,显示自身连接以及到同一节点的 2 个连接:

1, 0, 0, 0, 0, 1, 
1, 0, 0, 0, 1, 0, 
0, 1, 0, 1, 0, 0, 
0, 1, 2, 0, 0, 0, 
0, 0, 0, 1, 0, 1, 
0, 0, 0, 0, 1, 0,

如果您想使用它,这里是 haskell 中的代码,但我更关心算法是否正确(例如修剪搜索空间),而不是实现:

-- | generate all permutations of length n given symbols from xs
npermutations :: [a] -> Int -> [[a]]
npermutations xs size = mapM (const xs) [1..size]

identity :: Int -> [[Int]]
identity size = scanl
                (\xs _ -> take size $ 0 : xs)      -- keep shifting right
                (1 : (take (size - 1) (repeat 0))) -- initial, [1,0,0,...]
                [1 .. size-1]                      -- correct size

-- | return all possible pairings of [Column]
columnPairs :: [[a]] -> [([a], [a])]
columnPairs xs = (map (\x y -> (x,y)) xs)
                 <*> xs

-- | remove duplicates
rmdups :: Ord a => [a] -> [a]
rmdups = rmdups' Set.empty where
  rmdups' _ [] = []
  rmdups' a (b : c) = if Set.member b a
    then rmdups' a c
    else b : rmdups' (Set.insert b a) c


-- | all possible patterns for inputting 2 things into one node.
-- eg [0,1,1] means cells B, and C project into some node
--    [0,2,0] means cell B projects twice into one node
binaryInputs :: Int -> [[Int]]
binaryInputs size = rmdups $ map -- rmdups because [1,0]+[0,1] is same as flipped
         (\(x,y) -> zipWith (+) x y)
         (columnPairs $ identity size)

transposeAdjMat :: [[Int]] -> [[Int]]
transposeAdjMat ([]:_) = []
transposeAdjMat m = (map head m) : transposeAdjMat (map tail m)

-- | AdjMap [(name, inbounds)]
data AdjMap a = AdjMap [(a, [a])] deriving (Show, Eq)

addAdjColToMap :: Int -- index
               -> [Int] -- inbound
               -> AdjMap Int
               -> AdjMap Int
addAdjColToMap ix col (AdjMap xs) = 
  let conns = foldl (\c (cnt, i) -> case cnt of
                        1 -> i:c
                        2 -> i:i:c
                        _ -> c
                    ) 
              [] 
              (zip col [0..])  in
    AdjMap ((ix, conns) : xs)

adjMatToMap :: [[Int]] -> AdjMap Int
adjMatToMap cols = foldl 
  (\adjMap@(AdjMap nodes) col -> addAdjColToMap (length nodes) col adjMap)
  (AdjMap [])
  cols

-- | a graph's canonical form : http://mfukar.github.io/2015/09/30/haskellxiii.html
-- very expensive algo, of course
canon :: (Ord a, Enum a, Show a) => AdjMap a -> String
canon (AdjMap g) = minimum $ map f $ Data.List.permutations [1..(length g)]
   where
      -- Graph vertices:
      vs = map fst g
      -- Find, via brute force on all possible orderings (permutations) of vs,
      -- a mapping of vs to [1..(length g)] which is minimal.
      -- For example, map [1, 5, 6, 7] to [1, 2, 3, 4].
      -- Minimal is defined lexicographically, since `f` returns strings:
      f p = let n = zip vs p
            in (show [(snd x, sort id $ map (\x -> snd $ head $ snd $ break ((==) x . fst) n)
                                      $ snd $ take_edge g x)
                     | x <- sort snd n])
      -- Sort elements of N in ascending order of (map f N):
      sort f n = foldr (\x xs -> let (lt, gt) = break ((<) (f x) . f) xs
                                  in lt ++ [x] ++ gt) [] n
      -- Get the first entry from the adjacency list G that starts from the given node X
      -- (actually, the vertex is the first entry of the pair, hence `(fst x)`):
      take_edge g x = head $ dropWhile ((/=) (fst x) . fst) g

-- | all possible matrixes where each node has 2 inputs and arbitrary outs
binaryMatrixes :: Int -> [[[Int]]]
binaryMatrixes size = let columns = binaryInputs size 
                          unfiltered = mapM (const columns) [1..size] in
  fst $ foldl'
  (\(keep, seen) x -> let can = canon . adjMatToMap $ x in
                        (if Set.member can seen 
                         then keep
                         else id $! x : keep
                        , Set.insert can seen))
  ([], Set.fromList [])
  unfiltered

【问题讨论】:

  • 节点自己可以有边吗?一个节点可以有 2 条边到同一个其他节点吗?
  • @Cirdec 是的,也许我的解释不够,但一个节点可以连接到自己或任何其他节点两次。
  • 通过出度序列生成它们会消除一堆同构。
  • @Cirdec 你能澄清一下吗?如果我理解的话,我是按入度生成的,但是出度的可变性可能要大得多(因为 in=2,out=arbitrary),所以我猜出度会更贵。跨度>
  • 我无法很好地阅读 Haskell,无法确定,但您对规范检查的描述表明它仅与 nauty 的算法松散相关。本质上你是说en.wikipedia.org/wiki/Bogosort 与快速排序有关:)

标签: algorithm haskell graph graph-theory digraphs


【解决方案1】:

您可以尝试多种方法。我确实注意到的一件事是,具有多边的循环(彩色循环?)有点不寻常,但可能只是需要改进现有技术。

过滤另一个程序的输出

这里明显的候选者当然是 nAUTy/traces (http://pallini.di.uniroma1.it/) 或类似的(saucy、bliss 等)。根据您的操作方式,它可能很简单,例如运行 nauty(例如)并输出到文件,然后随时读取列表过滤。

对于较大的 n 值,如果您正在生成大文件,这可能会开始成为问题。我不确定您是否在时间用完之前开始用完空间,但仍然如此。可能更好的是在你去的时候生成和测试它们,扔掉候选人。出于您的目的,可能有一个用于生成的现有库 - 我找到了 this one,但我不知道它有多好。

使用图形不变量

更有效地列出图表的一个非常简单的第一步是使用graph invariants 进行过滤。一个明显的例子是degree sequence(图中度数的有序列表)。其他包括周期数、周长等。出于您的目的,您可能会使用一些入度/出度序列。

基本思想是使用不变量作为过滤器来避免昂贵的同构检查。您可以存储已生成图形的 (list of ) 不变量,并首先根据列表检查新的不变量。结构的规范形式是一种不变量。

实现算法

GI 算法丢失了,包括 nauty 和朋友使用的算法。但是,它们确实往往非常困难! this answer 中给出的描述是一个很好的概述,但魔鬼当然在细节中。

另请注意,描述是针对一般图表的,而您有一个特定的图表子类,可能更容易生成。那里可能有用于有向图列表(生成)的论文,但我没有检查。

【讨论】:

    猜你喜欢
    • 2018-07-13
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-01-26
    • 2011-04-27
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多