From e318b40cfc1a3079375a015a651b1b44f6279ad0 Mon Sep 17 00:00:00 2001 From: Justin Bedo Date: Fri, 16 Dec 2022 10:57:55 +1100 Subject: init --- .gitignore | 1 + flake.lock | 900 ++++++++++++++++++++++++++++++++++++++++++++++++++++ flake.nix | 39 +++ package.yaml | 20 ++ ppl.cabal | 31 ++ src/PPL.hs | 5 + src/PPL/Distr.hs | 100 ++++++ src/PPL/Internal.hs | 81 +++++ src/PPL/Sampling.hs | 52 +++ 9 files changed, 1229 insertions(+) create mode 100644 .gitignore create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 package.yaml create mode 100644 ppl.cabal create mode 100644 src/PPL.hs create mode 100644 src/PPL/Distr.hs create mode 100644 src/PPL/Internal.hs create mode 100644 src/PPL/Sampling.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fcfc4a1 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +result* diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..2f052dd --- /dev/null +++ b/flake.lock @@ -0,0 +1,900 @@ +{ + "nodes": { + "HTTP": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, + "blank": { + "locked": { + "lastModified": 1625557891, + "narHash": "sha256-O8/MWsPBGhhyPoPLHZAuoZiiHo9q6FLlEeIDEXuj6T4=", + "owner": "divnix", + "repo": "blank", + "rev": "5a5d2684073d9f563072ed07c871d577a6c614a8", + "type": "github" + }, + "original": { + "owner": "divnix", + "repo": "blank", + "type": "github" + } + }, + "cabal-32": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", + "owner": "haskell", + "repo": "cabal", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, + "cabal-34": { + "flake": false, + "locked": { + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", + "owner": "haskell", + "repo": "cabal", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36": { + "flake": false, + "locked": { + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "owner": "haskell", + "repo": "cabal", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cardano-shell": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, + "devshell": { + "inputs": { + "flake-utils": [ + "haskellNix", + "tullia", + "std", + "flake-utils" + ], + "nixpkgs": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1663445644, + "narHash": "sha256-+xVlcK60x7VY1vRJbNUEAHi17ZuoQxAIH4S4iUFUGBA=", + "owner": "numtide", + "repo": "devshell", + "rev": "e3dc3e21594fe07bdb24bdf1c8657acaa4cb8f66", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "devshell", + "type": "github" + } + }, + "dmerge": { + "inputs": { + "nixlib": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ], + "yants": [ + "haskellNix", + "tullia", + "std", + "yants" + ] + }, + "locked": { + "lastModified": 1659548052, + "narHash": "sha256-fzI2gp1skGA8mQo/FBFrUAtY0GQkAIAaV/V127TJPyY=", + "owner": "divnix", + "repo": "data-merge", + "rev": "d160d18ce7b1a45b88344aa3f13ed1163954b497", + "type": "github" + }, + "original": { + "owner": "divnix", + "repo": "data-merge", + "type": "github" + } + }, + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1635892615, + "narHash": "sha256-harGbMZr4hzat2BWBU+Y5OYXlu+fVz7E4WeQzHi5o8A=", + "owner": "input-output-hk", + "repo": "flake-compat", + "rev": "eca47d3377946315596da653862d341ee5341318", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_2": { + "flake": false, + "locked": { + "lastModified": 1650374568, + "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b4a34015c698c7793d592d66adbab377907a2be8", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "locked": { + "lastModified": 1667395993, + "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "locked": { + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_3": { + "locked": { + "lastModified": 1653893745, + "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_4": { + "locked": { + "lastModified": 1659877975, + "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_5": { + "locked": { + "lastModified": 1653893745, + "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "ghc-8.6.5-iohk": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, + "gomod2nix": { + "inputs": { + "nixpkgs": "nixpkgs_2", + "utils": "utils" + }, + "locked": { + "lastModified": 1655245309, + "narHash": "sha256-d/YPoQ/vFn1+GTmSdvbSBSTOai61FONxB4+Lt6w/IVI=", + "owner": "tweag", + "repo": "gomod2nix", + "rev": "40d32f82fc60d66402eb0972e6e368aeab3faf58", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "gomod2nix", + "type": "github" + } + }, + "hackage": { + "flake": false, + "locked": { + "lastModified": 1671063994, + "narHash": "sha256-4YZ6+JUSFPBlK0zNErqBY8GLvBVbS8q1ldNcBwqSuME=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "f42f80c9eda52453b6042aee6f614302d076b852", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "haskellNix": { + "inputs": { + "HTTP": "HTTP", + "cabal-32": "cabal-32", + "cabal-34": "cabal-34", + "cabal-36": "cabal-36", + "cardano-shell": "cardano-shell", + "flake-compat": "flake-compat", + "flake-utils": "flake-utils_2", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", + "hackage": "hackage", + "hpc-coveralls": "hpc-coveralls", + "hydra": "hydra", + "iserv-proxy": "iserv-proxy", + "nixpkgs": [ + "haskellNix", + "nixpkgs-unstable" + ], + "nixpkgs-2003": "nixpkgs-2003", + "nixpkgs-2105": "nixpkgs-2105", + "nixpkgs-2111": "nixpkgs-2111", + "nixpkgs-2205": "nixpkgs-2205", + "nixpkgs-2211": "nixpkgs-2211", + "nixpkgs-unstable": "nixpkgs-unstable", + "old-ghc-nix": "old-ghc-nix", + "stackage": "stackage", + "tullia": "tullia" + }, + "locked": { + "lastModified": 1671065520, + "narHash": "sha256-Mbcbyx0DKTdzNWmDj17nzfaazL7qg/cNAzJFKZ1i92E=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "af2c47f5909c5c74c28124f8793539736680d606", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, + "hpc-coveralls": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, + "hydra": { + "inputs": { + "nix": "nix", + "nixpkgs": [ + "haskellNix", + "hydra", + "nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1646878427, + "narHash": "sha256-KtbrofMtN8GlM7D+n90kixr7QpSlVmdN+vK5CA/aRzc=", + "owner": "NixOS", + "repo": "hydra", + "rev": "28b682b85b7efc5cf7974065792a1f22203a5927", + "type": "github" + }, + "original": { + "id": "hydra", + "type": "indirect" + } + }, + "iserv-proxy": { + "flake": false, + "locked": { + "lastModified": 1639165170, + "narHash": "sha256-QsWL/sBDL5GM8IXd/dE/ORiL4RvteEN+aok23tXgAoc=", + "rev": "6e95df7be6dd29680f983db07a057fc2f34f81f6", + "revCount": 7, + "type": "git", + "url": "https://gitlab.haskell.org/ghc/iserv-proxy.git" + }, + "original": { + "rev": "6e95df7be6dd29680f983db07a057fc2f34f81f6", + "type": "git", + "url": "https://gitlab.haskell.org/ghc/iserv-proxy.git" + } + }, + "lowdown-src": { + "flake": false, + "locked": { + "lastModified": 1633514407, + "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=", + "owner": "kristapsdz", + "repo": "lowdown", + "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8", + "type": "github" + }, + "original": { + "owner": "kristapsdz", + "repo": "lowdown", + "type": "github" + } + }, + "mdbook-kroki-preprocessor": { + "flake": false, + "locked": { + "lastModified": 1661755005, + "narHash": "sha256-1TJuUzfyMycWlOQH67LR63/ll2GDZz25I3JfScy/Jnw=", + "owner": "JoelCourtney", + "repo": "mdbook-kroki-preprocessor", + "rev": "93adb5716d035829efed27f65f2f0833a7d3e76f", + "type": "github" + }, + "original": { + "owner": "JoelCourtney", + "repo": "mdbook-kroki-preprocessor", + "type": "github" + } + }, + "n2c": { + "inputs": { + "flake-utils": "flake-utils_5", + "nixpkgs": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1665039323, + "narHash": "sha256-SAh3ZjFGsaCI8FRzXQyp56qcGdAqgKEfJWPCQ0Sr7tQ=", + "owner": "nlewo", + "repo": "nix2container", + "rev": "b008fe329ffb59b67bf9e7b08ede6ee792f2741a", + "type": "github" + }, + "original": { + "owner": "nlewo", + "repo": "nix2container", + "type": "github" + } + }, + "nix": { + "inputs": { + "lowdown-src": "lowdown-src", + "nixpkgs": "nixpkgs", + "nixpkgs-regression": "nixpkgs-regression" + }, + "locked": { + "lastModified": 1643066034, + "narHash": "sha256-xEPeMcNJVOeZtoN+d+aRwolpW8mFSEQx76HTRdlhPhg=", + "owner": "NixOS", + "repo": "nix", + "rev": "a1cd7e58606a41fcf62bf8637804cf8306f17f62", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "2.6.0", + "repo": "nix", + "type": "github" + } + }, + "nix-nomad": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-utils": [ + "haskellNix", + "tullia", + "nix2container", + "flake-utils" + ], + "gomod2nix": "gomod2nix", + "nixpkgs": [ + "haskellNix", + "tullia", + "nixpkgs" + ], + "nixpkgs-lib": [ + "haskellNix", + "tullia", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1658277770, + "narHash": "sha256-T/PgG3wUn8Z2rnzfxf2VqlR1CBjInPE0l1yVzXxPnt0=", + "owner": "tristanpemble", + "repo": "nix-nomad", + "rev": "054adcbdd0a836ae1c20951b67ed549131fd2d70", + "type": "github" + }, + "original": { + "owner": "tristanpemble", + "repo": "nix-nomad", + "type": "github" + } + }, + "nix2container": { + "inputs": { + "flake-utils": "flake-utils_3", + "nixpkgs": "nixpkgs_3" + }, + "locked": { + "lastModified": 1658567952, + "narHash": "sha256-XZ4ETYAMU7XcpEeAFP3NOl9yDXNuZAen/aIJ84G+VgA=", + "owner": "nlewo", + "repo": "nix2container", + "rev": "60bb43d405991c1378baf15a40b5811a53e32ffa", + "type": "github" + }, + "original": { + "owner": "nlewo", + "repo": "nix2container", + "type": "github" + } + }, + "nixago": { + "inputs": { + "flake-utils": [ + "haskellNix", + "tullia", + "std", + "flake-utils" + ], + "nixago-exts": [ + "haskellNix", + "tullia", + "std", + "blank" + ], + "nixpkgs": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1661824785, + "narHash": "sha256-/PnwdWoO/JugJZHtDUioQp3uRiWeXHUdgvoyNbXesz8=", + "owner": "nix-community", + "repo": "nixago", + "rev": "8c1f9e5f1578d4b2ea989f618588d62a335083c3", + "type": "github" + }, + "original": { + "owner": "nix-community", + "repo": "nixago", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1632864508, + "narHash": "sha256-d127FIvGR41XbVRDPVvozUPQ/uRHbHwvfyKHwEt5xFM=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "82891b5e2c2359d7e58d08849e4c89511ab94234", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "ref": "nixos-21.05-small", + "type": "indirect" + } + }, + "nixpkgs-2003": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105": { + "locked": { + "lastModified": 1659914493, + "narHash": "sha256-lkA5X3VNMKirvA+SUzvEhfA7XquWLci+CGi505YFAIs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "022caabb5f2265ad4006c1fa5b1ebe69fb0c3faf", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111": { + "locked": { + "lastModified": 1659446231, + "narHash": "sha256-hekabNdTdgR/iLsgce5TGWmfIDZ86qjPhxDg/8TlzhE=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "eabc38219184cc3e04a974fe31857d8e0eac098d", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2205": { + "locked": { + "lastModified": 1663981975, + "narHash": "sha256-TKaxWAVJR+a5JJauKZqibmaM5e/Pi5tBDx9s8fl/kSE=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "309faedb8338d3ae8ad8f1043b3ccf48c9cc2970", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-22.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2211": { + "locked": { + "lastModified": 1669997163, + "narHash": "sha256-vhjC0kZMFoN6jzK0GR+tBzKi5KgBXgehadfidW8+Va4=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6f87491a54d8d64d30af6663cb3bf5d2ee7db958", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-22.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-regression": { + "locked": { + "lastModified": 1643052045, + "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "indirect" + } + }, + "nixpkgs-unstable": { + "locked": { + "lastModified": 1663905476, + "narHash": "sha256-0CSwRKaYravh9v6qSlBpM0gNg0UhKT2lL7Yn6Zbx7UM=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "e14f9fb57315f0d4abde222364f19f88c77d2b79", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1653581809, + "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "83658b28fe638a170a19b8933aa008b30640fbd1", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1654807842, + "narHash": "sha256-ADymZpr6LuTEBXcy6RtFHcUZdjKTBRTMYwu19WOx17E=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "fc909087cc3386955f21b4665731dbdaceefb1d8", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_4": { + "locked": { + "lastModified": 1665087388, + "narHash": "sha256-FZFPuW9NWHJteATOf79rZfwfRn5fE0wi9kRzvGfDHPA=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "95fda953f6db2e9496d2682c4fc7b82f959878f7", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "old-ghc-nix": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "haskellNix": "haskellNix", + "nixpkgs": [ + "haskellNix", + "nixpkgs-unstable" + ] + } + }, + "stackage": { + "flake": false, + "locked": { + "lastModified": 1670890221, + "narHash": "sha256-kV7irjUr4Ot3b2MwTcgVKYuEe+legxhGh4ApBeESy1s=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "56f59c2d4ecdb237348a0774274f38874f81a3ca", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "std": { + "inputs": { + "blank": "blank", + "devshell": "devshell", + "dmerge": "dmerge", + "flake-utils": "flake-utils_4", + "makes": [ + "haskellNix", + "tullia", + "std", + "blank" + ], + "mdbook-kroki-preprocessor": "mdbook-kroki-preprocessor", + "microvm": [ + "haskellNix", + "tullia", + "std", + "blank" + ], + "n2c": "n2c", + "nixago": "nixago", + "nixpkgs": "nixpkgs_4", + "yants": "yants" + }, + "locked": { + "lastModified": 1665513321, + "narHash": "sha256-D6Pacw9yf/HMs84KYuCxHXnNDL7v43gtcka5URagFqE=", + "owner": "divnix", + "repo": "std", + "rev": "94a90eedb9cfc115b12ae8f6622d9904788559e4", + "type": "github" + }, + "original": { + "owner": "divnix", + "repo": "std", + "type": "github" + } + }, + "tullia": { + "inputs": { + "nix-nomad": "nix-nomad", + "nix2container": "nix2container", + "nixpkgs": [ + "haskellNix", + "nixpkgs" + ], + "std": "std" + }, + "locked": { + "lastModified": 1668711738, + "narHash": "sha256-CBjky16o9pqsGE1bWu6nRlRajgSXMEk+yaFQLibqXcE=", + "owner": "input-output-hk", + "repo": "tullia", + "rev": "ead1f515c251f0e060060ef0e2356a51d3dfe4b0", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "tullia", + "type": "github" + } + }, + "utils": { + "locked": { + "lastModified": 1653893745, + "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "yants": { + "inputs": { + "nixpkgs": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1660507851, + "narHash": "sha256-BKjq7JnVuUR/xDtcv6Vm9GYGKAblisXrAgybor9hT/s=", + "owner": "divnix", + "repo": "yants", + "rev": "0b895ca02a8fa72bad50b454cb3e7d8a66407c96", + "type": "github" + }, + "original": { + "owner": "divnix", + "repo": "yants", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..76c754c --- /dev/null +++ b/flake.nix @@ -0,0 +1,39 @@ +{ + nixConfig = { + extra-trusted-public-keys = ["hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ="]; + extra-substituters = ["https://cache.iog.io"]; + }; + description = "Bayesian phylogentic playground"; + inputs.haskellNix.url = "github:input-output-hk/haskell.nix"; + inputs.nixpkgs.follows = "haskellNix/nixpkgs-unstable"; + inputs.flake-utils.url = "github:numtide/flake-utils"; + outputs = { + self, + nixpkgs, + flake-utils, + haskellNix, + }: + flake-utils.lib.eachSystem ["x86_64-linux"] (system: let + overlays = [ + haskellNix.overlay + (final: prev: { + phylogenies = final.haskell-nix.project' { + src = ./.; + compiler-nix-name = "ghc925"; + shell.tools = { + hlint = {}; + ormolu = {}; + }; + shell.buildInputs = with pkgs; [ + ]; + }; + }) + ]; + pkgs = import nixpkgs { + inherit system overlays; + inherit (haskellNix) config; + }; + flake = pkgs.phylogenies.flake {}; + in + flake // { packages.default = flake.packages."ppl:lib:ppl";}); +} diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..7c3a3e8 --- /dev/null +++ b/package.yaml @@ -0,0 +1,20 @@ +name: ppl +version: 0.0.1 +synopsis: Reimplementation of LazyPPL +maintainer: Justin Bedo +license: MIT + +dependencies: + - base >= 4.9 && < 5 + - transformers + - log-domain + - random + - template-haskell + - containers + +library: + source-dirs: src + exposed-modules: + - PPL + - PPL.Distr + - PPL.Sampling diff --git a/ppl.cabal b/ppl.cabal new file mode 100644 index 0000000..b3b5533 --- /dev/null +++ b/ppl.cabal @@ -0,0 +1,31 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.7. +-- +-- see: https://github.com/sol/hpack + +name: ppl +version: 0.0.1 +synopsis: Reimplementation of LazyPPL +maintainer: Justin Bedo +license: MIT +build-type: Simple + +library + exposed-modules: + PPL + PPL.Distr + PPL.Sampling + other-modules: + PPL.Internal + Paths_ppl + hs-source-dirs: + src + build-depends: + base >=4.9 && <5 + , containers + , log-domain + , random + , template-haskell + , transformers + default-language: Haskell2010 diff --git a/src/PPL.hs b/src/PPL.hs new file mode 100644 index 0000000..21bb87c --- /dev/null +++ b/src/PPL.hs @@ -0,0 +1,5 @@ +module PPL(module PPL.Internal, module PPL.Sampling, module PPL.Distr) where + +import PPL.Internal +import PPL.Sampling +import PPL.Distr diff --git a/src/PPL/Distr.hs b/src/PPL/Distr.hs new file mode 100644 index 0000000..797379b --- /dev/null +++ b/src/PPL/Distr.hs @@ -0,0 +1,100 @@ +module PPL.Distr where + +import PPL.Internal +import qualified PPL.Internal as I + +-- Acklam's approximation +-- https://web.archive.org/web/20151030215612/http://home.online.no/~pjacklam/notes/invnorm/ +{-# INLINE probit #-} +probit :: Double -> Double +probit p + | p < lower = + let q = sqrt (-2 * log p) + in (((((c1 * q + c2) * q + c3) * q + c4) * q + c5) * q + c6) + / ((((d1 * q + d2) * q + d3) * q + d4) * q + 1) + | p < 1 - lower = + let q = p - 0.5 + r = q * q + in (((((a1 * r + a2) * r + a3) * r + a4) * r + a5) * r + a6) * q + / (((((b1 * r + b2) * r + b3) * r + b4) * r + b5) * r + 1) + | otherwise = -probit (1 - p) + where + a1 = -3.969683028665376e+01 + a2 = 2.209460984245205e+02 + a3 = -2.759285104469687e+02 + a4 = 1.383577518672690e+02 + a5 = -3.066479806614716e+01 + a6 = 2.506628277459239e+00 + + b1 = -5.447609879822406e+01 + b2 = 1.615858368580409e+02 + b3 = -1.556989798598866e+02 + b4 = 6.680131188771972e+01 + b5 = -1.328068155288572e+01 + + c1 = -7.784894002430293e-03 + c2 = -3.223964580411365e-01 + c3 = -2.400758277161838e+00 + c4 = -2.549732539343734e+00 + c5 = 4.374664141464968e+00 + c6 = 2.938163982698783e+00 + + d1 = 7.784695709041462e-03 + d2 = 3.224671290700398e-01 + d3 = 2.445134137142996e+00 + d4 = 3.754408661907416e+00 + + lower = 0.02425 + +iid :: Prob a -> Prob [a] +iid = sequence . repeat + +gauss = probit <$> uniform + +norm m s = (+ m) . (* s) <$> gauss + +-- Marsaglia's fast gamma rejection sampling +gamma a = do + x <- gauss + u <- uniform + if u < 1 - 0.03331 * x ** 4 + then pure $ d * v x + else gamma a + where + d = a - 1 / 3 + v x = (1 + x / sqrt (9 * d)) ** 3 + +beta a b = do + x <- gamma a + y <- gamma b + pure $ x / (x + y) + +bern p = (< p) <$> uniform + +binom n = fmap (length . filter id . take n) . iid . bern + +exponential lambda = negate . (/ lambda) . log <$> uniform + +geom :: Double -> Prob Int +geom p = first 0 <$> iid (bern p) + where + first n (True : _) = n + first n (_ : xs) = first (n + 1) xs + +bounded lower upper = (+ lower) . (* (upper - lower)) <$> uniform + +bounded' lower upper = round <$> bounded (fromIntegral lower) (fromIntegral upper) + +cat :: [Double] -> Prob Int +cat xs = search 0 (tail $ scanl (+) 0 xs) <$> uniform + where + search i [] _ = i + search i (x : xs) r + | x > r = i + | otherwise = search (i + 1) xs r + +dirichletProcess p = go 1 + where + go rest = do + x <- beta 1 p + (x*rest:) <$> go (rest - x*rest) diff --git a/src/PPL/Internal.hs b/src/PPL/Internal.hs new file mode 100644 index 0000000..a729d3d --- /dev/null +++ b/src/PPL/Internal.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module PPL.Internal (uniform, split, Prob(..), Meas, score, scoreLog, sample, +randomTree, samples, mutateTree) where + +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Writer +import Data.Monoid +import qualified Language.Haskell.TH.Syntax as TH +import Numeric.Log +import System.Random hiding (uniform, split) +import qualified System.Random as R +import Data.Bifunctor +import Control.Monad.IO.Class + +-- Reimplementation of the LazyPPL monads to avoid some dependencies + +data Tree = Tree Double [Tree] + +split :: Tree -> (Tree, Tree) +split (Tree r (t : ts)) = (t, Tree r ts) + +{-# INLINE randomTree #-} +randomTree :: RandomGen g => g -> Tree +randomTree g = let (a, g') = random g in Tree a (randomTrees g') + +{-# INLINE randomTrees #-} +randomTrees :: RandomGen g => g -> [Tree] +randomTrees g = let (g1, g2) = R.split g in randomTree g1 : randomTrees g2 + +{-# INLINE mutateTree #-} +mutateTree :: RandomGen g => Double -> g -> Tree -> Tree +mutateTree p g (Tree a ts) = + let (r, g1) = random g + (b, g2) = random g1 + in Tree (if r < p then b else a) (mutateTrees p g2 ts) + +{-# INLINE mutateTrees #-} +mutateTrees :: RandomGen g => Double -> g -> [Tree] -> [Tree] +mutateTrees p g (t:ts) = + let (g1, g2) = R.split g + in mutateTree p g1 t : mutateTrees p g2 ts + +newtype Prob a = Prob {runProb :: Tree -> a} + +instance Monad Prob where + Prob f >>= g = Prob $ \t -> + let (t1, t2) = split t + (Prob g') = g (f t1) + in g' t2 + +instance Functor Prob where fmap = liftM + +instance Applicative Prob where pure = Prob . const; (<*>) = ap + +uniform = Prob $ \(Tree r _) -> r + +newtype Meas a = Meas (WriterT (Product (Log Double)) Prob a) + deriving (Functor, Applicative, Monad) + +{-# INLINE score #-} +score :: Double -> Meas () +score = scoreLog . Exp . log . max eps + where + eps = $(TH.lift (until ((== 1) . (1 +)) (/ 2) (1 :: Double))) -- machine epsilon, force compile time eval + +{-# INLINE scoreLog #-} +scoreLog :: Log Double -> Meas () +scoreLog = Meas . tell . Product + +sample :: Prob a -> Meas a +sample = Meas . lift + +{-# INLINE samples #-} +samples :: forall a. Meas a -> Tree -> [(a, Log Double)] +samples (Meas m) t = map (second getProduct) $ runProb f t + where + f = runWriterT m >>= \x -> (x:) <$> f diff --git a/src/PPL/Sampling.hs b/src/PPL/Sampling.hs new file mode 100644 index 0000000..a3f38db --- /dev/null +++ b/src/PPL/Sampling.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ViewPatterns #-} + +module PPL.Sampling where + +import Control.Monad.IO.Class +import Control.Monad.Trans.State +import Data.Bifunctor +import Data.Monoid +import Numeric.Log +import PPL.Distr +import PPL.Internal hiding (split) +import System.Random (getStdGen, newStdGen, random, randoms, split) + +importance :: MonadIO m => Int -> Meas a -> m [a] +importance n m = do + newStdGen + g <- getStdGen + let ys = take n $ accumulate xs + max = snd $ last ys + xs = samples m $ randomTree g1 + (g1, g2) = split g + let rs = randoms g2 + pure $ flip map rs $ \r -> fst . head $ flip filter ys $ \(x, w) -> w >= Exp (log r) * max + where + cumsum = tail . scanl (+) 0 + accumulate = uncurry zip . second cumsum . unzip + +mh :: MonadIO m => Double -> Meas a -> m [(a, Log Double)] +mh p m = do + newStdGen + g <- getStdGen + let (g1, g2) = split g + (x, w) = head $ samples m t + t = randomTree g1 + pure $ map (\(_, x, w) -> (x, w)) $ evalState (iterateM step (t, x, w)) g2 + where + step (t, x, w) = do + g <- get + let (g1, g2) = split g + t' = mutateTree p g1 t + (x', w') = head $ samples m t' + ratio = w' / w + (Exp . log -> r, g3) = random g2 + put g3 + pure $ + if r < ratio + then (t', x', w') + else (t, x, w) + + iterateM f x = do + y <- f x + (y :) <$> iterateM f y -- cgit v1.2.3