# HG changeset patch # User Benjamin Weber # Date 1666178376 -7200 # Wed Oct 19 13:19:36 2022 +0200 # Node ID 54c73d579b6722f764f147cb892a15da2163a1c9 # Parent c95d879e46928d19a052153c144beb1e5dd4806a allow decimal rework probability per round diff --git a/src/Field.elm b/src/Field.elm --- a/src/Field.elm +++ b/src/Field.elm @@ -23,7 +23,7 @@ let trackReworked x = if x.conditions.rework == NeedsRework then - { x | conditions = { reqs = x.conditions.reqs, scrapped = x.conditions.scrapped , rework = Reworked} } + { x | conditions = { reqs = x.conditions.reqs, scrapped = x.conditions.scrapped, rework = Reworked } } else x @@ -121,19 +121,29 @@ newRoundField r = \x -> { x | inflow = inflowForRoundNr <| r + 1, touchCapacity = 3 } + + -- out-in >= scrapLimit + + isScrap : ScrapLimit -> Job -> Bool -isScrap l j = Maybe.withDefault False <| Maybe.map (\x -> x - j.roundParams.incomingRound >= l) j.roundParams.doneRound +isScrap l j = + Maybe.withDefault False <| Maybe.map (\x -> x - j.roundParams.incomingRound >= l) j.roundParams.doneRound + scrap : Maybe ScrapLimit -> Job -> Job -scrap l j = {j | conditions = {reqs = j.conditions.reqs, rework = j.conditions.rework, scrapped = Maybe.withDefault False <| Maybe.map (\x -> isScrap x j) l}} +scrap l j = + { j | conditions = { reqs = j.conditions.reqs, rework = j.conditions.rework, scrapped = Maybe.withDefault False <| Maybe.map (\x -> isScrap x j) l } } + noScrap : Field -> Field -noScrap field = {field | done = List.map (scrap Nothing) field.done} +noScrap field = + { field | done = List.map (scrap Nothing) field.done } + identifyScrap : ScrapLimit -> Field -> Field identifyScrap l field = - { field | done = List.map (scrap (Just l)) field.done} + { field | done = List.map (scrap (Just l)) field.done } dumpScrap : Field -> Field diff --git a/src/Main.elm b/src/Main.elm --- a/src/Main.elm +++ b/src/Main.elm @@ -135,12 +135,13 @@ S6 -> ( chain <| applyStep ( Just incompleteReqsFromWipToW2, Nothing ) model, Cmd.none ) - S7 -> let + S7 -> + let completeRound : Model -> Model completeRound m = { m | stats = trackStats m.round model.kit model.nkit m.stats, step = lastStepOfRound } - in - ( completeRound <| applyStep ( Just fifo, Nothing ) { model | finishRound = False}, Cmd.none ) + in + ( completeRound <| applyStep ( Just fifo, Nothing ) { model | finishRound = False }, Cmd.none ) SetReworksStart -> ( model, setReworksCmd model ) @@ -163,12 +164,11 @@ ChangedReworkProb x -> if emptyField x then - ( { model | reworkProbEmpty = True }, Cmd.none ) + ( { model | reworkProbEmpty = True, reworkProbPerRoundDot = False }, Cmd.none ) else - defaultToCurrentModel <| Maybe.map (\y -> { model | reworkProbPerRound = y, reworkProbEmpty = False }) <| validInput 0 100 x + defaultToCurrentModel <| Maybe.map (\y -> { model | reworkProbPerRound = y, reworkProbEmpty = False, reworkProbPerRoundDot = (\z -> z == ".") <| String.right 1 x }) <| validFloatInput 0 100 x - -- { model | toRound = Maybe.withDefault model.round <| validInput 0 500 x } ChangedStep x -> if emptyField x then ( { model | stepEmpty = True }, Cmd.none ) @@ -181,14 +181,14 @@ ( { model | cyclesPerIncrementEmpty = True }, Cmd.none ) else - defaultToCurrentModel <| Maybe.map (\y -> { model | cyclesPerIncrement = y, cyclesPerIncrementEmpty = False }) <| validInput 0 100 x + defaultToCurrentModel <| Maybe.map (\y -> { model | cyclesPerIncrement = y, cyclesPerIncrementEmpty = False }) <| validIntInput 0 100 x ChangedScrapLimit x -> if emptyField x then - ( applyStep (Just noScrap, Just noScrap) <| { model | scrapLimit = Nothing }, Cmd.none ) + ( applyStep ( Just noScrap, Just noScrap ) <| { model | scrapLimit = Nothing }, Cmd.none ) else - defaultToCurrentModel <| Maybe.map (\y -> applyStep (Just <| identifyScrap y, Just <| identifyScrap y) <| { model | scrapLimit = Just y }) <| validInput 0 500 x + defaultToCurrentModel <| Maybe.map (\y -> applyStep ( Just <| identifyScrap y, Just <| identifyScrap y ) <| { model | scrapLimit = Just y }) <| validIntInput 0 500 x SwapAutoPlay -> ( { model | autoPlay = not model.autoPlay }, Cmd.none ) @@ -244,8 +244,21 @@ RoundMode -validInput : Int -> Int -> String -> Maybe Int -validInput lo hi = +validFloatInput : Float -> Float -> String -> Maybe Float +validFloatInput lo hi = + Maybe.andThen + (\n -> + if n >= lo && n <= hi then + Just n + + else + Nothing + ) + << String.toFloat + + +validIntInput : Int -> Int -> String -> Maybe Int +validIntInput lo hi = Maybe.andThen (\n -> if n >= lo && n <= hi then @@ -297,14 +310,14 @@ roundInterface = interface ChangedRound "Round" model.roundEmpty (text <| String.fromInt model.round) (NextRounds 1) - interface2 value empty ts onchange suff = + interface2 label empty ts onchange suff = let labelText = if empty then "" else - String.fromInt value + label in column [ width fill, spacing 10 ] [ column [ width fill, Font.size 12 ] ts @@ -312,7 +325,19 @@ ] reworkProbInterface = - interface2 model.reworkProbPerRound model.reworkProbEmpty [ text "Rework", text "prob." ] ChangedReworkProb (text "%") + interface2 + (String.fromFloat model.reworkProbPerRound + ++ (if model.reworkProbPerRoundDot then + "." + + else + "" + ) + ) + model.reworkProbEmpty + [ text "Rework", text "prob." ] + ChangedReworkProb + (text "%") cyclesPerIncrementInterface = let @@ -324,10 +349,10 @@ StepMode -> "step" in - interface2 model.cyclesPerIncrement model.cyclesPerIncrementEmpty [ text "Increments" ] ChangedCyclesPerIncrement Element.none + interface2 (String.fromInt model.cyclesPerIncrement) model.cyclesPerIncrementEmpty [ text "Increments" ] ChangedCyclesPerIncrement Element.none scrapLimitInterface = - interface2 (Maybe.withDefault 0 model.scrapLimit) (Maybe.Extra.isNothing model.scrapLimit) [ text "scrap after", text "rounds" ] ChangedScrapLimit (text "rounds") + interface2 (String.fromInt <| Maybe.withDefault 0 model.scrapLimit) (Maybe.Extra.isNothing model.scrapLimit) [ text "scrap after", text "rounds" ] ChangedScrapLimit (text "rounds") batchButtons = let diff --git a/src/Rework.elm b/src/Rework.elm --- a/src/Rework.elm +++ b/src/Rework.elm @@ -21,7 +21,7 @@ Random.map (updateRework j) <| - Random.weighted ( toFloat p, NeedsRework ) [ ( 100 - toFloat p, NoRework ) ] + Random.weighted ( p, NeedsRework ) [ ( 100 - p, NoRework ) ] setReworksSingleMode : ProbPerRound -> List Job -> Random.Generator (List Job) diff --git a/src/Round.elm b/src/Round.elm --- a/src/Round.elm +++ b/src/Round.elm @@ -28,6 +28,8 @@ kitAfterReworks r l = conditionalScrap l >> justDoneToDone >> wipToJustDone (r + 1) >> updateWaiting >> inflowToW2OrW0 >> w0ToWip + + -- | f is finisher after reworks @@ -42,7 +44,7 @@ bothFieldsRound : Round -> ProbPerRound -> Maybe ScrapLimit -> ( Field, Field, Stats ) -> Random.Generator ( Field, Field, Stats ) bothFieldsRound r p l ( kf, nkf, stats ) = - Random.map (\( a, b ) -> ( a, b, trackStats (r+1) a b stats )) <| Random.map2 Tuple.pair (fieldRound kitAfterReworks r p l kf) (fieldRound nkitAfterReworks r p l nkf) + Random.map (\( a, b ) -> ( a, b, trackStats (r + 1) a b stats )) <| Random.map2 Tuple.pair (fieldRound kitAfterReworks r p l kf) (fieldRound nkitAfterReworks r p l nkf) @@ -64,10 +66,12 @@ conditionalScrap t = Maybe.withDefault (\x -> x) <| Maybe.map (\x -> identifyScrap x >> dumpScrap) t + nkitAfterReworks : Round -> Maybe ScrapLimit -> Field -> Field nkitAfterReworks r l = conditionalScrap l >> justDoneToDone >> wipToJustDone (r + 1) >> updateWaiting >> inflowToWip >> incompleteReqsFromWipToW2 >> fifo + fullRoundCmd : Model -> Cmd Msg fullRoundCmd model = Random.generate FullRoundDone <| bothFieldsRound model.round model.reworkProbPerRound model.scrapLimit ( model.kit, model.nkit, model.stats ) diff --git a/src/Types.elm b/src/Types.elm --- a/src/Types.elm +++ b/src/Types.elm @@ -8,7 +8,7 @@ type alias Model = - { viewport : Maybe Dom.Viewport, kit : Field, nkit : Field, round : Round, step : StepVariant, finishRound : Bool, roundEmpty : Bool, stepEmpty : Bool, stopRoundEmpty : Bool, autoPlay : Bool, incrementMode : AutoPlayMode, reworkProbPerRound : Int, reworkProbEmpty : Bool, scrapLimit : Maybe ScrapLimit, cyclesPerIncrement : Int, cyclesPerIncrementEmpty : Bool, chart1 : ChartingModel, chart3 : ChartingModel, chart5 : ChartingModel, stats : Stats } + { viewport : Maybe Dom.Viewport, kit : Field, nkit : Field, round : Round, step : StepVariant, finishRound : Bool, roundEmpty : Bool, stepEmpty : Bool, stopRoundEmpty : Bool, autoPlay : Bool, incrementMode : AutoPlayMode, reworkProbPerRound : Float, reworkProbPerRoundDot : Bool, reworkProbEmpty : Bool, scrapLimit : Maybe ScrapLimit, cyclesPerIncrement : Int, cyclesPerIncrementEmpty : Bool, chart1 : ChartingModel, chart3 : ChartingModel, chart5 : ChartingModel, stats : Stats } initChart : ChartType -> ChartingModel @@ -33,7 +33,7 @@ initModel : Model initModel = - { viewport = Nothing, nkit = initField, kit = initField, round = 0, step = S7, finishRound = False, roundEmpty = False, stepEmpty = False, stopRoundEmpty = False, autoPlay = False, incrementMode = RoundMode, reworkProbPerRound = 10, reworkProbEmpty = False, scrapLimit = Nothing, cyclesPerIncrement = 1, cyclesPerIncrementEmpty = False, chart1 = chart1, chart3 = chart3, chart5 = chart5, stats = { flowtimesSinglesNKIT = [], flowtimesSinglesKIT = [], justDonesNKIT = [], justDonesKIT = [], doneData = [] } } + { viewport = Nothing, nkit = initField, kit = initField, round = 0, step = S7, finishRound = False, roundEmpty = False, stepEmpty = False, stopRoundEmpty = False, autoPlay = False, incrementMode = RoundMode, reworkProbPerRound = 0.5, reworkProbPerRoundDot = False, reworkProbEmpty = False, scrapLimit = Nothing, cyclesPerIncrement = 1, cyclesPerIncrementEmpty = False, chart1 = chart1, chart3 = chart3, chart5 = chart5, stats = { flowtimesSinglesNKIT = [], flowtimesSinglesKIT = [], justDonesNKIT = [], justDonesKIT = [], doneData = [] } } type AutoPlayMode @@ -217,12 +217,12 @@ type alias Field = - { touchCapacity : Int, workingCapacity : Int, inflow : Inflow, w2 : W2, w1 : W1, w0 : W0, wip : WIP, justDone : JustDone, done : Done} + { touchCapacity : Int, workingCapacity : Int, inflow : Inflow, w2 : W2, w1 : W1, w0 : W0, wip : WIP, justDone : JustDone, done : Done } initField : Field initField = - { inflow = [], w2 = [], w1 = [], w0 = [], wip = [], justDone = [], done = [], touchCapacity = 3, workingCapacity = 2 } + { inflow = [], w2 = [], w1 = [], w0 = [], wip = [], justDone = [], done = [], touchCapacity = 3, workingCapacity = 2 } type Mode @@ -235,6 +235,7 @@ | NeedsRework | Reworked + type RequirementsCondition = Complete | Incomplete @@ -264,7 +265,7 @@ icplNew : Int -> Job icplNew n = - { conditions = { reqs = Incomplete, rework = NoRework , scrapped = False}, roundParams = { incomingRound = n, doneRound = Nothing } } + { conditions = { reqs = Incomplete, rework = NoRework, scrapped = False }, roundParams = { incomingRound = n, doneRound = Nothing } } cplNew : Int -> Job @@ -309,6 +310,7 @@ type alias Done = List Job + type alias FieldStep = Maybe (Field -> Field) @@ -334,13 +336,16 @@ type alias ProbPerRound = - Int + Float type alias ScrapLimit = Int -type alias Scrapped = Bool + +type alias Scrapped = + Bool + type alias WaitingRounds = Int diff --git a/src/Views.elm b/src/Views.elm --- a/src/Views.elm +++ b/src/Views.elm @@ -276,6 +276,7 @@ Reworked -> orange + toFillingColor : RequirementsCondition -> SquareFilling toFillingColor x = case x of @@ -288,7 +289,14 @@ toColorCombo : ( Scrapped, RequirementsCondition, ReworkCondition ) -> ( SquareFilling, BorderColor ) toColorCombo ( scr, req, rw ) = - ( toFillingColor req, if scr then red else toBorderColor rw ) + ( toFillingColor req + , if scr then + red + + else + toBorderColor rw + ) + isSet : NonRoundConditions -> Job -> Maybe Job isSet nrc j = @@ -568,8 +576,7 @@ flowtimeQuartile : Quartile -> Field -> Float flowtimeQuartile q field = r1 <| - quartile q - <| + quartile q <| List.filterMap flowTime field.done @@ -578,7 +585,6 @@ let ( n, qs ) = quartSum q <| List.filterMap flowTime field.done - in toFloat qs