first commit

This commit is contained in:
Thorn Avery 2021-04-18 13:29:09 +12:00
commit d5403500fa
11 changed files with 420 additions and 0 deletions

4
.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
result
result-doc
*.swp

2
LICENSE Normal file
View File

@ -0,0 +1,2 @@
if u use dis repo u agree to not be a chud.
military and corps get out.

63
README.md Normal file
View File

@ -0,0 +1,63 @@
# cellularAutomata
a small application for running a one-dimensional cellular automata from random inputs, using comonads
## usage
the program will default to the size of the window
`-w` and `-g` inputs can be given to determine the width and height, respectively
## requirements
* `getOpt`
* `ncurses` (for detecting term width/height)
## building / running
builds using nix
from a local folder:
```
nix build .
./result/bin/cellularAutomata
```
from the repo directly:
```
nix run github:techieAgnostic/cellularAutomata -- -w 40 -g 25
```
it may also be included as a flake input, as one normally would, and added to the package list using the included overlay
## example
`./cellularAutomata -w 40 -g 25`
```
██ ████ █ █████ █ ███ █ ███ ███
██ █ ███ █ ██ █ ███ ██ █ █ █ █ ██
█ ███ ███ █ ███ █ █ ██ ██ ███
███ █ █ █ █ ██ █ ███████ ██ ██
███ █ █ █ ██ █ ██ ██ ███ ██
█ █ █ ██████ █████ ██████ █ █
██ ██ █ █ █ ██ █ █ ██ ██ █
██ ██ ██ ███ █ █ ███ ███ █ █ █
█ ███████ ██ ███ █ █ █ █ █ ███ █ ██
█ █ █████ █ █ ██ █ ██ █ █
███ █ ██ █ █ ████ █ ██ ██
█ █ █ ████ █ █ █ ███ ██ █ █████████
██ █ █ ██ █ ███████ █ ██
█████ ██ █ █████ █ ███ █ ███
██ █ ██ ███ ███ █ ██ █ █ ██
████ █ █████ ██ ██ █ █ ███ ██ █ ████
█ ███ █ ██ ██ ██ █ █████ █ ██
█ █ ███ ██ █ ██ ████████ █ ██ █ ███
█ █ █ ██ ████ █ ███ █ ███ █ █
██ █ █████ █ █ ██ █ █ ██ █
██ █ ██ ███ ██ █ ███ █ █ ██ █ █
████ █████ ██ █ ██ ███ ███ ██████ ███
█ █ █ ██ █████ █ █ ██ ██ █ █
█ █ █ ███ ██ █ ██ ███ █ █
██ █ █ ███ █ ███ █ █ ███ █ ███ █ █
█ █ ██ █ █ █ █ ██ █ █ █ ██
```

2
Setup.hs Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

30
cellularAutomata.cabal Normal file
View File

@ -0,0 +1,30 @@
cabal-version: >=1.10
-- Initial package description 'cellularAutomata.cabal' generated by 'cabal
-- init'. For further documentation, see
-- http://haskell.org/cabal/users-guide/
name: cellularAutomata
version: 0.1.0.0
-- synopsis:
-- description:
-- bug-reports:
-- license:
license-file: LICENSE
author: Thorn Avery
maintainer: s@p7.co.nz
-- copyright:
-- category:
build-type: Simple
executable cellularAutomata
main-is: Main.hs
-- other-modules:
-- other-extensions:
build-depends: base >=4.13 && <4.14
, random
, turtle
, brick
, process
hs-source-dirs: src
default-language: Haskell2010
extra-libraries: ncurses

43
flake.lock Normal file
View File

@ -0,0 +1,43 @@
{
"nodes": {
"flake-utils": {
"locked": {
"lastModified": 1601282935,
"narHash": "sha256-WQAFV6sGGQxrRs3a+/Yj9xUYvhTpukQJIcMbIi7LCJ4=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "588973065fce51f4763287f0fda87a174d78bf48",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1604368813,
"narHash": "sha256-UOLaURSO448k+4bGJlaSMYeo2F5F6CuFo9VoYDkhmsk=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "d105075a1fd870b1d1617a6008cb38b443e65433",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-20.09",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
}
},
"root": "root",
"version": 7
}

19
flake.nix Normal file
View File

@ -0,0 +1,19 @@
{
description = "a basic cellular automata using comonads";
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs/nixos-20.09";
flake-utils.url = "github:numtide/flake-utils";
};
outputs = { self, nixpkgs, flake-utils, ... }:
flake-utils.lib.eachDefaultSystem (system:
let
pkgs = import nixpkgs {
overlays = [ (import ./overlay.nix) ];
inherit system;
};
in {
defaultPackage = pkgs.cellularAutomata;
}) // {
overlay = import ./overlay.nix;
};
}

13
nix/cellularAutomata.nix Normal file
View File

@ -0,0 +1,13 @@
{ mkDerivation, base, brick, lib, ncurses, process, random, turtle
}:
mkDerivation {
pname = "cellularAutomata";
version = "0.1.0.0";
src = ./..;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [ base brick process random turtle ];
executableSystemDepends = [ ncurses ];
license = "unknown";
hydraPlatforms = lib.platforms.none;
}

3
overlay.nix Normal file
View File

@ -0,0 +1,3 @@
final: prev: {
cellularAutomata = (import ./release.nix) prev;
}

47
release.nix Normal file
View File

@ -0,0 +1,47 @@
bspkgs:
let
dontCheckPackages = [ ];
doJailbreakPackages = [ ];
dontHaddockPackages = [ ];
config = {
packageOverrides = pkgs: rec {
haskellPackages =
let
generatedOverrides = haskellPackagesNew: haskellPackagesOld:
let
toPackage = file: _: {
name = builtins.replaceStrings [ ".nix" ] [ "" ] file;
value = haskellPackagesNew.callPackage
( ./. + "/nix/${file}") { };
};
in
pkgs.lib.mapAttrs' toPackage
(builtins.readDir ./nix);
makeOverrides =
function: names: haskellPackagesNew: haskellPackagesOld:
let
toPackage = name: {
inherit name;
value = function haskellPackagesOld.${name};
};
in
builtins.listToAttrs (map toPackage names);
composeExtensionsList =
pkgs.lib.fold pkgs.lib.composeExtensions (_: _: {});
manualOverrides = haskellPackagesNew: haskellPackagesOld: {
};
in
pkgs.haskellPackages.override {
overrides = composeExtensionsList [
generatedOverrides
(makeOverrides pkgs.haskell.lib.dontCheck dontCheckPackages)
(makeOverrides pkgs.haskell.lib.doJailbreak doJailbreakPackages)
(makeOverrides pkgs.haskell.lib.dontHaddock dontHaddockPackages)
manualOverrides
];
};
};
};
pkgs = import bspkgs.path { inherit config; system = bspkgs.system; };
in
pkgs.haskellPackages.cellularAutomata

194
src/Main.hs Normal file
View File

@ -0,0 +1,194 @@
module Main where
--import System.Random
import Control.Monad
import System.Process
import System.Random
import System.Console.GetOpt
import System.Environment(getArgs, getProgName)
import Data.Maybe (fromMaybe)
-------------------
-- comonad class --
-------------------
class Functor w => Comonad w
where
(=>>) :: w a -> (w a -> b) -> w b
extract :: w a -> a
duplicate :: w a -> w (w a)
x =>> f = fmap f (duplicate x)
------------
-- spaces --
------------
-- a locally focussed space
data Space t = Space [t] t [t]
-- spaces are also functors
instance Functor Space where
fmap f (Space l c r) = Space (map f l) (f c) (map f r)
-- our space is a comonad
instance Comonad Space where
-- duplicate will create a new space where
-- the focussed element is our original space
-- and each side is increasingly shifted copies
-- in that direction
duplicate w =
Space (tail $ iterate left w)
w
(tail $ iterate right w)
-- extract simply returns the focussed element
extract (Space _ c _) = c
-- functions for moving the point
-- of locality.
-- todo: question the empty list cases
-- most spaces should be infinite
right :: Space t -> Space t
right s@(Space l c []) = s
right (Space l c (r:rs)) = Space (c:l) r rs
left :: Space t -> Space t
left s@(Space [] c r) = s
left (Space (l:ls) c r) = Space ls l (c:r)
-- bound will take an infinite space
-- and bound it by i and j on each side
-- (not including the focus) and
-- turn it into a list for printing
bound :: Int -> Int -> Space t -> [t]
bound i j (Space l c r) = (reverse (take i l)) ++ (c:(take j r))
-- boundw works as above, but the
-- entire list will be the size
-- given
boundw :: Int -> Space t -> [t]
boundw n = bound (x-m) x
where
o = if odd n then 1 else 0
m = if even n then 1 else 0
x = (n - o) `div` 2
-----------------------
-- cellular automata --
-----------------------
-- the states our cells can be in
-- may need to provide an ordering
-- may need to generalise the number
-- of states
data CellState = Alive | Dead
deriving Eq
-- how the states are displayed on screen
-- this should probably be input to a function
-- rather than hardcoded
instance Show CellState
where
show Alive = ""
show Dead = " "
-- a rule stating how a cell is determined
rule :: Space CellState -> CellState
rule (Space (l:_) _ (r:_))
| l == r = Dead
| otherwise = Alive
-- take a space and a rule and
-- return the next space
step :: (Space t -> t) -> Space t -> Space t
step f w = w =>> f
---------------
-- rng stuff --
---------------
-- takes a generator and returns
-- an infinite list of bools
ilobs :: StdGen -> [Bool]
ilobs rng = b : (ilobs r)
where
(b,r) = random rng
-----------------
-- gross io bs --
-----------------
-- everything below this line deals with
-- input/output, and is therefore gross
-- i will clean this up one day, but it
-- hurts my soul.
------------------------
-- command line flags --
------------------------
-- structure containing the programs options
data Options = Options
{ optWidth :: Int
, optGenerations :: Int
} deriving Show
-- the default options for the program
-- the width and generations are injected
-- and intended to be gotten at runtime
-- to match the window dimensions
defaultOptions :: Int -> Int -> Options
defaultOptions w h = Options
{ optWidth = w
, optGenerations = h
}
-- the avaliable options
options :: [OptDescr (Options -> Options)]
options =
[ Option ['w'] ["width"]
(ReqArg (\w opts -> opts { optWidth = (read w) }) "WIDTH")
"term width"
, Option ['g'] ["generations"]
(ReqArg (\t opts -> opts { optGenerations = (read t) }) "GENERATIONS")
"time steps to simulate"
]
-- parse the options into the structure
-- erroring if encountering a flag not known to us
parseArgs :: IO Options
parseArgs = do
argv <- getArgs
progName <- getProgName
tw <- readProcess "tput" [ "cols" ] ""
th <- readProcess "tput" [ "lines" ] ""
case getOpt RequireOrder options argv of
(opts, [], []) -> return (foldl (flip id) (defaultOptions (read tw) (read th)) opts)
(_, _, errs) -> ioError (userError (concat errs ++ helpMessage))
where
header = "Usage: " ++ progName ++ " [OPTION...]"
helpMessage = usageInfo header options
---------------
-- main loop --
---------------
-- simply print the current space, then recurse to the next
runAutomata :: Space CellState -> Int -> Int -> IO ()
runAutomata s 0 w = putStrLn $ concat $ map show $ boundw w s
runAutomata s n w = do
putStrLn $ concat $ map show $ boundw w s
runAutomata (step rule s) (n - 1) w
main :: IO ()
main = do
options <- parseArgs
rng <- getStdGen
let cs = map (\x -> if x then Alive else Dead) $ ilobs rng
let w = (optWidth options)
let h = (optGenerations options)
let wh = (w + 1) `div` 2
let m = head cs
let l = take wh $ drop 1 cs
let r = take wh $ drop wh $ drop 1 cs
let s = Space (l ++ (repeat Dead)) m (r ++ (repeat Dead))
runAutomata s h w