Confusion Networks from Speech Recognition

cnet = {
   {{"Hi", 0.7}, {"My", 0.1}, {"I", 0.1}, {"-", 0.1}},
   {{"my", 0.5}, {"-", 0.3}, {"I'm", 0.2}},
   {{"name", 0.8}, {"named", 0.2}},
   {{"is", 0.6}, {"uh", 0.3}, {"-", 0.1}},
   {{"Matt", 0.5}, {"not", 0.3}, {"-", 0.2}},
   {{"-", 0.9}, {"eh", 0.1}}
   };

PlotCNet[c_] :=
  Module[{cnet = Map[SortBy[#, Last] &, c], l}, Graphics[{
     Table[Table[l = Length@cnet[[i]]; {
        Thickness[Exp[cnet[[i, j, 2]]]/300],
        Blend[{Red, Blue}, cnet[[i, j, 2]]],
        BezierCurve[{{i, 0}, {i + 0.5, j - (l + 1)/2}, {i + 1, 0}}],
        EdgeForm[Black], FaceForm[White],
        Rectangle[{i + 0.5, (j - (l + 1)/2)/2} - {0.3,
           0.1}, {i + 0.5, (j - (l + 1)/2)/2} + {0.3, 0.1}],
        Black,
        Text[cnet[[i, j, 1]], {i + 0.5, (j - (l + 1)/2)/2}]
        }, {j, Length@cnet[[i]]}], {i, Length@cnet}]
     }]];

NBest[cnet_] := Module[{top = {{0, {""}}}, newtop = {}},
   Do[
    newtop = {};
    Do[
     AppendTo[
      newtop, {top[[i, 1]] + Log[cnet[[j, k, 2]]],
       Join[top[[i, 2]], {cnet[[j, k, 1]]}]}]
     ,
     {i, Length@top}, {k, Length@cnet[[j]]}];
    newtop = Reverse@SortBy[newtop, First];
    top = newtop[[;; Min[20, Length@newtop]]];
    , {j, Length@cnet}];
   top = top[[;; Min[10, Length@top]]];
   Table[{Exp[3*First[t]]/Total[Exp[3*First /@ top]], Last[t]}, {t,
     top}]
   ];

nbest = NBest[cnet];

DrawHyp[c_, hyp_, t_, n_] :=
  Module[{i, cnet = Map[SortBy[#, Last] &, c], points},
   points =
    Table[{{i,
       0}, {i +
        0.5, (Position[First /@ cnet[[i]], hyp[[2, i + 1]]])[[1,
          1]] - (Length[cnet[[i]]] + 1)/2}, {i + 1, 0}}, {i,
      Length@cnet}];
   points = Map[f[#, t, n] &, points, {2}];
   Show[
    PlotCNet[cnet],
    Graphics[{Thickness[Exp[hyp[[1]]]/300],
      Blend[{Red, Blue}, hyp[[1]]],
      BezierCurve[points], Black,
      i = 1;
      Table[i++;
       Text[hyp[[2, i]],
        p + {0, 0.1 t}], {p, ({First@#, Last@#/(2 - t)}) & /@
         Partition[Flatten[Map[#[[2]] &, points]], 2]}]}]
    ]
   ];
f[p_, t_, n_] := (1 - t) p + t {p[[1]]/2, 2.5 - n/4};

NBestAnim[cnet_, nbest_, t_] := Module[{n, \[Tau], bg},
   n = Floor[t] + 1;
   \[Tau] = t - Floor[t];
   bg = Show[
     Join[{Graphics[{}],
       Table[DrawHyp[cnet, nbest[[i]], 1, i], {i, n - 1}]}]];
   Show[bg, DrawHyp[cnet, nbest[[n]], \[Tau], n]]
   ];
Manipulate[NBestAnim[cnet, nbest, t], {t, 0, 5}]