# Duplicated points not labeled when presented to ListPlot as point->"label"

A minimal working example is given via:

{{{1, 4} -> "A"}, {{2, 2} -> "B"}, {{3, 1} -> "C"}, {{3, 7} ->   "D"}, {{4, 5} -> "E"}, {{4, 5} -> "F"}, {{5, 3} -> "G"}, {{6, 6} ->
"H"}}
ListPlot[%] As can be seen, "E" and "F" have not been labeled. I am happy about a general solution but also a fix-around for this specific problem would be great.

This solution will Merge duplicate keys by joining their Value strings using "," as a separator.

data = {{{1, 4} -> "A"}, {{2, 2} -> "B"}, {{3, 1} -> "C"}, {{3, 7} ->
"D"}, {{4, 5} -> "E"}, {{4, 5} -> "F"}, {{5, 3} ->
"G"}, {{6, 6} -> "H"}}

data // Flatten // GatherBy[#, First] & //
Merge[StringJoin@StringRiffle[#, ","] &] // Normal //
List /@ # & // ListPlot Is this acceptable as a work-around?

list = {{{1, 4} -> "A"}, {{2, 2} -> "B"}, {{3, 1} -> "C"}, {{3, 7} ->
"D"}, {Callout[Callout[{4, 5}, "E", Right], "F",
Left]}, {{5, 3} -> "G"}, {{6, 6} -> "H"}};
ListPlot[list, PlotRange -> All] Here is a procedure to achieve your aim: First we gather all parts with the same position:

(old = Select[GatherBy[lab, (#[[1, 1]]) &], Length[#] > 1 &])


Then we join the labels for points with equal positions:

new = ({#[[1, 1, 1]] -> ToString[Join[#[[All, 1, 2]]]]}) & /@ (old =
Select[GatherBy[lab, (#[[1, 1]]) &], Length[#] > 1 &]);


Then we replace the parts with equal positions by the joined labels:

lab = Join[DeleteElements[lab, Flatten[old, 1]], new];


All together:

lab = {{{1, 4} -> "A"}, {{2, 2} -> "B"}, {{3, 1} -> "C"}, {{3, 7} ->
"D"}, {{4, 5} -> "E"}, {{4, 5} -> "F"}, {{5, 3} ->
"G"}, {{6, 6} -> "H"}};
new = ({#[[1, 1, 1]] -> ToString[Join[#[[All, 1, 2]]]]}) & /@ (old =
Select[GatherBy[lab, (#[[1, 1]]) &], Length[#] > 1 &]);
lab = Join[DeleteElements[lab, Flatten[old, 1]], new];
ListPlot[lab] 