Skip to content
This repository was archived by the owner on Apr 16, 2026. It is now read-only.

Commit 1864107

Browse files
stschiffstschiff
authored
Merge pull request #38 from poseidon-framework/prepare_for_monorepo_inclusion
updated to latest poseidon-hs
2 parents eea43c6 + 1d5028d commit 1864107

13 files changed

Lines changed: 117 additions & 298 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
- 1.0.2.0: Added VCF writing support to admixpops. Updated to newest poseidon-hs.
12
- 1.0.1.2: Fixed a bug in the FStatConfig parser.
23
- 1.0.1.0: fixed a bug in the FST estimation, added more graceful errors in case of illegal input for fstats
34
- 1.0.0.2: Switched to poseidon-hs v1.4.0.3 and a new compiler (GHC 9.4.7) and stackage snapshot version (LTS-21.17)

‎poseidon-analysis-hs.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: poseidon-analysis-hs
2-
version: 1.0.1.2
2+
version: 1.0.2.0
33
synopsis: A package with analysis-tools to work with Poseidon Genotype Data
44
description: The tools in this package analyse Poseidon-formatted genotype databases, a modular system for storing genotype data from thousands of individuals.
55
license: MIT
@@ -15,7 +15,7 @@ extra-source-files: README.md,
1515
library
1616
exposed-modules: Poseidon.Analysis.FStatsConfig, Poseidon.Analysis.RASconfig, Poseidon.Analysis.Utils,
1717
Poseidon.Analysis.CLI.FStats, Poseidon.Analysis.CLI.RAS,
18-
Poseidon.Generator.CLI.AdmixPops, Poseidon.Generator.CLI.SpaceTime,
18+
Poseidon.Generator.CLI.AdmixPops,
1919
Poseidon.Generator.Parsers, Poseidon.Generator.Types,
2020
Poseidon.Generator.SampleGeno, Poseidon.Generator.Utils
2121
hs-source-dirs: src

‎src-executables/Main.hs‎

Lines changed: 7 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,8 @@ import Paths_poseidon_analysis_hs (version)
2424
import Poseidon.CLI.OptparseApplicativeParsers
2525
import Poseidon.PoseidonVersion (showPoseidonVersion,
2626
validPoseidonVersions)
27-
import Poseidon.Utils (LogMode (..),
27+
import Poseidon.Utils (ErrorLength (..),
28+
LogMode (..),
2829
PlinkPopNameMode (..),
2930
PoseidonException (..),
3031
PoseidonIO, TestMode,
@@ -54,17 +55,12 @@ main = do
5455
hPutStrLn stderr renderVersion
5556
hPutStrLn stderr ""
5657
(Options logMode testMode errLength plinkMode subcommand) <- OP.customExecParser (OP.prefs OP.showHelpOnEmpty) optParserInfo
57-
catch (usePoseidonLogger logMode testMode plinkMode $ runCmd subcommand) (handler logMode testMode errLength plinkMode)
58+
catch (usePoseidonLogger logMode testMode plinkMode errLength $ runCmd subcommand) (handler logMode testMode plinkMode errLength)
5859
where
59-
handler :: LogMode -> TestMode -> ErrorLength -> PlinkPopNameMode -> PoseidonException -> IO ()
60-
handler l t len pm e = do
61-
usePoseidonLogger l t pm $ logError $ truncateErr len $ renderPoseidonException e
60+
handler :: LogMode -> TestMode -> PlinkPopNameMode -> ErrorLength -> PoseidonException -> IO ()
61+
handler l t pm len e = do
62+
usePoseidonLogger l t pm len $ logError $ renderPoseidonException e
6263
exitFailure
63-
truncateErr :: ErrorLength -> String -> String
64-
truncateErr CharInf s = s
65-
truncateErr (CharCount len) s
66-
| length s > len = take len s ++ "... (see more with --errLength)"
67-
| otherwise = s
6864

6965
runCmd :: Subcommand -> PoseidonIO ()
7066
runCmd o = case o of
@@ -239,6 +235,7 @@ admixPopsOptParser = AdmixPopsOptions <$> parseGenoDataSources
239235
<*> parseIndWithAdmixtureSetFromFile
240236
<*> parseAdmixPopsMethodSettings
241237
<*> parseOutGenotypeFormat True
238+
<*> parseZipOut
242239
<*> parseOutPackagePath
243240
<*> parseMaybeOutPackageName
244241
<*> parseOutputPlinkPopMode

‎src/Poseidon/Analysis/CLI/FStats.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Control.Exception (catch, throwIO)
2828
import Control.Foldl (FoldM (..), impurely, list,
2929
purely)
3030
import Control.Monad (forM, forM_, unless, when)
31+
import Control.Monad.Catch (throwM)
3132
import Control.Monad.IO.Class (MonadIO, liftIO)
3233
import Data.IORef (IORef, modifyIORef', newIORef,
3334
readIORef, writeIORef)
@@ -43,13 +44,13 @@ import Pipes (cat, for, yield, (>->))
4344
import Pipes.Group (chunksOf, foldsM, groupsBy)
4445
import qualified Pipes.Prelude as P
4546
import Pipes.Safe (runSafeT)
47+
import Poseidon.ColumnTypesJanno (JannoGenotypePloidy (..))
4648
import Poseidon.EntityTypes (IndividualInfo (..),
4749
PoseidonEntity (..),
4850
checkIfAllEntitiesExist,
4951
determineRelevantPackages,
5052
resolveUniqueEntityIndices,
5153
underlyingEntity)
52-
import Poseidon.Janno (JannoGenotypePloidy (..))
5354
import Poseidon.Package (PackageReadOptions (..),
5455
PoseidonPackage (..),
5556
defaultPackageReadOptions,
@@ -58,7 +59,7 @@ import Poseidon.Package (PackageReadOptions (..),
5859
getJointJanno,
5960
readPoseidonPackageCollection)
6061
import Poseidon.Utils (PoseidonException (..),
61-
PoseidonIO, envInputPlinkMode,
62+
PoseidonIO, envErrorLength,
6263
envLogAction, logInfo,
6364
logWithEnv)
6465
import SequenceFormats.Eigenstrat (EigenstratSnpEntry (..),
@@ -134,11 +135,11 @@ runFstats opts = do
134135
logInfo "Computing stats:"
135136
mapM_ (logInfo . summaryPrintFstats) statSpecs
136137
logA <- envLogAction
137-
inPlinkPopMode <- envInputPlinkMode
138138
statsFold <- buildStatSpecsFold relevantPackages statSpecs
139+
errLength <- envErrorLength
139140
blocks <- liftIO $ catch (
140141
runSafeT $ do
141-
(_, eigenstratProd) <- getJointGenotypeData logA False inPlinkPopMode relevantPackages Nothing
142+
eigenstratProd <- getJointGenotypeData logA False relevantPackages Nothing
142143
let eigenstratProdFiltered =
143144
eigenstratProd >->
144145
P.filter chromFilter >->
@@ -148,7 +149,7 @@ runFstats opts = do
148149
JackknifePerN chunkSize -> chunkEigenstratByNrSnps chunkSize eigenstratProdFiltered
149150
let summaryStatsProd = impurely foldsM statsFold eigenstratProdInChunks
150151
purely P.fold list (summaryStatsProd >-> printBlockInfoPipe logA)
151-
) (throwIO . PoseidonGenotypeExceptionForward)
152+
) (throwM . PoseidonGenotypeExceptionForward errLength)
152153
let jackknifeEstimates = processBlocks statSpecs blocks
153154
let nrSitesList = [sum [(vals !! i) !! 1 | BlockData _ _ _ vals <- blocks] | i <- [0..(length statSpecs - 1)]]
154155
let hasAscertainment = or $ do
@@ -238,7 +239,7 @@ buildStatSpecsFold packages fStatSpecs = do
238239
ploidyVec <- makePloidyVec . getJointJanno $ packages
239240
entityIndicesLookup <- do
240241
let collectedSpecs = collectStatSpecGroups fStatSpecs
241-
entityIndices <- sequence [resolveUniqueEntityIndices [s] indInfoCollection | s <- collectedSpecs]
242+
entityIndices <- sequence [resolveUniqueEntityIndices True [s] indInfoCollection | s <- collectedSpecs]
242243
return . M.fromList . zip collectedSpecs $ entityIndices
243244
blockAccum <- do
244245
listOfInnerVectors <- forM fStatSpecs $ \(FStatSpec fType _ _) -> do

‎src/Poseidon/Analysis/CLI/RAS.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -29,13 +29,13 @@ import Pipes (cat, (>->))
2929
import Pipes.Group (chunksOf, foldsM, groupsBy)
3030
import qualified Pipes.Prelude as P
3131
import Pipes.Safe (runSafeT)
32+
import Poseidon.ColumnTypesJanno (JannoGenotypePloidy (..))
3233
import Poseidon.EntityTypes (EntitiesList, IndividualInfo (..),
3334
PoseidonEntity (..),
3435
checkIfAllEntitiesExist,
3536
determineRelevantPackages,
3637
resolveUniqueEntityIndices,
3738
underlyingEntity)
38-
import Poseidon.Janno (JannoGenotypePloidy (..))
3939
import Poseidon.Package (PackageReadOptions (..),
4040
PoseidonPackage (..),
4141
defaultPackageReadOptions,
@@ -44,7 +44,7 @@ import Poseidon.Package (PackageReadOptions (..),
4444
getJointJanno,
4545
readPoseidonPackageCollection)
4646
import Poseidon.Utils (PoseidonException (..),
47-
PoseidonIO, envInputPlinkMode,
47+
PoseidonIO, envErrorLength,
4848
envLogAction, logInfo, logWithEnv)
4949
import SequenceFormats.Bed (filterThroughBed, readBedFile)
5050
import SequenceFormats.Eigenstrat (EigenstratSnpEntry (..),
@@ -137,10 +137,10 @@ runRAS rasOpts = do
137137

138138
-- run the fold and retrieve the block data needed for RAS computations and output
139139
logA <- envLogAction
140-
inPlinkPopMode <- envInputPlinkMode
140+
errLength <- envErrorLength
141141
blockData <- liftIO $ catch (
142142
runSafeT $ do
143-
(_, eigenstratProd) <- getJointGenotypeData logA False inPlinkPopMode relevantPackages Nothing
143+
eigenstratProd <- getJointGenotypeData logA False relevantPackages Nothing
144144
let eigenstratProdFiltered =
145145
bedFilterFunc (eigenstratProd >->
146146
P.filter (chromFilter (_rasExcludeChroms rasOpts)) >->
@@ -152,7 +152,7 @@ runRAS rasOpts = do
152152
let summaryStatsProd = impurely foldsM rasFold eigenstratProdInChunks
153153
logWithEnv logA . logInfo $ "performing counts"
154154
purely P.fold list (summaryStatsProd >-> P.tee (P.map showBlockLogOutput >-> P.toHandle stderr))
155-
) (throwIO . PoseidonGenotypeExceptionForward)
155+
) (throwIO . PoseidonGenotypeExceptionForward errLength)
156156

157157
-- outputting and computing results
158158
logInfo "collating results"
@@ -250,9 +250,9 @@ buildRasFold packages minFreq maxFreq maxM maybeOutgroup popLefts popRights = do
250250
ploidyVec <- makePloidyVec . getJointJanno $ packages
251251
outgroupI <- case maybeOutgroup of
252252
Nothing -> return []
253-
Just o -> resolveUniqueEntityIndices [o] indInfoCollection
254-
leftI <- sequence [resolveUniqueEntityIndices [l] indInfoCollection | l <- popLefts]
255-
rightI <- sequence [resolveUniqueEntityIndices [r] indInfoCollection | r <- popRights]
253+
Just o -> resolveUniqueEntityIndices True [o] indInfoCollection
254+
leftI <- sequence [resolveUniqueEntityIndices True [l] indInfoCollection | l <- popLefts]
255+
rightI <- sequence [resolveUniqueEntityIndices True [r] indInfoCollection | r <- popRights]
256256
let nL = length popLefts
257257
nR = length popRights
258258
let indivNames = map indInfoName (fst indInfoCollection)

‎src/Poseidon/Analysis/Utils.hs‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,19 @@ import Data.Aeson ((.:))
88
import Data.Aeson.Key (toString)
99
import Data.Aeson.KeyMap (toList)
1010
import Data.Aeson.Types (Object, Parser)
11+
import qualified Data.Text as T
1112
import qualified Data.Vector as V
1213
import Pipes (Pipe, cat)
1314
import qualified Pipes.Prelude as P
15+
import Poseidon.ColumnTypesJanno (GroupName (..),
16+
JannoGenotypePloidy (..))
17+
import Poseidon.ColumnTypesUtils (ListColumn (..))
1418
import Poseidon.EntityTypes (IndividualInfo (..),
1519
SignedEntitiesList,
1620
indInfoConformsToEntitySpecs,
1721
isLatestInCollection,
1822
makePacNameAndVersion)
19-
import Poseidon.Janno (JannoGenotypePloidy (..),
20-
JannoList (..), JannoRow (..),
21-
JannoRows (..), getJannoList)
23+
import Poseidon.Janno (JannoRow (..), JannoRows (..))
2224
import Poseidon.Package (PoseidonPackage (..),
2325
getJannoRowsFromPac)
2426
import Poseidon.Utils (PoseidonException (..), PoseidonIO,
@@ -45,13 +47,13 @@ addGroupDefs groupDefs pacs = do -- this loops through all input packages
4547
isLatest <- isLatestInCollection pacs pac
4648
let newJanno = JannoRows $ do -- this loops through the janno-file
4749
jannoRow <- getJannoRowsFromPac pac
48-
let oldGroupNames = (getJannoList . jGroupName) jannoRow
50+
let oldGroupNames = getListColumn . jGroupName $ jannoRow
4951
let additionalGroupNames = do -- this loops through each new group definition and returns those group names that apply to this janno-row
5052
(groupName, signedEntityList) <- groupDefs
51-
let indInfo = IndividualInfo (jPoseidonID jannoRow) oldGroupNames (makePacNameAndVersion pac)
53+
let indInfo = IndividualInfo (jPoseidonID jannoRow) (map (\(GroupName n) -> T.unpack n) oldGroupNames) (makePacNameAndVersion pac)
5254
True <- return $ indInfoConformsToEntitySpecs indInfo isLatest signedEntityList -- this checks whether a new group-def applies to this janno-row
53-
return groupName -- only returns if the previous row pattern-matched, i.e. if the group applies
54-
return $ jannoRow {jGroupName = JannoList (oldGroupNames ++ additionalGroupNames)} -- returns a new janno-row with the new group definitions
55+
return . GroupName . T.pack $ groupName -- only returns if the previous row pattern-matched, i.e. if the group applies
56+
return $ jannoRow {jGroupName = ListColumn (oldGroupNames ++ additionalGroupNames)} -- returns a new janno-row with the new group definitions
5557
return $ pac {posPacJanno = newJanno} -- returns a new package with the new janno
5658

5759
parseGroupDefsFromJSON :: Object -> Parser [GroupDef]

0 commit comments

Comments
 (0)
⚡