From 39893aed22786429f9f7c929db30a038492a9010 Mon Sep 17 00:00:00 2001 From: Necried Date: Sat, 31 Jul 2021 17:18:06 -0400 Subject: [PATCH 01/20] Add NPDA base type, NDA/DFA still working --- src/Building.elm | 75 +++++++++----- src/Error.elm | 6 +- src/Exporting.elm | 4 +- src/Helpers.elm | 32 +++++- src/Machine.elm | 245 +++++++++++++++++++++++++++++--------------- src/Mistakes.elm | 5 +- src/SharedModel.elm | 9 +- src/Simulating.elm | 26 +++-- 8 files changed, 271 insertions(+), 131 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index ed7acf0..e45e61f 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -9,7 +9,7 @@ import Json.Decode as D import Machine exposing (..) import Mistakes exposing (..) import Set -import SharedModel exposing (MachineType(..), SharedModel, machineModeButtons) +import SharedModel exposing (SharedModel, machineModeButtons) import Task import Tuple exposing (first, second) @@ -32,7 +32,7 @@ type PersistentModel type Msg = MachineMsg Machine.Msg | SaveStateName StateID String - | SaveTransitionName TransitionID String + | SaveTransitionName TransitionID ( String, String, String ) | ToggleStart StateID | ChangeMachine MachineType | AddState ( Float, Float ) @@ -131,16 +131,25 @@ update env msg ( model, pModel, sModel ) = AddingArrowOverOtherState st _ s1 -> let - newTrans = - case List.head <| Dict.values oldMachine.transitionNames of + oldTransitionNames = + oldMachine.transitionNames + + newInputLabel = + case List.head <| Dict.values oldTransitionNames of Just setchar -> - setchar + setchar.inputLabel Nothing -> Set.singleton "x" + newTrans = + { inputLabel = newInputLabel + , stackTop = "" + , stackPush = "" + } + newTransID = - case List.maximum <| Dict.keys oldMachine.transitionNames of + case List.maximum <| Dict.keys oldTransitionNames of Just n -> n + 1 @@ -148,7 +157,7 @@ update env msg ( model, pModel, sModel ) = 0 isValidTransition = - checkTransitionValid newTrans + checkTransitionValid newInputLabel newDelta : Delta newDelta = @@ -198,16 +207,19 @@ update env msg ( model, pModel, sModel ) = SelectArrow ( s0, tId, s1 ) -> let - oldTransName = + newInpLabel = case Dict.get tId sModel.machine.transitionNames of Just n -> - renderSet2String n + renderSet2String n.inputLabel Nothing -> "" + + newLab = + ( newInpLabel, "", "" ) in if env.holdingShift then - ( ( { model | machineState = EditingTransitionLabel ( s0, tId, s1 ) oldTransName }, pModel, sModel ), False, focusInput NoOp ) + ( ( { model | machineState = EditingTransitionLabel ( s0, tId, s1 ) newLab }, pModel, sModel ), False, focusInput NoOp ) else ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) @@ -344,6 +356,7 @@ update env msg ( model, pModel, sModel ) = in ( ( { model | machineState = newState }, pModel, sModel ), False, Cmd.none ) + -- FIXME: EditLabel doesn't work well with NPDA label type EditLabel _ lbl -> let newState = @@ -352,7 +365,7 @@ update env msg ( model, pModel, sModel ) = EditingStateLabel st lbl EditingTransitionLabel tr _ -> - EditingTransitionLabel tr lbl + EditingTransitionLabel tr ( lbl, "", "" ) _ -> model.machineState @@ -467,16 +480,25 @@ update env msg ( model, pModel, sModel ) = oldTransitionName = case Dict.get tId oldMachine.transitionNames of Just n -> - renderSet2String n + renderSet2String n.inputLabel _ -> "" in - if newLbl == oldTransitionName || newLbl == "" then - ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) + case sModel.machineType of + DFA -> + if fst newLbl == oldTransitionName || fst newLbl == "" then + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) - else - ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), True, sendMsg <| SaveTransitionName tId newLbl ) + else + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), True, sendMsg <| SaveTransitionName tId newLbl ) + + NFA -> + if fst newLbl == oldTransitionName || fst newLbl == "" then + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) + + else + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), True, sendMsg <| SaveTransitionName tId newLbl ) SelectedState sId -> let @@ -494,11 +516,11 @@ update env msg ( model, pModel, sModel ) = let oldTransName = case Dict.get tId sModel.machine.transitionNames of - Just n -> - renderSet2String n + Just label -> + ( renderSet2String label.inputLabel, label.stackTop, label.stackPush ) Nothing -> - "" + ( "", "", "" ) in ( ( { model | machineState = EditingTransitionLabel ( s0, tId, s1 ) oldTransName }, pModel, sModel ), False, focusInput NoOp ) @@ -643,17 +665,20 @@ update env msg ( model, pModel, sModel ) = in ( ( { model | machineState = Regular }, pModel, { sModel | machine = newMachine } ), True, Cmd.none ) - SaveTransitionName tId newLbl -> + SaveTransitionName tId ( inpLabel, stkTop, stkPush ) -> let newTransitions = - parseString2Set newLbl + parseString2Set inpLabel - isValidTransition = - checkTransitionValid newTransitions + newLabel = + { inputLabel = newTransitions + , stackTop = stkTop + , stackPush = stkPush + } newMachine = { oldMachine - | transitionNames = Dict.insert tId newTransitions oldMachine.transitionNames + | transitionNames = Dict.insert tId newLabel oldMachine.transitionNames } in ( ( { model | machineState = Regular }, pModel, { sModel | machine = newMachine } ), True, Cmd.none ) @@ -740,7 +765,7 @@ view env ( model, pModel, sModel ) = _ -> group [] - , GraphicSVG.map MachineMsg <| Machine.view env model.machineState sModel.machine Set.empty transMistakes + , GraphicSVG.map MachineMsg <| Machine.view env model.machineState sModel.machineType sModel.machine Set.empty transMistakes , editingButtons model |> move ( winX / 2 - 30, -winY / 2 + 25 ) , machineModeButtons sModel.machineType winX winY ChangeMachine ] diff --git a/src/Error.elm b/src/Error.elm index f242cb0..33c3f91 100644 --- a/src/Error.elm +++ b/src/Error.elm @@ -8,7 +8,7 @@ import Dict exposing (Dict) import Environment exposing (Environment) import GraphicSVG exposing (..) import Helpers exposing (..) -import Machine exposing (Machine, StateID, TransitionID) +import Machine exposing (Machine, MachineType(..), StateID, TransitionID) import Mistakes exposing (..) import Set exposing (Set) import SharedModel exposing (..) @@ -61,7 +61,7 @@ machineCheck sModel = getTransitionMistakes mac allTransitionLabels = - List.sort <| Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values mac.transitionNames + List.sort <| Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| List.map .inputLabel <| Dict.values mac.transitionNames catch : Maybe (Set String) -> List String catch ms = @@ -74,7 +74,7 @@ machineCheck sModel = getTrans : Dict TransitionID StateID -> List String getTrans d = - (List.concatMap (\e -> Dict.get e mac.transitionNames |> catch) <| Dict.keys d) |> List.sort + (List.concatMap (\e -> Dict.get e mac.transitionNames |> Maybe.map .inputLabel |> catch) <| Dict.keys d) |> List.sort foldingFunc : ( StateID, Dict TransitionID StateID ) -> Error -> Error foldingFunc sTuple err = diff --git a/src/Exporting.elm b/src/Exporting.elm index 97d05e8..ce09c71 100644 --- a/src/Exporting.elm +++ b/src/Exporting.elm @@ -141,7 +141,7 @@ view env ( model, pModel, sModel ) = |> move ( winX / 6 - 100, -105 ) in group - [ (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machine Set.empty transMistakes) |> move ( -winX / 6, 0 ) + [ (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine Set.empty transMistakes) |> move ( -winX / 6, 0 ) , machineSelected sModel.machineType winX winY , text "Choose format:" |> size 20 @@ -361,7 +361,7 @@ generateTikz time machine = transitionName = case Dict.get tId machine.transitionNames of Just n -> - renderSet2String n + renderSet2String n.inputLabel _ -> "" diff --git a/src/Helpers.elm b/src/Helpers.elm index 95deb14..a0c2b00 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -1,4 +1,4 @@ -module Helpers exposing (LabelPosition(..), LatexAlign(..), add, dot, editIcon, finsmBlue, finsmLightBlue, focusInput, icon, labelPosition, latex, latexurl, mult, p, parseString2Set, parseTLabel, renderSet2String, renderString, roundPrec, roundTo, sendMsg, setMax, specialSymbols, sub, trashIcon, uncurry, vertex) +module Helpers exposing (..) import Browser.Dom as Dom import GraphicSVG exposing (..) @@ -331,3 +331,33 @@ roundTo n m = roundPrec : Int -> Float -> Float roundPrec n m = Basics.toFloat (round (m * Basics.toFloat (10 ^ n))) / Basics.toFloat (10 ^ n) + + +fst : ( a, b, c ) -> a +fst ( a, b, c ) = + a + + +snd : ( a, b, c ) -> b +snd ( a, b, c ) = + b + + +thd : ( a, b, c ) -> c +thd ( a, b, c ) = + c + + +mapFst : (a -> d) -> ( a, b, c ) -> ( d, b, c ) +mapFst f ( a, b, c ) = + ( f a, b, c ) + + +mapSnd : (b -> d) -> ( a, b, c ) -> ( a, d, c ) +mapSnd f ( a, b, c ) = + ( a, f b, c ) + + +mapThd : (c -> d) -> ( a, b, c ) -> ( a, b, d ) +mapThd f ( a, b, c ) = + ( a, b, f c ) diff --git a/src/Machine.elm b/src/Machine.elm index 2108c26..7bd7258 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -1,5 +1,6 @@ module Machine exposing (..) +import Debug exposing (todo) import Dict exposing (Dict) import Environment exposing (Environment) import GraphicSVG exposing (..) @@ -30,7 +31,14 @@ type alias StateNames = type alias TransitionNames = - Dict TransitionID (Set String) + Dict TransitionID TransitionLabel + + +type alias TransitionLabel = + { inputLabel : Set String + , stackTop : String + , stackPush : String + } type alias StateTransitions = @@ -49,6 +57,56 @@ type alias TransitionMistakes = Maybe (Set TransitionID) +type alias Machine = + { q : Set StateID + , delta : Delta + , start : Set StateID + , final : Set StateID + , statePositions : StatePositions + , stateTransitions : StateTransitions + , stateNames : StateNames + , transitionNames : TransitionNames + } + + +type MachineType + = DFA + | NFA + + +type Model + = Regular + | DraggingState StateID ( Float, Float ) ( Float, Float ) + | SelectedState StateID + | MousingOverRim StateID ( Float, Float ) + | AddingArrow StateID ( Float, Float ) + | AddingArrowOverOtherState StateID ( Float, Float ) StateID + | MousingOverStateLabel StateID + | MousingOverTransitionLabel TransitionID + | EditingStateLabel StateID String + | EditingTransitionLabel ( StateID, TransitionID, StateID ) ( String, String, String ) + | SelectedArrow ( StateID, TransitionID, StateID ) + | DraggingArrow ( StateID, TransitionID, StateID ) ( Float, Float ) + | CreatingNewArrow StateID + + +type Msg + = StartDragging StateID ( Float, Float ) + | StartDraggingArrow ( StateID, TransitionID, StateID ) ( Float, Float ) + | StartMouseOverRim StateID ( Float, Float ) + | MoveMouseOverRim ( Float, Float ) + | StopMouseOverRim + | SelectArrow ( StateID, TransitionID, StateID ) + | MouseOverStateLabel StateID + | MouseOverTransitionLabel TransitionID + | MouseLeaveLabel + | EditLabel StateID String + | Drag ( Float, Float ) + | TapState StateID + | StopDragging + | Reset + + machineEncoder : Machine -> E.Value machineEncoder = machineEncoderV1 @@ -88,9 +146,17 @@ machineEncoderV1 machine = stateNamesEncoder = encodeDict E.int E.string + transitionLabelEncoder : TransitionLabel -> E.Value + transitionLabelEncoder tLabel = + E.object + [ ( "inputLabel", encodeSet E.string tLabel.inputLabel ) + , ( "stackTop", E.string tLabel.stackTop ) + , ( "stackPush", E.string tLabel.stackPush ) + ] + transNamesEncoder : TransitionNames -> E.Value transNamesEncoder = - encodeDict E.int (encodeSet E.string) + encodeDict E.int transitionLabelEncoder in E.object [ ( "q", qEncoder machine.q ) @@ -155,7 +221,7 @@ machineDecoderV1 = transNamesDecoder : D.Decoder TransitionNames transNamesDecoder = - D.field "transNames" <| decodeDict D.int (decodeSet D.string) + D.field "transNames" <| decodeDict D.int (D.map3 TransitionLabel (decodeSet D.string) D.string D.string) in D.map8 Machine qDecoder @@ -168,51 +234,6 @@ machineDecoderV1 = transNamesDecoder -type alias Machine = - { q : Set StateID - , delta : Delta - , start : Set StateID - , final : Set StateID - , statePositions : StatePositions - , stateTransitions : StateTransitions - , stateNames : StateNames - , transitionNames : TransitionNames - } - - -type Model - = Regular - | DraggingState StateID ( Float, Float ) ( Float, Float ) - | SelectedState StateID - | MousingOverRim StateID ( Float, Float ) - | AddingArrow StateID ( Float, Float ) - | AddingArrowOverOtherState StateID ( Float, Float ) StateID - | MousingOverStateLabel StateID - | MousingOverTransitionLabel TransitionID - | EditingStateLabel StateID String - | EditingTransitionLabel ( StateID, TransitionID, StateID ) String - | SelectedArrow ( StateID, TransitionID, StateID ) - | DraggingArrow ( StateID, TransitionID, StateID ) ( Float, Float ) - | CreatingNewArrow StateID - - -type Msg - = StartDragging StateID ( Float, Float ) - | StartDraggingArrow ( StateID, TransitionID, StateID ) ( Float, Float ) - | StartMouseOverRim StateID ( Float, Float ) - | MoveMouseOverRim ( Float, Float ) - | StopMouseOverRim - | SelectArrow ( StateID, TransitionID, StateID ) - | MouseOverStateLabel StateID - | MouseOverTransitionLabel TransitionID - | MouseLeaveLabel - | EditLabel StateID String - | Drag ( Float, Float ) - | TapState StateID - | StopDragging - | Reset - - test : Machine test = let @@ -240,7 +261,17 @@ test = Dict.fromList [ ( 0, "q_0" ), ( 1, "q_1" ), ( 2, "q_2" ), ( 3, "q_3" ) ] transitionNames = - Dict.fromList <| List.map (\( k, str ) -> ( k, Set.singleton str )) [ ( 0, "1" ), ( 1, "0" ), ( 2, "1" ), ( 3, "0" ), ( 4, "1" ), ( 5, "0" ), ( 6, "1" ), ( 7, "0" ) ] + Dict.fromList <| + List.map (\( k, str ) -> ( k, { inputLabel = Set.singleton str, stackTop = "", stackPush = "" } )) + [ ( 0, "1" ) + , ( 1, "0" ) + , ( 2, "1" ) + , ( 3, "0" ) + , ( 4, "1" ) + , ( 5, "0" ) + , ( 6, "1" ) + , ( 7, "0" ) + ] stateTransitions = Dict.fromList @@ -257,8 +288,8 @@ test = Machine q delta0 start final statePositions stateTransitions stateNames transitionNames -view : Environment -> Model -> Machine -> Set StateID -> TransitionMistakes -> Shape Msg -view env model machine currentStates tMistakes = +view : Environment -> Model -> MachineType -> Machine -> Set StateID -> TransitionMistakes -> Shape Msg +view env model macType machine currentStates tMistakes = let ( winX, winY ) = env.windowSize @@ -270,7 +301,7 @@ view env model machine currentStates tMistakes = |> notifyMouseUp StopDragging in group - [ renderArrows machine model tMistakes + [ renderArrows macType machine model tMistakes , renderStates currentStates machine model env , case model of AddingArrow s ( x, y ) -> @@ -284,12 +315,22 @@ view env model machine currentStates tMistakes = ( 0, 0 ) newTrans = - case List.head <| Dict.values machine.transitionNames of - Just schar -> - Set.toList schar |> renderString + case macType of + DFA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + Set.toList tLabel.inputLabel |> renderString - Nothing -> - " " + Nothing -> + " " + + NFA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + Set.toList tLabel.inputLabel |> renderString + + Nothing -> + " " newTransID = case List.head <| Dict.keys machine.transitionNames of @@ -299,7 +340,7 @@ view env model machine currentStates tMistakes = Nothing -> 0 in - renderArrow s0Pos ( 0, 0 ) ( x, y ) 20 0 newTrans newTransID False False s -1 model + renderArrow macType s0Pos ( 0, 0 ) ( x, y ) 20 0 newTrans newTransID False False s -1 model AddingArrowOverOtherState s ( x, y ) s1 -> let @@ -320,12 +361,22 @@ view env model machine currentStates tMistakes = ( 0, 0 ) newTrans = - case List.head <| Dict.values machine.transitionNames of - Just schar -> - Set.toList schar |> renderString + case macType of + DFA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + Set.toList tLabel.inputLabel |> renderString - Nothing -> - " " + Nothing -> + " " + + NFA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + Set.toList tLabel.inputLabel |> renderString + + Nothing -> + " " newTransID = case List.head <| Dict.keys machine.transitionNames of @@ -342,7 +393,7 @@ view env model machine currentStates tMistakes = else ( 0, 0 ) in - renderArrow s0Pos pullPos s1Pos 20 20 newTrans newTransID False False s s1 model + renderArrow macType s0Pos pullPos s1Pos 20 20 newTrans newTransID False False s s1 model _ -> group [] @@ -389,7 +440,8 @@ arrow ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) = renderArrow : - ( Float, Float ) + MachineType + -> ( Float, Float ) -> ( Float, Float ) -> ( Float, Float ) -> Float @@ -402,7 +454,7 @@ renderArrow : -> StateID -> Model -> Shape Msg -renderArrow ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mistake s1 s2 model = +renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mistake s1 s2 model = let ( tx, ty ) = --tangent between to and from states @@ -508,18 +560,32 @@ renderArrow ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mistake s1 s2 |> notifyMouseDown (SelectArrow ( s1, charID, s2 )) , group [ case model of - EditingTransitionLabel ( _, tId, _ ) str -> + EditingTransitionLabel ( _, tId, _ ) ( lab, stkTop, stkPush ) -> if tId == charID then - textBox str - (if String.length str == 0 then - 40 - - else - 8 * toFloat (String.length str) + 5 - ) - 20 - "LaTeX" - (EditLabel tId) + case macType of + DFA -> + textBox lab + (if String.length lab == 0 then + 40 + + else + 8 * toFloat (String.length lab) + 5 + ) + 20 + "LaTeX" + (EditLabel tId) + + NFA -> + textBox lab + (if String.length lab == 0 then + 40 + + else + 8 * toFloat (String.length lab) + 5 + ) + 20 + "LaTeX" + (EditLabel tId) else latex tLblW @@ -587,8 +653,8 @@ renderArrow ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mistake s1 s2 ] -renderArrows : Machine -> Model -> TransitionMistakes -> Shape Msg -renderArrows machine model tMistakes = +renderArrows : MachineType -> Machine -> Model -> TransitionMistakes -> Shape Msg +renderArrows macType machine model tMistakes = let states = machine.q @@ -652,10 +718,15 @@ renderArrows machine model tMistakes = ch = case Dict.get chId machine.transitionNames of - Just setc -> - Set.toList setc |> renderString + Just tLabel -> + case macType of + DFA -> + Set.toList tLabel.inputLabel |> renderString - _ -> + NFA -> + Set.toList tLabel.inputLabel |> renderString + + Nothing -> "" sel = @@ -683,7 +754,7 @@ renderArrows machine model tMistakes = getTransMistake tMistakes chId in group - [ renderArrow ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) 20 20 ch chId sel mistake s1 s2 model + [ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) 20 20 ch chId sel mistake s1 s2 model ] ) [ ss ] @@ -851,3 +922,11 @@ renderStates currentStates machine model env = ) ) stateList + + +emptyLabel : TransitionLabel +emptyLabel = + { inputLabel = Set.empty + , stackTop = "" + , stackPush = "" + } diff --git a/src/Mistakes.elm b/src/Mistakes.elm index 1e64268..e4bd415 100644 --- a/src/Mistakes.elm +++ b/src/Mistakes.elm @@ -16,6 +16,7 @@ getTransitionMistakes mac = -- Check if an epsilon label is well-typed +-- TODO: Check if this should be generalized to NPDAs checkEpsilonTransLabel : TransitionNames -> TransitionMistakes @@ -23,8 +24,8 @@ checkEpsilonTransLabel tNames = let tMistakes = Dict.foldl - (\tid tnames tmistakes -> - if not (checkTransitionValid tnames) then + (\tid tLabel tmistakes -> + if not (checkTransitionValid tLabel.inputLabel) then Set.insert tid tmistakes else diff --git a/src/SharedModel.elm b/src/SharedModel.elm index 0e76a72..69504e0 100644 --- a/src/SharedModel.elm +++ b/src/SharedModel.elm @@ -1,13 +1,8 @@ -module SharedModel exposing (MachineType(..), SharedModel, init, machineModeButtons) +module SharedModel exposing (SharedModel, init, machineModeButtons) import GraphicSVG exposing (..) import Helpers exposing (..) -import Machine exposing (Machine) - - -type MachineType - = DFA - | NFA +import Machine exposing (Machine, MachineType(..)) type alias SharedModel = diff --git a/src/Simulating.elm b/src/Simulating.elm index f7933f9..38b480c 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -129,7 +129,7 @@ checkTape sModel inp = sModel.machine.transitionNames allTransitionLabels = - List.foldr Set.union Set.empty <| Dict.values tNames + List.foldr (Set.union << .inputLabel) Set.empty <| Dict.values tNames arrFilter = Array.filter (\v -> not <| Set.member v allTransitionLabels) inp @@ -507,7 +507,12 @@ update env msg ( model, pModel, sModel ) = -1 chars = - Array.fromList <| Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values oldMachine.transitionNames + Array.fromList <| + Set.toList <| + Set.remove "\\epsilon" <| + List.foldr Set.union Set.empty <| + List.map .inputLabel <| + Dict.values oldMachine.transitionNames newChar = Array.get charCode chars @@ -672,7 +677,12 @@ view env ( model, pModel, sModel ) = chars = -- This is broken? - Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values oldMachine.transitionNames + -- 2021-07-31 TODO: Investigate why this is broken + Set.toList <| + Set.remove "\\epsilon" <| + List.foldr Set.union Set.empty <| + List.map .inputLabel <| + Dict.values oldMachine.transitionNames menu = group <| @@ -757,7 +767,7 @@ view env ( model, pModel, sModel ) = |> move ( -10 * toFloat (Array.length tape), winY / 6 - 65 ) ] |> move ( 0, -winY / 3 ) - , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) + , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) , machineModeButtons sModel.machineType winX winY ChangeMachine ] @@ -793,7 +803,7 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 500, winY / 6 - 45 ) , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 65 ) - , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl Set.union Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) , latex 500 18 "blank" "\\Delta = (above)" AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) @@ -812,7 +822,7 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 500, winY / 6 - 45 ) , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 65 ) - , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl Set.union Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) , latex 500 18 "blank" "\\delta = (above)" AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) @@ -848,7 +858,7 @@ epsTrans tNames d states = getName trans = case Dict.get trans tNames of Just n -> - renderSet2String n + renderSet2String n.inputLabel _ -> "" @@ -893,7 +903,7 @@ delta tNames d ch state = getName trans = case Dict.get trans tNames of Just n -> - n + n.inputLabel _ -> Set.empty From e67ba61ee598cc0ad07b6e5d3d947b4d5b83829c Mon Sep 17 00:00:00 2001 From: Necried Date: Mon, 2 Aug 2021 22:28:05 -0400 Subject: [PATCH 02/20] Cover existing case statements with NPDA case --- src/Building.elm | 58 +++++++++++++++++++++--- src/Error.elm | 7 +++ src/Exporting.elm | 3 ++ src/Machine.elm | 32 +++++++++++-- src/Simulating.elm | 110 ++++++++++++++++++++++++++++++++++++++++++--- src/Utils.elm | 15 +++++++ 6 files changed, 209 insertions(+), 16 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index e45e61f..45783db 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -356,12 +356,11 @@ update env msg ( model, pModel, sModel ) = in ( ( { model | machineState = newState }, pModel, sModel ), False, Cmd.none ) - -- FIXME: EditLabel doesn't work well with NPDA label type - EditLabel _ lbl -> + EditStateLabel st lbl -> let newState = case model.machineState of - EditingStateLabel st _ -> + EditingStateLabel _ _ -> EditingStateLabel st lbl EditingTransitionLabel tr _ -> @@ -372,6 +371,18 @@ update env msg ( model, pModel, sModel ) = in ( ( { model | machineState = newState }, pModel, sModel ), False, Cmd.none ) + EditTransitionLabel _ lbl -> + let + newState = + case model.machineState of + EditingTransitionLabel tr _ -> + EditingTransitionLabel tr ( lbl, "", "" ) + + _ -> + model.machineState + in + ( ( { model | machineState = newState }, pModel, sModel ), False, Cmd.none ) + TapState sId -> let oldStateName = @@ -401,6 +412,9 @@ update env msg ( model, pModel, sModel ) = DFA -> ( ( model, pModel, { sModel | machineType = NFA } ), False, Cmd.none ) + NPDA -> + ( ( model, pModel, { sModel | machineType = NFA } ), False, Cmd.none ) + DFA -> case sModel.machineType of DFA -> @@ -431,6 +445,20 @@ update env msg ( model, pModel, sModel ) = in ( ( model, pModel, newSModel ), True, Cmd.none ) + NPDA -> + ( ( model, pModel, { sModel | machineType = DFA } ), False, Cmd.none ) + + NPDA -> + case sModel.machineType of + DFA -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + NFA -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + NPDA -> + ( ( model, pModel, sModel ), False, Cmd.none ) + AddState ( x, y ) -> case model.machineState of Regular -> @@ -480,21 +508,32 @@ update env msg ( model, pModel, sModel ) = oldTransitionName = case Dict.get tId oldMachine.transitionNames of Just n -> - renderSet2String n.inputLabel + ( renderSet2String n.inputLabel, n.stackTop, n.stackPush ) _ -> - "" + ( "", "", "" ) in case sModel.machineType of DFA -> - if fst newLbl == oldTransitionName || fst newLbl == "" then + if fst newLbl == fst oldTransitionName || fst newLbl == "" then ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) else ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), True, sendMsg <| SaveTransitionName tId newLbl ) NFA -> - if fst newLbl == oldTransitionName || fst newLbl == "" then + if fst newLbl == fst oldTransitionName || fst newLbl == "" then + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) + + else + ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), True, sendMsg <| SaveTransitionName tId newLbl ) + + NPDA -> + if + (fst newLbl == fst oldTransitionName || fst newLbl == "") + && (snd newLbl == snd oldTransitionName || snd newLbl == "") + && (thd newLbl == thd oldTransitionName || thd newLbl == "") + then ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) else @@ -655,6 +694,11 @@ update env msg ( model, pModel, sModel ) = { oldMachine | start = Set.singleton sId } + + NPDA -> + { oldMachine + | start = Set.singleton sId + } in ( ( model, pModel, { sModel | machine = newMachine } ), True, Cmd.none ) diff --git a/src/Error.elm b/src/Error.elm index 33c3f91..be69d29 100644 --- a/src/Error.elm +++ b/src/Error.elm @@ -50,6 +50,13 @@ contextHasError err mtype = _ -> False + NPDA -> + if err == NoError then + False + + else + True + machineCheck : SharedModel -> Error machineCheck sModel = diff --git a/src/Exporting.elm b/src/Exporting.elm index ce09c71..8222ade 100644 --- a/src/Exporting.elm +++ b/src/Exporting.elm @@ -181,6 +181,9 @@ machineSelected mtype winX winY = NFA -> "NFA" + + NPDA -> + "NPDA" in text ("Your exported machine type: " ++ mtypeStr) |> centered diff --git a/src/Machine.elm b/src/Machine.elm index 7bd7258..43c0c77 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -72,6 +72,7 @@ type alias Machine = type MachineType = DFA | NFA + | NPDA type Model @@ -100,7 +101,8 @@ type Msg | MouseOverStateLabel StateID | MouseOverTransitionLabel TransitionID | MouseLeaveLabel - | EditLabel StateID String + | EditTransitionLabel TransitionID String + | EditStateLabel StateID String | Drag ( Float, Float ) | TapState StateID | StopDragging @@ -332,6 +334,14 @@ view env model macType machine currentStates tMistakes = Nothing -> " " + NPDA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + + Nothing -> + " " + newTransID = case List.head <| Dict.keys machine.transitionNames of Just char -> @@ -378,6 +388,14 @@ view env model macType machine currentStates tMistakes = Nothing -> " " + NPDA -> + case List.head <| Dict.values machine.transitionNames of + Just tLabel -> + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + + Nothing -> + " " + newTransID = case List.head <| Dict.keys machine.transitionNames of Just char -> @@ -573,7 +591,7 @@ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mista ) 20 "LaTeX" - (EditLabel tId) + (EditTransitionLabel tId) NFA -> textBox lab @@ -585,7 +603,10 @@ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mista ) 20 "LaTeX" - (EditLabel tId) + (EditTransitionLabel tId) + + NPDA -> + Debug.todo "TODO" else latex tLblW @@ -726,6 +747,9 @@ renderArrows macType machine model tMistakes = NFA -> Set.toList tLabel.inputLabel |> renderString + NPDA -> + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + Nothing -> "" @@ -841,7 +865,7 @@ renderStates currentStates machine model env = ) 20 "LaTeX" - (EditLabel sId) + (EditStateLabel sId) else group diff --git a/src/Simulating.elm b/src/Simulating.elm index 38b480c..9c48d40 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -555,6 +555,14 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, { sModel | machineType = NFA } ), False, Cmd.none ) + NPDA -> + case model of + Editing tId -> + ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + _ -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + DFA -> case sModel.machineType of DFA -> @@ -593,6 +601,60 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, newPModel, newSModel ), True, Cmd.none ) + NPDA -> + case model of + Editing tId -> + ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + _ -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + NPDA -> + case sModel.machineType of + DFA -> + case model of + Editing tId -> + ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + _ -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + + NFA -> + let + startState = + if Set.size oldMachine.start > 1 then + Set.singleton <| + (\x -> + case x of + Just val -> + val + + Nothing -> + -1 + ) + <| + List.head <| + Set.toList oldMachine.start + + else + oldMachine.start + + newPModel = + { pModel | currentStates = startState } + + newSModel = + { sModel | machine = { oldMachine | start = startState }, machineType = NPDA } + in + case model of + Editing tId -> + ( ( Default tId -1 Nothing, newPModel, newSModel ), True, Cmd.none ) + + _ -> + ( ( model, newPModel, newSModel ), True, Cmd.none ) + + NPDA -> + ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + MachineMsg mmsg -> case mmsg of StartDragging sId _ -> @@ -614,18 +676,20 @@ update env msg ( model, pModel, sModel ) = NFA -> { oldMachine | start = - case Set.member sId oldMachine.start of - True -> - Set.remove sId oldMachine.start + if Set.member sId oldMachine.start then + Set.remove sId oldMachine.start - False -> - Set.insert sId oldMachine.start + else + Set.insert sId oldMachine.start } DFA -> { oldMachine | start = Set.singleton sId } + + NPDA -> + { oldMachine | start = Set.singleton sId } in case model of Default tId _ _ -> @@ -847,6 +911,42 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 510, winY / 6 - 160 ) ] + NPDA -> + group + [ machineHeader + , latex 500 18 "blank" "let\\ M = (Q,\\Sigma,\\Gamma,\\delta,s,\\bot,F)" AlignLeft + |> move ( -winX / 2 + 500, winY / 6 - 25 ) + , latex 500 14 "blank" "where" AlignLeft + |> move ( -winX / 2 + 500, winY / 6 - 45 ) + , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 65 ) + , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 90 ) + , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| List.foldl (\t s -> Set.insert t.stackTop (Set.insert t.stackPush s)) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 90 ) + , latex 500 18 "blank" "\\delta = (above)" AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 115 ) + , latex 500 + 14 + "blank" + ("s = " + ++ (case Set.toList machine.start of + [] -> + "Please\\ select\\ a\\ start\\ state" + + x :: [] -> + getStateName x + + _ :: _ -> + "Congratulations,\\ you\\ found\\ a\\ bug!" + ) + ) + AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 140 ) + , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.final) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 160 ) + ] + epsTrans : TransitionNames -> Delta -> Set StateID -> Set StateID epsTrans tNames d states = diff --git a/src/Utils.elm b/src/Utils.elm index 228c243..f75d437 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -76,6 +76,21 @@ textBox txt w h place msg = [] +textBox3 : ( String, String, String ) -> Float -> Float -> ( String, String, String ) -> (String -> msg) -> Shape msg +textBox3 ( t1, t2, t3 ) w h ( p1, p2, p3 ) msg = + let + box1 = + textBox t1 w h p1 msg |> move ( 0, h ) + + box2 = + textBox t2 w h p2 msg + + box3 = + textBox t3 w h p3 msg |> move ( 0, -h ) + in + group [ box1, box2, box3 ] + + newMsg : msg -> Cmd msg newMsg msg = Task.perform identity <| Task.succeed msg From dbef0041a7d4a2e4e05d83870362a59d8641d7c3 Mon Sep 17 00:00:00 2001 From: Necried Date: Mon, 2 Aug 2021 22:44:41 -0400 Subject: [PATCH 03/20] Add the NPDA button, now app breaks in NPDA mode --- src/SharedModel.elm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/SharedModel.elm b/src/SharedModel.elm index 69504e0..53e949a 100644 --- a/src/SharedModel.elm +++ b/src/SharedModel.elm @@ -69,4 +69,28 @@ machineModeButtons mtype winX winY changeMsg = ] |> move ( -winX / 2 + 52, winY / 2 - 32 ) |> notifyTap (changeMsg NFA) + , group + [ roundedRect 40 15 1 + |> filled + (if mtype == NPDA then + finsmLightBlue + + else + blank + ) + |> addOutline (solid 1) darkGray + , text "NPDA" + |> centered + |> fixedwidth + |> filled + (if mtype == NPDA then + white + + else + darkGray + ) + |> move ( 0, -4 ) + ] + |> move ( -winX / 2 + 89, winY / 2 - 32 ) + |> notifyTap (changeMsg NPDA) ] From d5b009439e63fe180ea9f56e2eb03368605e6500 Mon Sep 17 00:00:00 2001 From: Necried Date: Tue, 3 Aug 2021 20:27:49 -0400 Subject: [PATCH 04/20] Build mode works for NPDA (not tested thoroughly) --- src/Building.elm | 26 ++++++++++++++++---------- src/Machine.elm | 34 +++++++++++++++++++++++++--------- src/Utils.elm | 10 +++++----- 3 files changed, 46 insertions(+), 24 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index 45783db..f2ffeae 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -1,5 +1,6 @@ module Building exposing (Model, Msg(..), PersistentModel(..), editingButtons, init, initPModel, onEnter, onExit, subscriptions, update, updateArrowPos, updateStatePos, view) +import Bootstrap.Form.InputGroup exposing (Input) import Browser.Events import Dict exposing (Dict) import Environment exposing (Environment) @@ -79,7 +80,7 @@ update env msg ( model, pModel, sModel ) = in case msg of MachineMsg mmsg -> - case mmsg of + case Debug.log "Build msg" mmsg of StartDragging st ( x, y ) -> let ( sx, sy ) = @@ -210,13 +211,13 @@ update env msg ( model, pModel, sModel ) = newInpLabel = case Dict.get tId sModel.machine.transitionNames of Just n -> - renderSet2String n.inputLabel + ( renderSet2String n.inputLabel, n.stackTop, n.stackPush ) Nothing -> - "" + ( "", "", "" ) newLab = - ( newInpLabel, "", "" ) + newInpLabel in if env.holdingShift then ( ( { model | machineState = EditingTransitionLabel ( s0, tId, s1 ) newLab }, pModel, sModel ), False, focusInput NoOp ) @@ -363,20 +364,25 @@ update env msg ( model, pModel, sModel ) = EditingStateLabel _ _ -> EditingStateLabel st lbl - EditingTransitionLabel tr _ -> - EditingTransitionLabel tr ( lbl, "", "" ) - _ -> model.machineState in ( ( { model | machineState = newState }, pModel, sModel ), False, Cmd.none ) - EditTransitionLabel _ lbl -> + EditTransitionLabel tr0 lblTy lbl -> let newState = case model.machineState of - EditingTransitionLabel tr _ -> - EditingTransitionLabel tr ( lbl, "", "" ) + EditingTransitionLabel tr ( oldInpLbl, oldStkTop, oldStkPush ) -> + case lblTy of + InputLabel -> + EditingTransitionLabel tr ( lbl, oldStkTop, oldStkPush ) + + StackTop -> + EditingTransitionLabel tr ( oldInpLbl, lbl, oldStkPush ) + + StackPush -> + EditingTransitionLabel tr ( oldInpLbl, oldStkTop, lbl ) _ -> model.machineState diff --git a/src/Machine.elm b/src/Machine.elm index 43c0c77..7344f1f 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -1,6 +1,5 @@ module Machine exposing (..) -import Debug exposing (todo) import Dict exposing (Dict) import Environment exposing (Environment) import GraphicSVG exposing (..) @@ -11,7 +10,7 @@ import Html.Events exposing (onInput) import Json.Decode as D import Json.Encode as E import Set exposing (Set) -import Utils exposing (decodeDict, decodePair, decodeSet, decodeTriple, encodeDict, encodePair, encodeSet, encodeTriple, textBox) +import Utils exposing (decodeDict, decodePair, decodeSet, decodeTriple, encodeDict, encodePair, encodeSet, encodeTriple, textBox, textBox3) type alias StateID = @@ -41,6 +40,12 @@ type alias TransitionLabel = } +type LabelEditType + = InputLabel + | StackTop + | StackPush + + type alias StateTransitions = Dict ( StateID, TransitionID, StateID ) ( Float, Float ) @@ -101,7 +106,7 @@ type Msg | MouseOverStateLabel StateID | MouseOverTransitionLabel TransitionID | MouseLeaveLabel - | EditTransitionLabel TransitionID String + | EditTransitionLabel TransitionID LabelEditType String | EditStateLabel StateID String | Drag ( Float, Float ) | TapState StateID @@ -337,7 +342,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush Nothing -> " " @@ -391,7 +396,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush Nothing -> " " @@ -591,7 +596,7 @@ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mista ) 20 "LaTeX" - (EditTransitionLabel tId) + (EditTransitionLabel tId InputLabel) NFA -> textBox lab @@ -603,10 +608,21 @@ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mista ) 20 "LaTeX" - (EditTransitionLabel tId) + (EditTransitionLabel tId InputLabel) NPDA -> - Debug.todo "TODO" + textBox3 ( lab, stkTop, stkPush ) + (if List.any ((==) 0) <| List.map String.length [ lab, stkTop, stkPush ] then + 80 + + else + 8 * toFloat (String.length lab) + 5 + ) + 20 + ( "inputLabel", "stackTop", "stackPush" ) + (EditTransitionLabel tId InputLabel) + (EditTransitionLabel tId StackTop) + (EditTransitionLabel tId StackPush) else latex tLblW @@ -748,7 +764,7 @@ renderArrows macType machine model tMistakes = Set.toList tLabel.inputLabel |> renderString NPDA -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackPush ++ ";" ++ tLabel.stackTop + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush Nothing -> "" diff --git a/src/Utils.elm b/src/Utils.elm index f75d437..15f2653 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -76,17 +76,17 @@ textBox txt w h place msg = [] -textBox3 : ( String, String, String ) -> Float -> Float -> ( String, String, String ) -> (String -> msg) -> Shape msg -textBox3 ( t1, t2, t3 ) w h ( p1, p2, p3 ) msg = +textBox3 : ( String, String, String ) -> Float -> Float -> ( String, String, String ) -> (String -> msg) -> (String -> msg) -> (String -> msg) -> Shape msg +textBox3 ( t1, t2, t3 ) w h ( p1, p2, p3 ) msg1 msg2 msg3 = let box1 = - textBox t1 w h p1 msg |> move ( 0, h ) + textBox t1 w h p1 msg1 |> move ( 0, h ) box2 = - textBox t2 w h p2 msg + textBox t2 w h p2 msg2 box3 = - textBox t3 w h p3 msg |> move ( 0, -h ) + textBox t3 w h p3 msg3 |> move ( 0, -h ) in group [ box1, box2, box3 ] From cab991ce16a08e265dac07d2a01fe408c9aeff02 Mon Sep 17 00:00:00 2001 From: Necried Date: Sat, 7 Aug 2021 22:48:11 -0400 Subject: [PATCH 05/20] Fix mode buttons in Simulate, and add run button on tapes --- src/Helpers.elm | 11 +++++++++++ src/Simulating.elm | 39 ++++++++++++++++++++++++--------------- 2 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/Helpers.elm b/src/Helpers.elm index a0c2b00..2d548a9 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -89,6 +89,17 @@ trashIcon = ] +thickRightArrowIcon = + group + [ rect 30 25 + |> filled black + |> move ( -10, 0 ) + , triangle 25 + |> filled black + |> move ( 10, 0 ) + ] + + type LatexAlign = AlignLeft | AlignRight diff --git a/src/Simulating.elm b/src/Simulating.elm index 9c48d40..5a773ef 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -246,6 +246,13 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = ] |> move ( toFloat <| (Array.length input + 1) * xpad, 3 ) |> notifyTap (DeleteTape tapeId) + , group + [ roundedRect 15 15 2 + |> filled white + |> addOutline (solid 1) darkGray + , thickRightArrowIcon |> scale 0.2 |> move ( 0, -1 ) + ] + |> move ( toFloat <| (Array.length input + 2) * xpad, 2 ) , if not (tapeSt == Fresh) then group ([ triangle 20 |> filled red |> rotate 22.5 @@ -558,10 +565,10 @@ update env msg ( model, pModel, sModel ) = NPDA -> case model of Editing tId -> - ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NFA } ), False, Cmd.none ) _ -> - ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + ( ( model, pModel, { sModel | machineType = NFA } ), False, Cmd.none ) DFA -> case sModel.machineType of @@ -604,10 +611,10 @@ update env msg ( model, pModel, sModel ) = NPDA -> case model of Editing tId -> - ( ( Default tId -1 Nothing, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + ( ( Default tId -1 Nothing, pModel, { sModel | machineType = DFA } ), False, Cmd.none ) _ -> - ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + ( ( model, pModel, { sModel | machineType = DFA } ), False, Cmd.none ) NPDA -> case sModel.machineType of @@ -861,9 +868,9 @@ machineDefn sModel mtype winX winY = NFA -> group [ machineHeader - , latex 500 18 "blank" "let\\ N = (Q,\\Sigma,\\Delta,S,F)" AlignLeft + , latex 500 18 "blank" "\\textrm{let}\\ N = (Q,\\Sigma,\\Delta,S,F)" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 25 ) - , latex 500 14 "blank" "where" AlignLeft + , latex 500 14 "blank" "\\textrm{where}" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 45 ) , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 65 ) @@ -880,9 +887,9 @@ machineDefn sModel mtype winX winY = DFA -> group [ machineHeader - , latex 500 18 "blank" "let\\ M = (Q,\\Sigma,\\delta,s,F)" AlignLeft + , latex 500 18 "blank" "\\textrm{let}\\ M = (Q,\\Sigma,\\delta,s,F)" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 25 ) - , latex 500 14 "blank" "where" AlignLeft + , latex 500 14 "blank" "\\textrm{where}" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 45 ) , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 65 ) @@ -914,18 +921,18 @@ machineDefn sModel mtype winX winY = NPDA -> group [ machineHeader - , latex 500 18 "blank" "let\\ M = (Q,\\Sigma,\\Gamma,\\delta,s,\\bot,F)" AlignLeft + , latex 500 18 "blank" "\\textrm{let}\\ M = (Q,\\Sigma,\\Gamma,\\delta,s,\\bot,F)" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 25 ) - , latex 500 14 "blank" "where" AlignLeft + , latex 500 14 "blank" "\\textrm{where}" AlignLeft |> move ( -winX / 2 + 500, winY / 6 - 45 ) , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 65 ) , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) - , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| List.foldl (\t s -> Set.insert t.stackTop (Set.insert t.stackPush s)) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft - |> move ( -winX / 2 + 510, winY / 6 - 90 ) - , latex 500 18 "blank" "\\delta = (above)" AlignLeft + , latex 500 18 "blank" ("\\Gamma = \\{ " ++ String.join "," (Set.toList <| List.foldl (\t s -> Set.insert t.stackTop (Set.insert t.stackPush s)) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) + , latex 500 18 "blank" "\\delta = (above)" AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 135 ) , latex 500 14 "blank" @@ -942,9 +949,11 @@ machineDefn sModel mtype winX winY = ) ) AlignLeft - |> move ( -winX / 2 + 510, winY / 6 - 140 ) - , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.final) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 160 ) + , latex 500 14 "blank" "\\bot = \\bot" AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 180 ) + , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.final) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 510, winY / 6 - 200 ) ] From 0d60e303dca9604dc6181c07366e90ae19bcc823 Mon Sep 17 00:00:00 2001 From: Necried Date: Sun, 8 Aug 2021 16:56:56 -0400 Subject: [PATCH 06/20] Add stacks to Simulating PersistentModel --- src/Helpers.elm | 13 +++++++++++ src/Main.elm | 6 ++--- src/Simulating.elm | 57 ++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 71 insertions(+), 5 deletions(-) diff --git a/src/Helpers.elm b/src/Helpers.elm index 2d548a9..ab49913 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -334,6 +334,19 @@ labelPosition y1 theta = Above +isPrefixOf : List a -> List a -> Bool +isPrefixOf xs ys = + case ( xs, ys ) of + ( [], _ ) -> + True + + ( _, [] ) -> + False + + ( x :: xs1, y :: ys1 ) -> + x == y && isPrefixOf xs1 ys1 + + roundTo : Float -> Float -> Float roundTo n m = Basics.toFloat (round (m + n / 2) // round n * round n) diff --git a/src/Main.elm b/src/Main.elm index 21f9aaf..5453443 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -70,7 +70,7 @@ initAppModel = initAppRecord = { appState = Building Building.init , sharedModel = SharedModel.init - , simulatingData = Simulating.initPModel + , simulatingData = Simulating.initPModel SharedModel.init.machineType , buildingData = Building.initPModel , exportingData = Exporting.initPModel } @@ -416,7 +416,7 @@ update msg model = { initSharedModel | machine = loadPayload.machine } initSimModel = - Simulating.initPModel + Simulating.initPModel initSharedModel.machineType --{ appState = Building Building.init --, sharedModel = SharedModel.init @@ -467,7 +467,7 @@ update msg model = fresh { initAppRecord | sharedModel = newSharedModel - , simulatingData = initSimModel + , simulatingData = initSimModel newSharedModel.machineType } in ( { model diff --git a/src/Simulating.elm b/src/Simulating.elm index 5a773ef..1452737 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -27,6 +27,7 @@ subscriptions model = type alias PersistentModel = { tapes : Dict Int ( InputTape, TapeStatus ) , currentStates : Set StateID + , currentStacks : Maybe (List ( Stack, StateID )) } @@ -59,8 +60,13 @@ type alias HoverError = Maybe Int +type alias Stack = + List Char + + type Model = Default Int {- tapeID -} Int {- charID -} HoverError + | Running Int {- tapeID -} Int {- charID -} | Editing Int @@ -101,14 +107,30 @@ onExit env ( model, pModel, sModel ) = ( ( pModel, sModel ), False ) -initPModel : PersistentModel -initPModel = +initPModel : MachineType -> PersistentModel +initPModel macType = + let + designatedStart = + case Set.toList test.start of + [] -> + 0 + + -- This should not happen + startState :: _ -> + startState + in { tapes = Dict.fromList [ ( 0, ( Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0" ], Fresh ) ) , ( 1, ( Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0", "1", "1", "1", "1", "0" ], Fresh ) ) ] , currentStates = test.start + , currentStacks = + if macType == NPDA then + Just [ ( [ 'Z' ], designatedStart ) ] + + else + Nothing } @@ -838,6 +860,9 @@ view env ( model, pModel, sModel ) = |> move ( -10 * toFloat (Array.length tape), winY / 6 - 65 ) ] |> move ( 0, -winY / 3 ) + + Running _ _ -> + Debug.todo "Running state" , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) , machineModeButtons sModel.machineType winX winY ChangeMachine ] @@ -1050,6 +1075,34 @@ deltaHat tNames d ch states = epsTrans tNames d newStates + +-- NPDA functions + + +updateStack : TransitionLabel -> Stack -> Stack +updateStack { stackTop, stackPush } stk = + case stk of + [] -> + [] + + _ -> + let + stackTopList = + String.toList stackTop + + stackPushList = + String.toList stackPush + + newStack = + stackPushList ++ List.drop (List.length stackTopList) stk + in + if isPrefixOf stackTopList stk then + newStack + + else + stk + + latexKeyboard : Float -> Float -> List Character -> Shape Msg latexKeyboard w h chars = let From 8b89296dd5374d767e166607ff88970aa7d010e1 Mon Sep 17 00:00:00 2001 From: Necried Date: Sun, 8 Aug 2021 18:33:52 -0400 Subject: [PATCH 07/20] Add untested simulation functions for NPDA --- src/Simulating.elm | 56 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/src/Simulating.elm b/src/Simulating.elm index 1452737..5eae027 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -10,10 +10,12 @@ import GraphicSVG exposing (..) import Helpers exposing (..) import Json.Decode as D import Json.Encode as E +import List exposing (..) import Machine exposing (..) import Mistakes exposing (..) import Set exposing (Set) import SharedModel exposing (..) +import String exposing (replace) import Task import Tuple exposing (first, second) import Utils exposing (decodeDict, encodeDict) @@ -1079,6 +1081,60 @@ deltaHat tNames d ch states = -- NPDA functions +nextConfigRel : TransitionNames -> Delta -> Character -> List ( Stack, StateID ) -> List ( Stack, StateID ) +nextConfigRel tNames d ch stacks = + List.concatMap (nextConfig tNames d ch) stacks + + +nextConfig : TransitionNames -> Delta -> Character -> ( Stack, StateID ) -> List ( Stack, StateID ) +nextConfig tNames d ch ( stk, stateID ) = + let + getName trans = + case Dict.get trans tNames of + Just n -> + n + + _ -> + emptyLabel + + matchStackTop pat = + case String.uncons pat of + Nothing -> + False + + Just ( c, _ ) -> + Just c == List.head stk + + replaceStackTop old new inpStk = + if isPrefixOf old inpStk then + new ++ drop (length old) inpStk + + else + inpStk + in + case Dict.get stateID d of + Just transMap -> + Dict.toList transMap + |> List.filterMap + (\( tId, sId ) -> + let + tLabel = + getName tId + in + if + (renderSet2String tLabel.inputLabel == ch || renderSet2String tLabel.inputLabel == "\\epsilon") + && matchStackTop tLabel.stackTop + then + Just ( updateStack tLabel stk, sId ) + + else + Nothing + ) + + Nothing -> + [] + + updateStack : TransitionLabel -> Stack -> Stack updateStack { stackTop, stackPush } stk = case stk of From 9d27b3800679038088fac5f5ea96eb08921f2952 Mon Sep 17 00:00:00 2001 From: Necried Date: Fri, 13 Aug 2021 19:53:17 -0400 Subject: [PATCH 08/20] Make epsilon transitions in timesteps --- src/Simulating.elm | 87 ++++++++++++++++++++++++++++++---------------- 1 file changed, 58 insertions(+), 29 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index 5eae027..431a11c 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -29,7 +29,7 @@ subscriptions model = type alias PersistentModel = { tapes : Dict Int ( InputTape, TapeStatus ) , currentStates : Set StateID - , currentStacks : Maybe (List ( Stack, StateID )) + , currentStacks : Maybe (List Configuration) } @@ -52,11 +52,21 @@ inputTapeDictDecoder = type alias InputTape = Array Character - type TapeStatus = Fresh | Stale (Set String) +type alias Configuration = + { stack : Stack + , state : StateID + , status : ConfigStatus + , tapePos : Int + } + +type ConfigStatus + = Alive + | Deadend + | RemoveMe type alias HoverError = Maybe Int @@ -129,7 +139,7 @@ initPModel macType = , currentStates = test.start , currentStacks = if macType == NPDA then - Just [ ( [ 'Z' ], designatedStart ) ] + Just [ { stack = [ 'Z' ], state = designatedStart, status = Alive, tapePos = -1 } ] else Nothing @@ -1079,15 +1089,14 @@ deltaHat tNames d ch states = -- NPDA functions - - -nextConfigRel : TransitionNames -> Delta -> Character -> List ( Stack, StateID ) -> List ( Stack, StateID ) + +nextConfigRel : TransitionNames -> Delta -> Character -> List Configuration -> List Configuration nextConfigRel tNames d ch stacks = List.concatMap (nextConfig tNames d ch) stacks -nextConfig : TransitionNames -> Delta -> Character -> ( Stack, StateID ) -> List ( Stack, StateID ) -nextConfig tNames d ch ( stk, stateID ) = +nextConfig : TransitionNames -> Delta -> Character -> Configuration -> List Configuration +nextConfig tNames d ch ({ stack, state, status, tapePos } as config) = let getName trans = case Dict.get trans tNames of @@ -1103,7 +1112,7 @@ nextConfig tNames d ch ( stk, stateID ) = False Just ( c, _ ) -> - Just c == List.head stk + Just c == List.head stack replaceStackTop old new inpStk = if isPrefixOf old inpStk then @@ -1111,29 +1120,49 @@ nextConfig tNames d ch ( stk, stateID ) = else inpStk + + nextTape cond = + if cond then 0 else 1 in - case Dict.get stateID d of - Just transMap -> - Dict.toList transMap - |> List.filterMap - (\( tId, sId ) -> - let - tLabel = - getName tId - in - if - (renderSet2String tLabel.inputLabel == ch || renderSet2String tLabel.inputLabel == "\\epsilon") - && matchStackTop tLabel.stackTop - then - Just ( updateStack tLabel stk, sId ) - - else - Nothing - ) + case status of + Alive -> + let + newConfigs = + case Dict.get state d of + Just transMap -> + Dict.toList transMap + |> List.filterMap + (\( tId, sId ) -> + let + tLabel = + getName tId + in + if + (renderSet2String tLabel.inputLabel == ch || renderSet2String tLabel.inputLabel == "\\epsilon") + && matchStackTop tLabel.stackTop + then + Just + { stack = updateStack tLabel stack + , state = sId + , status = Alive + , tapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") + } + else + Nothing + ) - Nothing -> - [] + Nothing -> + [] + in + if newConfigs == [] + then [ { config | status = Deadend } ] + else newConfigs + Deadend -> + [ { config | status = RemoveMe } ] + + RemoveMe -> + [] updateStack : TransitionLabel -> Stack -> Stack updateStack { stackTop, stackPush } stk = From 1f2476934e0f79cf94a33bec4068e40402b609ce Mon Sep 17 00:00:00 2001 From: Necried Date: Sun, 15 Aug 2021 21:39:12 -0400 Subject: [PATCH 09/20] Add primitive rendering of NPDA simulation --- src/Simulating.elm | 212 +++++++++++++++++++++++++++++++++++++-------- 1 file changed, 176 insertions(+), 36 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index 431a11c..f42115b 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -29,7 +29,7 @@ subscriptions model = type alias PersistentModel = { tapes : Dict Int ( InputTape, TapeStatus ) , currentStates : Set StateID - , currentStacks : Maybe (List Configuration) + , npdaAcceptCond : AcceptCond } @@ -65,8 +65,12 @@ type alias Configuration = type ConfigStatus = Alive + | Success | Deadend - | RemoveMe + +type AcceptCond + = EmptyStack + | FinalState type alias HoverError = Maybe Int @@ -79,11 +83,13 @@ type alias Stack = type Model = Default Int {- tapeID -} Int {- charID -} HoverError | Running Int {- tapeID -} Int {- charID -} + | RunningNPDA (List Configuration) Int {- tapeID -} | Editing Int type Msg = Step + | RunTape Int | EditTape Int | DeleteTape Int | AddNewTape @@ -118,31 +124,24 @@ onExit : Environment -> ( Model, PersistentModel, SharedModel ) -> ( ( Persisten onExit env ( model, pModel, sModel ) = ( ( pModel, sModel ), False ) +designatedStart : Set StateID -> StateID +designatedStart setStart = + case Set.toList setStart of + [] -> + 0 + + startState :: _ -> + startState initPModel : MachineType -> PersistentModel initPModel macType = - let - designatedStart = - case Set.toList test.start of - [] -> - 0 - - -- This should not happen - startState :: _ -> - startState - in { tapes = Dict.fromList [ ( 0, ( Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0" ], Fresh ) ) , ( 1, ( Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0", "1", "1", "1", "1", "0" ], Fresh ) ) ] , currentStates = test.start - , currentStacks = - if macType == NPDA then - Just [ { stack = [ 'Z' ], state = designatedStart, status = Alive, tapePos = -1 } ] - - else - Nothing + , npdaAcceptCond = FinalState } @@ -175,6 +174,85 @@ checkTape sModel inp = False -> Stale <| Set.fromList <| Array.toList arrFilter +-- TODO: Add size-aware resizing and horizontal scroll +renderConfigs : Machine -> Model -> Array String -> Int -> Float -> List Configuration -> Shape Msg +renderConfigs machine model input tapeId winX cfgs = + let + xPos idx = (winX / 6) * (idx - 3) + (winX / 3) + + in + group <| List.indexedMap (\idx cfg -> renderConfig machine model input tapeId cfg |> move (xPos (toFloat idx), 0) ) cfgs + +renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> Shape Msg +renderConfig machine model input tapeId cfg = + let + xpad = 200 + + stateName = + case Dict.get cfg.state machine.stateNames of + Just n -> + n + + _ -> + "" + + statusColour = + case cfg.status of + Success -> green + Deadend -> red + _ -> blank + + renderedState = group + [ circle 20 + |> filled statusColour + |> addOutline (solid 1) black + , latex 25 18 "none" stateName AlignCentre + |> move ( 0, 9 ) + ] + + stackLength = toFloat (xpad*(List.length cfg.stack)) + renderedStack = renderStack cfg.stack + renderedTape = renderTape model input Fresh tapeId tapeId cfg.tapePos False + + outerBox = + rectangle (100 + stackLength) 150 + |> outlined (solid 5) black + |> move (stackLength / 2, -10) + in + group + [ outerBox + , renderedState + , renderedStack |> move (0, -50) + , renderedTape |> move (25, 0) + ] + +renderStack : Stack -> Shape Msg +renderStack stk = + let + xpad = 20 + in + group + (List.indexedMap + (\n st -> + group + [ square xpad + |> filled white + |> addOutline + (solid 1) + black + |> move ( 0, 3 ) + , latex (xpad * 0.9) (xpad * 0.7) "white" (String.fromChar st) AlignCentre + |> move ( 0, 10.25 ) + ] + |> move + ( toFloat n + * xpad + , 0 + ) + ) + stk + ) + renderTape : Model -> Array String -> TapeStatus -> Int -> Int -> Int -> Bool -> Shape Msg renderTape model input tapeSt tapeId selectedId inputAt showButtons = @@ -194,6 +272,15 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = xpad = 20 + -- TODO: Figure out why this is necessary when renderTape is used in RunningNPDA mode + displaceTapePointer = + case model of + RunningNPDA _ _ -> + xpad + + _ -> + xpad / 2 + errWindow = group [ roundedRect 800 30 2 @@ -254,7 +341,7 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = |> filled black |> move ( 0, 3 ) ] - |> move ( xpad / 2 + xpad * toFloat inputAt, 0 ) + |> move ( displaceTapePointer + xpad * toFloat inputAt, 0 ) ] else @@ -287,6 +374,7 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = , thickRightArrowIcon |> scale 0.2 |> move ( 0, -1 ) ] |> move ( toFloat <| (Array.length input + 2) * xpad, 2 ) + |> notifyTap (RunTape tapeId) , if not (tapeSt == Fresh) then group ([ triangle 20 |> filled red |> rotate 22.5 @@ -301,7 +389,7 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = ) ) |> scale 0.5 - |> move ( toFloat <| (Array.length input + 2) * xpad, 1 ) + |> move ( toFloat <| (Array.length input + 3) * xpad, 1 ) |> notifyEnter (HoverErrorEnter tapeId) |> notifyLeave HoverErrorExit @@ -322,6 +410,7 @@ update env msg ( model, pModel, sModel ) = machineType = sModel.machineType + in case msg of Step -> @@ -360,9 +449,30 @@ update env msg ( model, pModel, sModel ) = else ( ( model, pModel, sModel ), False, Cmd.none ) + RunningNPDA cfgs tId -> + let + tape = + Dict.get tId pModel.tapes + |> Maybe.map first + |> Maybe.withDefault Array.empty + + newCfgs = nextConfigRel oldMachine.transitionNames oldMachine.delta tape pModel.npdaAcceptCond sModel.machine.final cfgs + in + ( ( RunningNPDA newCfgs tId, pModel, sModel), False, Cmd.none ) _ -> ( ( model, pModel, sModel ), False, Cmd.none ) + RunTape tId -> + case machineType of + DFA -> + ( ( Running tId (-1), pModel, sModel), False, Cmd.none ) + + NFA -> + ( ( Running tId (-1), pModel, sModel), False, Cmd.none ) + + NPDA -> + ( (RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel), False, Cmd.none) + EditTape tId -> ( ( Editing tId, pModel, sModel ), False, Cmd.none ) @@ -449,6 +559,9 @@ update env msg ( model, pModel, sModel ) = Default _ _ _ -> ( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) ) + RunningNPDA _ _ -> + ( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) ) + _ -> ( ( model, pModel, sModel ), False, Cmd.none ) @@ -827,6 +940,14 @@ view env ( model, pModel, sModel ) = validCheck = machineCheck sModel + + selectTape tapeId = + case Dict.get tapeId tapes of + Just ( t, st ) -> + ( t, st ) + + Nothing -> + ( Array.empty, Fresh ) in group [ case model of @@ -846,12 +967,7 @@ view env ( model, pModel, sModel ) = Editing tapeId -> let ( tape, tapeSt ) = - case Dict.get tapeId pModel.tapes of - Just ( t, st ) -> - ( t, st ) - - Nothing -> - ( Array.empty, Fresh ) + selectTape tapeId in group [ rect winX (winY / 3) @@ -875,6 +991,23 @@ view env ( model, pModel, sModel ) = Running _ _ -> Debug.todo "Running state" + RunningNPDA cfgs tId -> + group + [ rect winX (winY / 3) + |> filled lightGray + , text "Simulate NPDA" + |> size 16 + |> fixedwidth + |> filled black + |> move ( -winX / 2 + 2, winY / 6 - 15 ) + , text "(Press Right Arrow to step, Enter to exit simulation)" + |> size 6 + |> fixedwidth + |> filled black + |> move ( -winX / 2 + 120, winY / 6 - 15 ) + , renderConfigs oldMachine model (first (selectTape tId)) tId winX cfgs + ] + |> move ( 0, -winY / 3 ) , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) , machineModeButtons sModel.machineType winX winY ChangeMachine ] @@ -1090,13 +1223,13 @@ deltaHat tNames d ch states = -- NPDA functions -nextConfigRel : TransitionNames -> Delta -> Character -> List Configuration -> List Configuration -nextConfigRel tNames d ch stacks = - List.concatMap (nextConfig tNames d ch) stacks +nextConfigRel : TransitionNames -> Delta -> InputTape -> AcceptCond -> Set StateID -> List Configuration -> List Configuration +nextConfigRel tNames d tape acceptCond finals cfgs = + List.concatMap (nextConfig tNames d tape acceptCond finals) cfgs -nextConfig : TransitionNames -> Delta -> Character -> Configuration -> List Configuration -nextConfig tNames d ch ({ stack, state, status, tapePos } as config) = +nextConfig : TransitionNames -> Delta -> InputTape -> AcceptCond -> Set StateID -> Configuration -> List Configuration +nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as config) = let getName trans = case Dict.get trans tNames of @@ -1123,6 +1256,8 @@ nextConfig tNames d ch ({ stack, state, status, tapePos } as config) = nextTape cond = if cond then 0 else 1 + + ch = Maybe.withDefault "" (Array.get (tapePos + 1) tape) in case status of Alive -> @@ -1134,8 +1269,13 @@ nextConfig tNames d ch ({ stack, state, status, tapePos } as config) = |> List.filterMap (\( tId, sId ) -> let - tLabel = - getName tId + tLabel = getName tId + newStack = updateStack tLabel stack + newTapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") + newStatus = + case acceptCond of + EmptyStack -> if newStack == [] then Success else Alive + FinalState -> if Set.member sId finals && newTapePos == Array.length tape then Success else Alive in if (renderSet2String tLabel.inputLabel == ch || renderSet2String tLabel.inputLabel == "\\epsilon") @@ -1158,10 +1298,10 @@ nextConfig tNames d ch ({ stack, state, status, tapePos } as config) = then [ { config | status = Deadend } ] else newConfigs - Deadend -> - [ { config | status = RemoveMe } ] + Success -> + [] - RemoveMe -> + Deadend -> [] updateStack : TransitionLabel -> Stack -> Stack From 15d50addb9498a130f31341f36ea9fd32629d278 Mon Sep 17 00:00:00 2001 From: Necried Date: Mon, 16 Aug 2021 00:43:32 -0400 Subject: [PATCH 10/20] Highlight states in NPDA simulation --- src/Simulating.elm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index f42115b..65db9f8 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -457,10 +457,12 @@ update env msg ( model, pModel, sModel ) = |> Maybe.withDefault Array.empty newCfgs = nextConfigRel oldMachine.transitionNames oldMachine.delta tape pModel.npdaAcceptCond sModel.machine.final cfgs + + newStates = configToStates newCfgs in - ( ( RunningNPDA newCfgs tId, pModel, sModel), False, Cmd.none ) + ( ( RunningNPDA newCfgs tId, { pModel | currentStates = newStates }, sModel), False, Cmd.none ) _ -> - ( ( model, pModel, sModel ), False, Cmd.none ) + ( ( model, pModel , sModel ), False, Cmd.none ) RunTape tId -> case machineType of @@ -1223,6 +1225,9 @@ deltaHat tNames d ch states = -- NPDA functions +configToStates : List Configuration -> Set StateID +configToStates = List.filter (\cfg -> cfg.status == Alive || cfg.status == Success) >> List.map .state >> Set.fromList + nextConfigRel : TransitionNames -> Delta -> InputTape -> AcceptCond -> Set StateID -> List Configuration -> List Configuration nextConfigRel tNames d tape acceptCond finals cfgs = List.concatMap (nextConfig tNames d tape acceptCond finals) cfgs From 187e1f8b49b2d83a3d5434d3890765b3633c2d7f Mon Sep 17 00:00:00 2001 From: Necried Date: Mon, 16 Aug 2021 12:10:43 -0400 Subject: [PATCH 11/20] Format Simulating.elm --- src/Simulating.elm | 166 ++++++++++++++++++++++++++++++--------------- 1 file changed, 112 insertions(+), 54 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index 65db9f8..32767db 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -52,10 +52,12 @@ inputTapeDictDecoder = type alias InputTape = Array Character + type TapeStatus = Fresh | Stale (Set String) + type alias Configuration = { stack : Stack , state : StateID @@ -63,15 +65,18 @@ type alias Configuration = , tapePos : Int } + type ConfigStatus = Alive | Success | Deadend + type AcceptCond = EmptyStack | FinalState + type alias HoverError = Maybe Int @@ -124,6 +129,7 @@ onExit : Environment -> ( Model, PersistentModel, SharedModel ) -> ( ( Persisten onExit env ( model, pModel, sModel ) = ( ( pModel, sModel ), False ) + designatedStart : Set StateID -> StateID designatedStart setStart = case Set.toList setStart of @@ -133,6 +139,7 @@ designatedStart setStart = startState :: _ -> startState + initPModel : MachineType -> PersistentModel initPModel macType = { tapes = @@ -174,19 +181,25 @@ checkTape sModel inp = False -> Stale <| Set.fromList <| Array.toList arrFilter + + -- TODO: Add size-aware resizing and horizontal scroll + + renderConfigs : Machine -> Model -> Array String -> Int -> Float -> List Configuration -> Shape Msg -renderConfigs machine model input tapeId winX cfgs = +renderConfigs machine model input tapeId winX cfgs = let - xPos idx = (winX / 6) * (idx - 3) + (winX / 3) - + xPos idx = + (winX / 6) * (idx - 3) + (winX / 3) in - group <| List.indexedMap (\idx cfg -> renderConfig machine model input tapeId cfg |> move (xPos (toFloat idx), 0) ) cfgs - + group <| List.indexedMap (\idx cfg -> renderConfig machine model input tapeId cfg |> move ( xPos (toFloat idx), 0 )) cfgs + + renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> Shape Msg renderConfig machine model input tapeId cfg = let - xpad = 200 + xpad = + 200 stateName = case Dict.get cfg.state machine.stateNames of @@ -198,40 +211,53 @@ renderConfig machine model input tapeId cfg = statusColour = case cfg.status of - Success -> green - Deadend -> red - _ -> blank - - renderedState = group - [ circle 20 - |> filled statusColour - |> addOutline (solid 1) black - , latex 25 18 "none" stateName AlignCentre - |> move ( 0, 9 ) - ] + Success -> + green + + Deadend -> + red + + _ -> + blank + + renderedState = + group + [ circle 20 + |> filled statusColour + |> addOutline (solid 1) black + , latex 25 18 "none" stateName AlignCentre + |> move ( 0, 9 ) + ] + + stackLength = + toFloat (xpad * List.length cfg.stack) + + renderedStack = + renderStack cfg.stack + + renderedTape = + renderTape model input Fresh tapeId tapeId cfg.tapePos False - stackLength = toFloat (xpad*(List.length cfg.stack)) - renderedStack = renderStack cfg.stack - renderedTape = renderTape model input Fresh tapeId tapeId cfg.tapePos False - outerBox = rectangle (100 + stackLength) 150 |> outlined (solid 5) black - |> move (stackLength / 2, -10) + |> move ( stackLength / 2, -10 ) in group [ outerBox , renderedState - , renderedStack |> move (0, -50) - , renderedTape |> move (25, 0) - ] + , renderedStack |> move ( 0, -50 ) + , renderedTape |> move ( 25, 0 ) + ] + renderStack : Stack -> Shape Msg renderStack stk = let - xpad = 20 + xpad = + 20 in - group + group (List.indexedMap (\n st -> group @@ -252,7 +278,7 @@ renderStack stk = ) stk ) - + renderTape : Model -> Array String -> TapeStatus -> Int -> Int -> Int -> Bool -> Shape Msg renderTape model input tapeSt tapeId selectedId inputAt showButtons = @@ -410,7 +436,6 @@ update env msg ( model, pModel, sModel ) = machineType = sModel.machineType - in case msg of Step -> @@ -456,24 +481,27 @@ update env msg ( model, pModel, sModel ) = |> Maybe.map first |> Maybe.withDefault Array.empty - newCfgs = nextConfigRel oldMachine.transitionNames oldMachine.delta tape pModel.npdaAcceptCond sModel.machine.final cfgs + newCfgs = + nextConfigRel oldMachine.transitionNames oldMachine.delta tape pModel.npdaAcceptCond sModel.machine.final cfgs - newStates = configToStates newCfgs + newStates = + configToStates newCfgs in - ( ( RunningNPDA newCfgs tId, { pModel | currentStates = newStates }, sModel), False, Cmd.none ) + ( ( RunningNPDA newCfgs tId, { pModel | currentStates = newStates }, sModel ), False, Cmd.none ) + _ -> - ( ( model, pModel , sModel ), False, Cmd.none ) + ( ( model, pModel, sModel ), False, Cmd.none ) RunTape tId -> case machineType of DFA -> - ( ( Running tId (-1), pModel, sModel), False, Cmd.none ) - + ( ( Running tId -1, pModel, sModel ), False, Cmd.none ) + NFA -> - ( ( Running tId (-1), pModel, sModel), False, Cmd.none ) + ( ( Running tId -1, pModel, sModel ), False, Cmd.none ) NPDA -> - ( (RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel), False, Cmd.none) + ( ( RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) EditTape tId -> ( ( Editing tId, pModel, sModel ), False, Cmd.none ) @@ -993,6 +1021,7 @@ view env ( model, pModel, sModel ) = Running _ _ -> Debug.todo "Running state" + RunningNPDA cfgs tId -> group [ rect winX (winY / 3) @@ -1224,9 +1253,12 @@ deltaHat tNames d ch states = -- NPDA functions - + + configToStates : List Configuration -> Set StateID -configToStates = List.filter (\cfg -> cfg.status == Alive || cfg.status == Success) >> List.map .state >> Set.fromList +configToStates = + List.filter (\cfg -> cfg.status == Alive || cfg.status == Success) >> List.map .state >> Set.fromList + nextConfigRel : TransitionNames -> Delta -> InputTape -> AcceptCond -> Set StateID -> List Configuration -> List Configuration nextConfigRel tNames d tape acceptCond finals cfgs = @@ -1260,13 +1292,18 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as inpStk nextTape cond = - if cond then 0 else 1 + if cond then + 0 - ch = Maybe.withDefault "" (Array.get (tapePos + 1) tape) + else + 1 + + ch = + Maybe.withDefault "" (Array.get (tapePos + 1) tape) in case status of Alive -> - let + let newConfigs = case Dict.get state d of Just transMap -> @@ -1274,34 +1311,54 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as |> List.filterMap (\( tId, sId ) -> let - tLabel = getName tId - newStack = updateStack tLabel stack - newTapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") - newStatus = + tLabel = + getName tId + + newStack = + updateStack tLabel stack + + newTapePos = + tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") + + newStatus = case acceptCond of - EmptyStack -> if newStack == [] then Success else Alive - FinalState -> if Set.member sId finals && newTapePos == Array.length tape then Success else Alive + EmptyStack -> + if newStack == [] then + Success + + else + Alive + + FinalState -> + if Set.member sId finals && newTapePos == Array.length tape then + Success + + else + Alive in if (renderSet2String tLabel.inputLabel == ch || renderSet2String tLabel.inputLabel == "\\epsilon") && matchStackTop tLabel.stackTop then - Just + Just { stack = updateStack tLabel stack , state = sId , status = Alive - , tapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") + , tapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") } + else - Nothing + Nothing ) Nothing -> [] in - if newConfigs == [] - then [ { config | status = Deadend } ] - else newConfigs + if newConfigs == [] then + [ { config | status = Deadend } ] + + else + newConfigs Success -> [] @@ -1309,6 +1366,7 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as Deadend -> [] + updateStack : TransitionLabel -> Stack -> Stack updateStack { stackTop, stackPush } stk = case stk of From 42c086e75bc29817fe9df8db9e652643a15baddb Mon Sep 17 00:00:00 2001 From: Necried Date: Tue, 17 Aug 2021 23:45:06 -0400 Subject: [PATCH 12/20] Make minimal balanced parenthesis example work --- src/Building.elm | 2 +- src/Error.elm | 12 +++++++---- src/Machine.elm | 52 +++++++++++++++++++++++++++++++++++++++++++++ src/SharedModel.elm | 2 +- src/Simulating.elm | 35 +++++++++++++++++++----------- 5 files changed, 85 insertions(+), 18 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index f2ffeae..0f9f381 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -80,7 +80,7 @@ update env msg ( model, pModel, sModel ) = in case msg of MachineMsg mmsg -> - case Debug.log "Build msg" mmsg of + case mmsg of StartDragging st ( x, y ) -> let ( sx, sy ) = diff --git a/src/Error.elm b/src/Error.elm index be69d29..33fefa5 100644 --- a/src/Error.elm +++ b/src/Error.elm @@ -51,11 +51,15 @@ contextHasError err mtype = False NPDA -> - if err == NoError then - False + case err of + EpsTransError -> + True - else - True + DuplicateStates _ -> + True + + _ -> + False machineCheck : SharedModel -> Error diff --git a/src/Machine.elm b/src/Machine.elm index 7344f1f..26c865a 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -294,6 +294,58 @@ test = in Machine q delta0 start final statePositions stateTransitions stateNames transitionNames +{- +machine: { delta = Dict.fromList [(1,Dict.fromList [(0,1),(1,1),(2,1),(3,1)])], + final = Set.fromList [], + q = Set.fromList [1], + start = Set.fromList [], + stateNames = Dict.fromList [(1,"q_{1}")], + statePositions = Dict.fromList [(1,(18,-53))], + stateTransitions = Dict.fromList [((1,0,1),(-86,0)),((1,1,1),(-2,-61)),((1,2,1),(79,4)),((1,3,1),(0,50))], + transitionNames = Dict.fromList [(0,{ inputLabel = Set.fromList ["]"], stackPush = "", stackTop = "[" }),(1,{ inputLabel = Set.fromList [], stackPush = "", stackTop = "Z" }),(2,{ inputLabel = Set.fromList ["["], stackPush = "[[", stackTop = "[" }),(3,{ inputLabel = Set.fromList ["["], stackPush = "Z[", stackTop = "Z" })] } +-} + +testNPDA : Machine +testNPDA = + let + q = + Set.fromList [ 0 ] + + delta0 = + Dict.fromList + [ ( 0, Dict.fromList [ ( 0, 0 ), ( 1, 0 ), ( 2, 0 ), ( 3, 0 ) ] ) ] + + start = + Set.fromList [ 0 ] + + final = + Set.fromList [ ] + + statePositions = + Dict.fromList [ ( 0, ( 0, 0 ) ) ] + + stateNames = + Dict.fromList [ ( 0, "q_0" ) ] + + transitionNames = + Dict.fromList <| + [ ( 0, { inputLabel = Set.singleton "[", stackTop = "Z", stackPush = "[Z" } ) + , ( 1, { inputLabel = Set.singleton "[", stackTop = "[", stackPush = "[[" } ) + , ( 2, { inputLabel = Set.singleton "]", stackTop = "[", stackPush = "" } ) + , ( 3, { inputLabel = Set.singleton "\\epsilon", stackTop = "Z", stackPush = "" } ) + ] + + stateTransitions = + Dict.fromList + [ ( ( 0, 0, 0 ), ( 0, 70 ) ) + , ( ( 0, 1, 0 ), ( 0, -70 ) ) + , ( ( 0, 2, 0 ), ( 70, 0 ) ) + , ( ( 0, 3, 0 ), ( -70, 0 ) ) + ] + in + Machine q delta0 start final statePositions stateTransitions stateNames transitionNames + + view : Environment -> Model -> MachineType -> Machine -> Set StateID -> TransitionMistakes -> Shape Msg view env model macType machine currentStates tMistakes = diff --git a/src/SharedModel.elm b/src/SharedModel.elm index 53e949a..45d863e 100644 --- a/src/SharedModel.elm +++ b/src/SharedModel.elm @@ -13,7 +13,7 @@ type alias SharedModel = init : SharedModel init = - { machine = Machine.test + { machine = Machine.testNPDA , machineType = DFA } diff --git a/src/Simulating.elm b/src/Simulating.elm index 32767db..f9fa206 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -148,7 +148,7 @@ initPModel macType = , ( 1, ( Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0", "1", "1", "1", "1", "0" ], Fresh ) ) ] , currentStates = test.start - , npdaAcceptCond = FinalState + , npdaAcceptCond = EmptyStack } @@ -199,7 +199,10 @@ renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> Shape renderConfig machine model input tapeId cfg = let xpad = - 200 + 50 + + tapeLength = + Array.length input stateName = case Dict.get cfg.state machine.stateNames of @@ -230,7 +233,7 @@ renderConfig machine model input tapeId cfg = ] stackLength = - toFloat (xpad * List.length cfg.stack) + clamp 100 300 <| toFloat (xpad * tapeLength)/2 renderedStack = renderStack cfg.stack @@ -553,6 +556,14 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) + else if normalizedKey == "escape" then + case model of + RunningNPDA _ tId -> + ( ( Default tId -1 Nothing, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), True, Cmd.none ) + + _ -> + ( ( model, pModel, sModel ), False, Cmd.none ) + else if normalizedKey == "backspace" || normalizedKey == "arrowleft" then case model of Editing tapeId -> @@ -1031,7 +1042,7 @@ view env ( model, pModel, sModel ) = |> fixedwidth |> filled black |> move ( -winX / 2 + 2, winY / 6 - 15 ) - , text "(Press Right Arrow to step, Enter to exit simulation)" + , text "(Press Right Arrow to step, Esc to exit simulation)" |> size 6 |> fixedwidth |> filled black @@ -1322,12 +1333,8 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as newStatus = case acceptCond of - EmptyStack -> - if newStack == [] then - Success - - else - Alive + EmptyStack -> -- This is handled below, only when the config has an empty stack and no transitions to take + Alive FinalState -> if Set.member sId finals && newTapePos == Array.length tape then @@ -1343,7 +1350,7 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as Just { stack = updateStack tLabel stack , state = sId - , status = Alive + , status = newStatus , tapePos = tapePos + nextTape (renderSet2String tLabel.inputLabel == "\\epsilon") } @@ -1355,7 +1362,11 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as [] in if newConfigs == [] then - [ { config | status = Deadend } ] + if acceptCond == EmptyStack && stack == [] && tapePos == (Array.length tape - 1) + then + [ { config | status = Success } ] + else + [ { config | status = Deadend } ] else newConfigs From db4fe87976379899e25b2372081c52df76c5a26d Mon Sep 17 00:00:00 2001 From: Necried Date: Wed, 18 Aug 2021 18:32:52 -0400 Subject: [PATCH 13/20] Allow change of accept cond and improve rendering and tape error --- src/Machine.elm | 24 ++++----- src/Simulating.elm | 118 ++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 120 insertions(+), 22 deletions(-) diff --git a/src/Machine.elm b/src/Machine.elm index 26c865a..f08fcdd 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -294,17 +294,20 @@ test = in Machine q delta0 start final statePositions stateTransitions stateNames transitionNames + + {- -machine: { delta = Dict.fromList [(1,Dict.fromList [(0,1),(1,1),(2,1),(3,1)])], - final = Set.fromList [], - q = Set.fromList [1], - start = Set.fromList [], - stateNames = Dict.fromList [(1,"q_{1}")], - statePositions = Dict.fromList [(1,(18,-53))], - stateTransitions = Dict.fromList [((1,0,1),(-86,0)),((1,1,1),(-2,-61)),((1,2,1),(79,4)),((1,3,1),(0,50))], - transitionNames = Dict.fromList [(0,{ inputLabel = Set.fromList ["]"], stackPush = "", stackTop = "[" }),(1,{ inputLabel = Set.fromList [], stackPush = "", stackTop = "Z" }),(2,{ inputLabel = Set.fromList ["["], stackPush = "[[", stackTop = "[" }),(3,{ inputLabel = Set.fromList ["["], stackPush = "Z[", stackTop = "Z" })] } + machine: { delta = Dict.fromList [(1,Dict.fromList [(0,1),(1,1),(2,1),(3,1)])], + final = Set.fromList [], + q = Set.fromList [1], + start = Set.fromList [], + stateNames = Dict.fromList [(1,"q_{1}")], + statePositions = Dict.fromList [(1,(18,-53))], + stateTransitions = Dict.fromList [((1,0,1),(-86,0)),((1,1,1),(-2,-61)),((1,2,1),(79,4)),((1,3,1),(0,50))], + transitionNames = Dict.fromList [(0,{ inputLabel = Set.fromList ["]"], stackPush = "", stackTop = "[" }),(1,{ inputLabel = Set.fromList [], stackPush = "", stackTop = "Z" }),(2,{ inputLabel = Set.fromList ["["], stackPush = "[[", stackTop = "[" }),(3,{ inputLabel = Set.fromList ["["], stackPush = "Z[", stackTop = "Z" })] } -} + testNPDA : Machine testNPDA = let @@ -319,10 +322,10 @@ testNPDA = Set.fromList [ 0 ] final = - Set.fromList [ ] + Set.fromList [] statePositions = - Dict.fromList [ ( 0, ( 0, 0 ) ) ] + Dict.fromList [ ( 0, ( 0, 0 ) ) ] stateNames = Dict.fromList [ ( 0, "q_0" ) ] @@ -346,7 +349,6 @@ testNPDA = Machine q delta0 start final statePositions stateTransitions stateNames transitionNames - view : Environment -> Model -> MachineType -> Machine -> Set StateID -> TransitionMistakes -> Shape Msg view env model macType machine currentStates tMistakes = let diff --git a/src/Simulating.elm b/src/Simulating.elm index f9fa206..e38832c 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -102,6 +102,7 @@ type Msg | ToggleStart StateID | KeyPressed String | ChangeMachine MachineType + | ChangeNPDAAcceptCond AcceptCond | MachineMsg Machine.Msg | HoverErrorEnter Int | HoverErrorExit @@ -190,7 +191,9 @@ renderConfigs : Machine -> Model -> Array String -> Int -> Float -> List Configu renderConfigs machine model input tapeId winX cfgs = let xPos idx = - (winX / 6) * (idx - 3) + (winX / 3) + (winX / 7) * (idx - 3) + + -- + (winX / 3) in group <| List.indexedMap (\idx cfg -> renderConfig machine model input tapeId cfg |> move ( xPos (toFloat idx), 0 )) cfgs @@ -201,7 +204,7 @@ renderConfig machine model input tapeId cfg = xpad = 50 - tapeLength = + tapeLength = Array.length input stateName = @@ -233,7 +236,7 @@ renderConfig machine model input tapeId cfg = ] stackLength = - clamp 100 300 <| toFloat (xpad * tapeLength)/2 + clamp 100 300 <| toFloat (xpad * tapeLength) / 2 renderedStack = renderStack cfg.stack @@ -504,7 +507,16 @@ update env msg ( model, pModel, sModel ) = ( ( Running tId -1, pModel, sModel ), False, Cmd.none ) NPDA -> - ( ( RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) + case Dict.get tId pModel.tapes of + Just ( ar, tapeStatus ) -> + if tapeStatus == Fresh then + ( ( RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) + + else + ( ( model, pModel, sModel ), False, Cmd.none ) + + Nothing -> + ( ( model, pModel, sModel ), False, Cmd.none ) EditTape tId -> ( ( Editing tId, pModel, sModel ), False, Cmd.none ) @@ -850,6 +862,9 @@ update env msg ( model, pModel, sModel ) = NPDA -> ( ( model, pModel, { sModel | machineType = NPDA } ), False, Cmd.none ) + ChangeNPDAAcceptCond newCond -> + ( ( model, { pModel | npdaAcceptCond = newCond }, sModel ), True, Cmd.none ) + MachineMsg mmsg -> case mmsg of StartDragging sId _ -> @@ -1051,10 +1066,36 @@ view env ( model, pModel, sModel ) = ] |> move ( 0, -winY / 3 ) , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) - , machineModeButtons sModel.machineType winX winY ChangeMachine + , buttonRender ( model, pModel, sModel ) winX winY ] +buttonRender : ( Model, PersistentModel, SharedModel ) -> Float -> Float -> Shape Msg +buttonRender ( model, pModel, sModel ) winX winY = + let + condMachineModeButtons = + case model of + RunningNPDA _ _ -> + group [] + + _ -> + machineModeButtons sModel.machineType winX winY ChangeMachine + + condNPDAAcceptButtons = + case model of + RunningNPDA _ _ -> + group [] + + _ -> + if sModel.machineType == NPDA then + npdaAcceptCondButtons pModel winX winY + + else + group [] + in + group [ condMachineModeButtons, condNPDAAcceptButtons ] + + machineDefn : SharedModel -> MachineType -> Float -> Float -> Shape Msg machineDefn sModel mtype winX winY = let @@ -1333,7 +1374,8 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as newStatus = case acceptCond of - EmptyStack -> -- This is handled below, only when the config has an empty stack and no transitions to take + EmptyStack -> + -- This is handled below, only when the config has an empty stack and no transitions to take Alive FinalState -> @@ -1362,11 +1404,11 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as [] in if newConfigs == [] then - if acceptCond == EmptyStack && stack == [] && tapePos == (Array.length tape - 1) - then - [ { config | status = Success } ] - else - [ { config | status = Deadend } ] + if acceptCond == EmptyStack && stack == [] && tapePos == (Array.length tape - 1) then + [ { config | status = Success } ] + + else + [ { config | status = Deadend } ] else newConfigs @@ -1456,3 +1498,57 @@ latexKeyboard w h chars = , oneRow homeRow (fillOutExtras 9 0 chars) |> move ( -keyW / 3, -keyH - 2 ) , oneRow botRow (fillOutExtras 7 19 chars) |> move ( -keyW, -(keyH + 2) * 2 ) ] + + +npdaAcceptCondButtons : PersistentModel -> Float -> Float -> Shape Msg +npdaAcceptCondButtons pModel winX winY = + group + [ group + [ roundedRect 100 15 1 + |> filled + (if pModel.npdaAcceptCond == EmptyStack then + finsmLightBlue + + else + blank + ) + |> addOutline (solid 1) darkGray + , text "Empty Stack" + |> centered + |> fixedwidth + |> filled + (if pModel.npdaAcceptCond == EmptyStack then + white + + else + darkGray + ) + |> move ( 0, -4 ) + ] + |> move ( -winX / 2 + 55, winY / 2 - 52 ) + |> notifyTap (ChangeNPDAAcceptCond EmptyStack) + , group + [ roundedRect 100 15 1 + |> filled + (if pModel.npdaAcceptCond == FinalState then + finsmLightBlue + + else + blank + ) + |> addOutline (solid 1) darkGray + , text "Final State" + |> centered + |> fixedwidth + |> filled + (if pModel.npdaAcceptCond == FinalState then + white + + else + darkGray + ) + |> move ( 0, -4 ) + ] + |> move ( -winX / 2 + 157, winY / 2 - 52 ) + |> notifyTap (ChangeNPDAAcceptCond FinalState) + ] From 789b08bab1320c3e916ff1f07b39d0d012700360 Mon Sep 17 00:00:00 2001 From: Necried Date: Thu, 19 Aug 2021 21:49:40 -0400 Subject: [PATCH 14/20] Allow latex characters in stack operations --- src/Building.elm | 44 ++++++++++++++++++++++++++++++++------------ src/Machine.elm | 26 +++++++++++++------------- src/Simulating.elm | 31 ++++++++++++------------------- 3 files changed, 57 insertions(+), 44 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index 0f9f381..0773d00 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -145,8 +145,8 @@ update env msg ( model, pModel, sModel ) = newTrans = { inputLabel = newInputLabel - , stackTop = "" - , stackPush = "" + , stackTop = "\\epsilon" + , stackPush = [ "\\epsilon" ] } newTransID = @@ -211,10 +211,10 @@ update env msg ( model, pModel, sModel ) = newInpLabel = case Dict.get tId sModel.machine.transitionNames of Just n -> - ( renderSet2String n.inputLabel, n.stackTop, n.stackPush ) + ( renderSet2String n.inputLabel, n.stackTop, showStackPush n.stackPush ) Nothing -> - ( "", "", "" ) + ( "", "\\epsilon", "\\epsilon" ) newLab = newInpLabel @@ -514,10 +514,10 @@ update env msg ( model, pModel, sModel ) = oldTransitionName = case Dict.get tId oldMachine.transitionNames of Just n -> - ( renderSet2String n.inputLabel, n.stackTop, n.stackPush ) + ( renderSet2String n.inputLabel, n.stackTop, showStackPush n.stackPush ) _ -> - ( "", "", "" ) + ( "", "\\epsilon", "\\epsilon" ) in case sModel.machineType of DFA -> @@ -537,8 +537,8 @@ update env msg ( model, pModel, sModel ) = NPDA -> if (fst newLbl == fst oldTransitionName || fst newLbl == "") - && (snd newLbl == snd oldTransitionName || snd newLbl == "") - && (thd newLbl == thd oldTransitionName || thd newLbl == "") + && (snd newLbl == snd oldTransitionName || snd newLbl == "\\epsilon") + && (thd newLbl == thd oldTransitionName || thd newLbl == "\\epsilon") then ( ( { model | machineState = SelectedArrow ( s0, tId, s1 ) }, pModel, sModel ), False, Cmd.none ) @@ -562,10 +562,10 @@ update env msg ( model, pModel, sModel ) = oldTransName = case Dict.get tId sModel.machine.transitionNames of Just label -> - ( renderSet2String label.inputLabel, label.stackTop, label.stackPush ) + ( renderSet2String label.inputLabel, label.stackTop, String.concat label.stackPush ) Nothing -> - ( "", "", "" ) + ( "", "\\epsilon", "\\epsilon" ) in ( ( { model | machineState = EditingTransitionLabel ( s0, tId, s1 ) oldTransName }, pModel, sModel ), False, focusInput NoOp ) @@ -722,8 +722,18 @@ update env msg ( model, pModel, sModel ) = newLabel = { inputLabel = newTransitions - , stackTop = stkTop - , stackPush = stkPush + , stackTop = + if stkTop == "" then + "\\epsilon" + + else + stkTop + , stackPush = + if stkPush == "" then + [ "\\epsilon" ] + + else + parseStackPush stkPush } newMachine = @@ -913,3 +923,13 @@ snapIcon = ] |> move ( 5, -10 ) ] + + +parseStackPush : String -> List String +parseStackPush = + String.split " " + + +showStackPush : List String -> String +showStackPush = + String.join " " diff --git a/src/Machine.elm b/src/Machine.elm index f08fcdd..a7cd231 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -36,7 +36,7 @@ type alias TransitionNames = type alias TransitionLabel = { inputLabel : Set String , stackTop : String - , stackPush : String + , stackPush : List String } @@ -158,7 +158,7 @@ machineEncoderV1 machine = E.object [ ( "inputLabel", encodeSet E.string tLabel.inputLabel ) , ( "stackTop", E.string tLabel.stackTop ) - , ( "stackPush", E.string tLabel.stackPush ) + , ( "stackPush", E.list E.string tLabel.stackPush ) ] transNamesEncoder : TransitionNames -> E.Value @@ -228,7 +228,7 @@ machineDecoderV1 = transNamesDecoder : D.Decoder TransitionNames transNamesDecoder = - D.field "transNames" <| decodeDict D.int (D.map3 TransitionLabel (decodeSet D.string) D.string D.string) + D.field "transNames" <| decodeDict D.int (D.map3 TransitionLabel (decodeSet D.string) D.string (D.list D.string)) in D.map8 Machine qDecoder @@ -269,7 +269,7 @@ test = transitionNames = Dict.fromList <| - List.map (\( k, str ) -> ( k, { inputLabel = Set.singleton str, stackTop = "", stackPush = "" } )) + List.map (\( k, str ) -> ( k, { inputLabel = Set.singleton str, stackTop = "\\epsilon", stackPush = [ "\\epsilon" ] } )) [ ( 0, "1" ) , ( 1, "0" ) , ( 2, "1" ) @@ -332,10 +332,10 @@ testNPDA = transitionNames = Dict.fromList <| - [ ( 0, { inputLabel = Set.singleton "[", stackTop = "Z", stackPush = "[Z" } ) - , ( 1, { inputLabel = Set.singleton "[", stackTop = "[", stackPush = "[[" } ) - , ( 2, { inputLabel = Set.singleton "]", stackTop = "[", stackPush = "" } ) - , ( 3, { inputLabel = Set.singleton "\\epsilon", stackTop = "Z", stackPush = "" } ) + [ ( 0, { inputLabel = Set.singleton "[", stackTop = "\\bot", stackPush = [ "[", "\\bot" ] } ) + , ( 1, { inputLabel = Set.singleton "[", stackTop = "[", stackPush = [ "[", "[" ] } ) + , ( 2, { inputLabel = Set.singleton "]", stackTop = "[", stackPush = [ "\\epsilon" ] } ) + , ( 3, { inputLabel = Set.singleton "\\epsilon", stackTop = "\\bot", stackPush = [ "\\epsilon" ] } ) ] stateTransitions = @@ -396,7 +396,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush Nothing -> " " @@ -450,7 +450,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush Nothing -> " " @@ -818,7 +818,7 @@ renderArrows macType machine model tMistakes = Set.toList tLabel.inputLabel |> renderString NPDA -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ tLabel.stackPush + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush Nothing -> "" @@ -1021,6 +1021,6 @@ renderStates currentStates machine model env = emptyLabel : TransitionLabel emptyLabel = { inputLabel = Set.empty - , stackTop = "" - , stackPush = "" + , stackTop = "\\epsilon" + , stackPush = [ "\\epsilon" ] } diff --git a/src/Simulating.elm b/src/Simulating.elm index e38832c..f904b04 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -82,7 +82,7 @@ type alias HoverError = type alias Stack = - List Char + List String type Model @@ -273,7 +273,7 @@ renderStack stk = (solid 1) black |> move ( 0, 3 ) - , latex (xpad * 0.9) (xpad * 0.7) "white" (String.fromChar st) AlignCentre + , latex (xpad * 0.9) (xpad * 0.7) "white" st AlignCentre |> move ( 0, 10.25 ) ] |> move @@ -510,7 +510,7 @@ update env msg ( model, pModel, sModel ) = case Dict.get tId pModel.tapes of Just ( ar, tapeStatus ) -> if tapeStatus == Fresh then - ( ( RunningNPDA [ { stack = [ 'Z' ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) + ( ( RunningNPDA [ { stack = [ "\\bot" ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) else ( ( model, pModel, sModel ), False, Cmd.none ) @@ -1182,7 +1182,7 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 510, winY / 6 - 65 ) , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) - , latex 500 18 "blank" ("\\Gamma = \\{ " ++ String.join "," (Set.toList <| List.foldl (\t s -> Set.insert t.stackTop (Set.insert t.stackPush s)) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + , latex 500 18 "blank" ("\\Gamma = \\{ " ++ String.join "," (Set.toList <| Set.fromList <| List.concatMap (\lab -> lab.stackTop :: lab.stackPush) <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) , latex 500 18 "blank" "\\delta = (above)" AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 135 ) @@ -1329,12 +1329,7 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as emptyLabel matchStackTop pat = - case String.uncons pat of - Nothing -> - False - - Just ( c, _ ) -> - Just c == List.head stack + Just pat == List.head stack || pat == "\\epsilon" replaceStackTop old new inpStk = if isPrefixOf old inpStk then @@ -1428,17 +1423,15 @@ updateStack { stackTop, stackPush } stk = _ -> let - stackTopList = - String.toList stackTop + pushed = + if stackPush == [ "\\epsilon" ] then + [] - stackPushList = - String.toList stackPush - - newStack = - stackPushList ++ List.drop (List.length stackTopList) stk + else + stackPush in - if isPrefixOf stackTopList stk then - newStack + if Just stackTop == head stk then + pushed ++ List.drop 1 stk else stk From 8c3434b3125c678b18902a7dd2dcfba80066988d Mon Sep 17 00:00:00 2001 From: Necried Date: Thu, 19 Aug 2021 21:57:53 -0400 Subject: [PATCH 15/20] Make NPDA textbox length the max of the 3 inputs --- src/Machine.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Machine.elm b/src/Machine.elm index a7cd231..ec9c975 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -670,7 +670,7 @@ renderArrow macType ( x0, y0 ) ( x1, y1 ) ( x2, y2 ) r0 r1 char charID sel mista 80 else - 8 * toFloat (String.length lab) + 5 + 8 * toFloat (List.foldl max 0 <| List.map String.length [ lab, stkTop, stkPush ]) + 5 ) 20 ( "inputLabel", "stackTop", "stackPush" ) From d8fd985f97325b32bdbb8da7231f1b69f61a0fe5 Mon Sep 17 00:00:00 2001 From: Necried Date: Thu, 19 Aug 2021 22:20:17 -0400 Subject: [PATCH 16/20] Fix textbox rendering and reserved chars in NPDA Sigma --- src/Building.elm | 2 +- src/Machine.elm | 2 +- src/Simulating.elm | 13 +++++++++++-- src/Utils.elm | 2 +- 4 files changed, 14 insertions(+), 5 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index 0773d00..a5f1229 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -733,7 +733,7 @@ update env msg ( model, pModel, sModel ) = [ "\\epsilon" ] else - parseStackPush stkPush + (parseStackPush stkPush) } newMachine = diff --git a/src/Machine.elm b/src/Machine.elm index ec9c975..79f45c6 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -818,7 +818,7 @@ renderArrows macType machine model tMistakes = Set.toList tLabel.inputLabel |> renderString NPDA -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush + (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.join " " tLabel.stackPush Nothing -> "" diff --git a/src/Simulating.elm b/src/Simulating.elm index f904b04..5230a3f 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -2,7 +2,6 @@ module Simulating exposing (HoverError, InputTape, Model(..), Msg(..), Persisten import Array exposing (Array) import Browser.Events -import Debug import Dict exposing (Dict) import Environment exposing (Environment) import Error exposing (..) @@ -1182,7 +1181,17 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 510, winY / 6 - 65 ) , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) - , latex 500 18 "blank" ("\\Gamma = \\{ " ++ String.join "," (Set.toList <| Set.fromList <| List.concatMap (\lab -> lab.stackTop :: lab.stackPush) <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft + , latex 500 18 "blank" ("\\Gamma = \\{ " + ++ String.join "," + (Dict.values machine.transitionNames + |> List.concatMap (\lab -> lab.stackTop :: lab.stackPush) + |> Set.fromList + |> Set.remove "\\bot" + |> Set.remove "\\epsilon" + |> Set.remove " " + |> Set.toList) + ++ " \\}") + AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) , latex 500 18 "blank" "\\delta = (above)" AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 135 ) diff --git a/src/Utils.elm b/src/Utils.elm index 15f2653..00e67f6 100644 --- a/src/Utils.elm +++ b/src/Utils.elm @@ -64,7 +64,7 @@ textBox txt w h place msg = move ( -w / 2, h / 2 ) <| html (w * 1.5) (h * 1.5) <| input - [ id "input" + [ id <| "input" ++ place , placeholder place , onInput msg , value txt From 0ffbb4538c9706e3aa0c3479a0a38c6614aea0cf Mon Sep 17 00:00:00 2001 From: Necried Date: Fri, 20 Aug 2021 21:00:39 -0400 Subject: [PATCH 17/20] Nicer arrangement on config boxes --- src/Simulating.elm | 48 +++++++++++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index 5230a3f..bde10f6 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -183,21 +183,32 @@ checkTape sModel inp = --- TODO: Add size-aware resizing and horizontal scroll - - renderConfigs : Machine -> Model -> Array String -> Int -> Float -> List Configuration -> Shape Msg renderConfigs machine model input tapeId winX cfgs = + paginateConfigs winX <| List.map (renderConfig machine model input tapeId) cfgs + +paginateConfigs : Float -> List (Shape Msg, Float) -> Shape Msg +paginateConfigs winX cfgWithLengths = let - xPos idx = - (winX / 7) * (idx - 3) + ( cfgs, lengths ) = List.unzip cfgWithLengths - -- + (winX / 3) - in - group <| List.indexedMap (\idx cfg -> renderConfig machine model input tapeId cfg |> move ( xPos (toFloat idx), 0 )) cfgs + spacing = 10 + totalSpacing = toFloat <| spacing * List.length lengths -renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> Shape Msg + totalCfgLength = List.sum lengths + totalSpacing + + initLeftPos = winX/2 - 50 + + (shiftAmountByIdx, _) = + List.foldl (\a acc -> (second acc :: first acc, a + second acc + spacing) ) ([], 0) lengths + + in + if totalCfgLength <= winX + then group <| List.map2 (\cfg moveAmt -> cfg |> move (-initLeftPos + moveAmt, 0)) cfgs shiftAmountByIdx + else Debug.todo "paginate" + +renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> (Shape Msg, Float) renderConfig machine model input tapeId cfg = let xpad = @@ -206,6 +217,9 @@ renderConfig machine model input tapeId cfg = tapeLength = Array.length input + stackLength = + List.length cfg.stack + stateName = case Dict.get cfg.state machine.stateNames of Just n -> @@ -234,8 +248,8 @@ renderConfig machine model input tapeId cfg = |> move ( 0, 9 ) ] - stackLength = - clamp 100 300 <| toFloat (xpad * tapeLength) / 2 + configLength = + max 100 <| toFloat (max (xpad * tapeLength) (xpad * stackLength)) / 2 renderedStack = renderStack cfg.stack @@ -243,18 +257,22 @@ renderConfig machine model input tapeId cfg = renderedTape = renderTape model input Fresh tapeId tapeId cfg.tapePos False + cfgLength = + 50 + configLength + outerBox = - rectangle (100 + stackLength) 150 + rectangle (50 + configLength) 150 |> outlined (solid 5) black - |> move ( stackLength / 2, -10 ) + |> move ( configLength / 2, -25 ) in - group + ( group [ outerBox , renderedState , renderedStack |> move ( 0, -50 ) , renderedTape |> move ( 25, 0 ) ] - + , cfgLength + ) renderStack : Stack -> Shape Msg renderStack stk = From 763e23a0f01cafa6c9c96971be88ed983452c1db Mon Sep 17 00:00:00 2001 From: Necried Date: Fri, 20 Aug 2021 23:17:00 -0400 Subject: [PATCH 18/20] NPDA pagination complete --- src/Building.elm | 2 +- src/Machine.elm | 2 +- src/Simulating.elm | 155 ++++++++++++++++++++++++++++++++++----------- 3 files changed, 121 insertions(+), 38 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index a5f1229..0773d00 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -733,7 +733,7 @@ update env msg ( model, pModel, sModel ) = [ "\\epsilon" ] else - (parseStackPush stkPush) + parseStackPush stkPush } newMachine = diff --git a/src/Machine.elm b/src/Machine.elm index 79f45c6..a26f44e 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -334,7 +334,7 @@ testNPDA = Dict.fromList <| [ ( 0, { inputLabel = Set.singleton "[", stackTop = "\\bot", stackPush = [ "[", "\\bot" ] } ) , ( 1, { inputLabel = Set.singleton "[", stackTop = "[", stackPush = [ "[", "[" ] } ) - , ( 2, { inputLabel = Set.singleton "]", stackTop = "[", stackPush = [ "\\epsilon" ] } ) + , ( 2, { inputLabel = Set.singleton "\\epsilon", stackTop = "\\epsilon", stackPush = [ "[" ] } ) -- { inputLabel = Set.singleton "]", stackTop = "[", stackPush = [ "\\epsilon" ] } ) , ( 3, { inputLabel = Set.singleton "\\epsilon", stackTop = "\\bot", stackPush = [ "\\epsilon" ] } ) ] diff --git a/src/Simulating.elm b/src/Simulating.elm index bde10f6..b66e5cc 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -87,7 +87,7 @@ type alias Stack = type Model = Default Int {- tapeID -} Int {- charID -} HoverError | Running Int {- tapeID -} Int {- charID -} - | RunningNPDA (List Configuration) Int {- tapeID -} + | RunningNPDA (List Configuration) Int {- tapeID -} Int {- paginate start point -} | Editing Int @@ -105,6 +105,8 @@ type Msg | MachineMsg Machine.Msg | HoverErrorEnter Int | HoverErrorExit + | IncrementPaginateCounter + | DecrementPaginateCounter onEnter : Environment -> ( PersistentModel, SharedModel ) -> ( ( Model, PersistentModel, SharedModel ), Bool, Cmd Msg ) @@ -182,33 +184,92 @@ checkTape sModel inp = Stale <| Set.fromList <| Array.toList arrFilter +renderConfigs : Machine -> Model -> Array String -> Int -> Int -> Float -> List Configuration -> Shape Msg +renderConfigs machine model input paginateStart tapeId winX cfgs = + paginateConfigs paginateStart winX <| List.map (renderConfig machine model input tapeId) cfgs -renderConfigs : Machine -> Model -> Array String -> Int -> Float -> List Configuration -> Shape Msg -renderConfigs machine model input tapeId winX cfgs = - paginateConfigs winX <| List.map (renderConfig machine model input tapeId) cfgs -paginateConfigs : Float -> List (Shape Msg, Float) -> Shape Msg -paginateConfigs winX cfgWithLengths = +paginateConfigs : Int -> Float -> List ( Shape Msg, Float ) -> Shape Msg +paginateConfigs paginateStart winX cfgWithLengths = let - ( cfgs, lengths ) = List.unzip cfgWithLengths + ( cfgs, lengths ) = + List.unzip cfgWithLengths - spacing = 10 + totalConfigs = + List.length cfgs - totalSpacing = toFloat <| spacing * List.length lengths + ( cfgArr, lengthArr ) = + ( Array.fromList cfgs, Array.fromList lengths ) - totalCfgLength = List.sum lengths + totalSpacing + spacing = + 10 - initLeftPos = winX/2 - 50 + totalSpacing = + toFloat <| spacing * totalConfigs - (shiftAmountByIdx, _) = - List.foldl (\a acc -> (second acc :: first acc, a + second acc + spacing) ) ([], 0) lengths + totalCfgLength = + List.sum lengths + totalSpacing + initLeftPos = + winX / 2 - 50 + + shiftAmountByIdx lengthList = + first <| List.foldl (\a acc -> ( second acc :: first acc, a + second acc + spacing )) ( [], 0 ) (List.reverse lengthList) + + findEndPaginateIndex start curLength = + case Array.get start lengthArr of + Nothing -> + start + + Just cfgLen -> + if curLength + cfgLen + spacing > winX then + start + + else + findEndPaginateIndex (start + 1) (curLength + cfgLen + spacing) + + paginateEnd = + findEndPaginateIndex paginateStart 0 + + paginateLeftButton = + if paginateStart <= 0 then + group [ circle 20 |> filled darkGrey, triangle 10 |> filled black |> rotate (degrees 180) ] + + else + group [ circle 20 |> filled white, triangle 10 |> filled black |> rotate (degrees 180) ] |> notifyTap DecrementPaginateCounter + + paginateRightButton = + if paginateEnd == totalConfigs then + group [ circle 20 |> filled darkGrey, triangle 10 |> filled black ] |> move ( 50, 0 ) + + else + group [ circle 20 |> filled white, triangle 10 |> filled black ] |> move ( 50, 0 ) |> notifyTap IncrementPaginateCounter + + paginateButtons = + group [ paginateLeftButton, paginateRightButton ] |> move ( -initLeftPos, 100 ) + + paginateInfo = + text ("Showing (" ++ String.fromInt paginateStart ++ ", " ++ String.fromInt paginateEnd ++ ") from a total of " ++ String.fromInt (List.length cfgs) ++ " configurations") + |> size 12 + |> fixedwidth + |> filled black + |> move ( -initLeftPos - 20, 140 ) in - if totalCfgLength <= winX - then group <| List.map2 (\cfg moveAmt -> cfg |> move (-initLeftPos + moveAmt, 0)) cfgs shiftAmountByIdx - else Debug.todo "paginate" - -renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> (Shape Msg, Float) + if totalCfgLength <= winX then + group <| List.map2 (\cfg moveAmt -> cfg |> move ( -initLeftPos + moveAmt, 0 )) cfgs (shiftAmountByIdx lengths) + + else + group + [ group <| + List.map2 (\cfg moveAmt -> cfg |> move ( -initLeftPos + moveAmt, 0 )) + (Array.toList <| Array.slice paginateStart paginateEnd cfgArr) + (Debug.log "shiftAmountByIdx" <| shiftAmountByIdx <| Array.toList <| Array.slice paginateStart paginateEnd lengthArr) + , paginateButtons + , paginateInfo + ] + + +renderConfig : Machine -> Model -> Array String -> Int -> Configuration -> ( Shape Msg, Float ) renderConfig machine model input tapeId cfg = let xpad = @@ -274,6 +335,7 @@ renderConfig machine model input tapeId cfg = , cfgLength ) + renderStack : Stack -> Shape Msg renderStack stk = let @@ -324,7 +386,7 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = -- TODO: Figure out why this is necessary when renderTape is used in RunningNPDA mode displaceTapePointer = case model of - RunningNPDA _ _ -> + RunningNPDA _ _ _ -> xpad _ -> @@ -497,7 +559,7 @@ update env msg ( model, pModel, sModel ) = else ( ( model, pModel, sModel ), False, Cmd.none ) - RunningNPDA cfgs tId -> + RunningNPDA cfgs tId _ -> let tape = Dict.get tId pModel.tapes @@ -510,7 +572,7 @@ update env msg ( model, pModel, sModel ) = newStates = configToStates newCfgs in - ( ( RunningNPDA newCfgs tId, { pModel | currentStates = newStates }, sModel ), False, Cmd.none ) + ( ( RunningNPDA newCfgs tId 0, { pModel | currentStates = newStates }, sModel ), False, Cmd.none ) _ -> ( ( model, pModel, sModel ), False, Cmd.none ) @@ -527,7 +589,7 @@ update env msg ( model, pModel, sModel ) = case Dict.get tId pModel.tapes of Just ( ar, tapeStatus ) -> if tapeStatus == Fresh then - ( ( RunningNPDA [ { stack = [ "\\bot" ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId, pModel, sModel ), False, Cmd.none ) + ( ( RunningNPDA [ { stack = [ "\\bot" ], state = designatedStart test.start, status = Alive, tapePos = -1 } ] tId 0, pModel, sModel ), False, Cmd.none ) else ( ( model, pModel, sModel ), False, Cmd.none ) @@ -587,7 +649,7 @@ update env msg ( model, pModel, sModel ) = else if normalizedKey == "escape" then case model of - RunningNPDA _ tId -> + RunningNPDA _ tId _ -> ( ( Default tId -1 Nothing, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), True, Cmd.none ) _ -> @@ -629,7 +691,7 @@ update env msg ( model, pModel, sModel ) = Default _ _ _ -> ( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) ) - RunningNPDA _ _ -> + RunningNPDA _ _ _ -> ( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) ) _ -> @@ -941,6 +1003,22 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) + IncrementPaginateCounter -> + case model of + RunningNPDA cfgs tId pagCount -> + ( ( RunningNPDA cfgs tId (pagCount + 1), pModel, sModel ), False, Cmd.none ) + + _ -> + ( ( model, pModel, sModel ), False, Cmd.none ) + + DecrementPaginateCounter -> + case model of + RunningNPDA cfgs tId pagCount -> + ( ( RunningNPDA cfgs tId (pagCount - 1), pModel, sModel ), False, Cmd.none ) + + _ -> + ( ( model, pModel, sModel ), False, Cmd.none ) + isAccept : Set StateID -> Set StateID -> InputTape -> Int -> Bool isAccept states finals input inputAt = @@ -1065,7 +1143,7 @@ view env ( model, pModel, sModel ) = Running _ _ -> Debug.todo "Running state" - RunningNPDA cfgs tId -> + RunningNPDA cfgs tId pagStart -> group [ rect winX (winY / 3) |> filled lightGray @@ -1079,7 +1157,7 @@ view env ( model, pModel, sModel ) = |> fixedwidth |> filled black |> move ( -winX / 2 + 120, winY / 6 - 15 ) - , renderConfigs oldMachine model (first (selectTape tId)) tId winX cfgs + , renderConfigs oldMachine model (first (selectTape tId)) pagStart tId winX cfgs ] |> move ( 0, -winY / 3 ) , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machineType sModel.machine pModel.currentStates transMistakes) |> move ( 0, winY / 6 ) @@ -1092,7 +1170,7 @@ buttonRender ( model, pModel, sModel ) winX winY = let condMachineModeButtons = case model of - RunningNPDA _ _ -> + RunningNPDA _ _ _ -> group [] _ -> @@ -1100,7 +1178,7 @@ buttonRender ( model, pModel, sModel ) winX winY = condNPDAAcceptButtons = case model of - RunningNPDA _ _ -> + RunningNPDA _ _ _ -> group [] _ -> @@ -1199,17 +1277,22 @@ machineDefn sModel mtype winX winY = |> move ( -winX / 2 + 510, winY / 6 - 65 ) , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl (Set.union << .inputLabel) Set.empty <| Dict.values machine.transitionNames) ++ " \\}") AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 90 ) - , latex 500 18 "blank" ("\\Gamma = \\{ " - ++ String.join "," + , latex 500 + 18 + "blank" + ("\\Gamma = \\{ " + ++ String.join "," (Dict.values machine.transitionNames - |> List.concatMap (\lab -> lab.stackTop :: lab.stackPush) - |> Set.fromList - |> Set.remove "\\bot" + |> List.concatMap (\lab -> lab.stackTop :: lab.stackPush) + |> Set.fromList + |> Set.remove "\\bot" |> Set.remove "\\epsilon" |> Set.remove " " - |> Set.toList) - ++ " \\}") - AlignLeft + |> Set.toList + ) + ++ " \\}" + ) + AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 115 ) , latex 500 18 "blank" "\\delta = (above)" AlignLeft |> move ( -winX / 2 + 510, winY / 6 - 135 ) From 110315ac0e40a920869c796ec0c379b3dae23213 Mon Sep 17 00:00:00 2001 From: Necried Date: Fri, 20 Aug 2021 23:44:21 -0400 Subject: [PATCH 19/20] Add NPDA in header in SaveLoad, and export NPDA transitions properly --- src/Exporting.elm | 13 +++++++--- src/Machine.elm | 20 +++++++------- src/SaveLoad.elm | 2 +- src/SharedModel.elm | 2 +- src/Simulating.elm | 63 ++++++++++++++++++++++++++++++--------------- 5 files changed, 63 insertions(+), 37 deletions(-) diff --git a/src/Exporting.elm b/src/Exporting.elm index 8222ade..5c4b39a 100644 --- a/src/Exporting.elm +++ b/src/Exporting.elm @@ -164,7 +164,7 @@ view env ( model, pModel, sModel ) = group [] , case ( model, pModel.outputType ) of ( ShowingOutput, Tikz ) -> - output (winX / 2) (winY / 2) (generateTikz pModel.time sModel.machine) + output (winX / 2) (winY / 2) (generateTikz pModel.time sModel.machine sModel.machineType) _ -> group [] @@ -299,8 +299,8 @@ output w h txt = ] -generateTikz : Int -> Machine -> String -generateTikz time machine = +generateTikz : Int -> Machine -> MachineType -> String +generateTikz time machine macType = let scale = 40 @@ -364,7 +364,12 @@ generateTikz time machine = transitionName = case Dict.get tId machine.transitionNames of Just n -> - renderSet2String n.inputLabel + case macType of + NPDA -> + renderSet2String n.inputLabel ++ ";" ++ n.stackTop ++ ";" ++ String.join " " n.stackPush + + _ -> + renderSet2String n.inputLabel _ -> "" diff --git a/src/Machine.elm b/src/Machine.elm index a26f44e..614c51d 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -334,7 +334,7 @@ testNPDA = Dict.fromList <| [ ( 0, { inputLabel = Set.singleton "[", stackTop = "\\bot", stackPush = [ "[", "\\bot" ] } ) , ( 1, { inputLabel = Set.singleton "[", stackTop = "[", stackPush = [ "[", "[" ] } ) - , ( 2, { inputLabel = Set.singleton "\\epsilon", stackTop = "\\epsilon", stackPush = [ "[" ] } ) -- { inputLabel = Set.singleton "]", stackTop = "[", stackPush = [ "\\epsilon" ] } ) + , ( 2, { inputLabel = Set.singleton "]", stackTop = "[", stackPush = [ "\\epsilon" ] } ) , ( 3, { inputLabel = Set.singleton "\\epsilon", stackTop = "\\bot", stackPush = [ "\\epsilon" ] } ) ] @@ -380,7 +380,7 @@ view env model macType machine currentStates tMistakes = DFA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel Nothing -> " " @@ -388,7 +388,7 @@ view env model macType machine currentStates tMistakes = NFA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel Nothing -> " " @@ -396,7 +396,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush + renderSet2String tLabel.inputLabel ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush Nothing -> " " @@ -434,7 +434,7 @@ view env model macType machine currentStates tMistakes = DFA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel Nothing -> " " @@ -442,7 +442,7 @@ view env model macType machine currentStates tMistakes = NFA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel Nothing -> " " @@ -450,7 +450,7 @@ view env model macType machine currentStates tMistakes = NPDA -> case List.head <| Dict.values machine.transitionNames of Just tLabel -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush + renderSet2String tLabel.inputLabel ++ ";" ++ tLabel.stackTop ++ ";" ++ String.concat tLabel.stackPush Nothing -> " " @@ -812,13 +812,13 @@ renderArrows macType machine model tMistakes = Just tLabel -> case macType of DFA -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel NFA -> - Set.toList tLabel.inputLabel |> renderString + renderSet2String tLabel.inputLabel NPDA -> - (Set.toList tLabel.inputLabel |> renderString) ++ ";" ++ tLabel.stackTop ++ ";" ++ String.join " " tLabel.stackPush + renderSet2String tLabel.inputLabel ++ ";" ++ tLabel.stackTop ++ ";" ++ String.join " " tLabel.stackPush Nothing -> "" diff --git a/src/SaveLoad.elm b/src/SaveLoad.elm index b31e538..b9dd318 100644 --- a/src/SaveLoad.elm +++ b/src/SaveLoad.elm @@ -1045,7 +1045,7 @@ renderNew loginStatus = [ Grid.col [] [ Card.deck [ Card.config [] - |> Card.headerH3 [] [ Html.text "DFA / NFA" ] + |> Card.headerH3 [] [ Html.text "DFA / NFA / NPDA" ] |> Card.block [] [ Block.text [] [ Html.text "Create a new Finite State Machine." ] ] |> Card.footer [] diff --git a/src/SharedModel.elm b/src/SharedModel.elm index 45d863e..53e949a 100644 --- a/src/SharedModel.elm +++ b/src/SharedModel.elm @@ -13,7 +13,7 @@ type alias SharedModel = init : SharedModel init = - { machine = Machine.testNPDA + { machine = Machine.test , machineType = DFA } diff --git a/src/Simulating.elm b/src/Simulating.elm index b66e5cc..b1984c7 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -86,7 +86,7 @@ type alias Stack = type Model = Default Int {- tapeID -} Int {- charID -} HoverError - | Running Int {- tapeID -} Int {- charID -} + -- | Running Int {- tapeID -} Int {- charID -} -- TODO: Decide if want to standardize simulation to a separate bottom menu screen | RunningNPDA (List Configuration) Int {- tapeID -} Int {- paginate start point -} | Editing Int @@ -316,7 +316,7 @@ renderConfig machine model input tapeId cfg = renderStack cfg.stack renderedTape = - renderTape model input Fresh tapeId tapeId cfg.tapePos False + renderTape model NPDA input Fresh tapeId tapeId cfg.tapePos False cfgLength = 50 + configLength @@ -365,8 +365,8 @@ renderStack stk = ) -renderTape : Model -> Array String -> TapeStatus -> Int -> Int -> Int -> Bool -> Shape Msg -renderTape model input tapeSt tapeId selectedId inputAt showButtons = +renderTape : Model -> MachineType -> Array String -> TapeStatus -> Int -> Int -> Int -> Bool -> Shape Msg +renderTape model macType input tapeSt tapeId selectedId inputAt showButtons = let hoverOn = case model of @@ -403,6 +403,14 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = |> fixedwidth |> filled red ] + + disableInDefaultNPDA = + case ( model, macType ) of + ( Default _ _ _, NPDA ) -> + False + + _ -> + True in group <| Array.toList @@ -438,7 +446,7 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = ) input ) - ++ (if tapeId == selectedId then + ++ (if tapeId == selectedId && disableInDefaultNPDA then [ group [ triangle 2.25 |> filled black @@ -478,14 +486,18 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = ] |> move ( toFloat <| (Array.length input + 1) * xpad, 3 ) |> notifyTap (DeleteTape tapeId) - , group - [ roundedRect 15 15 2 - |> filled white - |> addOutline (solid 1) darkGray - , thickRightArrowIcon |> scale 0.2 |> move ( 0, -1 ) - ] - |> move ( toFloat <| (Array.length input + 2) * xpad, 2 ) - |> notifyTap (RunTape tapeId) + , if macType /= NPDA then + group [] + + else + group + [ roundedRect 15 15 2 + |> filled white + |> addOutline (solid 1) darkGray + , thickRightArrowIcon |> scale 0.2 |> move ( 0, -1 ) + ] + |> move ( toFloat <| (Array.length input + 2) * xpad, 2 ) + |> notifyTap (RunTape tapeId) , if not (tapeSt == Fresh) then group ([ triangle 20 |> filled red |> rotate 22.5 @@ -500,7 +512,19 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = ) ) |> scale 0.5 - |> move ( toFloat <| (Array.length input + 3) * xpad, 1 ) + |> move + ( toFloat <| + (Array.length input + + (if macType /= NPDA then + 2 + + else + 3 + ) + ) + * xpad + , 1 + ) |> notifyEnter (HoverErrorEnter tapeId) |> notifyLeave HoverErrorExit @@ -580,10 +604,10 @@ update env msg ( model, pModel, sModel ) = RunTape tId -> case machineType of DFA -> - ( ( Running tId -1, pModel, sModel ), False, Cmd.none ) + ( ( model, pModel, sModel ), False, Cmd.none ) NFA -> - ( ( Running tId -1, pModel, sModel ), False, Cmd.none ) + ( ( model, pModel, sModel ), False, Cmd.none ) NPDA -> case Dict.get tId pModel.tapes of @@ -1079,7 +1103,7 @@ view env ( model, pModel, sModel ) = |> move ( -winX / 2 + 20, winY / 6 - 35 - 25 * (toFloat <| Dict.size pModel.tapes) ) , case model of Default tapeId charId _ -> - group (List.indexedMap (\x ( chId, ( ch, tapeSt ) ) -> renderTape model ch tapeSt chId tapeId charId True |> move ( 0, -(toFloat x) * 25 )) <| Dict.toList tapes) + group (List.indexedMap (\x ( chId, ( ch, tapeSt ) ) -> renderTape model sModel.machineType ch tapeSt chId tapeId charId True |> move ( 0, -(toFloat x) * 25 )) <| Dict.toList tapes) |> move ( -winX / 2 + 20, winY / 6 - 40 ) _ -> @@ -1135,14 +1159,11 @@ view env ( model, pModel, sModel ) = |> move ( -winX / 2 + 95, winY / 6 - 15 ) , latexKeyboard winX winY chars |> move ( 0, 0 ) - , renderTape model tape tapeSt tapeId -1 -1 False + , renderTape model sModel.machineType tape tapeSt tapeId -1 -1 False |> move ( -10 * toFloat (Array.length tape), winY / 6 - 65 ) ] |> move ( 0, -winY / 3 ) - Running _ _ -> - Debug.todo "Running state" - RunningNPDA cfgs tId pagStart -> group [ rect winX (winY / 3) From 632b3ce5c85e1549f7f0012ff961317bb5e2fcca Mon Sep 17 00:00:00 2001 From: Necried Date: Fri, 20 Aug 2021 23:50:50 -0400 Subject: [PATCH 20/20] Fix final state acceptance bug and cleanup debug --- src/Simulating.elm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index b1984c7..d4b827a 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -263,7 +263,7 @@ paginateConfigs paginateStart winX cfgWithLengths = [ group <| List.map2 (\cfg moveAmt -> cfg |> move ( -initLeftPos + moveAmt, 0 )) (Array.toList <| Array.slice paginateStart paginateEnd cfgArr) - (Debug.log "shiftAmountByIdx" <| shiftAmountByIdx <| Array.toList <| Array.slice paginateStart paginateEnd lengthArr) + (shiftAmountByIdx <| Array.toList <| Array.slice paginateStart paginateEnd lengthArr) , paginateButtons , paginateInfo ] @@ -1505,7 +1505,7 @@ nextConfig tNames d tape acceptCond finals ({ stack, state, status, tapePos } as Alive FinalState -> - if Set.member sId finals && newTapePos == Array.length tape then + if Set.member sId finals && newTapePos == (Array.length tape - 1) then Success else