Minor changes, documentation.

BACKLOG.md

@@ -1,3 +1,7 @@
+- When an async is cancelled, we see "imj-game-hamazed-exe: AsyncCancelled"
+in the console. This will be problematic for console-only rendering, as it will interfere
+with the game content. So we should catch these exceptions instead.
+
 - we could stream audio at 200 kBytes per second ( 4bytes per frame, i.e 16 bits per channel in stereo)
 i.e 1.6 Mb / s
 
@@ -13,8 +17,13 @@ Buzzwords:
 . documentation will likely fail to build: upload it manually.
 
 - naive fft optimization (for linux):
-use assume(N%4 == 0) where applicable and AssumeAligned64 so that compilers
-can generate more efficient simd code.
+. use assume(N%4 == 0) where applicable and AssumeAligned64 so that compilers
+    can generate more efficient simd code.
+. use a non-recursive cooley-tuckey (see gpgpu-experiments), but make sure cache is
+  well used (measure naive implementation vs. tiling : maybe the prefetcher will do
+  a better job for the naive implementation)
+.. as suggested in https://www.mathworks.com/help/signal/ref/bitrevorder.html,
+   avoid having to bit-reverse the input by bit-reversing the coefficients.
 we could also use another radix, or use fft libraries.
 
 - midi polling should occur outside ghc's scope to avoid GC pauses, and Haskell overhead.

imj-game-hamazed/src/Imj/Game/Hamazed.hs

@@ -140,7 +140,6 @@ instance GameDraw HamazedGame where
 
 instance GameLogic HamazedGame where
   type ServerT        HamazedGame = HamazedServer
-  type ClientOnlyEvtT HamazedGame = ()
   type ColorThemeT    HamazedGame = ColorCycles
 
   -- Swaps the future world with the current one, and notifies the server using 'IsReady'
@@ -157,11 +156,12 @@ instance GameLogic HamazedGame where
   {-# INLINABLE onClientOnlyEvent #-}
   onClientOnlyEvent = \case
     () -> return ()
+
   {-# INLINABLE onServerEvent #-}
   onServerEvent = \case
     WorldRequest wid arg -> case arg of
       GetGameState ->
-        maybe Nothing (mkGameStateEssence wid) <$> getIGame >>= sendToServer . CurrentGameState wid
+        (join . (fmap $ mkGameStateEssence wid) <$> getIGame) >>= sendToServer . CurrentGameState wid
       Build dt spec ->
         asks sendToServer' >>= \send -> asks belongsTo' >>= \ownedByRequest ->
           void $ liftIO $ forkIO $ flip withAsync (`ownedByRequest` (fromIntegral wid)) $
@@ -170,7 +170,7 @@ instance GameLogic HamazedGame where
             mkOneGenPerCapability >>= \gens -> do
               let go = do
                     deadline <- addDuration dt <$> liftIO getSystemTime
-                    -- TODO getSystemTime can be costly... instead, we should have a thread that queries time every second,
+                    -- TODO if getSystemTime is costly, we can have a thread that queries time every second,
                     -- and atomicModifyIORef an IORef Bool. this same IORef Bool can be used to cancel the async gracefully.
                     -- But we should also read the IORef in the inner loop of matrix transformations to ensure prompt finish.
                     let continue = getSystemTime >>= \t -> return (t < deadline)

imj-game-hamazed/src/Imj/Game/Hamazed/World/Create.hs

@@ -69,8 +69,12 @@ data Association = Association {
 mkMinimalWorldEssence :: WorldEssence
 mkMinimalWorldEssence = WorldEssence Map.empty Map.empty mkZeroSpace
 
-mkWorldEssence :: WorldSpec -> IO Bool -> NonEmpty GenIO -> IO (MkSpaceResult WorldEssence, Map Properties Statistics)
-mkWorldEssence (WorldSpec s@(LevelSpec levelNum _) shipIds (WorldParameters shape (WallDistribution blockSize wallProba))) continue gens@(gen:|_) =
+mkWorldEssence :: WorldSpec
+               -> IO Bool
+               -> NonEmpty GenIO
+               -> IO (MkSpaceResult WorldEssence, Map Properties Statistics)
+mkWorldEssence (WorldSpec s@(LevelSpec levelNum _) shipIds (WorldParameters shape (WallDistribution blockSize wallProba))) continue gens@(gen:|_) = do
+  --putStrLn $ "wallProba:" ++ show wallProba
   -- 4 is the max number of components in the file containing optimal strategies.
   go (min 4 $ max 1 $ fromIntegral nShips) [] Map.empty
  where

imj-space/src/Imj/Space.hs

@@ -161,6 +161,7 @@ mkRandomlyFilledSpace :: Int
 mkRandomlyFilledSpace blockSize wallAirRatio s nComponents continue gens optStrats
   | blockSize <= 0 = fail $ "block size should be strictly positive : " ++ show blockSize
   | otherwise = do
+      --putStrLn $ "wallAirRatio" ++ show wallAirRatio
       (closeWorld@(SWCharacteristics smallSz _ _), OptimalStrategy strategy _) <- go blockSize
       let property = mkProperties closeWorld $ fmap (toVariants smallSz) strategy
       mkSmallWorld gens property continue >>= \(res, stats) ->
@@ -180,7 +181,7 @@ mkRandomlyFilledSpace blockSize wallAirRatio s nComponents continue gens optStra
     $ lookupOptimalStrategy userCharacteristics timeBudget optStrats
    where
     userCharacteristics = SWCharacteristics (bigToSmall s bsz) nComponents wallAirRatio
-    timeBudget = fromSecs 1
+    timeBudget = fromSecs 2 -- TODO make it user configurable.
 
 
 bigToSmall :: Size -> Int -> Size
@@ -200,7 +201,10 @@ smallWorldToBigWorld s blockSize small@(SmallWorld (SmallMatInfo _ smallWorldMat
   replicateElems = replicateElements blockSize
   innerMat = replicateElems $ map replicateElems $ Cyclic.toLists smallWorldMat
 
-data MatrixPipeline = MatrixPipeline !MatrixSource !MatrixTransformer
+data MatrixPipeline = MatrixPipeline
+  !Int -- number of elements per matrix
+  !MatrixSource
+  !MatrixTransformer
 
 newtype MatrixSource = MatrixSource (MS.IOVector MaterialAndKey -> GenIO -> IO SmallMatInfo)
 
@@ -224,17 +228,25 @@ mkMatrixPipeline :: ComponentCount
                  -> LowerBounds
                  -> Maybe MatrixVariants
                  -> IO MatrixPipeline
-mkMatrixPipeline nComponents' wallProba (Size (Length nRows) (Length nCols)) lb variants =
-  return $ MatrixPipeline (MatrixSource produce) $ MatrixTransformer consume
+mkMatrixPipeline
+ nComponents'
+ wallProba
+ (Size (Length nRows) (Length nCols))
+ (LowerBounds minAirCount minWallCount countBlocks)
+ variants =
+  return $ MatrixPipeline nBlocks (MatrixSource produce) $ MatrixTransformer consume
  where
   produce v gen =
     fillSmallVector gen wallProba v >>= \nAir ->
       SmallMatInfo (fromIntegral nAir) . Cyclic.fromVector nRows nCols <$> S.unsafeFreeze v
 
   consume s v mat =
-    foldStats (s{countRandomMatrices = 1 + countRandomMatrices s}) $ either
+    foldStats
+      (s{countRandomMatrices = 1 + countRandomMatrices s})
+      $ either
           ((:|[]) . Left)
-          (takeWhilePlus isLeft . matchAndVariate nComponents variants v) $ checkRandomMatrix lb mat
+          (takeWhilePlus isLeft . matchAndVariate nComponents variants v)
+          $ smallWorldIsValid mat
 
   !nComponents = -- relax the constraint on number of components if the size is too small
     min
@@ -243,24 +255,38 @@ mkMatrixPipeline nComponents' wallProba (Size (Length nRows) (Length nCols)) lb
 
   nBlocks = nRows * nCols
 
-runPipeline :: Int -> NonEmpty GenIO -> IO Bool -> MatrixPipeline -> IO (Maybe SmallWorld, Statistics)
-runPipeline nBlocks generators continue (MatrixPipeline (MatrixSource produce) (MatrixTransformer consume)) = do
+  smallWorldIsValid :: SmallMatInfo -> Either SmallWorldRejection SmallMatInfo
+  smallWorldIsValid  m@(SmallMatInfo countAirBlocks _)
+     | countAirBlocks < minAirCount = Left $ NotEnough Air
+     | countWallBlocks < minWallCount = Left $ NotEnough Wall
+     | otherwise = Right m
+     where
+      !countWallBlocks = countBlocks - countAirBlocks
+
+-- | Runs the computation in parallel (one thread per random number generator).
+--
+-- Returns the result of the first thread that finds a valid matrix.
+runPipeline :: NonEmpty GenIO
+            -- ^ The list of random number generators
+            -> IO Bool
+            -- ^ The computation should stop if this is 'False'
+            -> MatrixPipeline
+            -> IO (Maybe SmallWorld, Statistics)
+runPipeline generators continue (MatrixPipeline nBlocks (MatrixSource produce) (MatrixTransformer consume)) = do
   resVar <- newEmptyMVar :: IO (MVar (Maybe SmallWorld, Statistics))
   run resVar
  where
   run resM =
-    run' (NE.toList generators)
+    run' $ NE.toList generators
    where
-    run' [] =
-      takeMVar resM -- the first will win
+    run' (gen:gens) = withAsync (shortcut gen) $ \_ ->
+      -- print =<< threadCapability (asyncThreadId a)
+      run' gens
 
-    run' (gen:gens) =
-      withAsync (shortcut gen) $ \_ ->
-        -- print =<< threadCapability (asyncThreadId a)
-        run' gens
+    run' []         = takeMVar resM -- the first thread that finishes its computation wins
 
     -- Note that running producer and consummer in separate threads, and forwarding the results
-    -- through an MVar is slower than calling them sequentially, like here.
+    -- from producer to consumer through an MVar is slower than calling them sequentially, like so:
     shortcut gen = do
       -- we align to 64 bytes and allocate a multiple of 64 bytes to avoid false sharing
       -- (assuming a cache line size of 64 bytes)
@@ -279,18 +305,10 @@ runPipeline nBlocks generators continue (MatrixPipeline (MatrixSource produce) (
             consume s ba <$> produce v gen >>= \(BRMV m s') ->
                 either (const $ go s') (void . tryPutMVar resM . flip (,) s' . Just) m
 
-checkRandomMatrix :: LowerBounds -> SmallMatInfo -> Either SmallWorldRejection SmallMatInfo
-checkRandomMatrix (LowerBounds minAirCount minWallCount countBlocks) m@(SmallMatInfo countAirBlocks _)
-   | countAirBlocks < minAirCount = Left $ NotEnough Air
-   | countWallBlocks < minWallCount = Left $ NotEnough Wall
-   | otherwise = Right m
-   where
-    !countWallBlocks = countBlocks - countAirBlocks
-
 mkSmallWorld :: NonEmpty GenIO
              -> Properties
              -> IO Bool
-             -- ^ Can continue?
+             -- ^ The computation should stop if this is 'False'
              -> IO (MkSpaceResult SmallWorld, Statistics)
              -- ^ the "small world"
 mkSmallWorld gens (Properties (SWCharacteristics sz nComponents' userP) variants eitherLowerBounds) continue
@@ -305,8 +323,12 @@ mkSmallWorld gens (Properties (SWCharacteristics sz nComponents' userP) variants
                         }))
       eitherLowerBounds
  where
-  go lowerBounds@(LowerBounds minAirCount minWallCount totalCount) =
-    mkMatrixPipeline nComponents wallProba sz lowerBounds variants >>= runPipeline (area sz) gens continue
+  go lowerBounds@(LowerBounds minAirCount minWallCount totalCount) = do
+    --print userP -- this is not the one the user sees in the UI, it is already adapted
+    --print minP
+    --print maxP
+    --print wallProba
+    mkMatrixPipeline nComponents wallProba sz lowerBounds variants >>= runPipeline gens continue
    where
     wallProba = fromMaybe (error "logic") $ mapRange 0 1 minP maxP userP
     minP =     fromIntegral minWallCount / fromIntegral totalCount
@@ -323,36 +345,36 @@ foldStats :: Statistics -> NonEmpty TopoMatch -> BestRandomMatrixVariation
 foldStats stats (x:|xs) =
   List.foldl' (\(BRMV _ s) v -> BRMV v $ addToStats v s) (BRMV x $ addToStats x stats) xs
 
-addToStats' :: SmallWorldRejection -> Statistics -> Statistics
-addToStats' (NotEnough Air) s = s { countNotEnoughWalls  = 1 + countNotEnoughWalls s }
-addToStats' (NotEnough Wall) s = s { countNotEnoughWalls  = 1 + countNotEnoughWalls s }
-addToStats' UnusedFronteers s = s { countUnusedFronteers = 1 + countUnusedFronteers s }
-addToStats' (CC x nComps) s = addNComp nComps $ case x of
-  ComponentCountMismatch ->
-    s { countComponentCountMismatch = 1 + countComponentCountMismatch s }
-  ComponentsSizesNotWellDistributed ->
-    s { countComponentsSizesNotWellDistributed = 1 + countComponentsSizesNotWellDistributed s }
-  SpaceNotUsedWellEnough ->
-    s { countSpaceNotUsedWellEnough = 1 + countSpaceNotUsedWellEnough s }
-  UnusedFronteers' ->
-    s { countUnusedFronteers = 1 + countUnusedFronteers s }
-
-addToStats'' :: SmallWorld -> Statistics -> Statistics
-addToStats'' (SmallWorld _ topo) s =
-  let nComps = ComponentCount $ length $ getConnectedComponents topo
-  in addNComp nComps s
-
 addToStats :: TopoMatch -> Statistics -> Statistics
 addToStats elt s =
- let s'' = case elt of
-      Right r -> addToStats'' r s
-      Left l  -> addToStats' l s
- in s'' { countGeneratedMatrices = 1 + countGeneratedMatrices s'' }
-
-addNComp :: ComponentCount -> Statistics -> Statistics
-addNComp n s =
-  s { countGeneratedGraphsByComponentCount =
-    Map.alter (Just . (+1) . fromMaybe 0) n $ countGeneratedGraphsByComponentCount s }
+  s' { countGeneratedMatrices = 1 + countGeneratedMatrices s' }
+ where
+  s' = either addToStats' addToStats'' elt
+
+  addToStats' :: SmallWorldRejection -> Statistics
+  addToStats' (NotEnough Air) = s { countNotEnoughWalls  = 1 + countNotEnoughWalls s }
+  addToStats' (NotEnough Wall) = s { countNotEnoughWalls  = 1 + countNotEnoughWalls s }
+  addToStats' UnusedFronteers = s { countUnusedFronteers = 1 + countUnusedFronteers s }
+  addToStats' (CC x nComps) = addNComp nComps $ case x of
+    ComponentCountMismatch ->
+      s { countComponentCountMismatch = 1 + countComponentCountMismatch s }
+    ComponentsSizesNotWellDistributed ->
+      s { countComponentsSizesNotWellDistributed = 1 + countComponentsSizesNotWellDistributed s }
+    SpaceNotUsedWellEnough ->
+      s { countSpaceNotUsedWellEnough = 1 + countSpaceNotUsedWellEnough s }
+    UnusedFronteers' ->
+      s { countUnusedFronteers = 1 + countUnusedFronteers s }
+
+  addToStats'' :: SmallWorld -> Statistics
+  addToStats'' (SmallWorld _ topo) =
+    let nComps = ComponentCount $ length $ getConnectedComponents topo
+    in addNComp nComps s
+
+
+  addNComp :: ComponentCount -> Statistics -> Statistics
+  addNComp n s2 =
+    s2 { countGeneratedGraphsByComponentCount =
+      Map.alter (Just . (+1) . fromMaybe 0) n $ countGeneratedGraphsByComponentCount s }
 
 matchAndVariate :: ComponentCount
                 -> Maybe MatrixVariants
@@ -381,7 +403,7 @@ matchAndVariate nComponents curB v info =
 
               produceVariations (Rotate (RotationDetail order _)) =
                 Cyclic.produceRotations order m
-          -- TODO try conduit or pipes or https://www.twanvl.nl/blog/haskell/streaming-vector in
+          -- TODO try conduit or pipes or https://www.twanvl.nl/blog/haskell/streaming-vector in:
           --    matchAndVariate
           --    random matrix creation
           --    matrix production.
@@ -635,12 +657,13 @@ data AccumSource = AS {
 }
 
 fillSmallVector :: GenIO
+                -- ^ Random number generator
                 -> AlmostFloat
                 -- ^ Probability to generate a wall
                 -> MS.IOVector MaterialAndKey
-                -- ^ Use this memory
+                -- ^ The "small vector" that will be filled by this function
                 -> IO Word16
-                -- ^ The count of air keys
+                -- ^ The count of 'air' keys
 fillSmallVector gen wallProba v = do
   let countBlocks = MS.length v
       !limit = mapNormalizedToDiscrete wallProba maxBound :: Word8

imj-space/src/Imj/Space/Types.hs

@@ -346,8 +346,7 @@ data RotationDetail = RotationDetail {
   -- /Rotated/ variations "preserve" the topology more than /interleaved/ variations, this is the reason why
   -- we don't use this criteria for interleaved rotations.
   --
-  -- TODO We could have a function here : depending on the distance, we could
-  --
+  -- TODO We could have a function here : depending on the distance, we could:
   --  * chose one type of rotation or the other (the choice of Cyclic.RotationOrder could be automated this way)
   --  * chose to rotate "less", i.e take one out of n rotations
 } deriving(Generic, Eq, Ord, Lift)