Commiting some old changes
This commit is contained in:
parent
0bb81bfc46
commit
3f6091369a
7 changed files with 244 additions and 25 deletions
purescript/factorio-throughput/src
|
@ -6,7 +6,7 @@ import Data.Array (length, mapWithIndex)
|
|||
import Data.Array as Array
|
||||
import Data.Either (Either)
|
||||
import Data.Foldable (foldMap, for_, minimum)
|
||||
import Data.FoldableWithIndex (forWithIndex_)
|
||||
import Data.FoldableWithIndex (foldlWithIndex, forWithIndex_)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.HashMap (HashMap)
|
||||
import Data.HashMap as HashMap
|
||||
|
@ -16,12 +16,11 @@ import Data.Int (toNumber)
|
|||
import Data.Lens (Lens')
|
||||
import Data.Lens.Record (prop)
|
||||
import Data.List (List(..), (:))
|
||||
import Data.List as 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, uncurry)
|
||||
import Data.Tuple (Tuple(..), fst, snd, uncurry)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Functorio.Lens (modifyAt)
|
||||
import Math (sin)
|
||||
|
@ -70,8 +69,8 @@ blueBelt :: BeltConfig
|
|||
blueBelt = { speed: 45.0, delay: 4.0/8.0 }
|
||||
|
||||
-- | Example factory
|
||||
myFactory :: Factory
|
||||
myFactory = Map.fromArray machines
|
||||
myFactory1 :: Factory
|
||||
myFactory1 = Map.fromArray machines
|
||||
where
|
||||
machines = mapWithIndex Tuple
|
||||
[ Provider [0, 1] $ startsAtZero $ \t -> 40.0 + 10.0 * sin t
|
||||
|
@ -82,6 +81,19 @@ myFactory = Map.fromArray machines
|
|||
, 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
|
||||
|
||||
|
@ -190,7 +202,7 @@ tryFindBoundImpl (targetId /\ targetSide) = do
|
|||
evalExpr expr <*> pure time
|
||||
BiRelationship id raw
|
||||
| Just relationship <- focusBiRelationship (targetId /\ targetSide) raw -> do
|
||||
f <- once id fail $ tryFindBoundImpl relationship.p2
|
||||
f <- once id fail $ tryFindValueImpl $ fst relationship.p2
|
||||
f (relationship.p1top2 time)
|
||||
_ -> fail
|
||||
# runReader constraints
|
||||
|
@ -225,29 +237,27 @@ collectConstraintsImpl at = case _ of
|
|||
Provider for amount -> do
|
||||
forWithIndex_ for \index id -> do
|
||||
let limit ports time
|
||||
= outputs ports time
|
||||
# Array.findMap (\(id' /\ f) -> if id == id' then Just (f time) else Nothing)
|
||||
# unsafePartial fromJust -- TODO: error handling
|
||||
= 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 :: Array PortData -> Number -> Array (PortId /\ RealFunction)
|
||||
outputs ports time
|
||||
= outputsImpl (length ports) (List.fromFoldable sorted) amount
|
||||
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
|
||||
# Array.zipWith (_.id >>> Tuple) sorted
|
||||
where
|
||||
sorted :: Array PortData
|
||||
sorted = Array.sortWith (_.maxOutput >>> (#) time) ports
|
||||
|
||||
outputsImpl :: Int -> List PortData -> RealFunction -> List RealFunction
|
||||
outputsImpl 1 (head:Nil) remaining = pure \time -> min (head.maxOutput time) (remaining time)
|
||||
outputsImpl n (head:tail) remaining = current:(outputsImpl (n - 1) tail $ remaining - current)
|
||||
where
|
||||
current time
|
||||
| head.maxOutput time >= (remaining time) / (toNumber n) = (remaining time) / (toNumber n)
|
||||
| otherwise = head.maxOutput time
|
||||
outputsImpl _ _ _ = Nil
|
||||
|
||||
count = length ports
|
||||
Consumer for -> do
|
||||
constrain $ Limit (Literal infinity) Output for
|
||||
Belt { input, output, config } -> do
|
||||
|
|
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
|
Loading…
Add table
Add a link
Reference in a new issue