mathematica deterministic automaton

Question

I want to make a module in mathematica that returns if an automaton is deterministic or not. I am considering that an automaton is not deterministic if there are 2 transitions that start at the same state and read the same simbol, or also if there exists an empty transition.

I want to debug this code but I cant:

isDeterministic[au_] := Module[{a, s},
  For[i = 1, i <= Length[au[[3]]],
   a = au[[3]][[i]][[1]];
   s = au[[3]][[i]][[2]];
   If[s == {}, Return[False]];
   For[j = i, j <= Length[au[[3]]],
    If[a == au[[3]][[j]][[1]] && s == au[[3]][[j]][[2]], 
     Return[False]];
    j++;
    ];
   i++;
   ];
  Return[True];
  ]
A = {{1, 2},
  {a, b},
  {{1, a, 2}, {2, b, 1}},
  1,
  {2}
  }
isDeterministic[A]

A is an automaton where the first element is a list of the states, second is the alphabet, third are the transitions, fourth is the initial state, fifth is the list of final states.

The main problem is that when I apply the function to A it never ends.

EDIT: SOLVED

this is the final code:

isDeterministic[au_] := 
 Module[{a, s, lambda}, 
  For[i = 1, i <= Length[au[[3]]], i++, a = au[[3]][[i]][[1]];
   s = au[[3]][[i]][[2]];
   If[s == lambda, Return[False]];
   For[j = i + 1, j <= Length[au[[3]]], j++, 
    If[a == au[[3]][[j]][[1]] && s == au[[3]][[j]][[2]], 
     Return[False]]]];
  True]

A = {{1, 2},
  {a, b},
  {{2, b, 1}, {1, a, 2}},
  1,
  {2}
  }

isDeterministic[A]

True

Answer 1

Try this

isDeterministic[au_]:=Module[{a,s,len = Length[au[[3]]] },

  For[i = 1, i <= len, i++,

     a=au[[3]][[i]][[1]];
     s=au[[3]][[i]][[2]];

     If[s=={}, Return[False,Module] ];

     For[j = i, j <= len, j++,

        If[a==au[[3]][[j]][[1]]&&s==au[[3]][[j]][[2]],
           Return[False,Module]
        ]
     ]
  ];

  True
 ]

Answer 2

I hate to see people writing loops in Mathematica, they're almost always unnecessary, and in almost all cases there are better alternatives, better in the senses of being faster to execute and easier to both write and comprehend. Some of this ease of writing and comprehension only comes with experience with doing things the way Mathematica was designed to be used but you'll never get that if you continue to program in the imperative style.

OK, enough of the homily, onto some Mathematica. I'll start by defining an automaton which is non-deterministic

aub = {{1, 2, 3}, {a, b}, {{1, a, 2}, {2, b, 1}, {2, b, 3}}, 1, {2}};

Taking the first clause of your rule for determining the determinism of an automaton, first group the set of transitions by their first 2 elements. The expression

GatherBy[aub[[3]], {First[#], First[Rest[#]]} &]

produces the output

{{{1, a, 2}}, {{2, b, 1}, {2, b, 3}}}

and if you examine this carefully you'll see that this is a list of lists each of which is the list of transitions whose first 2 elements (the start state and the event) match. Now it's a simple matter of checking the length of these lists:

Map[Length[#] == 1 &, GatherBy[aub[[3]], {First[#], First[Rest[#]]} &]]

produces the list

{True, False}

finally, change the head of this last expression to And and we get

And @@ Map[Length[#] == 1 &, GatherBy[aub[[3]], {First[#], First[Rest[#]]} &]]

which gives the response

False

Next the second clause of your rule for determining determinism requires that there be no empty transitions. I'm not sure how you would model these, I'll suppose that such a transition would look like {1,{},2}, a start and end state with an empty list of events. I'll need another test case

auc = {{1, 2}, {a, b}, {{1, a, 2}, {2, {}, 1}, {2, b, 1}}, 1, {2}};

To check this, first get the set of all events from the transitions:

auc[[3, ;; , 2]]

returns

{a, {}, b}

I've used the ;; notation to slice the array of transitions and select only the events from them. Then

FreeQ[auc[[3, ;; , 2]], {}]

checks whether the empty list is in the slice of the transitions. Of course in this case the expression returns False.

So, I'd suggest the function

isDeterministic[au_]:=And[(And @@ 
   Map[Length[#] == 1 &, 
    GatherBy[au[[3]], {First[#], First[Rest[#]]} &]]), 
 FreeQ[au[[3, ;; , 2]], {}]]

to replace your loop-based approach.

Or feel free to ignore this gratuitous advice.