How to find all possible paths between a collection of vertices in a DAG graph

Question

I have a toy example "system" that is a DAG and has 16 vertices. Suppose I have a collection of vertices "collection". How can I find all paths that passes through at least all vertices present in "collection"? The functions available all seem to work with source and target vertices but not with a collection of vertices.

My only solution up to now is rather naïve and I need to know the source and target vertex. I would like to avoid that if possible.

g = Graph[{1 \[DirectedEdge] 2, 1 \[DirectedEdge] 3, 
     2 \[DirectedEdge] 6, 3 \[DirectedEdge] 7, 3 \[DirectedEdge] 8, 
     7 \[DirectedEdge] 9, 7 \[DirectedEdge] 10, 6 \[DirectedEdge] 11, 
     6 \[DirectedEdge] 12, 12 \[DirectedEdge] 13, 13 \[DirectedEdge] 14, 
     8 \[DirectedEdge] 10, 6 \[DirectedEdge] 10, 12 \[DirectedEdge] 15, 
     15 \[DirectedEdge] 16, 15 \[DirectedEdge] 17, 17 \[DirectedEdge] 14,
     2 \[DirectedEdge] 12, 11 \[DirectedEdge] 16, 10 \[DirectedEdge] 16,
     9 \[DirectedEdge] 16}, VertexLabels->Automatic];
collection = {1, 3, 10, 16};
HighlightGraph[g, collection, VertexLabels -> Automatic]

Now I search for all paths between the vertices 1 and 16

allpaths = FindPath[g, 1, 16, All, All]
HighlightGraph[g, allpaths, ImageSize -> 300]

Now I collect the possible candidates

paths = If[ContainsAll[#, collection], #, Nothing] & /@ allpaths
HighlightGraph[g, paths, ImageSize -> 300]

As asked above are there other ways to do this WITHOUT knowing that I need paths between vertex 1 and 16?

UPDATE 1

In fact the graph I'm investigating is a kind of product knowledge graph. A product can consist of many possible configurations and the software we're using is only checking with some complicated rule based system. I'm investigating doing the same thing based on graphs (combined with some other stuff). By building a graph I can get next to "this product combination will not work" possible options. Something like adding possible products (vertices) and then it works. I believe I should add 1 or more possible endstates. This is not attached to a product and so I know that all vertices in the collection should fit somewhere on the road between the root vertex and one of the possible end states. It might be that the graph becomes to large or to many paths etc but I'm not sure yet about this. I think it should be okay.

So when I add the states (and use vertex 1 as start state) and add some additional paths I get:

system = {1 \[DirectedEdge] 2, 1 \[DirectedEdge] 3, 
  2 \[DirectedEdge] 6, 3 \[DirectedEdge] 7, 3 \[DirectedEdge] 8, 
  7 \[DirectedEdge] 9, 7 \[DirectedEdge] 10, 6 \[DirectedEdge] 11, 
  6 \[DirectedEdge] 12, 12 \[DirectedEdge] 13, 13 \[DirectedEdge] 14, 
  8 \[DirectedEdge] 10, 6 \[DirectedEdge] 10, 12 \[DirectedEdge] 15, 
  15 \[DirectedEdge] 16, 15 \[DirectedEdge] 17, 17 \[DirectedEdge] 14,
   2 \[DirectedEdge] 12, 11 \[DirectedEdge] 16, 10 \[DirectedEdge] 16,
   9 \[DirectedEdge] 16, 7 \[DirectedEdge] 5, 5 \[DirectedEdge] 10, 
  5 \[DirectedEdge] 11, 11 \[DirectedEdge] 15, 1 \[DirectedEdge] 16, 
  16 \[DirectedEdge] "end state 1", 14 \[DirectedEdge] "end state 2", 
  3 \[DirectedEdge] 2, 16 \[DirectedEdge] 17}
collection = {1, 3, 10, 16}
endstates = {"end state 1", "end state 2"}
g = Graph[system, VertexLabels -> Placed[Automatic, {After, Below}], 
  GraphLayout -> {"LayeredDigraphEmbedding", "RootVertex" -> 1}]
allpaths = Flatten[FindPath[g, 1, #, All, All] & /@ endstates, 1]
paths = Select[allpaths, 
  ContainsAll[#, collection] &] (*thanks David G. Stork*)
HighlightGraph[g, DirectedEdge @@@ Partition[#, 2, 1] & /@ paths]

and the paths would be

or

thanks for you help!

HighlightGraph[g, DirectedEdge @@@ Partition[#, 2, 1]] & /@ 
  paths // Multicolumn

Answer 1

Here's a general solution that identifies root vertices and the end states in your graph. We find all paths from the roots to the end states, and select the paths that include all the vertices that are members of a collection. You can investigate possible configurations for multiple end states.

Choose any set of vertices for the collection. You don't need to know the source or target vertices, and they aren't required in the collection.

First, find the vertices for the root and end states, and all the paths. Then we can find the paths that match collection = {1, 3, 10, 16}.

roots = Extract[VertexList[g], 
  Position[VertexInDegree[g], 0]];(* {1} *)
endStates = 
  Extract[VertexList[g], Position[VertexOutDegree[g], 0]];(* {14,16} *)
allPaths = Flatten[Table[
  FindPath[g, i, j, Infinity, All], {i, roots}, {j, endStates}], 2];

collection = {1, 3, 10, 16};
collectionPaths = Select[allPaths, ContainsAll[collection]];
GraphicsGrid[Partition[
  Table[HighlightGraph[g, 
    Flatten[{path, #1 \[DirectedEdge] #2 & @@@ 
       Transpose[{Most@path, Rest@path}]}]],
   {path, collectionPaths}], UpTo[4]]]

We can check another possible configuration by choosing a new collection.

collection = {1, 2, 6, 12};
collectionPaths = Select[allPaths, ContainsAll[collection]];
GraphicsGrid[Partition[
  Table[HighlightGraph[g, 
    Flatten[{path, #1 \[DirectedEdge] #2 & @@@ 
       Transpose[{Most@path, Rest@path}]}]],
   {path, collectionPaths}], UpTo[4]]]

Answer 2

myPaths = FindPath[g, First[collection], Last[collection], Infinity, All];

correctPaths = Select[myPaths, ContainsAll[collection]];

HighlightGraph[g, #] & /@ correctPaths

Or

HighlightGraph[g, #, EdgeStyle -> Red] & /@ 
 Table[Map[(#[[1]] -> #[[2]]) &, 
   Table[Map[(#[[1]] -> #[[2]]) &, (Partition[#, 2, 1] & /@ 
         correctPaths)[[i]]], {i, 2}][[i]]], {i, 2}]