Browse Source

first commit

master
Thorn Avery 3 years ago
commit
d5403500fa
11 changed files with 420 additions and 0 deletions
  1. +4
    -0
      .gitignore
  2. +2
    -0
      LICENSE
  3. +63
    -0
      README.md
  4. +2
    -0
      Setup.hs
  5. +30
    -0
      cellularAutomata.cabal
  6. +43
    -0
      flake.lock
  7. +19
    -0
      flake.nix
  8. +13
    -0
      nix/cellularAutomata.nix
  9. +3
    -0
      overlay.nix
  10. +47
    -0
      release.nix
  11. +194
    -0
      src/Main.hs

+ 4
- 0
.gitignore View File

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


+ 2
- 0
LICENSE View File

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

+ 63
- 0
README.md 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
- 0
Setup.hs View File

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

+ 30
- 0
cellularAutomata.cabal 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
- 0
flake.lock 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
- 0
flake.nix 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
- 0
nix/cellularAutomata.nix 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
- 0
overlay.nix View File

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

+ 47
- 0
release.nix 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
- 0
src/Main.hs 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

Loading…
Cancel
Save