From 4aceb760286e084c335e86e32a2d13bfd6c2c08f Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Thu, 26 Sep 2024 00:25:24 +0200 Subject: [PATCH 1/1] init --- .reuse/dep5 | 8 ++ flake.lock | 319 ++++++++++++++++++++++++++++++++++++++++++++++++++++ flake.nix | 79 +++++++++++++ script.hs | 73 ++++++++++++ 4 files changed, 479 insertions(+) create mode 100644 .reuse/dep5 create mode 100644 flake.lock create mode 100644 flake.nix create mode 100755 script.hs diff --git a/.reuse/dep5 b/.reuse/dep5 new file mode 100644 index 0000000..7afb923 --- /dev/null +++ b/.reuse/dep5 @@ -0,0 +1,8 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: script +Upstream-Contact: Jane Doe +Source: https://example.com/script + +Files: *.lock *.dot .envrc .gitattributes .gitignore .gitmodules +Copyright: Jane Doe +License: CC0-1.0 diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..afa629c --- /dev/null +++ b/flake.lock @@ -0,0 +1,319 @@ +{ + "nodes": { + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1696426674, + "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_2": { + "flake": false, + "locked": { + "lastModified": 1696426674, + "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1710146030, + "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "inputs": { + "systems": "systems_2" + }, + "locked": { + "lastModified": 1710146030, + "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "git-hooks": { + "inputs": { + "flake-compat": "flake-compat", + "flake-utils": "flake-utils", + "gitignore": "gitignore", + "nixpkgs": [ + "literate-phylomemy", + "nixpkgs" + ], + "nixpkgs-stable": "nixpkgs-stable" + }, + "locked": { + "lastModified": 1715609711, + "narHash": "sha256-/5u29K0c+4jyQ8x7dUIEUWlz2BoTSZWUP2quPwFCE7M=", + "owner": "cachix", + "repo": "git-hooks.nix", + "rev": "c182c876690380f8d3b9557c4609472ebfa1b141", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "git-hooks.nix", + "type": "github" + } + }, + "git-hooks_2": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-utils": "flake-utils_2", + "gitignore": "gitignore_2", + "nixpkgs": [ + "literate-phylomemy", + "logic", + "nixpkgs" + ], + "nixpkgs-stable": "nixpkgs-stable_2" + }, + "locked": { + "lastModified": 1715609711, + "narHash": "sha256-/5u29K0c+4jyQ8x7dUIEUWlz2BoTSZWUP2quPwFCE7M=", + "owner": "cachix", + "repo": "git-hooks.nix", + "rev": "c182c876690380f8d3b9557c4609472ebfa1b141", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "git-hooks.nix", + "type": "github" + } + }, + "gitignore": { + "inputs": { + "nixpkgs": [ + "literate-phylomemy", + "git-hooks", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1709087332, + "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, + "gitignore_2": { + "inputs": { + "nixpkgs": [ + "literate-phylomemy", + "logic", + "git-hooks", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1709087332, + "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, + "literate-phylomemy": { + "inputs": { + "git-hooks": "git-hooks", + "logic": "logic", + "nixpkgs": "nixpkgs_2" + }, + "locked": { + "lastModified": 1728381939, + "narHash": "sha256-flmlzK5Megm15OwY8WSeI5NBA54gpRzCgDNgPSRJxc4=", + "ref": "refs/heads/main", + "rev": "8c2a19dbf52c13f8bfc9356740ad4687efa0318e", + "revCount": 1, + "type": "git", + "url": "https://seed.radicle.garden/z2364hmzZUAGy1nKdSFa1gLSoUE2M.git" + }, + "original": { + "type": "git", + "url": "https://seed.radicle.garden/z2364hmzZUAGy1nKdSFa1gLSoUE2M.git" + } + }, + "logic": { + "inputs": { + "git-hooks": "git-hooks_2", + "nixpkgs": "nixpkgs" + }, + "locked": { + "lastModified": 1719224209, + "narHash": "sha256-9wLe/nHEJ55MP7j/xFeLbkYUIJDrQ5MHfw2lZn7ynfQ=", + "ref": "refs/heads/main", + "rev": "68250d2551950b4ac2a76a31e3e8f0274fec5040", + "revCount": 1, + "type": "git", + "url": "https://radicle-mermet.sourcephile.fr/z3795BqJN8hSMGkyAUr8hHviEEi2H.git" + }, + "original": { + "type": "git", + "url": "https://radicle-mermet.sourcephile.fr/z3795BqJN8hSMGkyAUr8hHviEEi2H.git" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1716793392, + "narHash": "sha256-ex3nO87EEQhshXd19QSVW5UIXL0pbPuew4q8TdEJQBY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "67a8b308bae9c26be660ccceff3e53a65e01afe1", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs-stable": { + "locked": { + "lastModified": 1710695816, + "narHash": "sha256-3Eh7fhEID17pv9ZxrPwCLfqXnYP006RKzSs0JptsN84=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "614b4613980a522ba49f0d194531beddbb7220d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-23.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-stable_2": { + "locked": { + "lastModified": 1710695816, + "narHash": "sha256-3Eh7fhEID17pv9ZxrPwCLfqXnYP006RKzSs0JptsN84=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "614b4613980a522ba49f0d194531beddbb7220d3", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-23.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1727264057, + "narHash": "sha256-KQPI8CTTnB9CrJ7LrmLC4VWbKZfljEPBXOFGZFRpxao=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "759537f06e6999e141588ff1c9be7f3a5c060106", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1727264057, + "narHash": "sha256-KQPI8CTTnB9CrJ7LrmLC4VWbKZfljEPBXOFGZFRpxao=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "759537f06e6999e141588ff1c9be7f3a5c060106", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "literate-phylomemy": "literate-phylomemy", + "nixpkgs": "nixpkgs_3" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + }, + "systems_2": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..a87037a --- /dev/null +++ b/flake.nix @@ -0,0 +1,79 @@ +# SPDX-FileCopyrightText: 2024 Jane Doe +# SPDX-License-Identifier: CC0-1.0 +{ + description = "A phylomemy script example"; + inputs = { + # Update with: + # nix flake lock --override-input nixpkgs github:NixOS/nixpkgs + nixpkgs.url = "flake:nixpkgs"; + literate-phylomemy.url = "git+https://seed.radicle.garden/z2364hmzZUAGy1nKdSFa1gLSoUE2M.git"; + }; + outputs = + inputs: + let + lib = inputs.nixpkgs.lib; + # Helper to build for each system in `lib.systems.flakeExposed`. + perSystem = + f: + lib.genAttrs lib.systems.flakeExposed ( + system: + f rec { + inherit system; + pkgs = import inputs.nixpkgs { inherit system; }; + haskellPackages = pkgs.haskellPackages; + } + ); + in + { + # `nix -L build` + packages = perSystem ( + { pkgs, system, haskellPackages, ... }: + { + # The Glasgow Haskell Compiler (GHC) + # Here made available as `.#ghc` for script.hs's shebang + ghc = haskellPackages.ghcWithPackages ( + haskellPackages: [ + # Extra Haskell packages available + inputs.literate-phylomemy.packages.${system}.default + haskellPackages.bytestring + haskellPackages.turtle + haskellPackages.pretty-show + ] + ); + ghcid = pkgs.ghcid; + xdot = pkgs.xdot; + # A compiled version of `script.hs` + # (instead of an interpreted one when run as `./script.hs`) + # To avoid writing a `.cabal` file, `ghc --make` is called directly here, + # but should the script become a full fledge executable, + # a `.cabal` file should be written instead. + default = pkgs.stdenv.mkDerivation { + name = "script"; + src = ./.; + buildInputs = [ + inputs.self.packages.${system}.ghc + ]; + buildPhase = '' + mkdir -p $out/bin + ghc -o "$out/bin/script" -O2 --make ./script.hs + ''; + }; + } + ); + # `nix develop` or `direnv allow` + devShells = perSystem ( + { pkgs, system, ... }: + { + default = pkgs.mkShell { + nativeBuildInputs = [ + inputs.self.packages.${system}.ghc + pkgs.haskellPackages.haskell-language-server + pkgs.haskellPackages.hlint + pkgs.reuse + pkgs.xdot + ]; + }; + } + ); + }; +} diff --git a/script.hs b/script.hs new file mode 100755 index 0000000..079b8df --- /dev/null +++ b/script.hs @@ -0,0 +1,73 @@ +#!/usr/bin/env -S nix -L shell .#ghc .#ghcid .#xdot --command ghcid --test :main +-- Alternatively: #!/usr/bin/env -S nix -L shell .#ghc .#xdot --command runghc +-- SPDX-FileCopyrightText: 2024 Jane Doe +-- SPDX-License-Identifier: CC0-1.0 +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ParallelListComp #-} + +import Control.Concurrent.Async qualified as Async +import Data.ByteString.Builder qualified as BS +import Data.Either (fromRight) +import Data.Map.Strict qualified as Map +import Data.Sequence qualified as Seq +import Logic +import Logic.Theory.Arithmetic +import Logic.Theory.Ord +import Numeric.Probability +import Phylomemy qualified as Phylo +import System.IO qualified as Sys +import System.Process qualified as Sys +import Text.Pretty.Simple + +main = do + let minSupp = assertStrictlyPositive 1 + let minSize = assertStrictlyPositive 2 + + letName rangeToDocs0 $ \rangeToDocs -> + letName ["a", "b", "c", "d", "e", "f", "g"] $ \roots -> do + let clusters = + Phylo.clusterize roots minSupp minSize rangeToDocs + + let msf :: Phylo.MaximalSpanningForest Pos Phylo.Cluster = + Phylo.maximalSpanningForest Phylo.similarityJaccard (unName <$> clusters) + let phylomemy :: Phylo.MaximalSpanningForest Pos Phylo.Cluster = + let Just lambda = probability 0.3 + in letName (Phylo.predictionMeasureF lambda) $ \predMeasure -> + Phylo.msfSplit predMeasure roots msf + let dot = Phylo.dotMaximalSpanningForest phylomemy + + pPrint ("Number of maximal spanning trees", length phylomemy) + Sys.withFile "phylomemy.dot" Sys.WriteMode (`BS.hPutBuilder` dot) + Sys.callProcess "xdot" ["phylomemy.dot"] + +rangeToDocs0 :: Pos Phylo.:-> Seq.Seq (Phylo.Document Pos) +rangeToDocs0 = + Map.fromList + [ ( Pos rangeIndex + , Seq.fromList + [ Phylo.Document + { Phylo.documentPosition = Pos (2 * rangeIndex + 3 * docIndex) + , Phylo.documentRoots = Map.fromList [(r, ()) | r <- roots] + } + | roots <- docs + | docIndex <- [1 ..] + ] + ) + | docs <- + [ [["a", "b", "c"], ["a", "d", "e"], ["e", "f", "g"]] + , [["a", "b"], ["d", "f"]] + , [["f"], ["d", "f"], ["f", "g", "a"]] + , [["b", "c", "e"], ["a", "d", "e"], ["a", "b", "c"]] + , [["d", "f", "g"], ["b", "f"], ["a", "c", "d"], ["a", "f"]] + , [["c", "d", "g"], ["b", "c", "g"], ["a", "b", "c"], ["e", "g"]] + ] + | rangeIndex <- [1 ..] + ] + +assertStrictlyPositive :: (Ord a) => (Zeroable a) => a -> () ::: a / () > Zero +assertStrictlyPositive i = unitName i Logic./ fromRight undefined (prove (unitName i Logic.Theory.Ord.> zero)) + +newtype Pos = Pos Int deriving (Eq, Ord, Show, Num) +instance Phylo.ShowHuman Pos where + showHuman (Pos x) = show x -- 2.44.1