Add 'factorio-throughput'
This commit is contained in:
commit
40db6f8b37
|
@ -1,27 +1,28 @@
|
|||
# Purescript
|
||||
|
||||
| Name | Description |
|
||||
| ---------------------------------------- | -------------------------------------------------------------------------------------------------------------------- |
|
||||
| [abilities](./abilities/) | Typeclass-dictionary abuse enabling the creation of a barebones effect system |
|
||||
| [bug](./bug/) | Unknown reason of existence |
|
||||
| [canopy](./canopy/) | Unfinished attempt at writing a [Diplomacy](<https://en.wikipedia.org/wiki/Diplomacy_(game)>) adjudecation engine |
|
||||
| [compose](./compose/) | Overload do-notation for function composition and existential types |
|
||||
| [ecs](./ecs/) | Purescript-wrapper for [thi.ng/ecs](thi.ng/ecs) |
|
||||
| [existentials-blog](./existentials-blog) | Perhaps supposed to turn into a blog about existentials? |
|
||||
| [existentials](./existentials) | Experiment regarding the Church-encoding of existential types |
|
||||
| [free](./free/) | Experiments regarding free monads and interpreting algebras |
|
||||
| [gadts](./gadts) | Experiment regarding ways to encode GADTs in Purescript |
|
||||
| [kombinators](./kombinators) | Attempt at generating factorio combinator networks programmatically |
|
||||
| [lambda-calculus](./lambda-calculus) | Lambda calculus evaluator |
|
||||
| [lunarline](./lunarline) | Attempt at optimizing a functional language using compile-time partial evaluation |
|
||||
| [lune](./lune) | Failed effect-system project |
|
||||
| [maps](./maps) | Attempt at implementing maps with membership proofs |
|
||||
| [proofs](./proofs) | Attempt at expressing mathematical proofs using Purescript's effect system |
|
||||
| [purebird](./purebird) | Flappy-bird game |
|
||||
| [purpleflow](./purpleflow) | Unfinished dependently-typed programming language |
|
||||
| [slice](./slice) | Basic benchmarks and a `Slice` type |
|
||||
| [sprint](./sprint) | Failled effect-system based on typelevel lists |
|
||||
| [strategy](./strategy) | Unfinished attempt at implementing a mixed strategy nash equilibrium solver |
|
||||
| [streams](./streams) | Playing with `purescript-pipes` |
|
||||
| [thumbor](./thumbor) | Dropped attempt at writing purescript bindings for [thumbor-ts](https://github.com/Brettm12345/thumbor-ts) |
|
||||
| [typelevel](./typelevel) | Typelevel naturals, vectors, sum-types, orderings and lambda-calculus evaluation and a value-level bounded-type GADT |
|
||||
| Name | Description |
|
||||
| --------------------------------------------- | -------------------------------------------------------------------------------------------------------------------- |
|
||||
| [abilities](./abilities/) | Typeclass-dictionary abuse enabling the creation of a barebones effect system |
|
||||
| [bug](./bug/) | Unknown reason of existence |
|
||||
| [canopy](./canopy/) | Unfinished attempt at writing a [Diplomacy](<https://en.wikipedia.org/wiki/Diplomacy_(game)>) adjudecation engine |
|
||||
| [compose](./compose/) | Overload do-notation for function composition and existential types |
|
||||
| [ecs](./ecs/) | Purescript-wrapper for [thi.ng/ecs](thi.ng/ecs) |
|
||||
| [existentials-blog](./existentials-blog) | Perhaps supposed to turn into a blog about existentials? |
|
||||
| [existentials](./existentials) | Experiment regarding the Church-encoding of existential types |
|
||||
| [free](./free/) | Experiments regarding free monads and interpreting algebras |
|
||||
| [factorio-throughput](./factorio-throughput/) | Experiments with computing throughput of factorio systems |
|
||||
| [gadts](./gadts) | Experiment regarding ways to encode GADTs in Purescript |
|
||||
| [kombinators](./kombinators) | Attempt at generating factorio combinator networks programmatically |
|
||||
| [lambda-calculus](./lambda-calculus) | Lambda calculus evaluator |
|
||||
| [lunarline](./lunarline) | Attempt at optimizing a functional language using compile-time partial evaluation |
|
||||
| [lune](./lune) | Failed effect-system project |
|
||||
| [maps](./maps) | Attempt at implementing maps with membership proofs |
|
||||
| [proofs](./proofs) | Attempt at expressing mathematical proofs using Purescript's effect system |
|
||||
| [purebird](./purebird) | Flappy-bird game |
|
||||
| [purpleflow](./purpleflow) | Unfinished dependently-typed programming language |
|
||||
| [slice](./slice) | Basic benchmarks and a `Slice` type |
|
||||
| [sprint](./sprint) | Failled effect-system based on typelevel lists |
|
||||
| [strategy](./strategy) | Unfinished attempt at implementing a mixed strategy nash equilibrium solver |
|
||||
| [streams](./streams) | Playing with `purescript-pipes` |
|
||||
| [thumbor](./thumbor) | Dropped attempt at writing purescript bindings for [thumbor-ts](https://github.com/Brettm12345/thumbor-ts) |
|
||||
| [typelevel](./typelevel) | Typelevel naturals, vectors, sum-types, orderings and lambda-calculus evaluation and a value-level bounded-type GADT |
|
||||
|
|
16
purescript/factorio-throughput/.gitignore
vendored
Normal file
16
purescript/factorio-throughput/.gitignore
vendored
Normal file
|
@ -0,0 +1,16 @@
|
|||
/bower_components/
|
||||
/node_modules/
|
||||
/.pulp-cache/
|
||||
/output/
|
||||
/generated-docs/
|
||||
/.psc-package/
|
||||
/.psc*
|
||||
/.purs*
|
||||
/.psa*
|
||||
/.spago
|
||||
dist
|
||||
*.aux
|
||||
*.fls
|
||||
*.fdb_*
|
||||
*.synctex*
|
||||
*.log
|
22
purescript/factorio-throughput/build.js
Normal file
22
purescript/factorio-throughput/build.js
Normal file
|
@ -0,0 +1,22 @@
|
|||
const esbuild = require("esbuild");
|
||||
const PurescriptPlugin = require("esbuild-plugin-purescript");
|
||||
const path = require("path");
|
||||
|
||||
const isProd = process.env.NODE_ENV === "production";
|
||||
|
||||
esbuild
|
||||
.build({
|
||||
entryPoints: ["src/index.js"],
|
||||
bundle: true,
|
||||
outdir: "dist",
|
||||
watch: !isProd,
|
||||
plugins: [
|
||||
PurescriptPlugin({
|
||||
output: isProd ? path.resolve(__dirname, "dce-output") : undefined,
|
||||
}),
|
||||
],
|
||||
define: {
|
||||
global: "window",
|
||||
},
|
||||
})
|
||||
.catch((_e) => process.exit(1));
|
BIN
purescript/factorio-throughput/idea/example.pdf
Normal file
BIN
purescript/factorio-throughput/idea/example.pdf
Normal file
Binary file not shown.
94
purescript/factorio-throughput/idea/example.tex
Normal file
94
purescript/factorio-throughput/idea/example.tex
Normal file
|
@ -0,0 +1,94 @@
|
|||
\documentclass[a4paper, 12pt]{article}
|
||||
|
||||
\newcommand{\bold}{\textbf}
|
||||
|
||||
\usepackage[english]{babel}
|
||||
\usepackage{amsmath}
|
||||
\usepackage{tikz}
|
||||
\usepackage{indentfirst}
|
||||
|
||||
\begin{document}
|
||||
|
||||
\newcommand{\q2}{\quad\quad}
|
||||
|
||||
\title{\Large{\bold{Moontorio}}}
|
||||
\author{Matei Adriel}
|
||||
\date {}
|
||||
|
||||
\maketitle
|
||||
|
||||
\section{Example 1}
|
||||
|
||||
Solve the following factory:
|
||||
|
||||
\vspace*{20pt}
|
||||
\begin{figure}[h]
|
||||
\centering
|
||||
\begin{tikzpicture}[shorten >=1pt, auto, node distance={30mm},
|
||||
main/.style = {draw, rectangle}]
|
||||
|
||||
\node[main] (3) {$consumer_1$};
|
||||
\node[main] (1) [above left of=3] {$provider_1$};
|
||||
\node[main] (2) [below left of=3] {$provider_2$};
|
||||
\node[main] (4) [right of=2] {$consumer_2$};
|
||||
|
||||
\draw[->] (1) edge node{$p_1$} (3);
|
||||
\draw[->] (2) edge node{$p_2$} (3);
|
||||
\draw[->] (2) edge node{$p_3$} (4);
|
||||
|
||||
\end{tikzpicture}
|
||||
\caption{Factory}
|
||||
\label{fig:Factory}
|
||||
\end{figure}
|
||||
|
||||
Generating the constraints:
|
||||
\begin{figure}[h]
|
||||
\centering
|
||||
|
||||
\begin{equation}
|
||||
p_1(t) < provider_1(t)
|
||||
\end{equation}
|
||||
|
||||
\begin{equation}
|
||||
p_3(t) < consumer_2(t)
|
||||
\end{equation}
|
||||
|
||||
\begin{equation}
|
||||
\begin{split}
|
||||
\begin{cases}
|
||||
\begin{cases}
|
||||
p_2(t) &< \displaystyle\frac{consumer_1(t)}{2}\\
|
||||
p_1(t) &< consumer_1(t) - p_2(t)
|
||||
\end{cases}
|
||||
\ ,&\;\mbox{if } p_1(t) \geq p_2(t)\\\\
|
||||
\begin{cases}
|
||||
p_1(t) &< \displaystyle\frac{consumer_1(t)}{2}\\
|
||||
p_2(t) &< consumer_1(t) - p_1(t)
|
||||
\end{cases}
|
||||
\ ,&\;\mbox{if } p_1(t) < p_2(t)
|
||||
\end{cases}
|
||||
\end{split}
|
||||
\end{equation}
|
||||
|
||||
\begin{equation}
|
||||
\begin{split}
|
||||
\begin{cases}
|
||||
\begin{cases}
|
||||
p_3(t) &< \displaystyle\frac{provider_2(t)}{2}\\
|
||||
p_2(t) &< provider_2(t) - p_3(t)
|
||||
\end{cases}
|
||||
\ ,&\;\mbox{if } p_2(t) \geq p_3(t)\\\\
|
||||
\begin{cases}
|
||||
p_2(t) &< \displaystyle\frac{provider_2(t)}{2}\\
|
||||
p_3(t) &< provider_2(t) - p_3(t)
|
||||
\end{cases}
|
||||
\ ,&\;\mbox{if } p_2(t) < p_3(t)
|
||||
\end{cases}
|
||||
\end{split}
|
||||
\end{equation}
|
||||
|
||||
\caption{Constraints}
|
||||
\label{fig:Constraints}
|
||||
\end{figure}
|
||||
|
||||
\end{document}
|
BIN
purescript/factorio-throughput/idea/hmm.pdf
Normal file
BIN
purescript/factorio-throughput/idea/hmm.pdf
Normal file
Binary file not shown.
77
purescript/factorio-throughput/idea/hmm.tex
Normal file
77
purescript/factorio-throughput/idea/hmm.tex
Normal file
|
@ -0,0 +1,77 @@
|
|||
\documentclass[a4paper, 12pt]{article}
|
||||
|
||||
\newcommand{\bold}{\textbf}
|
||||
|
||||
\usepackage[english]{babel}
|
||||
\usepackage{amsmath}
|
||||
\usepackage{tikz}
|
||||
\usepackage{indentfirst}
|
||||
|
||||
\begin{document}
|
||||
|
||||
\newcommand{\q2}{\quad\quad}
|
||||
|
||||
\title{\Large{\bold{Moontorio}}}
|
||||
\author{Matei Adriel}
|
||||
\date {}
|
||||
|
||||
\maketitle
|
||||
|
||||
\section{Describing a factory}
|
||||
|
||||
A factory is made out of machines. A machine is either a provider, a belt or a consumer. Machines are connected by ports.
|
||||
|
||||
\begin{figure}[h]
|
||||
|
||||
\begin{equation}
|
||||
\begin{split}
|
||||
Machines\ A,\ B,\ C\ &::=\; belt\ p_i\ p_o \\
|
||||
&\quad|\quad provider\ p_1,\ p_2,\ ...\ p_n \\
|
||||
&\quad|\quad consumer\ p_1,\ p_2,\ ...\ p_n
|
||||
\end{split}
|
||||
\end{equation}
|
||||
\caption{Machines}
|
||||
\label{Machines}
|
||||
\end{figure}
|
||||
|
||||
We can represent the factory as a directed graph, with the machines being the nodes and the ports being the edges:
|
||||
|
||||
\vspace*{20pt}
|
||||
\begin{figure}[h]
|
||||
\centering
|
||||
\begin{tikzpicture}[shorten >=1pt, auto, node distance={50mm},
|
||||
main/.style = {draw, rectangle}]
|
||||
|
||||
\node[main] (1) {$provider_1$};
|
||||
\node[main] (2) [right of=1] {$belt_1$};
|
||||
\node[main] (3) [right of=2] {$consumer_1$};
|
||||
|
||||
\draw[->] (1) edge node{$p_1$} (2);
|
||||
\draw[->] (2) edge node{$p_2$} (3);
|
||||
|
||||
\end{tikzpicture}
|
||||
\caption{Example of a simple factory}
|
||||
\label{SimpleFactory}
|
||||
\end{figure}
|
||||
|
||||
\section{Constraints}
|
||||
The first step of the factory solving process is the constraint generation.
|
||||
We currently use 3 different types of constraints (Figure \ref{Constraints}).
|
||||
Let's take them one step at a time. The first two constrains (
|
||||
$p_k(t) <_{\Leftarrow} f(t)$ and $p_k(t) <_{\Rightarrow} f(t)$
|
||||
) are pretty similar, both limiting the flow through a port.
|
||||
|
||||
\begin{figure}[ht]
|
||||
|
||||
\begin{equation}
|
||||
\begin{split}
|
||||
Constraints\quad C_k\ &::=\; p_k(t) <_{\Leftarrow} f(t) \\
|
||||
&\quad|\quad p_k(t) <_{\Rightarrow} f(t) \\
|
||||
&\quad|\quad p_1(t) = p_2(f(t))
|
||||
\end{split}
|
||||
\end{equation}
|
||||
\caption{Constraints}
|
||||
\label{Constraints}
|
||||
\end{figure}
|
||||
|
||||
\end{document}
|
13
purescript/factorio-throughput/package.json
Normal file
13
purescript/factorio-throughput/package.json
Normal file
|
@ -0,0 +1,13 @@
|
|||
{
|
||||
"name": "moontorio",
|
||||
"scripts": {
|
||||
"build": "node build.js"
|
||||
},
|
||||
"dependencies": {
|
||||
"calculess": "^1.0.2",
|
||||
"esbuild": "^0.11.4",
|
||||
"esbuild-plugin-purescript": "^1.0.0",
|
||||
"events": "^3.3.0",
|
||||
"function-plot": "^1.22.7"
|
||||
}
|
||||
}
|
27
purescript/factorio-throughput/packages.dhall
Normal file
27
purescript/factorio-throughput/packages.dhall
Normal file
|
@ -0,0 +1,27 @@
|
|||
let upstream =
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210324/packages.dhall sha256:b4564d575da6aed1c042ca7936da97c8b7a29473b63f4515f09bb95fae8dddab
|
||||
|
||||
let additions =
|
||||
{ debugged =
|
||||
{ dependencies =
|
||||
[ "prelude"
|
||||
, "console"
|
||||
, "ordered-collections"
|
||||
, "either"
|
||||
, "tuples"
|
||||
, "lists"
|
||||
, "strings"
|
||||
, "arrays"
|
||||
, "bifunctors"
|
||||
, "record"
|
||||
, "effect"
|
||||
, "datetime"
|
||||
, "enums"
|
||||
, "unordered-collections"
|
||||
]
|
||||
, repo = "https://github.com/hdgarrood/purescript-debugged"
|
||||
, version = "master"
|
||||
}
|
||||
}
|
||||
|
||||
in upstream // additions
|
228
purescript/factorio-throughput/pnpm-lock.yaml
Normal file
228
purescript/factorio-throughput/pnpm-lock.yaml
Normal file
|
@ -0,0 +1,228 @@
|
|||
dependencies:
|
||||
calculess: 1.0.2
|
||||
esbuild: 0.11.4
|
||||
esbuild-plugin-purescript: 1.0.0
|
||||
events: 3.3.0
|
||||
function-plot: 1.22.7
|
||||
lockfileVersion: 5.1
|
||||
packages:
|
||||
/@types/assert/1.5.4:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-CaFVW21Ulu0J9sUaEWJjwmhkDkeoxa4fniVSERzZC13sU9v8NNM2lMlkfZZv60j47D+qDt0Lyo8skVP3CTXUdA==
|
||||
/built-in-math-eval/0.3.0:
|
||||
dependencies:
|
||||
math-codegen: 0.3.5
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-JA3CHLOJQ5WIxhxGDrAHZJfvxBw=
|
||||
/calculess/1.0.2:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-9VCZJhW9fp7JmMgn6aTZ0U8NhcbJRFdD3vPlaYWMKIVIH1z4F/ZgDZKqx28fABjn4HaM4VT1ZoQzsONvI2LrCA==
|
||||
/clamp/1.0.1:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-ZqDmQBGBbjcZaCj9yMjBRzEshjQ=
|
||||
/d3-array/2.12.1:
|
||||
dependencies:
|
||||
internmap: 1.0.1
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-B0ErZK/66mHtEsR1TkPEEkwdy+WDesimkM5gpZr5Dsg54BiTA5RXtYW5qTLIAcekaS9xfZrzBLF/OAkB3Qn1YQ==
|
||||
/d3-axis/2.1.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-z/G2TQMyuf0X3qP+Mh+2PimoJD41VOCjViJzT0BHeL/+JQAofkiWZbWxlwFGb1N8EN+Cl/CW+MUKbVzr1689Cw==
|
||||
/d3-color/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-SPXi0TSKPD4g9tw0NMZFnR95XVgUZiBH+uUTqQuDu1OsE2zomHU7ho0FISciaPvosimixwHFl3WHLGabv6dDgQ==
|
||||
/d3-dispatch/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-S/m2VsXI7gAti2pBoLClFFTMOO1HTtT0j99AuXLoGFKO6deHDdnv6ZGTxSTTUTgO1zVcv82fCOtDjYK4EECmWA==
|
||||
/d3-drag/2.0.0:
|
||||
dependencies:
|
||||
d3-dispatch: 2.0.0
|
||||
d3-selection: 2.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-g9y9WbMnF5uqB9qKqwIIa/921RYWzlUDv9Jl1/yONQwxbOfszAWTCm8u7HOTgJgRDXiRZN56cHT9pd24dmXs8w==
|
||||
/d3-ease/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-68/n9JWarxXkOWMshcT5IcjbB+agblQUaIsbnXmrzejn2O82n3p2A9R2zEB9HIEFWKFwPAEDDN8gR0VdSAyyAQ==
|
||||
/d3-format/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-Ab3S6XuE/Q+flY96HXT0jOXcM4EAClYFnRGY5zsjRGNy6qCYrQsMffs7cV5Q9xejb35zxW5hf/guKw34kvIKsA==
|
||||
/d3-interpolate/2.0.1:
|
||||
dependencies:
|
||||
d3-color: 2.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-c5UhwwTs/yybcmTpAVqwSFl6vrQ8JZJoT5F7xNFK9pymv5C0Ymcc9/LIJHtYIggg/yS9YHw8i8O8tgb9pupjeQ==
|
||||
/d3-path/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-ZwZQxKhBnv9yHaiWd6ZU4x5BtCQ7pXszEV9CU6kRgwIQVQGLMv1oiL4M+MK/n79sYzsj+gcgpPQSctJUsLN7fA==
|
||||
/d3-scale/3.2.4:
|
||||
dependencies:
|
||||
d3-array: 2.12.1
|
||||
d3-format: 2.0.0
|
||||
d3-interpolate: 2.0.1
|
||||
d3-time: 2.0.0
|
||||
d3-time-format: 3.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-PG6gtpbPCFqKbvdBEswQcJcTzHC8VEd/XzezF5e68KlkT4/ggELw/nR1tv863jY6ufKTvDlzCMZvhe06codbbA==
|
||||
/d3-selection/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-XoGGqhLUN/W14NmaqcO/bb1nqjDAw5WtSYb2X8wiuQWvSZUsUVYsOSkOybUrNvcBjaywBdYPy03eXHMXjk9nZA==
|
||||
/d3-shape/2.1.0:
|
||||
dependencies:
|
||||
d3-path: 2.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-PnjUqfM2PpskbSLTJvAzp2Wv4CZsnAgTfcVRTwW03QR3MkXF8Uo7B1y/lWkAsmbKwuecto++4NlsYcvYpXpTHA==
|
||||
/d3-time-format/3.0.0:
|
||||
dependencies:
|
||||
d3-time: 2.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-UXJh6EKsHBTjopVqZBhFysQcoXSv/5yLONZvkQ5Kk3qbwiUYkdX17Xa1PT6U1ZWXGGfB1ey5L8dKMlFq2DO0Ag==
|
||||
/d3-time/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-2mvhstTFcMvwStWd9Tj3e6CEqtOivtD8AUiHT8ido/xmzrI9ijrUUihZ6nHuf/vsScRBonagOdj0Vv+SEL5G3Q==
|
||||
/d3-timer/2.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-TO4VLh0/420Y/9dO3+f9abDEFYeCUr2WZRlxJvbp4HPTQcSylXNiL6yZa9FIUvV1yRiFufl1bszTCLDqv9PWNA==
|
||||
/d3-transition/2.0.0_d3-selection@2.0.0:
|
||||
dependencies:
|
||||
d3-color: 2.0.0
|
||||
d3-dispatch: 2.0.0
|
||||
d3-ease: 2.0.0
|
||||
d3-interpolate: 2.0.1
|
||||
d3-selection: 2.0.0
|
||||
d3-timer: 2.0.0
|
||||
dev: false
|
||||
peerDependencies:
|
||||
d3-selection: '2'
|
||||
resolution:
|
||||
integrity: sha512-42ltAGgJesfQE3u9LuuBHNbGrI/AJjNL2OAUdclE70UE6Vy239GCBEYD38uBPoLeNsOhFStGpPI0BAOV+HMxog==
|
||||
/d3-zoom/2.0.0:
|
||||
dependencies:
|
||||
d3-dispatch: 2.0.0
|
||||
d3-drag: 2.0.0
|
||||
d3-interpolate: 2.0.1
|
||||
d3-selection: 2.0.0
|
||||
d3-transition: 2.0.0_d3-selection@2.0.0
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-fFg7aoaEm9/jf+qfstak0IYpnesZLiMX6GZvXtUSdv8RH2o4E2qeelgdU09eKS6wGuiGMfcnMI0nTIqWzRHGpw==
|
||||
/double-bits/1.1.1:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-WKu6RUlNpND6Nrc60RoobJGEscY=
|
||||
/esbuild-plugin-purescript/1.0.0:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-WdSdRtpm5AoRyDj3vEnmLsMsTY9kl3znRUTQe5ilbtcK/JIJv3Nz6d8lsEA079vmWgjc3JtR7Ii1y1omoz/wLg==
|
||||
/esbuild/0.11.4:
|
||||
dev: false
|
||||
hasBin: true
|
||||
requiresBuild: true
|
||||
resolution:
|
||||
integrity: sha512-qWGlOOTwyTn4f846LoR47Mif4Aek4rY9ChdXN7q7G15HpDYq3pxwnPFWe2os/jOq8naFh2Z+FqWfkq8ZP6kATw==
|
||||
/events/3.3.0:
|
||||
dev: false
|
||||
engines:
|
||||
node: '>=0.8.x'
|
||||
resolution:
|
||||
integrity: sha512-mQw+2fkQbALzQ7V0MY0IqdnXNOeTtP4r0lN9z7AAawCXgqea7bDii20AYrIBrFd/Hx0M2Ocz6S111CaFkUcb0Q==
|
||||
/extend/3.0.2:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-fjquC59cD7CyW6urNXK0FBufkZcoiGG80wTuPujX590cB5Ttln20E2UB4S/WARVqhXffZl2LNgS+gQdPIIim/g==
|
||||
/function-plot/1.22.7:
|
||||
dependencies:
|
||||
built-in-math-eval: 0.3.0
|
||||
clamp: 1.0.1
|
||||
d3-axis: 2.1.0
|
||||
d3-color: 2.0.0
|
||||
d3-format: 2.0.0
|
||||
d3-interpolate: 2.0.1
|
||||
d3-scale: 3.2.4
|
||||
d3-selection: 2.0.0
|
||||
d3-shape: 2.1.0
|
||||
d3-zoom: 2.0.0
|
||||
interval-arithmetic-eval: 0.4.7
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-rB6FeVqvgNECmt5PhIvFFEOyEjM9AWLIpMkj9Nzbzq9f81Irgn3ZrXAuv5+qnuzM99jPL7ZM4kK3+ImiKXcSHA==
|
||||
/internmap/1.0.1:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-lDB5YccMydFBtasVtxnZ3MRBHuaoE8GKsppq+EchKL2U4nK/DmEpPHNH8MZe5HkMtpSiTSOZwfN0tzYjO/lJEw==
|
||||
/interval-arithmetic-eval/0.4.7:
|
||||
dependencies:
|
||||
interval-arithmetic: 1.0.6
|
||||
math-codegen: 0.3.5
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-ClK+N4efbsgjlZR8h0qd0LQbyzUzJ9IkrjmTnD5MVb4Ytebd0lesoVP4AxLclcsEI+nIieskQ8cepHIWUPaRhQ==
|
||||
/interval-arithmetic/1.0.6:
|
||||
dependencies:
|
||||
'@types/assert': 1.5.4
|
||||
is-safe-integer: 2.0.0
|
||||
nextafter: 1.0.0
|
||||
typedarray: 0.0.6
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha512-eVotDGYPNiEaJ63oa4CeEHgOczZJ3gNHqG5wfVQ2o8sN2CEczQyR82Sjey/Bp36x8e7PtBcBvitcMnw6VUpjgQ==
|
||||
/is-safe-integer/2.0.0:
|
||||
dependencies:
|
||||
max-safe-integer: 1.0.1
|
||||
deprecated: This package is no longer relevant as ES2015 support is widespread.
|
||||
dev: false
|
||||
engines:
|
||||
node: '>=0.10.0'
|
||||
resolution:
|
||||
integrity: sha512-eDaA39/1+3SNtYTRP28lRYOHMwiB1gfqXQaXcf/+f4mLwKgm8TTDkwJldsdtbgrK1R5CoDbf6AQ0KqP7BKoGtQ==
|
||||
/math-codegen/0.3.5:
|
||||
dependencies:
|
||||
extend: 3.0.2
|
||||
mr-parser: 0.2.1
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-R5nuRnfe0Ud2bQA8ykt4ee3UDMo=
|
||||
/max-safe-integer/1.0.1:
|
||||
dev: false
|
||||
engines:
|
||||
node: '>=0.10.0'
|
||||
resolution:
|
||||
integrity: sha1-84BgvixWPYwC5tSK85Ei/YO29BA=
|
||||
/mr-parser/0.2.1:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-hhi5ukF+KOn0OaQcaVtVTq/u2Sc=
|
||||
/nextafter/1.0.0:
|
||||
dependencies:
|
||||
double-bits: 1.1.1
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-t9d7U1MQ4+CX5gJauwqQNHfsGjo=
|
||||
/typedarray/0.0.6:
|
||||
dev: false
|
||||
resolution:
|
||||
integrity: sha1-hnrHTjhkGHsdPUfZlqeOxciDB3c=
|
||||
specifiers:
|
||||
calculess: ^1.0.2
|
||||
esbuild: ^0.11.4
|
||||
esbuild-plugin-purescript: ^1.0.0
|
||||
events: ^3.3.0
|
||||
function-plot: ^1.22.7
|
24
purescript/factorio-throughput/spago.dhall
Normal file
24
purescript/factorio-throughput/spago.dhall
Normal file
|
@ -0,0 +1,24 @@
|
|||
{-
|
||||
Welcome to a Spago project!
|
||||
You can edit this file as you like.
|
||||
-}
|
||||
{ name = "my-project"
|
||||
, dependencies =
|
||||
[ "console"
|
||||
, "debug"
|
||||
, "effect"
|
||||
, "filterable"
|
||||
, "profunctor-lenses"
|
||||
, "psci-support"
|
||||
, "quickcheck"
|
||||
, "quickcheck-laws"
|
||||
, "run"
|
||||
, "spec"
|
||||
, "spec-discovery"
|
||||
, "spec-quickcheck"
|
||||
, "strings"
|
||||
, "unordered-collections"
|
||||
]
|
||||
, packages = ./packages.dhall
|
||||
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
|
||||
}
|
62
purescript/factorio-throughput/src/Lens.purs
Normal file
62
purescript/factorio-throughput/src/Lens.purs
Normal file
|
@ -0,0 +1,62 @@
|
|||
module Functorio.Lens where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.HashMap (HashMap)
|
||||
import Data.HashMap as H
|
||||
import Data.HashSet (HashSet)
|
||||
import Data.HashSet as S
|
||||
import Data.Hashable (class Hashable)
|
||||
import Data.Lens (AGetter, Fold, Iso', Lens', Setter, iso, lens, over, preview, set, view)
|
||||
import Data.Maybe (Maybe(..), maybe')
|
||||
import Data.Maybe.First (First)
|
||||
import Run (Run)
|
||||
import Run.Reader (READER, ask)
|
||||
import Run.State (STATE, get, modify)
|
||||
|
||||
---------- Missing instances
|
||||
atHashMap :: forall k v. Hashable k => k -> Lens' (HashMap k v) (Maybe v)
|
||||
atHashMap k =
|
||||
lens (H.lookup k) \m ->
|
||||
maybe' (\_ -> H.delete k m) \v -> H.insert k v m
|
||||
|
||||
-- | At implementation for hash sets
|
||||
atHashSetRaw :: forall v. Hashable v => v -> Lens' (HashSet v) (Maybe Unit)
|
||||
atHashSetRaw x = lens get (flip update)
|
||||
where
|
||||
get xs =
|
||||
if S.member x xs
|
||||
then Just unit
|
||||
else Nothing
|
||||
update Nothing = S.delete x
|
||||
update (Just _) = S.insert x
|
||||
|
||||
-- | Boolean implementation for AT on hash sets
|
||||
atHashSet :: forall v. Hashable v => v -> Lens' (HashSet v) Boolean
|
||||
atHashSet v = atHashSetRaw v <<< maybeUnitToBoolean
|
||||
|
||||
-- | Helper fro implementing atHashSet'
|
||||
maybeUnitToBoolean :: Iso' (Maybe Unit) Boolean
|
||||
maybeUnitToBoolean = iso to from
|
||||
where
|
||||
from true = Just unit
|
||||
from false = Nothing
|
||||
|
||||
to Nothing = false
|
||||
to _ = true
|
||||
|
||||
--------- Helpers for monadic state
|
||||
getAt :: forall s t a b r. AGetter s t a b -> Run (STATE s r) a
|
||||
getAt optic = view optic <$> get
|
||||
|
||||
getPreview :: forall r s t a b. Fold (First a) s t a b -> Run (STATE s r) (Maybe a)
|
||||
getPreview optic = preview optic <$> get
|
||||
|
||||
setAt :: forall s a b r. Setter s s a b -> b -> Run (STATE s r) Unit
|
||||
setAt optic value = set optic value # modify
|
||||
|
||||
modifyAt :: forall s a b r. Setter s s a b -> (a -> b) -> Run (STATE s r) Unit
|
||||
modifyAt optic f = over optic f # modify
|
||||
|
||||
askAt :: forall s t a b r. AGetter s t a b -> Run (READER s r) a
|
||||
askAt optic = ask <#> view optic
|
35
purescript/factorio-throughput/src/Main.purs
Normal file
35
purescript/factorio-throughput/src/Main.purs
Normal file
|
@ -0,0 +1,35 @@
|
|||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Either (Either(..))
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Console (log)
|
||||
import Moontorio.Render (RenderFn, renderFactory)
|
||||
import RealFunction (PortSide(..), RealFunction, SolveM, collectConstraints, myFactory, runSolveM, tryFindBoundSolveM)
|
||||
|
||||
p :: SolveM (Array RealFunction)
|
||||
p = do
|
||||
collectConstraints
|
||||
a <- tryFindBoundSolveM (0 /\ Input)
|
||||
b <- tryFindBoundSolveM (0 /\ Output)
|
||||
c <- tryFindBoundSolveM (1 /\ Input)
|
||||
d <- tryFindBoundSolveM (1 /\ Output)
|
||||
e <- tryFindBoundSolveM (2 /\ Input)
|
||||
f <- tryFindBoundSolveM (2 /\ Output)
|
||||
g <- tryFindBoundSolveM (4 /\ Input)
|
||||
h <- tryFindBoundSolveM (4 /\ Output)
|
||||
pure [a, b, c, d, e, f, g, h]
|
||||
|
||||
main :: RenderFn -> Effect Unit
|
||||
main render = do
|
||||
-- for_ (HashMap.toArrayBy Tuple myFactory) \(Tuple key value) -> log $ show key <> ": " <> show value
|
||||
|
||||
case runSolveM myFactory p of
|
||||
Left err -> log err
|
||||
Right (Tuple s f) -> do
|
||||
renderFactory render myFactory s.constraints
|
||||
-- log $ joinWith "\n" $ show <$> s.constraints
|
||||
-- logShow $ f <*> pure 0.0
|
18
purescript/factorio-throughput/src/Render.purs
Normal file
18
purescript/factorio-throughput/src/Render.purs
Normal file
|
@ -0,0 +1,18 @@
|
|||
module Moontorio.Render where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Foldable (for_)
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Effect (Effect)
|
||||
import RealFunction (Constraints, Factory, PortSide(..), RealFunction, factoryPorts, tryFindBoundPure, tryFindValuePure)
|
||||
|
||||
type RenderFn = String -> Array RealFunction -> Effect Unit
|
||||
|
||||
renderFactory :: RenderFn -> Factory -> Constraints -> Effect Unit
|
||||
renderFactory render factory constraints = for_ (factoryPorts factory) \portId -> do
|
||||
let inputMax = tryFindBoundPure (portId /\ Input) constraints
|
||||
let outputMax = tryFindBoundPure (portId /\ Output) constraints
|
||||
let actual = tryFindValuePure portId constraints
|
||||
|
||||
render ("Port " <> show portId) [inputMax, outputMax, actual]
|
12
purescript/factorio-throughput/src/Run/Fail.purs
Normal file
12
purescript/factorio-throughput/src/Run/Fail.purs
Normal file
|
@ -0,0 +1,12 @@
|
|||
module Run.Fail.Extra where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Compactable (class Compactable, compact)
|
||||
import Data.Traversable (class Traversable, traverse)
|
||||
import Run (Run)
|
||||
import Run.Except (FAIL, runFail)
|
||||
|
||||
-- | `Compact` / `MapMaybe` usnig the `Fail` ability
|
||||
traverseFail :: forall r t a b. Compactable t => Traversable t => (a -> Run (FAIL r) b) -> t a -> Run r (t b)
|
||||
traverseFail f = traverse (f >>> runFail) >>> map compact
|
33
purescript/factorio-throughput/src/Run/Id.purs
Normal file
33
purescript/factorio-throughput/src/Run/Id.purs
Normal file
|
@ -0,0 +1,33 @@
|
|||
module Run.Supply where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Run (Run, Step(..), lift, on, runAccumPure)
|
||||
import Type.Proxy (Proxy(..))
|
||||
|
||||
-- | Monad providing an infinite supply of values of a particular type.
|
||||
-- | Example use cases: generating unique ids.
|
||||
data SupplyF s a = Supply (s -> a)
|
||||
|
||||
type SUPPLY s r = ( supply :: SupplyF s | r )
|
||||
|
||||
generate :: forall r s. Run (SUPPLY s r) s
|
||||
generate = lift _supply (Supply identity)
|
||||
|
||||
-- | Elimininate the supply monad using a function generating the next value
|
||||
runSupply :: forall r s a. (s -> s) -> s -> Run (SUPPLY s r) a -> Run r a
|
||||
runSupply next
|
||||
= runAccumPure
|
||||
(next >>> \current -> on _supply (Loop <<< handleSupply current) Done)
|
||||
(\s a -> a)
|
||||
where
|
||||
handleSupply :: forall i. s -> SupplyF s i -> Tuple s i
|
||||
handleSupply current (Supply continue) = Tuple current (continue current)
|
||||
|
||||
---------- Typeclass instances
|
||||
derive instance functorSupply :: Functor (SupplyF s)
|
||||
|
||||
--------- SProxies
|
||||
_supply :: Proxy "supply"
|
||||
_supply = Proxy
|
18
purescript/factorio-throughput/src/Run/Reader.purs
Normal file
18
purescript/factorio-throughput/src/Run/Reader.purs
Normal file
|
@ -0,0 +1,18 @@
|
|||
module Run.Reader.Extra where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Lens (AGetter)
|
||||
import Functorio.Lens (getAt)
|
||||
import Run (Run)
|
||||
import Run.Reader (READER, runReader)
|
||||
import Run.State (STATE, get)
|
||||
import Type.Row (type (+))
|
||||
|
||||
-- | Use state from the environemtn to eliminate a reader monad.
|
||||
fromState :: forall r s a. Run (STATE s + READER s r) a -> Run (STATE s r) a
|
||||
fromState m = get >>= flip runReader m
|
||||
|
||||
-- | Focus on some state in the environemtn to eliminate a reader monad.
|
||||
fromState' :: forall s t a b r x. AGetter s t a b -> Run (STATE s + READER a r) x -> Run (STATE s r) x
|
||||
fromState' optic m = getAt optic >>= flip runReader m
|
35
purescript/factorio-throughput/src/Run/Visited.purs
Normal file
35
purescript/factorio-throughput/src/Run/Visited.purs
Normal file
|
@ -0,0 +1,35 @@
|
|||
-- | Allows the programmer to limit a monad to only run once (using a key)
|
||||
module Visited (VISITED, runVisited, once) where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.HashSet (HashSet)
|
||||
import Data.HashSet as HashSet
|
||||
import Data.Hashable (class Hashable)
|
||||
import Run (Run)
|
||||
import Run.State (State, evalStateAt, getAt, modifyAt)
|
||||
import Type.Proxy (Proxy(..))
|
||||
|
||||
-- | Monad keeping track of all the runned monad' keys
|
||||
type VISITED a r = ( visited :: State (HashSet a) | r )
|
||||
|
||||
-- | Eliminate the Visited effect
|
||||
runVisited :: forall d a r. Hashable d => Run (VISITED d r) a -> Run r a
|
||||
runVisited = evalStateAt _visited mempty
|
||||
|
||||
-- | Mark a key as visited
|
||||
visit :: forall a r. Hashable a => a -> Run (VISITED a r) Unit
|
||||
visit e = modifyAt _visited $ HashSet.insert e
|
||||
|
||||
-- | Condition a monad to only run once.
|
||||
-- | The first argument is a key,
|
||||
-- | and the second is a default value to use when the monad has already run.
|
||||
once :: forall d a r. Hashable d => d -> Run (VISITED d r) a -> Run (VISITED d r) a -> Run (VISITED d r) a
|
||||
once at default m = do
|
||||
visited <- getAt _visited
|
||||
if HashSet.member at visited
|
||||
then default
|
||||
else visit at *> m
|
||||
|
||||
_visited :: Proxy "visited"
|
||||
_visited = Proxy
|
308
purescript/factorio-throughput/src/Throughput.purs
Normal file
308
purescript/factorio-throughput/src/Throughput.purs
Normal file
|
@ -0,0 +1,308 @@
|
|||
module RealFunction where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Array (length, mapWithIndex)
|
||||
import Data.Array as Array
|
||||
import Data.Either (Either)
|
||||
import Data.Foldable (foldMap, for_, minimum)
|
||||
import Data.FoldableWithIndex (foldlWithIndex, forWithIndex_)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.HashMap (HashMap)
|
||||
import Data.HashMap as HashMap
|
||||
import Data.HashMap as Map
|
||||
import Data.HashSet as HashSet
|
||||
import Data.Int (toNumber)
|
||||
import Data.Lens (Lens')
|
||||
import Data.Lens.Record (prop)
|
||||
import Data.List (List(..), (:))
|
||||
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
|
||||
import Data.Number (infinity)
|
||||
import Data.Show.Generic (genericShow)
|
||||
import Data.Traversable (for)
|
||||
import Data.Tuple (Tuple(..), fst, snd, uncurry)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Functorio.Lens (modifyAt)
|
||||
import Math (sin)
|
||||
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
|
||||
import Run (Run, extract)
|
||||
import Run.Except (EXCEPT, fail, runExcept)
|
||||
import Run.Fail.Extra (traverseFail)
|
||||
import Run.Reader (READER, ask, runReader)
|
||||
import Run.Reader.Extra (fromState')
|
||||
import Run.State (STATE, runState)
|
||||
import Run.Supply (SUPPLY, generate, runSupply)
|
||||
import Type.Proxy (Proxy(..))
|
||||
import Type.Row (type (+))
|
||||
import Visited (VISITED, once, runVisited)
|
||||
|
||||
type RealFunction = Number -> Number
|
||||
type BeltConfig =
|
||||
{ speed :: Number
|
||||
, delay :: Number }
|
||||
|
||||
type ChestConfig =
|
||||
{ maxContent :: Number
|
||||
, delay :: Number }
|
||||
|
||||
type PortId = Int
|
||||
type MachineId = Int
|
||||
|
||||
data PortSide = Input | Output
|
||||
|
||||
data Machine
|
||||
= Belt { input :: PortId, output :: PortId, config :: BeltConfig }
|
||||
| Chest { inputs :: Array PortId, outputs :: Array PortId, config :: ChestConfig }
|
||||
| Provider (Array PortId) RealFunction
|
||||
| Consumer PortId
|
||||
|
||||
type Factory = HashMap MachineId Machine
|
||||
|
||||
---------- Some configs
|
||||
yellowBelt :: BeltConfig
|
||||
yellowBelt = { speed: 15.0, delay: 4.0/3.0 }
|
||||
|
||||
redBelt :: BeltConfig
|
||||
redBelt = { speed: 30.0, delay: 4.0/6.0 }
|
||||
|
||||
blueBelt :: BeltConfig
|
||||
blueBelt = { speed: 45.0, delay: 4.0/8.0 }
|
||||
|
||||
-- | Example factory
|
||||
myFactory1 :: Factory
|
||||
myFactory1 = Map.fromArray machines
|
||||
where
|
||||
machines = mapWithIndex Tuple
|
||||
[ Provider [0, 1] $ startsAtZero $ \t -> 40.0 + 10.0 * sin t
|
||||
, Belt { input: 0, output: 3, config: yellowBelt }
|
||||
, Belt { input: 1, output: 4, config: redBelt }
|
||||
-- , Belt { input: 2, output: 5, config: blueBelt }
|
||||
, Consumer 3
|
||||
, Consumer 4
|
||||
]
|
||||
|
||||
myFactory :: Factory
|
||||
myFactory = Map.fromArray machines
|
||||
where
|
||||
machines = mapWithIndex Tuple
|
||||
[ Provider [0, 1, 2] $ startsAtZero $ \t -> 80.0
|
||||
, Belt { input: 0, output: 3, config: yellowBelt }
|
||||
, Belt { input: 1, output: 4, config: redBelt }
|
||||
, Belt { input: 2, output: 5, config: blueBelt }
|
||||
, Consumer 3
|
||||
, Consumer 4
|
||||
, Consumer 5
|
||||
]
|
||||
|
||||
---------- Helpers for real functions
|
||||
type Endomorphism a = a -> a
|
||||
|
||||
startsAtZero :: Endomorphism RealFunction
|
||||
startsAtZero f x | x >= 0.0 = f x
|
||||
| otherwise = 0.0
|
||||
|
||||
---------- Monad for factory solving
|
||||
type PortData =
|
||||
{ id :: PortId
|
||||
, maxInput :: Number -> Number
|
||||
, maxOutput :: Number -> Number }
|
||||
|
||||
data ConstraintExpression
|
||||
= PortDependent (Array PortId) (Array PortData -> RealFunction)
|
||||
| Function RealFunction
|
||||
| Literal Number
|
||||
|
||||
type BiRelationship =
|
||||
{ p1top2 :: RealFunction
|
||||
, p2top1 :: RealFunction
|
||||
, p1 :: PortId /\ PortSide
|
||||
, p2 :: PortId /\ PortSide }
|
||||
|
||||
type BiRelationshipId = Int
|
||||
|
||||
data ThroughputConstraint
|
||||
= Limit ConstraintExpression PortSide PortId
|
||||
| BiRelationship BiRelationshipId BiRelationship
|
||||
|
||||
type Constraints = Array ThroughputConstraint
|
||||
|
||||
type SolveState =
|
||||
{ constraints :: Constraints }
|
||||
|
||||
type SolveM = Run
|
||||
( EXCEPT String
|
||||
+ STATE SolveState
|
||||
+ READER Factory
|
||||
+ SUPPLY Int
|
||||
+ () )
|
||||
|
||||
runSolveM :: forall a. Factory -> SolveM a -> Either String (Tuple SolveState a)
|
||||
runSolveM factory = runReader factory >>> runState mempty >>> runExcept >>> runSupply ((+) 1) 0 >>> extract
|
||||
|
||||
focusBiRelationship :: PortId /\ PortSide -> BiRelationship -> Maybe BiRelationship
|
||||
focusBiRelationship place relationship | relationship.p1 == place = Just relationship
|
||||
| relationship.p2 == place = Just $ flipBiRelationship relationship
|
||||
| otherwise = Nothing
|
||||
|
||||
focusBiRelationshipWithoutSide :: PortId -> BiRelationship -> Maybe BiRelationship
|
||||
focusBiRelationshipWithoutSide id relationship | fst relationship.p1 == id = Just relationship
|
||||
| fst relationship.p2 == id = Just $ flipBiRelationship relationship
|
||||
| otherwise = Nothing
|
||||
|
||||
flipBiRelationship :: BiRelationship -> BiRelationship
|
||||
flipBiRelationship { p1, p2, p1top2, p2top1 } = { p1: p2, p2: p1, p1top2: p2top1, p2top1: p1top2 }
|
||||
|
||||
factoryPorts :: Factory -> HashSet.HashSet PortId
|
||||
factoryPorts = foldMap case _ of
|
||||
Belt { input, output } -> HashSet.fromArray [input, output]
|
||||
Provider outputs _ -> HashSet.fromArray outputs
|
||||
Chest { inputs, outputs } -> HashSet.fromArray (inputs <> outputs)
|
||||
Consumer input -> HashSet.singleton input
|
||||
|
||||
---------- System solving algorithm
|
||||
constrain :: ThroughputConstraint -> SolveM Unit
|
||||
constrain constraint = modifyAt _constraints $ push constraint
|
||||
where
|
||||
push = flip Array.snoc
|
||||
|
||||
collectConstraints :: SolveM Unit
|
||||
collectConstraints = do
|
||||
factory <- ask
|
||||
for_ (HashMap.toArrayBy (/\) $ factory) $ uncurry collectConstraintsImpl
|
||||
|
||||
getPortData :: forall r. PortId -> Run (READER Constraints r) PortData
|
||||
getPortData id = ado
|
||||
maxInput <- tryFindBound $ id /\ Input
|
||||
maxOutput <- tryFindBound $ id /\ Output
|
||||
in { id, maxInput, maxOutput }
|
||||
|
||||
evalExpr :: forall r. ConstraintExpression -> Run (READER Constraints r) RealFunction
|
||||
evalExpr = case _ of
|
||||
Literal a -> pure (const a)
|
||||
Function f -> pure f
|
||||
PortDependent portIds f -> for portIds getPortData <#> f
|
||||
|
||||
tryFindBound :: forall r. PortId /\ PortSide -> Run (READER Constraints r) RealFunction
|
||||
tryFindBound at = tryFindBoundImpl at <#> \f time -> extract $ runVisited $ f time
|
||||
|
||||
tryFindBoundSolveM :: PortId /\ PortSide -> SolveM RealFunction
|
||||
tryFindBoundSolveM at = fromState' _constraints $ tryFindBound at
|
||||
|
||||
tryFindBoundPure :: PortId /\ PortSide -> Constraints -> RealFunction
|
||||
tryFindBoundPure at constraints = extract $ runReader constraints $ tryFindBound at
|
||||
|
||||
tryFindBoundImpl :: forall r k.
|
||||
PortId /\ PortSide ->
|
||||
Run (READER Constraints r) (Number -> Run (VISITED BiRelationshipId k) Number)
|
||||
tryFindBoundImpl (targetId /\ targetSide) = do
|
||||
constraints <- ask
|
||||
pure \time -> constraints
|
||||
# traverseFail case _ of
|
||||
Limit expr side id | side == targetSide && id == targetId ->
|
||||
evalExpr expr <*> pure time
|
||||
BiRelationship id raw
|
||||
| Just relationship <- focusBiRelationship (targetId /\ targetSide) raw -> do
|
||||
f <- once id fail $ tryFindValueImpl $ fst relationship.p2
|
||||
f (relationship.p1top2 time)
|
||||
_ -> fail
|
||||
# runReader constraints
|
||||
<#> minimum'
|
||||
where
|
||||
minimum' = minimum >>> fromMaybe 0.0
|
||||
|
||||
tryFindValue :: forall r. PortId -> Run (READER Constraints r) RealFunction
|
||||
tryFindValue at = tryFindValueImpl at <#> \f time -> extract $ runVisited $ f time
|
||||
|
||||
tryFindValueImpl :: forall r k. PortId -> Run (READER Constraints r) (Number -> Run (VISITED BiRelationshipId k) Number)
|
||||
tryFindValueImpl targetId = do
|
||||
constraints <- ask
|
||||
pure \time -> constraints
|
||||
# traverseFail case _ of
|
||||
Limit expr _ id | id == targetId -> evalExpr expr <*> pure time
|
||||
BiRelationship id raw
|
||||
| Just relationship <- focusBiRelationshipWithoutSide targetId raw -> do
|
||||
f <- once id fail $ tryFindValueImpl $ fst relationship.p2
|
||||
f (relationship.p1top2 time)
|
||||
_ -> fail
|
||||
# runReader constraints
|
||||
<#> minimum'
|
||||
where
|
||||
minimum' = minimum >>> fromMaybe 0.0
|
||||
|
||||
tryFindValuePure :: PortId -> Constraints -> RealFunction
|
||||
tryFindValuePure at constraints = extract $ runReader constraints $ tryFindValue at
|
||||
|
||||
collectConstraintsImpl :: MachineId -> Machine -> SolveM Unit
|
||||
collectConstraintsImpl at = case _ of
|
||||
Provider for amount -> do
|
||||
forWithIndex_ for \index id -> do
|
||||
let limit ports time
|
||||
= ports
|
||||
# map (\port -> port.id /\ port.maxOutput time)
|
||||
# outputs (amount time)
|
||||
# Array.findMap (\(id' /\ f) -> if id == id' then Just f else Nothing)
|
||||
# unsafePartial fromJust
|
||||
constrain $ Limit (PortDependent for limit) Input id
|
||||
where
|
||||
outputs :: Number -> Array (PortId /\ Number) -> Array (PortId /\ Number)
|
||||
outputs total ports
|
||||
= ports
|
||||
# Array.sortWith snd
|
||||
# foldlWithIndex (\index (past /\ remaining) (id /\ value) -> do
|
||||
let current
|
||||
| lengthLeft <- remaining / toNumber (count - index), value >= lengthLeft = lengthLeft
|
||||
| otherwise = value
|
||||
((id /\ current):past) /\ (remaining - current))
|
||||
(Nil /\ total)
|
||||
# fst
|
||||
# Array.fromFoldable
|
||||
where
|
||||
count = length ports
|
||||
Consumer for -> do
|
||||
constrain $ Limit (Literal infinity) Output for
|
||||
Belt { input, output, config } -> do
|
||||
biId <- generate
|
||||
|
||||
constrain $ BiRelationship biId
|
||||
{ p1: input /\ Output
|
||||
, p2: output /\ Input
|
||||
, p1top2: (+) config.delay
|
||||
, p2top1: (+) (-config.delay) }
|
||||
|
||||
constrain $ Limit (Literal config.speed) Output input
|
||||
constrain $ Limit (Literal config.speed) Input output
|
||||
|
||||
_ -> unsafeCrashWith "unimplemented"
|
||||
|
||||
---------- Lenses
|
||||
_constraints :: Lens' SolveState (Array ThroughputConstraint)
|
||||
_constraints = prop (Proxy :: _ "constraints")
|
||||
|
||||
---------- Typeclass instances
|
||||
derive instance genericMachine :: Generic Machine _
|
||||
derive instance genericPortSide :: Generic PortSide _
|
||||
derive instance eqPortSide :: Eq PortSide
|
||||
|
||||
instance showMachine :: Show Machine where
|
||||
show = case _ of
|
||||
Provider for _ -> "Provider<" <> show for <> ">"
|
||||
Consumer for -> "Consumer<" <> show for <> ">"
|
||||
Belt { config, input, output } -> "Belt<" <> show input <> " -> " <> show output <> ", " <> show config <> ">"
|
||||
Chest { inputs, outputs, config } -> "Chest<" <> show inputs <> " -> " <> show outputs <> ", " <> show config <> ">"
|
||||
|
||||
instance showConstraint :: Show ThroughputConstraint where
|
||||
show = case _ of
|
||||
Limit f side id -> show f <> " !> " <> showPort (id /\ side)
|
||||
BiRelationship _ { p1, p2 } -> showPort p1 <> " <-> " <> showPort p2
|
||||
where
|
||||
showPort (p /\ side) = "?" <> show p <> case side of
|
||||
Input -> "<-"
|
||||
Output -> "<-"
|
||||
|
||||
instance showConstraintExpression :: Show ConstraintExpression where
|
||||
show (Literal i) = show i
|
||||
show (Function f) = "<Function>"
|
||||
show (PortDependent ids f) = "(" <> show ids <> " -> <Function>)"
|
||||
|
||||
instance showPortSide :: Show PortSide where
|
||||
show = genericShow
|
33
purescript/factorio-throughput/src/Utils/Ord.purs
Normal file
33
purescript/factorio-throughput/src/Utils/Ord.purs
Normal file
|
@ -0,0 +1,33 @@
|
|||
module Moontorio.Ord.Extra (Side, left, right, OrderedArray, binarySearch) where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Array (length, unsafeIndex)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
|
||||
type OrderedArray = Array
|
||||
newtype Side = Side Boolean
|
||||
|
||||
left :: Side
|
||||
left = Side false
|
||||
|
||||
right :: Side
|
||||
right = Side true
|
||||
|
||||
binarySearch :: forall a. (Int -> a -> Side) -> OrderedArray a -> Maybe Int
|
||||
binarySearch f arr = unsafePartial $ findImpl 0 (length arr)
|
||||
where
|
||||
findImpl :: Partial => _
|
||||
findImpl start length | length == 0 = Nothing
|
||||
| length == 1 = Just start
|
||||
| otherwise = do
|
||||
let middle = start + length / 2
|
||||
let element = unsafeIndex arr middle
|
||||
if f middle element == left then
|
||||
findImpl start (middle - start)
|
||||
else
|
||||
findImpl middle (length + start - middle)
|
||||
|
||||
---------- Typeclass instances
|
||||
derive instance eqSide :: Eq Side
|
20
purescript/factorio-throughput/src/index.html
Normal file
20
purescript/factorio-throughput/src/index.html
Normal file
|
@ -0,0 +1,20 @@
|
|||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<meta http-equiv="X-UA-Compatible" content="IE=edge">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<title>Moontorio</title>
|
||||
|
||||
<script defer src="../dist/index.js"></script>
|
||||
|
||||
<style>
|
||||
body {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
</body>
|
||||
</html>
|
38
purescript/factorio-throughput/src/index.js
Normal file
38
purescript/factorio-throughput/src/index.js
Normal file
|
@ -0,0 +1,38 @@
|
|||
import { main } from "Main.purs";
|
||||
import functionPlot from "function-plot";
|
||||
|
||||
let lastId = 0;
|
||||
const root = document.body;
|
||||
|
||||
const width = 400;
|
||||
const height = 250;
|
||||
|
||||
const render = (name) => (functions) => () => {
|
||||
const currentId = ++lastId;
|
||||
|
||||
console.log("Renering!!!");
|
||||
|
||||
const node = document.createElement("div");
|
||||
node.id = currentId;
|
||||
node.title = name;
|
||||
node.className = "graph";
|
||||
|
||||
root.appendChild(node);
|
||||
|
||||
const functionData = functions.map((fn) => ({
|
||||
fn: (scope) => fn(scope.x),
|
||||
graphType: "polyline",
|
||||
}));
|
||||
|
||||
functionPlot({
|
||||
target: node,
|
||||
width,
|
||||
height,
|
||||
yAxis: { domain: [-5, 35] },
|
||||
xAxis: { domain: [-1, 5] },
|
||||
grid: true,
|
||||
data: functionData,
|
||||
});
|
||||
};
|
||||
|
||||
main(render)();
|
11
purescript/factorio-throughput/test/Main.purs
Normal file
11
purescript/factorio-throughput/test/Main.purs
Normal file
|
@ -0,0 +1,11 @@
|
|||
module Test.Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Effect (Effect)
|
||||
import Effect.Class.Console (log)
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
log "🍝"
|
||||
log "You should add some tests."
|
Loading…
Reference in a new issue