22/07/18 Reduce : checkCReduce() の実装1

ver4src/app/Reduce.hs

@@ -15,6 +15,7 @@ import ReLibStrip      ( getEdgeNo )
 import ReLibAngles     ( findAngle )
 import ReLibFindlive   ( findLive )
 import ReLibUpdateLive ( updateLive )
+import ReLibCRedu      ( checkCReduce )
 
 
 main :: IO ()
@@ -52,7 +53,7 @@ mainLoop gConfs
   --print contract2
 
   -- 3. findlive()
-    ncodes = (power !! ring + 1) `div` 2       -- number of codes of colorings of R
+    ncodes = (power !!  ring      + 1) `div` 2 -- number of codes of colorings of R
     bigno  = (power !! (ring + 1) - 1) `div` 2 -- needed in "inlive"
     live0  = replicate ncodes 1
   (nlive1, live1) <- findLive ring bigno live0 ncodes angle power (gConf !! 1 !! 2)
@@ -66,7 +67,14 @@ mainLoop gConfs
   -- 5. checkContract()
   {- This verifies that the set claimed to be a contract for the
     configuration really is. -}
-  --checkContract live2 nlive2 diffangle sameangle contract
+  if nlive2 == 0 then
+    if contract !! 0 == 0 then
+      -- D可約 のときは、checkCReduce() を呼ばない
+      return True
+    else
+      error "         ***  ERROR: CONTRACT PROPOSED  ***\n\n"
+  else
+    checkCReduce ring bigno nlive2 live2 diffangle sameangle contract
 
   -- 6 . recursion
   -- mainLoop $ tail gConfs

ver4src/src/ReLibCRedu.hs

@@ -0,0 +1,32 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use head" #-}
+module ReLibCRedu where
+
+import CoLibCConst
+    ( siMatchNumber,
+      power,
+      maxRing,
+      --debugLogUpdateLive,
+      TpRealityPack,
+      TpBaseCol,
+      TpTMbind,
+      TpUpdateState2,
+      TpLiveTwin,
+      TpRingNchar )
+import Control.Applicative            ( empty )
+import Control.Arrow                  ( (<<<) )
+import Control.Lens                   ( (&), (.~), Ixed(ix) )
+import Control.Monad.Trans.Class      ( lift )
+import Control.Monad.Trans.Maybe      ( MaybeT(..) )
+import Control.Monad.Trans.State.Lazy ( StateT(..), execStateT, get, put )
+import Data.Bits                      ( Bits(shift, (.&.), (.|.), xor) )    
+import Data.Function                  ( fix )
+import Data.Int                       ( Int8 )
+import Data.Maybe                     ( isNothing, fromJust )
+
+
+checkCReduce :: Int -> Int -> Int -> [Int] -> [[Int]] -> [[Int]] -> [Int] -> IO Bool
+checkCReduce ring bigno nLive live diffangle sameangle contract = return True
+
+
+

ver4src/ver4src.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: efe2621c2c39b9497817fdc2b03704d487e2d4517b318c14b574fc60fc86e90c
+-- hash: 8e359889b0918202705505cac71e046aafb7b085a5b03c2940dbfd8eff839e1d
 
 name:           ver4src
 version:        0.1.0.0
@@ -33,6 +33,7 @@ library
       DiLibSymmetry
       Lib
       ReLibAngles
+      ReLibCRedu
       ReLibFindlive
       ReLibStrip
       ReLibUpdateLive