Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Stale tape detection implementation #55

Merged
merged 2 commits into from
Feb 12, 2019
Merged

Stale tape detection implementation #55

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f5b1615
Initial stale tape warning
Necried Feb 10, 2019
e0d3353
Hover error messages implemented
Necried Feb 11, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
199 changes: 162 additions & 37 deletions src/Simulating.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ type DFAErrorType


type alias PersistentModel =
{ tapes : Dict Int (Array Character)
{ tapes : Dict Int ( InputTape, TapeStatus )
, currentStates : Set StateID
, machineType : MachineType
}
Expand All @@ -48,8 +48,17 @@ type alias InputTape =
Array Character


type TapeStatus
= Fresh
| Stale (Set String)


type alias HoverError =
Maybe Int


type Model
= Default Int {- tapeID -} Int {- charID -}
= Default Int {- tapeID -} Int {- charID -} HoverError
| Editing Int


Expand All @@ -63,11 +72,26 @@ type Msg
| KeyPressed Int
| ChangeMachine MachineType
| MachineMsg Machine.Msg
| HoverErrorEnter Int
| HoverErrorExit


onEnter : Environment -> ( PersistentModel, SharedModel ) -> ( ( Model, PersistentModel, SharedModel ), Bool, Cmd Msg )
onEnter env ( pModel, sModel ) =
( ( Default 0 -1, { pModel | currentStates = epsTrans sModel.machine.transitionNames sModel.machine.delta sModel.machine.start }, sModel ), False, Cmd.none )
( ( Default 0 -1 Nothing
, { pModel
| currentStates =
epsTrans
sModel.machine.transitionNames
sModel.machine.delta
sModel.machine.start
, tapes = checkTapes sModel pModel.tapes
}
, sModel
)
, False
, Cmd.none
)


onExit : Environment -> ( Model, PersistentModel, SharedModel ) -> ( ( PersistentModel, SharedModel ), Bool )
Expand All @@ -79,19 +103,68 @@ initPModel : PersistentModel
initPModel =
{ tapes =
Dict.fromList
[ ( 0, Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0" ] )
, ( 1, Array.fromList [ "0", "0", "0", "1", "1", "0", "1", "0", "1", "0", "1", "1", "1", "1", "0" ] )
[ ( 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
, machineType = DFA
}


renderTape : Array String -> Int -> Int -> Int -> Bool -> Shape Msg
renderTape input tapeId selectedId inputAt showButtons =
checkTapes : SharedModel -> Dict Int ( InputTape, TapeStatus ) -> Dict Int ( InputTape, TapeStatus )
checkTapes sModel tapes =
Dict.map (\k ( tape, _ ) -> ( tape, checkTape sModel tape )) tapes


checkTape : SharedModel -> InputTape -> TapeStatus
checkTape sModel inp =
let
tNames =
sModel.machine.transitionNames

allTransitionLabels =
List.foldr Set.union Set.empty <| Dict.values tNames

arrFilter =
Array.filter (\v -> not <| Set.member v allTransitionLabels) inp
in
case Array.isEmpty arrFilter of
True ->
Fresh

False ->
Stale <| Set.fromList <| Array.toList arrFilter


renderTape : Model -> Array String -> TapeStatus -> Int -> Int -> Int -> Bool -> Shape Msg
renderTape model input tapeSt tapeId selectedId inputAt showButtons =
let
hoverOn =
case model of
Default _ _ (Just errId) ->
if errId == tapeId then
True

else
False

_ ->
False

xpad =
20

errWindow =
group
[ roundedRect 800 30 2
|> filled white
|> addOutline (solid 1) darkGray
|> move ( 400, 5 )
, text "This tape has stale transitions. Modify or delete it!"
|> size 25
|> fixedwidth
|> filled red
]
in
group <|
Array.toList
Expand All @@ -102,7 +175,12 @@ renderTape input tapeId selectedId inputAt showButtons =
|> filled white
|> addOutline
(solid 1)
black
(if tapeSt == Fresh then
black

else
red
)
|> move ( 0, 3 )
, latex (xpad * 0.9) (xpad * 0.7) "white" st AlignCentre
|> move ( 0, 10.25 )
Expand Down Expand Up @@ -152,6 +230,26 @@ renderTape input tapeId selectedId inputAt showButtons =
]
|> move ( toFloat <| (Array.length input + 1) * xpad, 3 )
|> notifyTap (DeleteTape tapeId)
, if not (tapeSt == Fresh) then
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 )
]
++ (if hoverOn then
[ errWindow ]

else
[]
)
)
|> scale 0.5
|> move ( toFloat <| (Array.length input + 2) * xpad, 1 )
|> notifyEnter (HoverErrorEnter tapeId)
|> notifyLeave HoverErrorExit

else
group []
]

else
Expand All @@ -171,14 +269,18 @@ update env msg ( model, pModel, sModel ) =
case msg of
Step ->
case model of
Default tapeId charId ->
Default tapeId charId hover ->
let
nextCh =
case Dict.get tapeId pModel.tapes of
Just ar ->
Just ( ar, tapeStatus ) ->
case Array.get (charId + 1) ar of
Just ch ->
ch
if tapeStatus == Fresh then
ch

else
""

_ ->
""
Expand All @@ -187,7 +289,7 @@ update env msg ( model, pModel, sModel ) =
""
in
if nextCh /= "" then
( ( Default tapeId (charId + 1)
( ( Default tapeId (charId + 1) hover
, { pModel
| currentStates =
deltaHat oldMachine.transitionNames oldMachine.delta nextCh pModel.currentStates
Expand All @@ -211,13 +313,13 @@ update env msg ( model, pModel, sModel ) =
let
newModel =
case model of
Default tId0 chId ->
Default tId0 chId hover ->
-- FIXME: choose a good tape to go to
if tId0 == tId then
Default 0 -1
Default 0 -1 hover

else
Default tId0 chId
Default tId0 chId hover

_ ->
model
Expand All @@ -236,17 +338,17 @@ update env msg ( model, pModel, sModel ) =
)
+ 1
in
( ( model, { pModel | tapes = Dict.insert newId Array.empty pModel.tapes }, sModel ), True, Cmd.none )
( ( model, { pModel | tapes = Dict.insert newId ( Array.empty, Fresh ) pModel.tapes }, sModel ), True, Cmd.none )

ChangeTape tId ->
( ( Default tId -1, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), False, Cmd.none )
( ( Default tId -1 Nothing {- ??? -}, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), False, Cmd.none )

KeyPressed k ->
if k == 13 then
--pressed enter
case model of
Editing tId ->
( ( Default tId -1, pModel, sModel ), True, Cmd.none )
( ( Default tId -1 Nothing, pModel, sModel ), True, Cmd.none )

_ ->
( ( model, pModel, sModel ), False, Cmd.none )
Expand All @@ -262,8 +364,15 @@ update env msg ( model, pModel, sModel ) =
Dict.update tapeId
(\m ->
case m of
Just ar ->
Just <| Array.slice 0 -1 ar
Just ( ar, tapeSt ) ->
let
newTape =
Array.slice 0 -1 ar

freshSt =
checkTape sModel newTape
in
Just ( Array.slice 0 -1 ar, freshSt )

_ ->
m
Expand All @@ -279,7 +388,7 @@ update env msg ( model, pModel, sModel ) =
else if k == 39 then
--right arrow key
case model of
Default _ _ ->
Default _ _ _ ->
( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) )

_ ->
Expand Down Expand Up @@ -384,11 +493,11 @@ update env msg ( model, pModel, sModel ) =
Dict.update tapeId
(\m ->
case ( m, newChar ) of
( Just ar, Just ch ) ->
Just <| Array.push ch ar
( Just ( ar, tapeSt ), Just ch ) ->
Just ( Array.push ch ar, tapeSt )

( Nothing, Just ch ) ->
Just <| Array.fromList [ ch ]
Just ( Array.fromList [ ch ], Fresh )

_ ->
m
Expand All @@ -411,7 +520,7 @@ update env msg ( model, pModel, sModel ) =
DFA ->
case model of
Editing tId ->
( ( Default tId -1, { pModel | machineType = NFA }, sModel ), False, Cmd.none )
( ( Default tId -1 Nothing, { pModel | machineType = NFA }, sModel ), False, Cmd.none )

_ ->
( ( model, { pModel | machineType = NFA }, sModel ), False, Cmd.none )
Expand Down Expand Up @@ -449,7 +558,7 @@ update env msg ( model, pModel, sModel ) =
in
case model of
Editing tId ->
( ( Default tId -1, newPModel, newSModel ), True, Cmd.none )
( ( Default tId -1 Nothing, newPModel, newSModel ), True, Cmd.none )

_ ->
( ( model, newPModel, newSModel ), True, Cmd.none )
Expand Down Expand Up @@ -489,8 +598,24 @@ update env msg ( model, pModel, sModel ) =
}
in
case model of
Default tId _ ->
( ( Default tId -1, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta newMachine.start }, { sModel | machine = newMachine } ), True, Cmd.none )
Default tId _ _ ->
( ( Default tId -1 Nothing, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta newMachine.start }, { sModel | machine = newMachine } ), True, Cmd.none )

_ ->
( ( model, pModel, sModel ), False, Cmd.none )

HoverErrorEnter tapeId ->
case model of
Default tId pos _ ->
( ( Default tId pos (Just tapeId), pModel, sModel ), False, Cmd.none )

_ ->
( ( model, pModel, sModel ), False, Cmd.none )

HoverErrorExit ->
case model of
Default tId pos _ ->
( ( Default tId pos Nothing, pModel, sModel ), False, Cmd.none )

_ ->
( ( model, pModel, sModel ), False, Cmd.none )
Expand Down Expand Up @@ -546,8 +671,8 @@ 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 ) -> renderTape ch chId tapeId charId True |> move ( 0, -(toFloat x) * 25 )) <| Dict.toList tapes)
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)
|> move ( -winX / 2 + 20, winY / 6 - 40 )

_ ->
Expand All @@ -562,10 +687,11 @@ view env ( model, pModel, sModel ) =
in
group
[ case model of
Default _ _ ->
Default _ _ _ ->
group
[ rect winX (winY / 3)
|> filled lightGray
, machineDefn sModel pModel.machineType winX winY
, case pModel.machineType of
DFA ->
if validCheck == NoError then
Expand All @@ -580,19 +706,18 @@ view env ( model, pModel, sModel ) =

else
menu
, machineDefn sModel pModel.machineType winX winY
]
|> move ( 0, -winY / 3 )

Editing tapeId ->
let
tape =
( tape, tapeSt ) =
case Dict.get tapeId pModel.tapes of
Just t ->
t
Just ( t, st ) ->
( t, st )

Nothing ->
Array.empty
( Array.empty, Fresh )
in
group
[ rect winX (winY / 3)
Expand All @@ -609,7 +734,7 @@ view env ( model, pModel, sModel ) =
|> move ( -winX / 2 + 95, winY / 6 - 15 )
, latexKeyboard winX winY chars
|> move ( 0, 0 )
, renderTape tape tapeId -1 -1 False
, renderTape model tape tapeSt tapeId -1 -1 False
|> move ( -10 * toFloat (Array.length tape), winY / 6 - 65 )
]
|> move ( 0, -winY / 3 )
Expand Down