我有下面的代码,使用Weisfeiler-Lehman isomorphism test来确定两个图是否同构。我知道没有已知的多项式时间算法来最终确定两个图是否同构,但是为了这个练习的目的,这是无关紧要的。
iso :: (Ord a, Ord b, Hashable a, Hashable b) => [a] -> [(a, a)] -> [b] -> [(b, b)] -> Bool
iso v1 e1 v2 e2 = m == n && go 0 Map.empty Map.empty [] []
where
ug1 = Map.unionWith (++) (Map.fromList $ map (, []) v1) (buildUG e1)
ug2 = Map.unionWith (++) (Map.fromList $ map (, []) v2) (buildUG e2)
m = length v1
n = length v2
-- Find old label.
oldLabel = flip (Map.findWithDefault 1)
-- Given the neighbors and old labels, compute new label.
label l = H.hash . L.sort . map (oldLabel l)
canonical = L.sortBy (compare `F.on` fst) . map (head &&& length) . L.group
go :: forall a b. Int -> Map a Int -> Map b Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
go i l1 l2 c1 c2
| i > n = False
| otherwise = do
let xs = map (label l1 . neighbors ug1) v1
let l1' = Map.fromList $ zip v1 xs
let ys = map (label l2 . neighbors ug2) v2
let l2' = Map.fromList $ zip v2 ys
let c1' = canonical xs
let c2' = canonical ys
(c1 == c1' && c2 == c2') || (c1' == c2' && go (i + 1) l1' l2' c1' c2')
字符串Hashable
来自hashable包,buildUG
从边列表构建无向图。
type Graph a = Map a [a]
type Edge a = (a, a)
-- Builds a directed graph.
buildG :: (Ord a) => [Edge a] -> Graph a
buildG = foldr merge Map.empty
where
-- insertWith called with key, f new_value old_value,
-- and new_value is a singleton.
merge (u, v) = Map.insertWith ((:) . head) u [v]
-- Reverses the edges.
reverseE :: [Edge a] -> [Edge a]
reverseE = map (\(u, v) -> (v, u))
-- Builds an undirected graph.
-- Since the graph may contain cycles, make sure
-- to not include the same vertex more than once.
buildUG :: (Ord a) => [Edge a] -> Graph a
buildUG edges = Map.unionWith ((L.nub .) . (++)) g g'
where
g = buildG edges
g' = (buildG . reverseE) edges
neighbors :: (Ord a) => Graph a -> a -> [a]
neighbors = flip (Map.findWithDefault [])
型
以上是一个最小的、可重复的例子。
当函数go
的签名被省略时,问题如下。
• Couldn't match type ‘a’ with ‘b’
Expected: Int
-> Map a Int -> Map b Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
Actual: Int
-> Map a Int -> Map a Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
‘a’ is a rigid type variable bound by
the type signature for:
iso :: forall a b.
...
型
按照建议here,如果我显式指定forall
并启用ScopedTypeVariables
,则在let xs
和let ys
行中会出现新的错误,如下所示:
Couldn't match type ‘a0’ with ‘a1’
Expected: Map a0 Int
Actual: Map a1 Int
• Couldn't match type ‘a0’ with ‘b1’
Expected: Map a0 Int
Actual: Map b1 Int
...
型
我该如何解决此问题?
编辑:
根据要求增加进口。
import Data.Hashable (Hashable)
import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as Map
import Control.Arrow ((&&&))
import qualified Data.Hashable as H
import qualified Data.Function as F
型
2条答案
按热度按时间vddsk6oq1#
使用
ScopedTypeVariables
扩展,您可以给予所有类型的签名,如下所示:1.使
iso
的类型签名为**forall a b.**(Ord a, Ord b) => [a] -> [(a, a)] -> [b] -> [(b, b)] -> Bool
。这里重要的变化是添加了显式的forall
,以便将a
和b
纳入以后的范围。(我还删除了冗余的Hashable a
和Hashable b
,因为您调用H.hash
的唯一类型是[Int]
,但这与您问题中的问题无关。)1.使
go
的类型签名为Int -> Map a Int -> Map b Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
,删除forall a b.
。删除这意味着a
和b
与iso
的类型签名带入作用域的是相同的,而不是新的,这是原始错误的来源。1.如果需要,也可以添加这些类型签名:
字符串
请注意,最后三个函数有时都是以
a
作为类型调用的,有时则是以b
作为类型调用的,因此它们需要是具有新类型的多态函数。(我做了,k
和t
),或者使用另一个显式的forall
。如果你使用a
或b
而不使用forall
,那么它会在一个呼叫点工作但在另一个呼叫点失败。最后一点注意:你也可以选择这两个类型签名:
型
但是,由于
v
在代码中调用这些函数的任何地方都是Int
,并且它们不会导出,因此不需要额外的多态性。jaql4c8m2#
我通过反复试验确定,给
oldLabel
一个显式的类型签名,而不给go
一个类型签名,可以使程序编译:字符串
禁用可怕的单态限制也可以让程序编译,但我有点不知道TDMR在这种特定情况下到底是如何工作的。此外,我不知道什么显式签名适用于
go
。