Grammar and anti-parser (travesty generator) for game Wff-n-Prrof

WffTravesties.nb

ClearAll[P, Wff, Proposition, Unary, Binary, T, 
  nonTerminalsFromGrammar, terminalsFromGrammar];

P[Wff] = {{Proposition}, {Unary}, {Binary}};
P[Proposition] = {{"p"}, {"q"}, {"r"}, {"s"}};
P[Unary] = {{"N", Wff}};
P[Binary] = {{"C", Wff, Wff}, {"A", Wff, Wff}, {"K", Wff, Wff}, {"E", 
    Wff, Wff}};
P[Start] = P[Wff];
ClearAll[nonTerminalsFromGrammar];
nonTerminalsFromGrammar[ps_] := #[[1, 1, 1]] & /@ DownValues[ps]
ClearAll[allSymbols];
allSymbols[ps_] := Union@Flatten[#[[2]] & /@ DownValues[ps]]
ClearAll[terminalsFromGrammar];
terminalsFromGrammar[ps_] :=
 Complement[
  allSymbols @ ps,
  nonTerminalsFromGrammar @ ps]
(T = terminalsFromGrammar @ P);
Zip[l1_, l2_, f_] := MapThread[f, {l1, l2}]
ClearAll[injectGenerationProbabilities];
injectGenerationProbabilities[
  grammar_,
  probsFromAlternatives_] :=
 Module[{newTable, nonTerminals = nonTerminalsFromGrammar@grammar},
  Scan[
   Function[nonTerminal,
    With[{
      alternatives = grammar[nonTerminal],
      probabilities = probsFromAlternatives[grammar[nonTerminal]]},
     newTable[nonTerminal] =
      Zip[probabilities, alternatives,
       Function[{prob, alt},
        {"probability" -> prob, "alternative" -> alt}]]
     (*Print[newTable[nonTerminal]];
     Print[DownValues[newTable]];*)
     ]],
   nonTerminals];
  newTable]
ClearAll[equiProbabilities];
equiProbabilities[list_List] :=
 With[{l = Length@list}, Table[N[1/l], {l}]]
ClearAll[iP];
(iP = injectGenerationProbabilities[P, equiProbabilities]);
ClearAll[chooseFromAlternatives];
chooseFromAlternatives[{probabilizedAlternative_}, dieRoll_] := 
  "alternative" /. probabilizedAlternative;
chooseFromAlternatives[{probabilizedAlternative_, rest___}, 
   dieRoll_] :=
  With[{p = "probability" /. probabilizedAlternative},
   If[dieRoll < p,
    (* then *)"alternative" /. probabilizedAlternative,
    (* else *)chooseFromAlternatives[{rest}, dieRoll - p]]];
chooseFromAlternatives[badArgs___] := 
  Throw[{"CHOOSE:BADARGS: ", {badArgs}}];
ClearAll[chainExpansion];
chainExpansion[iP_, groundTerm_, T_, production : {},
   sentence_, i_, iLim_] := sentence;
chainExpansion[iP_, groundTerm_, Terminals_, 
   production : {term_, rest___},
   sentence_, i_, iLim_] /; i < iLim :=(* limit recursion *)
 (If[MemberQ[Terminals, term],
   (* If the term is a terminal symbol (if it's in the set "T"), 
   then append it to the sentence being accumulated and recurse on \
the rest of the production. *)
   chainExpansion[iP, groundTerm, Terminals, {rest},
    Append[sentence, term], i + 1, iLim],
   (* Otherwise, the term is a non-terminal symbol. Choose, non-
   uniformly, randomly from the alternatives of the non-
   terminal and internally recurse on that. *)
   With[{randomAlt = chooseFromAlternatives[iP[term], RandomReal[]]},
    chainExpansion[iP, groundTerm, Terminals, {rest},
     Join[
      sentence,
      (* start a new sentence accumulator in this recursion: *)
      chainExpansion[iP, groundTerm, Terminals, randomAlt, {}, i + 1, 
       iLim]],
     i + 1, iLim]]])
chainExpansion[iP_, groundTerm_, T_, production_,
   sentence_, i_, iLim_] :=
  chooseFromAlternatives[
   iP[groundTerm],
   RandomReal[]];
ClearAll[generateSentence];
generateSentence[iP_, groundTerm_, T_, recursionLimit : 100] :=
 chainExpansion[iP, groundTerm, T, {Start}, {}, 0, recursionLimit]
ClearAll[expressionStringFromSentenceRules, 
  expressionStringFromSentence];
expressionStringFromSentenceRules = {};
expressionStringFromSentence[sentence_] :=
  sentence /. expressionStringFromSentenceRules // StringJoin;
ClearAll[parse, remToks, partTree];
remToks[list_List] := First@list;
partTree[list_List] := First@Rest@list;

parse[{}, tree_] := {{}, tree};

parse[{tok : Alternatives @@ {"p", "q", "r", "s"}, toks___}, 
   tree_: Null] := 
  {{toks}, Proposition[tok]};

parse[{tok : Alternatives @@ {"N"}, toks___}, tree_: Null] :=
  With[{R = parse[{toks}]},
   {remToks@R, Unary[tok, partTree@R]}];

parse[{tok : Alternatives @@ {"C", "A", "K", "E"}, toks___}, 
   tree_: Null] :=
  With[{L = parse[{toks}]},
   With[{R = parse[remToks@L]},
    {remToks@R, Binary[tok, partTree@L, partTree@R]}]];

(*parse[xs___]:=Throw[{"PARSE: CATASTROPHE: ", xs}];*)
Module[{foo},
 Manipulate[foo, Button["Gen", foo =
    With[{sen = generateSentence[iP, Proposition, T, 100]},
     With[{tpt = Timing@partTree@parse@sen},
      With[{s = expressionStringFromSentence @ sen},
       With[{e = ToExpression @ s},
        With[{c =
           
           Column[{sen, s, e, Length@sen Leaves, 
             ToString@tpt[[1]]*Seconds,
             TreeForm[tpt[[2]], VertexLabeling -> Automatic],
             tpt[[2]]
             }, Frame -> All]},
         c]]]]]]]]