平面グラフの直交表現を生成するプログラムを作成します。この仕事では、GHC6.10.1を使用します。私のコードはFGLライブラリに基づいています。グラフ構造を維持するために使用します。
最近、説明できないエラーを見つけました。私のプログラムのコンテキストジョブを削除する場合は、次のようにします。
main = let g = insEdge（0,1、（））$ buildGr [（[]、0、（）、[]）、（[]、1、（）、[]）]
g'= delEdge（0,1）g
in if 1 `elem` suc g 0
次にputStrLn"OK"
それ以外の場合、putStrLn "ERROR"
このプログラムは「OK」を出力する必要がありますが、結果は「ERROR」です。
詳細はこちらです。関数prepareDataは、ヘルプエッジのあるグラフを取得します。Data BlockSchemeは、それらをリストcyclesInfoBSに保持します。これらのエッジには、関数dualGraphのアルゴリズムが必要です。
関数prepareGは、これらのエッジを削除したグラフから新しいグラフを作成します。また、embeddedBSG変数の値はどこでも同じである必要があります。
ただし、dualGraphが機能するとエラーが発生します。内部をトレースすると、グラフにはヘルプエッジ（2,1）がありませんが、dualGraphを呼び出す前に、そのグラフ引数にヘルプエッジがあります。dualGraphのモジュールには、delEdge、delEdge、delNodes、delNodeのいずれも含まれておらず、これを行う関数を呼び出していません。dualGraphのモジュールは、グラフ変数のみを読み取ります。
コメントコードがヘルプエッジを削除する場合、それらは残ります。
dualGraphの前のグラフの状態：
__ + embeddedBSG =
0：NodeLabel {typeLabel =ターミネーター、sizeLabel =（30.0,10.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}-> [（（1,3）、3）]
1：NodeLabel {typeLabel =ターミネーター、sizeLabel =（30.0,10.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}-> []
2：NodeLabel {typeLabel = HelpNode、sizeLabel =（0.0,0.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}-> [（（2,0）、1）]
3：NodeLabel {typeLabel = IfWhBlock、sizeLabel =（30.0,20.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}-> [（（1,0）、2）、（（2,2）、1 ）、（（0,1）、4）]
4：NodeLabel {typeLabel = OpBlock、sizeLabel =（30.0,20.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}-> [（（0,1）、2）]
グラフの状態をDualGraphモジュールに：
0：（0.0、NodeLabel {typeLabel =ターミネーター、sizeLabel =（30.0,10.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}）-> [（（1,3）、3）]
1：（30.0、NodeLabel {typeLabel =ターミネーター、sizeLabel =（30.0,10.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}）-> []
2：（45.0、NodeLabel {typeLabel = HelpNode、sizeLabel =（0.0,0.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}）-> []
3：（15.0、NodeLabel {typeLabel = IfWhBlock、sizeLabel =（30.0,20.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}）-> [（（2,2）、1）、（（1、 0）、2）、（（0,1）、4）]
4：（35.0、NodeLabel {typeLabel = OpBlock、sizeLabel =（30.0,20.0）、textLabel =（）、foregroundLabel = 0x000000、backgroundLabel = 0xFFFFFF}）-> [（（0,1）、2）]
allEdges：= [（OutEdge、（2、（0,1）））、（InEdge、（3、（0,1）））]
2番目の状態のノード2には、発信エッジがありません。
DualGraphの関数lSortSucでエラーが検出される場所があります。
lSortSucvertexIdグラフ=....これには、vertexIdが少なくとも1つの入力エッジと1つの出力エッジを持っているか、シンクノードである頂点が必要です。この場合、シンクノードは1です。
次に、ノード2のヘルプエッジがないグラフに対して、lSortSucがまだどこかで呼び出されていると想定できます。しかし、それは正しくありません。
誰かアイデアはありますか？私に何ができる？
タイプBlockSchemeGraph=Gr NodeLabel（）
データCycleInfo=
CycleInfo {
reverseEdge :: Edge、
helpEdge::エッジ
}導出（Show、Eq）
data BlockScheme = BlockScheme {graphBS :: BlockSchemeGraph、
cycleInfoBS :: [CycleInfo]、
generalSchemeOptionsBS ::（）、
backBonesBS::[[ノード]]
}導出（Show、Eq）
prepareData bs =
bsg=graphBSbsとします
[シンク、ソース]=マップヘッド$pam bsg [getSinks、getSources]
[helpNode] = newNodes 1 bsg
helpEdges = [（source、helpNode）、（helpNode、sink）]
bsg'= insEdges [（a、b、（））| （a、b）（l、0.0））
-ここでヘルプエッジが削除されます
$ foldr（\ cinf g-> delEdge（helpEdge cinf）g）
（トレース（ "\ n \ nembG =" ++ show embG）embG）
CyclesInfo
f（v、高さ）g =
fsuc（w、（order、weight））g =
setELabel'（v、w）（order、weight + height / 2）g
fpre（w、（order、weight））g =
setELabel'（w、v）（order、weight + height / 2）g
g'= foldr fsuc g $ lsuc gv
フォルダー内fpreg'$lpre g'v
emapで（\（order、weight）->（order、{-round-} weight））
。foldr f embG '
。マップ（\ n->（n、snd。sizeLabel$ getVLabel n embG））
$ノードembG
-------------------------------------------------- ---------------------
{-＃LANGUAGE ScopedTypeVariables＃-}
モジュールGraphVisualiser
#if defined（MYDEBUG）
＃そうしないと
（visualiseScheme、BlockSchemeImage）
#endif
どこ
SimpleUtilのインポート（map2、swap、pam、vopt、compareDouble）
Data.Maybeをインポートします（fromJust、isJust）
Data.Listをインポートします（foldl'、find、nubBy、deleteFirstsBy、maximumBy）
修飾されたData.Mapをマップとしてインポートします
インポートSchemeCompiler
InductivePlusをインポートする
GraphEmbedderをインポートする
DualGraphをインポートする
TopologicalNumberingをインポートする
Text.Printf（printf）をインポートします
Debug.Traceをインポートします
タイプNodePosition=（Double、Double）
タイプEdgePosition=[NodePosition]
タイプBSIG=Gr（NodePosition、NodeLabel）EdgePosition
newtype BlockSchemeImage =BlkScmImgBSIG派生式
getWeight = fst
visualiseScheme :: BlockScheme-> BlockSchemeImage
visualiseScheme bs =
let（numEmbBsg、numDualBsg、emf、nmf、source、sink）= prepareData bs
xCoords = map（calcXForBackBone（numEmbBsg、numDualBsg、emf、nmf））$ backBonesBS bs
calcedNodes = calcNodePositions numEmbBsg numDualBsgnmfemfソースシンクxCoords
calcedEdges = calcEdgePositions numEmbBsg numDualBsgnmfemfソースシンクcalcedNodesxCoords
scaledG = scaleGraph calcedEdges
-
g'= reverseFeedBacks scaledG $ CyclesInfoBS bs
BlkScmImgg'で---calcedEdges
calcXForBackBone（numEmbBsg、numDualBsg、emf、nmf）idsOfNodes =
-
let（_、（xleft、xright））=
maximumBy（\（v1、（xleft1、xright1））（v2、（xleft2、xright2））->
比較（xright1-xleft1）（xright2-xleft2））
$ map（\ v->（v、fidsToWeights numDualBsg $ Map.lookup v nmf））
idsOfNodes
in（（xright + xleft）/ 2.0、idsOfNodes）
--g :: Gr（NodePosition、NodeLabel）[NodePositions]
reverseFeedBacks g CyclesInfo = foldr fEdge gcyclesInfo
ここで、fEdge cinfo g =
elbl=getELabelなどとします。
e = reverseEdge cinfo
（v、w）= e
g'= delEdge eg
insEdge（w、v、reverse elbl）g '
calcEdgePositions numEmbBsg numDualBsgnmfemfソースシンクcalcedNodesbackBones=
fEdge e @（v、w）g =
xOfe = case find（\（x、lst）->
if v `elem` lst && w` elem` lst
次にTrue
それ以外の場合はFalse
）backBones of
何もない->halfSumEdgenumDualBsg emf e
ちょうど（x、_）-> x
[startY、endY] = map（\ n-> getWeight $ getVLabel n numEmbBsg）[v、w]
coords = [（xOfe、startY）、（xOfe、endY）]
g'= setELabel'（v、w）座標g
トレース内（ "\ n \ ncoords =" ++ show coords ++ "\ ncalc edge" ++ show（v、w）++ "\ nemf ="
++ show emf ++ "\ nnmf =" ++ show nmf
++ "\ nnumDualBsg =" ++ show numDualBsg
++ "\ nnumEmbBsg =" ++ show numEmbBsg）
g '
outEdgesOfSource = map fst $ lSortSuc numEmbBsg source
inEdgesOfSink = map fst $lSortPrenumEmbBsgシンク
fixFouthEdgeLbl v lst yModifier g =
のケースlst
[_]-> g
[_、_]->（trace "\ nFixFouth \ n" g）
[_、_、_]-> g
[_、_、_、w]->
let [（x1、y1）、p2] = getELabel（v、w）g
（xv、yv）= fst $ getVLabel vg
setELabel'（v、w）
[（xv、yModifier y1）、（x1、yModifier y1）、p2]
g
_->エラー$"visualiseScheme.fixFouthEdgeLbl：lstに4つを超えるエッジがあります!!! \ n"
++ show lst
calcedUsualEdges = foldr fEdge
calcedNodes
$エッジcalcedNodes
calcedAll = fixFouthEdgeLblシンクinEdgesOfSink（+1）
$ fixFouthEdgeLbl source outEdgesOfSource（\ a-> a-1）calcedUsualEdges
トレース内（ "\ ncalcedAll =" ++ show calcedAll）calcedAll
scaleGraph g =
させて
係数=3.0
marginLT = 10
modifyCoord =（marginLT +）。（*ファクター）-marginLeftиmarginTop
modifyCoords a =map2modifyCoord。vopt（-）a $ minCoordinates g
emapで（map modifyCoords）
$ nmap（\（coords、lbl）->（modifyCoords coords、lbl））
g
prepareData bs =
bsg=graphBSbsとします
[シンク、ソース]=マップヘッド$pam bsg [getSinks、getSources]
[helpNode] = newNodes 1 bsg
helpEdges = [（source、helpNode）、（helpNode、sink）]
bsg'= insEdges [（a、b、（））| （a、b）（l、0.0））
$ foldr（\ cinf g-> {-g）---} delEdge（helpEdge cinf）g）
（トレース（ "\ n \ nembG =" ++ show embG）embG）
CyclesInfo
f（v、高さ）g =
fsuc（w、（order、weight））g =
setELabel'（v、w）（order、weight + height / 2）g
fpre（w、（order、weight））g =
setELabel'（w、v）（order、weight + height / 2）g
g'= foldr fsuc g $ lsuc gv
フォルダー内fpreg'$lpre g'v
emapで（\（order、weight）->（order、{-round-} weight））
。foldr f embG '
。マップ（\ n->（n、snd。sizeLabel$ getVLabel n embG））
$ノードembG
prepareDualG dg g =
dg'= emap（\ lbl->（lbl、0.0））dg
widthElement v sucOrPre =
width=fstとします。sizeLabel $ getVLabel vg
幅/（fromIntegral。length$ sucOrPre gv）
-ノードは面です
fNodes v（dg :: Gr Face（Edge、Double））=
fEdge（w、（orig @（origV、origW）、weight））dg =
wV = widthElementorigVlsucとします
wW = widthElement origW lpre
setELabel'（v、w）（orig、weight + wV + wW）dg
発信::[（Node、（Edge、Double））]
発信=lsucdg v
フォルダー内fEdgedg発信
emapで（\（e、weight）->（e、{-round-} weight））
。foldr fNodes dg '
$ノードdg
calcNodePositions numEmbBsg numDualBsgnmfemfソースシンクbackBones{-::[（Double、[Node]）-} =
let fNode v（g :: Gr（NodePosition、NodeLabel）[NodePosition]）=
v==ソースの場合--s
次に、calcSorT v id g lSortSuc numEmbBsg numDualBsg emf backBones
それ以外の場合、v==シンク--t
次に、calcSorT v swap g lSortPre numEmbBsg numDualBsg emf backBones
それ以外の場合は、vlbl = getVLabel v numEmbBsg
xCoord =ケース検索（\（x、lst）->
v`elem`lstの場合
次にTrue
それ以外の場合はFalse
）backBones of
なし->halfSumNodenumDualBsg nmf v
ちょうど（x、_）-> x
setVLabel'v（（xCoord、getWeight vlbl）、snd vlbl）g
g':: Gr（NodePosition、NodeLabel）[NodePosition]
g'= emap（\ _-> []）$ nmap（\（weight、lbl）->（（0.0,0.0）、lbl））
numEmbBsg
結果::Gr（NodePosition、NodeLabel）[NodePosition]
結果=foldrfNode
g '
$ノードnumEmbBsg
結果として
calcSorT vセレクター（g :: Gr（NodePosition、NodeLabel）[NodePosition]）edgeSelector numEmbBsg numDualBsg emf backBones =
calcSTDegree4 w =
let（weight、vlbl）= getVLabel v numEmbBsg
in setVLabel'v（（halfSumEdge numDualBsg emf $セレクター（v、w）、
重さ ）、
vlbl）
g
マップfst$edgeSelectornumEmbBsgvの場合
[]->エラー$"calcSorT：ノード" ++ show v
++ "sucエッジがありません！\ nグラフ：\ n" ++ show g
++ "\ nnumEmbBsg = \ n" ++ show numEmbBsg
[w]-> let（weight、vlbl）= getVLabel v numEmbBsg
xCoord =ケース検索（\（x、lst）->
v`elem`lstの場合
次にTrue
それ以外の場合はFalse
）backBones of
なし->halfSumEdgenumDualBsg emf $セレクター（v、w）
----- halfSumNode numDualBsg nmf v
ちょうど（x、_）-> x
setVLabel'v（（xCoord、weight）、vlbl）
g
[w1、_]-> let（weight、vlbl）= getVLabel v numEmbBsg
in setVLabel'v（（snd .fidsToWeights numDualBsg
$ Map.lookup（selector（v、w1））emf、
重さ）、
vlbl
）。
g
[_、w、_]-> calcSTDegree4 w
[_、w、_、_]-> calcSTDegree4 w
moreEdges->エラー$"calcSorT：node" ++ show v ++ "has got too may edge！：\ n"
++ show moreEdges ++ "\ nGraph：" ++ show g
++ "\ nnumEmbBsg =" ++ show numEmbBsg
---fidsToWeights::たぶんEdgeFaces->NodePosition
fidsToWeights numDualBsg = map2（\ fid-> getWeight $ getVLabel fid numDualBsg）。fromJust
halfSum numDualBsg fids =（uncurry（+）（fidsToWeights numDualBsg fids）/ 2.0）:: Double
halfSumNode numDualBsg nmf v =（halfSum numDualBsg）$ Map.lookup v nmf
halfSumEdge numDualBsg emf e =（halfSum numDualBsg）$ Map.lookup e emf
-------------------------------------------------- ---------------------
モジュールDualGraph
#if defined（MYDEBUG）
＃そうしないと
（dualGraph、Face（..）、leftFace、rightFace、FaceId、EdgeFaces、EdgeMapFaces、NodeMapFaces、DualGraph、lSortSuc、lSortPre）
#endif
どこ
修飾されたData.SetをSetとしてインポートします
修飾されたData.Mapをマップとしてインポートします
Data.Maybeをインポートします（fromJust、isJust）
SimpleUtil（apa、swap、map2）をインポートします
Data.Listのインポート（foldl'、sortBy、find）
InductivePlusをインポートする
GraphEmbedderをインポートする
Debug.Traceをインポートします
タイプFaceId=Int
タイプEdgeFaces=（FaceId、FaceId）
タイプEdgeMapFaces=Map.Map Edge EdgeFaces
タイプNodeMapFaces=Map.Map Node EdgeFaces
leftFace :: EdgeFaces-> FaceId
leftFace = fst
rightFace :: EdgeFaces-> FaceId
rightFace = snd
data Face = Face {sourceNode、sinkNode :: Node、
leftContour、rightContour :: Set.Set Edge --- [Node]、
} |
OuterFace {
leftContour、rightContour :: Set.Set Edge --- [Node]、
}導出（Show、Eq）
nodePathToEdgePath :: Ord a => [a]-> Set.Set（a、a）
nodePathToEdgePath（h：rest）=Set.fromList。snd
$ foldl'（\（current、result）next->
（次、（現在、次）：結果））
（h、[]）
残り
newFace src leftC rightC =
Face {sourceNode = src、
シンクノード=最後のleftC、
leftContour = nodePathToEdgePath $ src：leftC、
rightContour = nodePathToEdgePath $ src：rightC-、
}
newOuterFace embG edgeSelector slotModifier =
ケースフィルター（\ v-> null $ lpre embG v）$ノードembG of
[]->エラー$"newOuterFace：グラフにソース頂点がありません\ n"
++ show embG
[v]-> slotModifier emptyOuterFace
。nodePathToEdgePath
$ findContour v
sourceVertexes->
エラー$"newOuterFace：グラフに複数のソース頂点があります："
++ show sourceVertexes
++ "\ nグラフ：\ n" ++ show embG
どこ
emptyOuterFace = OuterFace {leftContour = Set.empty、
rightContour = Set.empty
}
findContour v =
ケースlSortSucembGv of
[]-> [v]
someEdges-> v：（findContour。fst$ edgeSelector someEdges）
setRightContour face con = face {rightContour = con}
setLeftContour face con = face {leftContour = con}
タイプDualGraph=Gr Face Edge
dualGraph :: BlockSchemeEmbeddedGraph->（DualGraph、EdgeMapFaces、NodeMapFaces）
checkm msg g = if 1 `notElem` suc g 2
次にエラー$"\ncheckm：" ++ msg ++ "\ nthe G =" ++ show g
else trace（ "\ n \ nsuc g 2 =" ++ show（suc g 2））g
dualGraph embGr =
let embG = checkm "dualGraph：" embGr
normalFaces=snd。foldr（findFaces embG）
（2、buildGr []）--- Map.empty）
$ノードembG
sFace =newOuterFaceembGヘッドsetRightContour
tFace = newOuterFace embG last setLeftContour
allFaces = insNodes [（0、sFace）、（1、tFace）]通常のFaces
allNodes = map（\ n->（n、getVLabel n allFaces））
$ノードallFaces
linkedFaces=フォルダリンケージ
allFaces
[（f1、f2）| f1 @（fid1、_）fid1
]
emf = foldr（\（fid、f）m->コームを楽しくするconSel m = Set.fold（\ em-> Map.insertWith fun
e
（fid、fid）
m）
m
$ conSel f
くしで（\（_、r）（l、_）->（l、r））
leftContour
$くし（\（l、_）（_、r）->（l、r））
rightContour
m
）。
Map.empty
allNodes
fNMF nm = let（lFace、rFace）= case lSortSuc embG n of
[]-> ls = lSortPreembGnとします
lFace = leftFace
。fromJust
$ Map.lookup（fst $ head ls、n）-最後のls、n）
emf
rFace = rightFace
。fromJust
$ Map.lookup（fst $ last ls、n）-head ls、n）
emf
in（lFace、rFace）
ls-> let lFace = leftFace
。fromJust
$ Map.lookup（n、fst $ head ls）
emf
rFace = rightFace
。fromJust
$ Map.lookup（n、fst $ last ls）
emf
in（lFace、rFace）
Map.insert n（lFace、rFace）m
nmf = foldr fNMFMap.empty$ノードembG
トレース内（ "\ nDualGrapn：（linkedFaces、emf、nmf）\ n" ++ show（linkedFaces、emf、nmf））（linkedFaces、emf、nmf）
findFaces embG v st =
ケースマップfst$lSortSuc（checkm "findFaces：" embG）v of
[]->st--вершинанеможетобразоватьгрань
[_]-> st
（firstOut：outgoing）-> snd $ foldl'（findFace embG v）
（firstOut、st）
発信
データEdgeType=InEdge | OutEdgeの導出（Show、Eq）
lSortEdges gren v =
let g = trace（ "\ nlSortEdges：g =" ++ show gren）（checkm（ "lSortEdges：v =" ++ show v）gren）
getEdgeNumber（OutEdge、（_、（n、_）））= n
getEdgeNumber（InEdge、（_、（_、n）））= n
oute = lsuc gv
ine = lpre gv
allEdges = sortBy（apa compare getEdgeNumber）
$ concat [map（\ lbl->（OutEdge、lbl））oute、
マップ（\ lbl->（InEdge、lbl））ine]
cAllEdges=サイクルallEdges
zeroEdge = head（trace（ "allEdges：=" ++ show allEdges）allEdges）
spanE e = span（（e ==）。fst）
outEdges = case fst zeroEdge of
OutEdge->fst。spanE OutEdge
。snd。spanE InEdge
。snd $ spanE OutEdge cAllEdges
_->fst。spanEOutEdge。snd $ spanE InEdge cAllEdges
inEdges = case fst zeroEdge of
InEdge->fst。spanE InEdge
。snd。spanE OutEdge
。snd $ spanE InEdge cAllEdges
_->fst。spanEInEdge。snd $ spanE OutEdge cAllEdges
nullineの場合|| null oute
次に、[sv] =getSourcesgとします。
findContour prew w =
w /=vの場合
次にfindContour（ちょうどw）。fst。head $（trace（ "\ n \ nlSortSuc gw =" ++ show w
++ "lsortSuc =" ++ show（lSortSuc gw））
（lSortSuc gw））
そうでなければprew
wOfFirstEdge = fromJust $ findContour Nothing sv
sine = sortBy（apa notCompare（snd。snd））ine
（beforeW、withW）= span（（wOfFirstEdge / =）。fst）sine
in（sortBy（apa compare（fst .snd））oute、
withW ++ sortBy（apa compare（snd .snd））beforeW
）。
else map2（map snd）
（outEdges、inEdges）
ここで、notCompare ab = case compare ab of
EQ-> EQ
LT-> GT
GT-> LT
lSortPre gv = let res = snd $ lSortEdges gv in
trace（ "\ n \ nlSortPre（" ++ show v ++ "）=" ++ show res）res
lSortSuc gv = let res = fst $ lSortEdges gv in
trace（ "\ n \ nlSortSuc（" ++ show v ++ "、g =" ++ show g ++ "）=" ++ show res）res
findFace embG v（wi、st @（freeFID、mf））wj =
findContour vw pStop selectEdge =
let preEdges = lSortPre（checkm（ "findFace：v =" ++ show v ++ "wi ="
++ show wi ++ "v =" ++ show v
++ "w =" ++ show w ++ "wj ="
++ show wj）embG）w
sucEdges = lSortSuc embG w
nextW = selectEdge sucEdges
res = if null sucEdges || （not（null preEdges）&& pStop v preEdges）-wはtノードです
次に[w]
else w：findContour w nextW pStop selectEdge
トレース内（ "findContour：v =" ++ show v ++ "w =" ++ show w ++ "suc =" ++ show sucEdges ++ "pre =" ++ show preEdges）
res
leftCon = findContour v wi
（\ v->（v / =）。fst。head）-last）
（fst .last）
rightCon = findContour v wj
（\ v->（v / =）。fst。last）-head）
（fst .head）
tr = trace（ "\ nfindFace v =" ++ show v ++ "wi =" ++ show wi ++ "wj =" ++ show wj ++ "freeFID =" ++ show freeFID）
leftCon
res =（wj、（freeFID + 1、
insNode（freeFID、newFace v tr rightCon）mf
）。
）。
トレース内（ "\ nfindFace：" ++ show res）res
リンケージ（（fid1、f1）、（fid2、f2））g =
getC f =（leftContour f、rightContour f）
[（lc1、rc1）、（lc2、rc2）] = map getC [f1、f2]
foldIntersectionresセレクター=
let（ff1、ff2）=セレクター（fid1、fid2）in
foldr（\ e @（v、w）g-> insEdge（ff1、ff2、e）g）
g
res
Set.toList $ lc1`Set.intersection`rc2の場合
[]->
case Set.toList $ rc1 `Set.intersection` lc2 of
[]-> g
--изf2×f1
res-> foldIntersection res id
res-> foldIntersection res swap