How do I make the color of arrowheads in a graph different from the colors of the arrows?

Question

I'm graphing a Markov process

mp = DiscreteMarkovProcess[{1, 0, 0}, ({
     {0.6, 0.1, 0.3},
     {0.2, 0.7, 0.1},
     {0.3, 0.3, 0.4}
    })];

and would like to have arrows whose thicknesses corresponds to the transition probabilities, with arrowheads of a different color in the exact center of each edge. But all my attempts end up a mess.

g = Graph[mp];
Scan[(PropertyValue[{g, #}, EdgeLabels] = 
     PropertyValue[{g, #}, "Probability"]) &, EdgeList[g]];
Scan[(PropertyValue[{g, #}, EdgeStyle] =
     Directive[Arrowheads[{{.045, .575}}], GrayLevel[.7], 
      Thickness[PropertyValue[{g, #}, "Probability"]/20]]) &, 
  EdgeList[g]];
g

The thick edges leave gaps between their ends and the nodes of the graph, and I can't figure out how to change the color of the arrow heads so that they stand out against the color of the edges.

How can I change the color of the arrowheads in my figure. How can I avoid the gaps that appear between nodes and the ends of the edges?

Answer 1

Using an EdgeShapeFunction seems to do what you want. Adapting from the examples in the help:

ef[pts_List, e_] :=
 {Arrowheads[{{0.1, 0.5, Graphics@{Red, Arrowheads[0.5], Arrow[{{0, 0}, {0.5, 0}}]}}}], 
  Arrow[pts]}

g = Graph[mp];
Scan[(PropertyValue[{g, #}, EdgeLabels] = 
    PropertyValue[{g, #}, "Probability"]) &, EdgeList[g]];
Scan[(PropertyValue[{g, #}, EdgeStyle] = 
    Directive[GrayLevel[.7], Thickness[PropertyValue[{g, #}, "Probability"]/20]]) &, 
    EdgeList[g]];
Scan[(PropertyValue[{g, #}, EdgeShapeFunction] = ef) &, EdgeList[g]];
g

It's a bit ugly, with mysterious red dots within the arrowheads. But this only reflects how little time I've put into it. With some competence and patience I suspect it could do what you want.

Edit: Something nicer:

ef[pts_List, e_] := {Arrowheads[{{0.02, 0.65, 
    Graphics@{Red, EdgeForm[Gray], Polygon[{{-1.5, -1}, {1.5, 0}, {-1.5, 1}}]}
  }}], Arrow[pts]}

Answer 2

If you don't mind having a Graphics object, you can replace the Arrowheads directives with wxffles's Arrowheads specification, and get to keep the arc shapes of the orginial g:

arrowheads = Arrowheads[{{0.02, 0.65, Graphics@{Red, EdgeForm[Gray], 
    Polygon[{{-1.5, -1}, {1.5, 0}, {-1.5, 1}}]}}}];

g2 = Show[g] /. TagBox -> (# &) /. _Arrowheads :> arrowheads

If you have to have a Graph object, you can extract the edge primitives from g2 and use them as EdgeShapeFunction for g:

edgehapefunctions = Function /@ 
   Cases[g2[[1]], {dirs___, _Arrowheads, _ArrowBox}, {0, Infinity}];

SetProperty[g, EdgeShapeFunction -> Thread[EdgeList[g] -> edgehapefunctions]]