Skip to content

Commit

Permalink
Adding and modifying files to compile
Browse files Browse the repository at this point in the history
  • Loading branch information
Ward Wheeler committed Sep 27, 2024
1 parent 38143b7 commit ec7b4ad
Show file tree
Hide file tree
Showing 3 changed files with 137 additions and 16 deletions.
3 changes: 0 additions & 3 deletions PhyloWidgits.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -109,10 +109,7 @@ executable pruneRandGraph
, fgl
, graphviz
, MissingH
, MonadRandom
, parallel
, PHANE-evaluation
, PHANE-PhyloLib
, process
, text
, random
Expand Down
27 changes: 14 additions & 13 deletions src/LocalGraph.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@ This is for indirection so can change underlying graph library without polutting
-}
module LocalGraph where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Random.Class
--import Control.Monad.IO.Class (MonadIO (..))
--import Control.Monad.Random.Class
import Control.Parallel.Strategies
import Cyclic qualified as C
import Data.Graph.Inductive.Basic qualified as B
Expand All @@ -28,9 +28,9 @@ import Data.Text.Lazy qualified as T
import Data.Vector qualified as V
import GeneralUtilities
import GraphFormatUtilities qualified as GFU
import PHANE.Evaluation
import PHANE.Evaluation.ErrorPhase (ErrorPhase (Computing))
import PHANE.Evaluation.Verbosity (Verbosity (..))
--import PHANE.Evaluation
--import PHANE.Evaluation.ErrorPhase (ErrorPhase (Computing))
--import PHANE.Evaluation.Verbosity (Verbosity (..))
import System.IO


Expand All @@ -40,7 +40,7 @@ import System.IO
{- | to avoid circular dependency with Types.hs
Core monad transformer stack for evaluating computations within the application PhyG.
-}
type PhyG = Evaluation ()
--type PhyG = Evaluation ()


-- | Gr local graph definition using FGL
Expand Down Expand Up @@ -483,7 +483,7 @@ labParents inGraph inNode =

{- | isPhylogeneticGraph checks various issues to see if
there is wierdness in graph
-}
isPhylogeneticGraph ∷ (Show a, Eq a, NFData a, Show b, Eq b) ⇒ Gr a b → PhyG Bool
isPhylogeneticGraph inGraph =
if isEmpty inGraph
Expand Down Expand Up @@ -517,6 +517,7 @@ isPhylogeneticGraph inGraph =
if not consistent
then pure False
else pure True
-}


-- | removeParentsInChain checks the parents of each netowrk node are not anc/desc of each other
Expand Down Expand Up @@ -1529,7 +1530,7 @@ getCoevalConstraintEdges inGraph inNode =
(_, edgeAfterList) = nodesAndEdgesAfter inGraph [inNode]
in (edgeBeforeList, edgeAfterList)


{-
-- | getGraphCoevalConstraints takes a graph and returns coeval constraints based on network nodes
getGraphCoevalConstraints ∷ (Eq a, Eq b, Show a, NFData b) ⇒ Gr a b → PhyG [([LEdge b], [LEdge b])]
getGraphCoevalConstraints inGraph =
Expand Down Expand Up @@ -1571,7 +1572,7 @@ getGraphCoevalConstraintsNodes inGraph =
-- let (edgeBeforeList, edgeAfterList) = unzip (PU.seqParMap PU.myStrategy (getCoevalConstraintEdges inGraph) networkNodeList) -- `using` PU.myParListChunkRDS)
pure $ zip3 networkNodeList edgeBeforeList edgeAfterList

-}
{- | meetsAllCoevalConstraintsNodes checks constraint pair list and examines
whether one edge is from before and one after--if so fails False
else True if all pass
Expand Down Expand Up @@ -1646,7 +1647,7 @@ notMatchEdgeIndices unlabeledEdegList labelledEdge =
then False
else True


{-
-- | isGraphTimeConsistent retuns False if graph fails time consistency
isGraphTimeConsistent ∷ (Show a, Eq a, Eq b, NFData a) ⇒ Gr a b → PhyG Bool
isGraphTimeConsistent inGraph =
Expand All @@ -1668,6 +1669,7 @@ isGraphTimeConsistent inGraph =
pure $ null timeOffendingEdgeList
-}

{- | addBeforeAfterToPair adds before and after node list to pari of nodes for later use
in time contraint edge removal
Expand Down Expand Up @@ -2257,7 +2259,7 @@ getToFlipEdges parentNodeIndex inEdgeList =
then firstEdge : getToFlipEdges parentNodeIndex (drop 1inEdgeList)
else getToFlipEdges parentNodeIndex (drop 1inEdgeList)


{-
{- | Random generates display trees up to input number by choosing
to keep indegree nodes > 1 unifomaly at random
-}
Expand Down Expand Up @@ -2301,8 +2303,7 @@ chooseOneDumpRest = \case
[] → pure []
x : [] → pure []
x : xs → fmap NE.tail . shuffleList $ x :| xs


-}
-- | generateDisplayTrees nice wrapper around generateDisplayTrees' with clean interface
generateDisplayTrees (Eq a) Bool Gr a b [Gr a b]
generateDisplayTrees contractEdges inGraph =
Expand Down
123 changes: 123 additions & 0 deletions src/ParallelUtilities.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,123 @@
{- |
Module : ParallelUtilities.hs
Description : Utilities for parallel traversals, and other related functions
Copyright : (c) 2021 Ward C. Wheeler, Division of Invertebrate Zoology, AMNH. All rights reserved.
License :
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
The views and conclusions contained in the software and documentation are those
of the authors and should not be interpreted as representing official policies,
either expressed or implied, of the FreeBSD Project.
Maintainer : Ward Wheeler <[email protected]>
Stability : unstable
Portability : portable (I hope)
-}

{-# Language ImportQualifiedPost #-}

{-# Options_GHC -fno-warn-orphans #-}

module ParallelUtilities
( parmap
, seqParMap
, getNumThreads
, rnf
, myStrategy
, myStrategyR0
, myStrategyRS
, myStrategyRDS
, myStrategyRPAR
, myParListChunk
, myParListChunkRDS
, myChunkParMapRDS
, myStrategyHighLevel
, myStrategyLowLevel
) where

import Control.Concurrent
import Control.DeepSeq
import Control.Parallel.Strategies
import Data.BitVector qualified as BV
import System.IO.Unsafe


-- Map a function over a traversable structure in parallel
-- Preferred over parMap which is limited to lists
-- Add chunking (with arguement) (via chunkList) "fmap blah blah `using` parListChunk chunkSize rseq/rpar"
-- but would have to do one for lists (with Chunk) and one for vectors (splitAt recusively)
parmap :: Traversable t => Strategy b -> (a -> b) -> t a -> t b
parmap strat f = withStrategy (parTraversable strat).fmap f

-- | seqParMap takes strategy, if numThread == 1 retuns fmap otherwise parmap and
seqParMap :: Traversable t => Strategy b -> (a -> b) -> t a -> t b
seqParMap strat f =
if getNumThreads > 1 then parmap strat f
else fmap f

myParListChunk :: Strategy a -> Strategy [a]
myParListChunk = parListChunk getNumThreads

myParListChunkRDS :: (NFData a) => Strategy [a]
myParListChunkRDS = parListChunk getNumThreads myStrategyRDS

-- | myStrategy can be r0, rpar, rseq, rdeepseq
-- r0 seems fastest in tests of PhyG
myStrategy :: (NFData b) => Strategy b
myStrategy = r0 --rseq -- rpar -- rseq -- r0

myStrategyLowLevel :: (NFData b) => Strategy b
myStrategyLowLevel = r0

myStrategyHighLevel :: (NFData b) => Strategy b
myStrategyHighLevel = rdeepseq

myStrategyR0 :: Strategy b
myStrategyR0 = r0

myStrategyRDS :: (NFData b) => Strategy b
myStrategyRDS = rdeepseq

myStrategyRS :: Strategy b
myStrategyRS = rseq

myStrategyRPAR :: Strategy b
myStrategyRPAR = rpar

-- | getNumThreads gets number of COncurrent threads
{-# NOINLINE getNumThreads #-}
getNumThreads :: Int
getNumThreads = unsafePerformIO getNumCapabilities


-- NFData instance for parmap/rdeepseq Bit Vectory types
instance NFData BV.BV where

rnf bv = BV.size bv `seq` BV.nat bv `seq` ()


-- | myChunkParMapRDS chuncked parmap that defaults to fmap if not paralell
myChunkParMapRDS :: NFData c => (b -> c) -> [b] -> [c]
myChunkParMapRDS f inList =
if getNumThreads == 1 then fmap f inList
else fmap f inList `using` myParListChunkRDS

0 comments on commit ec7b4ad

Please sign in to comment.