Positioning Vertices in a Graph

Question

I made a graph that has a given number at each vertex:

I want to place vertex 1 above vertex 2 if value of vertex 1 is larger than of vertex 2. And also, vertices with same value should be located on the same horizontal line.

Above graph satisfies the condition. (I think because of luck.)

But, another graph constructed by the same function does not satisfy it:

Here 5 is not above 2.

How can I implement this condition?

(The height of the gap between 2 and 5 does not need to be exactly 3 times the height gap between 1 and 2.)

==== Editted ====

Here is the code for function makes the graph. (I simplified it.)

LatticeGraph[group_] :=
    Module[{subgroup = (*omitted*), nodes, edges, list},
        nodes = Table[Property[Labeled[i, Placed[subgroup[[i]], Center]],(*VertexStyle Omitted*)], {i, 1, Length[subgroup]}];
        list = {(*Omitted and it's used for generate edges*)}
        edges = {(*Omitted and it was just the list of v1->v2*)};

        Graph[nodes, edges, VertexSize -> Large,EdgeShapeFunction -> GraphElementData["Line"], ImagePadding -> 20]]

Answer 1

vertices = Range[7];
labels = {10, 5, 2, 2, 2, 2, 1};
(* Note: if labels is not already sorted in descending order, 
   use labels = Sort[labels, Greater] -- thanks: @TeakeNutma  *)
labels2 = Thread[vertices -> 
         (Placed[#, Center] & /@ (Rotate[#, 90 Degree] & /@labels))];
vp = Last /@ Tally[labels]; (*thanks: Oska *)
edges = UndirectedEdge @@@ {{1, 2}, {1, 3}, {1, 4}, {1, 5}, 
                            {1, 6}, {2, 7}, {3, 7}, {4, 7}, {5, 7}, {6, 7}};

Rotate[
  Graph[vertices, edges,
        VertexLabels -> labels2,
        VertexSize -> Large,
        GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> vp}], -90 Degree]

Update: To deal with overlapping edges,

Modify vertex coordinates for selected edges:

vertices2 = Range[8];
newedges = UndirectedEdge @@@ {{1, 8}, {8, 7}};
edges2 = Join[edges, newedges] /. {7 -> 8, 8 -> 7};
labels2 = {10, 5, 2, 2, 2, 2, 2, 1};
labels2b =  Thread[vertices2 -> (Placed[#, Center] & /@ 
                                (Rotate[#, 90 Degree] & /@ labels2))];
vp2 = Last /@ Tally[labels2]; 

gA = Graph[vertices2, edges2, VertexLabels -> labels2b, 
          VertexSize -> Large, 
          GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> vp2}];
vc = # /.  MapIndexed[#1 -> #1 + {0, (-1)^(First@#2) .15} &, 
                      Cases[#, {_, 0.}][[2 ;; -2]]] &@GraphEmbedding[gA];
Rotate[SetProperty[gA, VertexCoordinates -> vc], -90 Degree]

Or, keep the VertexCoordinates and use an EdgeShapeFunction to curve selected edges:

esF = Function[{pts}, 
        If[pts[[1, 2]] == pts[[2, 2]] && pts[[2, 1]] - pts[[1, 1]] > 1, 
           BezierCurve[{pts[[1]], {(pts[[1, 1]] + pts[[2, 1]])/2, 
                      pts[[2, 2]] + (-1)^(1 + Round[pts[[1, 1]]]) (#)}, pts[[2]]}], 
           Line[{pts[[1]], pts[[2]]}]]] &;
gB = Graph[vertices2, edges2, VertexLabels -> labels2b, 
          VertexSize -> Large, 
          GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> vp2},
          EdgeShapeFunction -> esF[.3]];
Rotate[gB, -90 Degree]

Answer 2

What you are looking for is a kind of Hasse diagram. Unfortunately, there is no GraphLayout that does exactly what you want out of the box. (Although kguler has shown in his answer you can coax "MultipartiteEmbedding" into the desired behaviour).

However, it still can also be done with specifying the option VertexCoordinates of Graph. This requires us to compute appropriate coordinates of all vertices based on their label. It's a bit of work, but perfectly doable nonetheless.

Since you haven't given the necessary details of your graph generating function, I'll be using your second example with an additional "2" vertex:

vertices = Thread @ Labeled[Range[8], {10, 2, 2, 2, 2, 5, 1, 2}];
edges    = UndirectedEdge @@@ {
    {1, 2}, {1, 3}, {1, 4}, {1, 5}, {1, 6}, {1, 8},
    {2, 7}, {3, 7}, {4, 7}, {5, 7}, {6, 7}, {7, 8}
}

We need to determine the vertex coordinates from their labels. For this you can write a custom function (which is what I did in the first draft of this answer), but you can also use the power of the Combinatorica package:

Block[{$ContextPath},
  << Combinatorica`;
]

coordinates = Sequence @@@ Extract[
  Combinatorica`HasseDiagram @ Combinatorica`MakeGraph[vertices, Last@#1 < Last@#2 &], 
  2
]

{{0., 4.}, {-1.5, 2.}, {-0.5, 2.}, {0.5, 2.}, {1.5, 2.}, {0., 3.}, {0., 1.}}

Finally, these coordinates can then be plugged into Graph as an argument for VertexCoordinates to get the desired result:

Graph[vertices, edges, VertexCoordinates -> coordinates]

There is overlap in some of the edges; this can be fixed by simply adding a random perturbation to the x-coordinates of the vertices::

perturbedcoordinates = coordinates /. {x_Real, y_Real} :> {x + RandomReal[{-1, 1}/3], y}

Graph[vertices, edges, VertexCoordinates -> perturbedcoordinates]