Linking points in separate lists in ListPlot (updated)

Question

Updated: I have two lists (of different lengths) of co-ordinates, in the form {x,y,"tag"}, that I wish to plot so that one list is graphically linked to the other list via their tags. In other words, I want to show the parent-daughter relationships between two datasets on a plot. Here is some example code:

parents = {Flatten@{RandomReal[10, 2], "p1" (*parent 1*)}, 
   Flatten@{RandomReal[10, 2], "p2" (*parent 2*)}}

daughters = 
  Partition[
   Flatten@Thread@
     List[Partition[RandomReal[10, 12], 2], {"d1", "d1", "d1", "d2", "d2", "d2"}], 3]

(* d1 corresponds to p1, etc. *)

ListPlot[{parents[[All, 1 ;; 2]], daughters[[All, 1 ;; 2]]}, 
 PlotMarkers -> {{"\[FilledSquare]", 18}, {"\[FilledDiamond]", 18}}, 
 AxesOrigin -> {0, 0}]

which produces the following:

{{3.89794, 6.38947, "p1"}, {2.97147, 2.27053, "p2"}}

{{5.05879, 8.04477, "d1"}, {3.94848, 0.52971, "d1"}, {0.310406, 5.55621, "d1"},
 {8.058, 4.5872, "d2"}, {9.64885, 3.806, "d2"}, {9.63257, 7.76892, "d2"}}

What I want to end up with is something like this:

I think this may be achieved with Epilog but I am unsure about how to utilise the 'tags' effectively. Does anyone know how to do this?

Also, the number daughters relative to parents (although consistent in the above example) needs to be variable (e.g. 1 parent - 10 daughters,1 parent - 2 daughters, etc.)

---

EDIT: Just to clarify/extend the usefulness of what i'm trying to achieve (taking on board what was said by Halirutan and Mr Wizard in their answers), here is an amended example:

parents = {Flatten@{RandomReal[10, 2], "cats" }, 
  Flatten@{RandomReal[10, 2], "dogs"}, 
  Flatten@{RandomReal[10, 2], "frogs" }}

children = 
 Partition[
  Flatten@Thread@
    List[Partition[RandomReal[10, 18], 2], {"kittens", "kittens", 
      "kittens", "puppies", "puppies", "puppies", "tadpoles", 
      "tadpoles", "tadpoles"}], 3]
(* kittens corresponds to cats, etc. *)

ListPlot[{parents[[All, 1 ;; 2]], children[[All, 1 ;; 2]]}, 
 PlotMarkers -> {{"\[FilledSquare]", 18}, {"\[FilledDiamond]", 18}}, 
 AxesOrigin -> {0, 0}]

The output is essentially the same as above, however, the tags are unique and need to be related to each other explicitly. How do I tell Mathematica that kittens come from cats?

Update2: For those who are interested here is an example of one of the plots created as a result of the answers:

The filled circles are starting compositions (made from various natural and synthetic rocktypes) for melting experiments between 700 - 1100 degC and 1 - 15 kbar. The diamonds are partial melts resulting from the incongruent melting of the starting material. The darker diamonds are low-pressure experiments. The lighter diamonds are high-pressure experiments. The small dots in the background are natural granite compositions for comparison.

A first order observation is that the melts are always less mafic (MgO+FeO) than the starting material (and generally more potassic). One would expect that this phenomena would lead to the formation of more mafic residue if melt is lost from the system.

Thanks again!

Answer 1

Okay, the updated and clarified question is significantly different from the original. You need a look-up table to convert the child types to the parent types, or vice versa. Two standard methods are indexed objects such as tab["kitten"] = "cats", or Rule lists. Rule lists should be optimized with Dispatch if they are long. I find rule lists more convenient when the data does not need to be changed often, and indexed objects better when it does.

Using the definitions made in your EDIT section of the question:

rls = {"kittens" -> "cats", "puppies" -> "dogs", "tadpoles" -> "frogs"};

GatherBy[parents ~Join~ children, #[[3]] /. rls &][[All, All, ;; 2]];

lines = Tuples@{{#}, {##2}} & @@@ %;

ListPlot[
 {parents, children}[[All, All, ;; 2]],
 PlotMarkers -> {{"\[FilledSquare]", 18}, {"\[FilledDiamond]", 18}},
 AxesOrigin -> {0, 0},
 Epilog -> Riffle[Line /@ lines, {Red, Blue}]
]

If you wish to use indexed objects replace the first two lines with:

lt["kittens"]  = "cats";
lt["puppies"]  = "dogs";
lt["tadpoles"] = "frogs";
lt[other_]    := other

GatherBy[parents ~Join~ children, lt @ #[[3]] &][[All, All, ;; 2]];

Answer 2

Your data-structure is not chosen very well. To find out that "d123" is related to "p123" you have to drop the first letter of the strings and then compare them. This looks ugly in the implementation but nevertheless you can do it.

First, think of a function which takes one parent and all children, and then selects the matching children and draws a collection of lines

makeLines[parent_, children_] := 
 Line[{Most[parent], Most[#]} & /@ 
   Select[children, 
    StringDrop[Last[parent], 1] === StringDrop[Last[#], 1] &]]

Let me say a few words to the above function. The Select gets the list of children (you call it daughters) from where it should select all daughters having the same label as parent. Unfortunately, the number is a string having the form "p1", "p4" or "d2" or .... Let's look how we can extract the id from the label

{3.89794, 6.38947, "p1"}

Now I want the last element of this: Last. From this, I want to remove the "p" which means I have to StringDrop exactly 1.

StringDrop[Last[{3.89794, 6.38947, "p1"}], 1]
(* 1 *)

The select call now runs through all daughters. This means, I have to do the same for all daughters. Our comparison whether a parent and a daughter matches is then the following pure function

StringDrop[Last[parent], 1] === StringDrop[Last[#], 1] &]

The result of Select is now a list of matching daughters. Now we want to draw for every daughter a line from its parent. To extract the coordinates only from something like {3.89794, 6.38947, "p1"} I use Most, which drops the last element.

This means a function creating the coordinates to draw a line from the parent to one daughter looks like this

{Most[parent], Most[#]}&

When we Map this function over the list of daughters, we get exactly the structure we can use for Line.

What's left is to create this collection of lines for each parent and Show it together with your plot

Show[
 ListPlot[{parents[[All, 1 ;; 2]], daughters[[All, 1 ;; 2]]}, 
  PlotMarkers -> {{"\[FilledSquare]", 18}, {"\[FilledDiamond]", 18}}, 
  AxesOrigin -> {0, 0}],
 Graphics[makeLines[#, daughters] & /@ parents]
 ]

Answer 3

Here is a somewhat ad-hoc implementation, that just isolates your child-parent relationship in it's own function, and then allows you to define whatever relations you want though definitions of it:

parentChildLines[parents_, children_] := Outer[
  If[childQ[#1, #2], Line[{#1[[1 ;; 2]], #2[[1 ;; 2]]}], {}] &
  , parents, children, 1] // Flatten

You can then define your parent/child relations in definitions of childQ, for instance for your fist example:

childQ[_, _] = False;
childQ[{_, _, "p1"}, {_, _, "d1"}] = True;
childQ[{_, _, "p2"}, {_, _, "d2"}] = True;

For your updated case you would use for instance:

childQ[{_,_,"cat"},{_,_,"kittens"}] = True;

To plot it you simply add the epilog:

ListPlot[{parents[[All, 1 ;; 2]], children[[All, 1 ;; 2]]}, 
 PlotMarkers -> {{"\[FilledSquare]", 18}, {"\[FilledDiamond]", 18}}, 
 AxesOrigin -> {0, 0}, Epilog -> parentChildLines[parents, children]]