diff --git a/src/Building.elm b/src/Building.elm index 68f7a2f..d0c4f06 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -467,12 +467,16 @@ update env msg ( model, pModel, sModel ) = case model.machineState of SelectedState stId -> let + new_q = + Set.remove stId oldMachine.q + newDelta = Dict.map (\_ d -> Dict.filter (\tId _ -> not <| Dict.member tId removedTransitions) d) oldMachine.delta + |> Dict.filter (\key _ -> Set.member key new_q) newMachine = { oldMachine - | q = Set.remove stId oldMachine.q + | q = new_q , delta = newDelta , start = Set.remove stId oldMachine.start , final = Set.remove stId oldMachine.final diff --git a/src/Main.elm b/src/Main.elm index 286d20c..f04214a 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -35,8 +35,6 @@ type Msg | UrlChange Url | UrlRequest UrlRequest | GoTo Module - | ShowModal - | HideModal type Module @@ -52,7 +50,6 @@ type ApplicationState type alias Model = { appModel : BetterUndoList ApplicationModel , environment : Environment - , alertModalOpen : Bool } @@ -81,7 +78,6 @@ main = \flags url key -> ( { appModel = initAppModel , environment = Environment.init - , alertModalOpen = False } , Task.perform (\vp -> WindowSize ( round vp.viewport.width, round vp.viewport.height )) Browser.Dom.getViewport ) @@ -201,7 +197,7 @@ update msg model = KeyPressed k -> if k == 16 then - ( { model | environment = { oldEnvironment | holdingShift = True } }, Helpers.sendMsg <| HideModal ) + ( { model | environment = { oldEnvironment | holdingShift = True } }, Cmd.none ) else if k == 89 {- y -} || k == 90 {- z -} then let @@ -223,16 +219,16 @@ update msg model = else model.appModel } - , Helpers.sendMsg <| HideModal + , Cmd.none ) else if k == 91 then --pressed meta key - ( { model | environment = { oldEnvironment | holdingMeta = True } }, Helpers.sendMsg <| HideModal ) + ( { model | environment = { oldEnvironment | holdingMeta = True } }, Cmd.none ) else if k == 17 then --pressed control - ( { model | environment = { oldEnvironment | holdingControl = True } }, Helpers.sendMsg <| HideModal ) + ( { model | environment = { oldEnvironment | holdingControl = True } }, Cmd.none ) {- else if k == 66 then ( model, sendMsg <| GoTo BuildingModule ) @@ -241,7 +237,7 @@ update msg model = -} else - ( model, Helpers.sendMsg <| HideModal ) + ( model, Cmd.none ) GoTo mod -> let @@ -300,35 +296,17 @@ update msg model = newAppState = { currentAppState | appState = Simulating simModel, simulatingData = pModel, sharedModel = sModel } - - hasTransitionMistakes = - case sModel.machine.transitionMistakes of - Nothing -> - False - - _ -> - True in - if hasTransitionMistakes then - ( model.appModel, Helpers.sendMsg <| ShowModal ) - - else - ( if checkpoint then - new newAppState model.appModel + ( if checkpoint then + new newAppState model.appModel - else - replace newAppState model.appModel - , Cmd.map SMsg sCmd - ) + else + replace newAppState model.appModel + , Cmd.map SMsg sCmd + ) in ( { model | appModel = enter }, cmd ) - ShowModal -> - ( { model | alertModalOpen = True }, Cmd.none ) - - HideModal -> - ( { model | alertModalOpen = False }, Cmd.none ) - textHtml : String -> Html msg textHtml t = @@ -368,11 +346,6 @@ view model = , icon False (text "?" |> size 30 |> fixedwidth |> centered |> filled (rgb 220 220 220) |> move ( 0, -9 )) |> addHyperlink "https://github.com/CSchank/finsm/wiki" |> move ( winX / 2 - 25, -winY / 2 + 25 ) - , if model.alertModalOpen then - errorEpsTrans model - - else - group [] ] diff --git a/src/Simulating.elm b/src/Simulating.elm index 0b3c228..ad861ee 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -1,4 +1,4 @@ -module Simulating exposing (InputTape, Model(..), Msg(..), PersistentModel, delta, deltaHat, initPModel, isAccept, latexKeyboard, onEnter, onExit, renderTape, subscriptions, update, view) +module Simulating exposing (InputTape, Model(..), Msg(..), PersistentModel, delta, deltaHat, initPModel, isAccept, latexKeyboard, machineCheck, onEnter, onExit, renderTape, subscriptions, update, view) import Array exposing (Array) import Browser.Events @@ -19,9 +19,28 @@ subscriptions model = Browser.Events.onKeyDown (D.map KeyPressed (D.field "keyCode" D.int)) +type MachineType + = DFA + | NFA + + +type Error + = NoError + | DFAError DFAErrorType StateID + | EpsTransError + + +type DFAErrorType + = HasEpsilon + | Incomplete + | Nondeterministic + | Unsure -- Good for debugging? + + type alias PersistentModel = { tapes : Dict Int (Array Character) , currentStates : Set StateID + , machineType : MachineType } @@ -42,6 +61,7 @@ type Msg | ChangeTape Int | ToggleStart StateID | KeyPressed Int + | ChangeMachine MachineType | MachineMsg Machine.Msg @@ -63,6 +83,7 @@ initPModel = , ( 1, Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0", "1", "1", "1", "1", "0" ] ) ] , currentStates = test.start + , machineType = DFA } @@ -143,6 +164,9 @@ update env msg ( model, pModel, sModel ) = let oldMachine = sModel.machine + + machineType = + pModel.machineType in case msg of Step -> @@ -377,6 +401,59 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) + ChangeMachine mtype -> + case mtype of + NFA -> + case pModel.machineType of + NFA -> + ( ( model, pModel, sModel ), False, Cmd.none ) + + DFA -> + case model of + Editing tId -> + ( ( Default tId -1, { pModel | machineType = NFA }, sModel ), False, Cmd.none ) + + _ -> + ( ( model, { pModel | machineType = NFA }, sModel ), False, Cmd.none ) + + DFA -> + case pModel.machineType of + DFA -> + ( ( model, pModel, sModel ), 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 | machineType = DFA, currentStates = startState } + + newSModel = + { sModel | machine = { oldMachine | start = startState } } + in + case model of + Editing tId -> + ( ( Default tId -1, newPModel, newSModel ), True, Cmd.none ) + + _ -> + ( ( model, newPModel, newSModel ), True, Cmd.none ) + MachineMsg mmsg -> case mmsg of StartDragging sId _ -> @@ -394,15 +471,22 @@ update env msg ( model, pModel, sModel ) = oldMachine.start newMachine = - { oldMachine - | start = - case Set.member sId oldMachine.start of - True -> - Set.remove sId oldMachine.start - - False -> - Set.insert sId oldMachine.start - } + case machineType of + NFA -> + { oldMachine + | start = + case Set.member sId oldMachine.start of + True -> + Set.remove sId oldMachine.start + + False -> + Set.insert sId oldMachine.start + } + + DFA -> + { oldMachine + | start = Set.singleton sId + } in case model of Default tId _ -> @@ -437,16 +521,8 @@ view env ( model, pModel, sModel ) = -- This is broken? Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values oldMachine.transitionNames - getStateName sId = - case Dict.get sId oldMachine.stateNames of - Just n -> - n - - Nothing -> - "\\ " - menu = - group + group <| [ text "Simulate" |> size 16 |> fixedwidth @@ -469,25 +545,6 @@ view env ( model, pModel, sModel ) = |> notifyTap AddNewTape ] |> move ( -winX / 2 + 20, winY / 6 - 35 - 25 * (toFloat <| Dict.size pModel.tapes) ) - , text "Machine" - |> size 16 - |> fixedwidth - |> filled black - |> move ( -winX / 2 + 492, winY / 6 - 15 ) - , latex 500 18 "blank" "let\\ N = (Q,\\Sigma,\\Delta,S,F)" AlignLeft - |> move ( -winX / 2 + 750, winY / 6 - 25 ) - , latex 500 14 "blank" "where" AlignLeft - |> move ( -winX / 2 + 750, winY / 6 - 45 ) - , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values oldMachine.stateNames) ++ " \\}") AlignLeft - |> move ( -winX / 2 + 760, winY / 6 - 65 ) - , latex 500 18 "blank" ("\\Sigma = \\{ " ++ String.join "," (Set.toList <| Set.remove "\\epsilon" <| List.foldl Set.union Set.empty <| Dict.values oldMachine.transitionNames) ++ " \\}") AlignLeft - |> move ( -winX / 2 + 760, winY / 6 - 90 ) - , latex 500 18 "blank" "\\Delta = (above)" AlignLeft - |> move ( -winX / 2 + 760, winY / 6 - 115 ) - , latex 500 18 "blank" ("S = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| oldMachine.start) ++ " \\}") AlignLeft - |> move ( -winX / 2 + 760, winY / 6 - 140 ) - , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| oldMachine.final) ++ " \\}") AlignLeft - |> move ( -winX / 2 + 760, winY / 6 - 165 ) , case model of Default tapeId charId -> group (List.indexedMap (\x ( chId, ch ) -> renderTape ch chId tapeId charId True |> move ( 0, -(toFloat x) * 25 )) <| Dict.toList tapes) @@ -499,6 +556,9 @@ view env ( model, pModel, sModel ) = tapes = pModel.tapes + + validCheck = + machineCheck sModel in group [ case model of @@ -506,7 +566,21 @@ view env ( model, pModel, sModel ) = group [ rect winX (winY / 3) |> filled lightGray - , menu + , case pModel.machineType of + DFA -> + if validCheck == NoError then + menu + + else + errorMenu validCheck oldMachine winX winY + + NFA -> + if validCheck == EpsTransError then + errorMenu validCheck oldMachine winX winY + + else + menu + , machineDefn sModel pModel.machineType winX winY ] |> move ( 0, -winY / 3 ) @@ -540,9 +614,204 @@ view env ( model, pModel, sModel ) = ] |> move ( 0, -winY / 3 ) , (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machine pModel.currentStates) |> move ( 0, winY / 6 ) + , machineModeButtons pModel.machineType winX winY ] +errorMenu : Error -> Machine -> Float -> Float -> Shape Msg +errorMenu err mac winX winY = + let + errStId = + case err of + DFAError _ stId -> + case Dict.get stId mac.stateNames of + Just name -> + name + + Nothing -> + "" + + _ -> + "" + + errorHeader txt = + group + [ triangle 20 |> filled red |> rotate 22.5 + , roundedRect 7.5 10 5 |> filled white |> move ( 0, 7.5 ) + , circle 3 |> filled white |> move ( 0, -2.5 ) + , text txt + |> size 20 + |> fixedwidth + |> filled darkRed + |> move ( 20, 0 ) + ] + |> scale 0.75 + |> move ( -winX / 2 + 20, winY / 6 - 20 ) + + errorReason = + group + [ circle 3 |> filled red + , (text <| + case err of + DFAError HasEpsilon _ -> + "Possible cause: There are epsilon transitions" + + DFAError Incomplete _ -> + "Possible cause: There are missing transitions" + + DFAError Nondeterministic _ -> + "Possible cause: There are extraneous transitions" + + EpsTransError -> + "Cause: Epsilon transitions are mixed with normal transitions" + + _ -> + "You might have missed something somewhere?" + ) + |> size 12 + |> fixedwidth + |> filled darkRed + |> move ( 15, -5 ) + ] + |> move ( -winX / 2 + 20, winY / 6 - 40 ) + + errorHint = + group + [ circle 3 |> filled red + , (text <| + case err of + DFAError HasEpsilon _ -> + "Hint: Try removing all your epsilon transitions" + + DFAError Incomplete _ -> + "Hint: Check states for missing transitions" + + DFAError Nondeterministic _ -> + "Hint: Find and remove extra transitions" + + EpsTransError -> + "Hint: Switch to Build mode and fix transitions in red" + + _ -> + "" + ) + |> size 12 + |> fixedwidth + |> filled darkRed + |> move ( 15, -5 ) + ] + |> move ( -winX / 2 + 20, winY / 6 - 60 ) + + errorState = + group + [ circle 3 |> filled red + , text "Hint: Check state " + |> size 12 + |> fixedwidth + |> filled darkRed + |> move ( 15, -5 ) + , latex 50 12 "blank" errStId AlignLeft |> move ( 170, 3 ) + ] + |> move ( -winX / 2 + 20, winY / 6 - 80 ) + + actionHint = + group + [ circle 3 |> filled red + , text "Go to Build mode to fix your machine, or use a NFA" + |> size 12 + |> fixedwidth + |> filled darkRed + |> move ( 15, -5 ) + ] + |> move ( -winX / 2 + 20, winY / 6 - 100 ) + in + case err of + DFAError _ _ -> + group [ errorHeader "DFA error: Your machine has a problem!", errorReason, errorHint, errorState, actionHint ] + + EpsTransError -> + group [ errorHeader "Error: You have invalid state transitions!", errorReason, errorHint ] + + NoError -> + group [] + + +machineDefn : SharedModel -> MachineType -> Float -> Float -> Shape Msg +machineDefn sModel mtype winX winY = + let + machine = + sModel.machine + + getStateName sId = + case Dict.get sId machine.stateNames of + Just n -> + n + + Nothing -> + "\\ " + + machineHeader = + text "Machine" + |> size 16 + |> fixedwidth + |> filled black + |> move ( -winX / 2 + 492, winY / 6 - 15 ) + in + case mtype of + NFA -> + group + [ machineHeader + , latex 500 18 "blank" "let\\ N = (Q,\\Sigma,\\Delta,S,F)" AlignLeft + |> move ( -winX / 2 + 750, winY / 6 - 25 ) + , latex 500 14 "blank" "where" AlignLeft + |> move ( -winX / 2 + 750, winY / 6 - 45 ) + , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 760, 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 + |> move ( -winX / 2 + 760, winY / 6 - 90 ) + , latex 500 18 "blank" "\\Delta = (above)" AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 115 ) + , latex 500 18 "blank" ("S = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.start) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 140 ) + , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.final) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 165 ) + ] + + DFA -> + group + [ machineHeader + , latex 500 18 "blank" "let\\ M = (Q,\\Sigma,\\delta,s,F)" AlignLeft + |> move ( -winX / 2 + 750, winY / 6 - 25 ) + , latex 500 14 "blank" "where" AlignLeft + |> move ( -winX / 2 + 750, winY / 6 - 45 ) + , latex 500 18 "blank" ("Q = \\{ " ++ String.join "," (Dict.values machine.stateNames) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 760, 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 + |> move ( -winX / 2 + 760, winY / 6 - 90 ) + , latex 500 18 "blank" "\\delta = (above)" AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 115 ) + , latex 500 + 14 + "blank" + ("s = " + ++ (case Set.toList machine.start of + [] -> + "Please\\ select\\ a\\ start\\ state" + + x :: [] -> + getStateName x + + x :: xs -> + "Congratulations,\\ you\\ found\\ a\\ bug!" + ) + ) + AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 140 ) + , latex 500 18 "blank" ("F = \\{ " ++ String.join "," (List.map getStateName <| Set.toList <| machine.final) ++ " \\}") AlignLeft + |> move ( -winX / 2 + 760, winY / 6 - 160 ) + ] + + epsTrans : TransitionNames -> Delta -> Set StateID -> Set StateID epsTrans tNames d states = let @@ -690,3 +959,124 @@ 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 ) ] + + +machineModeButtons : MachineType -> Float -> Float -> Shape Msg +machineModeButtons mtype winX winY = + group + [ group + [ roundedRect 30 15 1 + |> filled + (if mtype == DFA then + finsmLightBlue + + else + blank + ) + |> addOutline (solid 1) darkGray + , text "DFA" + |> centered + |> fixedwidth + |> filled + (if mtype == DFA then + white + + else + darkGray + ) + |> move ( 0, -4 ) + ] + |> move ( -winX / 2 + 20, winY / 2 - 32 ) + |> notifyTap (ChangeMachine DFA) + , group + [ roundedRect 30 15 1 + |> filled + (if mtype == NFA then + finsmLightBlue + + else + blank + ) + |> addOutline (solid 1) darkGray + , text "NFA" + |> centered + |> fixedwidth + |> filled + (if mtype == NFA then + white + + else + darkGray + ) + |> move ( 0, -4 ) + ] + |> move ( -winX / 2 + 52, winY / 2 - 32 ) + |> notifyTap (ChangeMachine NFA) + ] + + +machineCheck : SharedModel -> Error +machineCheck sModel = + let + mac = + sModel.machine + + tMistakes = + sModel.machine.transitionMistakes + + allTransitionLabels = + List.sort <| Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values mac.transitionNames + + catch : Maybe (Set String) -> List String + catch ms = + case ms of + Nothing -> + [] + + Just s -> + Set.toList s + + getTrans : Dict TransitionID StateID -> List String + getTrans d = + (List.concatMap (\e -> Dict.get e mac.transitionNames |> catch) <| Dict.keys d) |> List.sort + + foldingFunc : ( StateID, Dict TransitionID StateID ) -> Error -> Error + foldingFunc sTuple err = + case err of + DFAError errType x -> + DFAError errType x + + NoError -> + let + transitions = + getTrans <| second sTuple + + stId = + first sTuple + in + if transitions == allTransitionLabels then + NoError + + else if List.member "\\epsilon" transitions then + DFAError HasEpsilon stId + + else + case compare (List.length transitions) (List.length allTransitionLabels) of + LT -> + DFAError Incomplete stId + + EQ -> + DFAError Incomplete stId + + -- e.g. compare [1,1,2] [1,2,3], can be Nondeterministic too + GT -> + DFAError Nondeterministic stId + + EpsTransError -> + EpsTransError + in + if tMistakes /= Nothing then + EpsTransError + + else + List.foldr (\x acc -> foldingFunc x acc) NoError <| Dict.toList mac.delta