Tom's family how to cross the bridge

A variant of the graph solution. I represent the flashlight as a sixth "person" with a crossing time of zero.

v = With[{s = Subsets[{0, 1, 3, 6, 8, 12}]}, Transpose[{Reverse@s, s}]];

f[{L1_, R1_}, {L2_, R2_}] := cross[R2 ⋂ L1, L2 ⋂ R1]

cross[LtoR : {0, Repeated[_, 2]}, {}] := Max[LtoR]
cross[{}, RtoL : {0, Repeated[_, 2]}] := Max[RtoL]
cross[__] := Infinity

g = WeightedAdjacencyGraph[v, Outer[f, v, v, 1]];

GraphDistance[g, First@v, Last@v]
(* 29. *)

Grid[FindShortestPath[g, First@v, Last@v], Alignment -> {{Right, Left}}]

enter image description here

Brief explanation

  • v is the list of vertices for the graph, it contains every possible way of splitting the six people (actually five people plus one flashlight) between the two sides of the bridge.
  • f takes two such vertices and works out who must cross from left to right, and who from right to left, to change from the first configuration to the second. For example R2 ⋂ L1 is the set of people who are on the right side in configuration 2 and on the left side in configuration 1 - these people must cross from left to right.
  • cross returns the crossing time for a step, which will be the edge weight in the graph. The allowed steps consist of one or two people plus the flashlight crossing in one direction, and nobody crossing in the other direction. Any other step is forbidden and gets an infinite time.
  • The graph is constructed from its weighted adjacency matrix, i.e. the result of applying f to each pair of vertices.
  • The solution is the shortest path from the first configuration {{0, 1, 3, 6, 8, 12}, {}} to the last {{}, {0, 1, 3, 6, 8, 12}}

Without graphs ... I don't see an easy way with them:

a = {1, 3, 6, 8, 12};
b = {};

go[{a_, b_, t_, c_}] := ({Complement[a, #], Join[b, #], t + Max@#, Append[c, #]} &/@ 
                                                                     Subsets[a, {2}])

ret[{a_, b_, t_, c_}] := {Join[a, #], Complement[b, #], t + Max@#, Append[c, #]} &/@
                                                                      Subsets[b, {1}]


gf[x_] := Flatten[go /@ x, 1];
rf[x_] := Flatten[ret /@ x, 1];

res = gf@rf@gf@rf@gf@rf[go /@ {{a, b, 0, {}}} // First];

Select[res, #1[[3]] <= 30 &][[All,3;;]]

(*
{{29, {{1, 3}, {1}, {6, 1}, {3}, {8, 12}, {1}, {3, 1}}}, 
 {29, {{1, 3}, {1}, {6, 1}, {1}, {8, 12}, {3}, {1, 3}}}, 
 {29, {{1, 3}, {1}, {8, 12}, {3}, {1, 6}, {1}, {3, 1}}}, 
 {29, {{1, 3}, {1}, {8, 12}, {3}, {1, 3}, {1}, {6, 1}}}, 
 {29, {{1, 3}, {3}, {8, 12}, {1}, {3, 1}, {1}, {6, 1}}}, 
 {29, {{1, 3}, {3}, {8, 12}, {1}, {6, 1}, {1}, {3, 1}}},
 {29, {{1, 6}, {1}, {3, 1}, {3}, {8, 12}, {1}, {3, 1}}},
 {29, {{1, 6}, {1}, {3, 1}, {1}, {8, 12}, {3}, {1, 3}}}}
*)

Here you have it solved by using graph functions. I don't think you gain anything by doing it this way

a = {1, 3, 6, 8, 12}; int = Intersection; len = Length;
validTransitionFwd[{a_, _}, {x_, _}]  :=  len@a - len@x == 2 && int[a, x] == x
validTransitionBkwd[{a_, _}, {x_, _}] :=  len@x - len@a == 1 && int[a, x] == a
transCost[{s1_, s2_}] := Max[Complement @@@ Transpose@{s1, s2}]

sa = Subsets[Flatten[{#, Reverse@#}&/@ ({Complement[a, #], #} & /@ Subsets@a), 1], {2}];

transitionsFwd = Thread[{{f, b}, #}] & /@ Select[sa, validTransitionFwd @@ # &];
transitionsBwd = Thread[{{b, f}, #}] & /@ Select[sa, validTransitionBkwd @@ # &];

g = Graph[DirectedEdge @@@ #, EdgeWeight -> transCost /@ #[[All, All, 2]]] &@
                                        Union[transitionsBwd, transitionsFwd]

FindShortestPath[g, {f, {{1, 3, 6, 8, 12}, {}}}, {b, {{}, {1, 3, 6, 8,  12}}}][[All, 2]]
(* 
{{{1, 3, 6, 8, 12}, {}}, 
 {{6, 8, 12},       {1, 3}}, 
 {{1, 6, 8, 12},    {3}},
 {{1, 6},           {3, 8, 12}},
 {{1, 3, 6},        {8, 12}},
 {{6},              {1, 3, 8, 12}},
 {{1, 6},           {3, 8, 12}},
 {{},               {1, 3, 6, 8, 12}}}
*)