0
$\begingroup$

I would like to plot these x,y data:

FkFl2={{0.108705, 0.505448}, {0.358493, 0.0753008}, {-0.418082, 0.0156307}, {-0.00893736, -0.519801}, {0.341173, -0.170573},{0.139561, 0.546447},{0.0991457, 0.236118}, {-0.408699,0.060441}, {-0.371379, 0.0200262}, {-0.411535, 0.0433609}, {0.254496, -0.28112}}

adding labels, taken from the matrix below, and coordinates vectors for the corresponding point. The plot axes are labelled "F"k and "F"l (k and l defined in the routine =1 and =2 respectively). 

elements={{"SiO2", "Al2O3", "FeO", "MgO", "CaO", "Na2O", "K2O", "TiO2","P2O5","MnO", "Cr2O3"}}

PCA

I used this very naive routine (see below), which despite of this fits for this simple case with a fixed number of 11 elements. 

dataPlot2 = ListPlot[FkFl2, PlotRange -> {{-1, 1}, {-1, 1}}, AxesLabel -> {"F" <> ToString[k], "F" <> ToString[l]}];
blabelEl1 = Graphics[Text[elements[[1, 1]], {FkFl2[[1, 1]], FkFl2[[1, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl1 = Graphics[Line[{{0, 0}, {FkFl2[[1, 1]], FkFl2[[1, 2]]}}]];
blabelEl2 = Graphics[Text[elements[[1, 2]], {FkFl2[[2, 1]], FkFl2[[2, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl2 = Graphics[Line[{{0, 0}, {FkFl2[[2, 1]], FkFl2[[2, 2]]}}]];
blabelEl3 = Graphics[Text[elements[[1, 3]], {FkFl2[[3, 1]], FkFl2[[3, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl3 = Graphics[Line[{{0, 0}, {FkFl2[[3, 1]], FkFl2[[3, 2]]}}]];
blabelEl4 = Graphics[Text[elements[[1, 4]], {FkFl2[[4, 1]], FkFl2[[4, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl4 = Graphics[Line[{{0, 0}, {FkFl2[[4, 1]], FkFl2[[4, 2]]}}]];
blabelEl5 = Graphics[Text[elements[[1, 5]], {FkFl2[[5, 1]], FkFl2[[5, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl5 = Graphics[Line[{{0, 0}, {FkFl2[[5, 1]], FkFl2[[5, 2]]}}]];
blabelEl6 = Graphics[Text[elements[[1, 6]], {FkFl2[[6, 1]], FkFl2[[6, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl6 = Graphics[Line[{{0, 0}, {FkFl2[[6, 1]], FkFl2[[6, 2]]}}]];
blabelEl7 = Graphics[Text[elements[[1, 7]], {FkFl2[[7, 1]], FkFl2[[7, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl7 = Graphics[Line[{{0, 0}, {FkFl2[[7, 1]], FkFl2[[7, 2]]}}]];
blabelEl8 = Graphics[Text[elements[[1, 8]], {FkFl2[[8, 1]], FkFl2[[8, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl8 = Graphics[Line[{{0, 0}, {FkFl2[[8, 1]], FkFl2[[8, 2]]}}]];
blabelEl9 = Graphics[Text[elements[[1, 9]], {FkFl2[[9, 1]], FkFl2[[9, 2]]}],PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl9 = Graphics[Line[{{0, 0}, {FkFl2[[9, 1]], FkFl2[[9, 2]]}}]];
blabelEl10 = Graphics[Text[elements[[1, 10]], {FkFl2[[10, 1]], FkFl2[[10, 2]]}], PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl10 = Graphics[Line[{{0, 0}, {FkFl2[[10, 1]], FkFl2[[10, 2]]}}]];
blabelEl11 = Graphics[Text[elements[[1, 11]], {FkFl2[[11, 1]], FkFl2[[11, 2]]}], PlotRange -> {{-1, 1}, {-1, 1}}];
blineEl11 = Graphics[Line[{{0, 0}, {FkFl2[[11, 1]], FkFl2[[11, 2]]}}]];
Show[dataPlot2, blabelEl1, blabelEl2, blabelEl3, blabelEl4, blabelEl5, blabelEl6, blabelEl7, blabelEl8, blabelEl9, blabelEl10, blabelEl11, blineEl1, blineEl2, blineEl3, blineEl4, blineEl5, blineEl6, blineEl7, blineEl8, blineEl9, blineEl10, blineEl11]

It would be so nice if a could treat a variable number of elements. Do you have any suggestion? I tried with loops (For, Do + Show) but I was not successful in plotting all (data points, lines, labels) at the same time.

|improve this question
$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour and check the faqs! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – user9660 Apr 11 '16 at 13:51
3
$\begingroup$

Here is an interactive approach using Tooltip and DynamicWrapper. The data is reformatted.

f = DynamicModule[{col = Black}, 
   DynamicWrapper[Dynamic[Style[#, col, Bold]], 
    If[CurrentValue["MouseOver"], col = Red; 
     pos = {Red, Thickness[0.01], Arrow[{{0, 0}, {#2, #3}}]}, 
     col = Black; pos = {}]]] &
dat = {#1, Sequence @@ ##2} & @@@ Thread[{elements[[1]], FkFl2}];
col = ColorData[3, #] & /@ Range[11];
With[{g = 
   MapThread[{#1, 
      Tooltip[{Arrow[{{0, 0}, {#2[[2]], #2[[3]]}}]}, #2[[1]], 
       TooltipStyle -> Directive[Red, Bold, 16]]} &, {col, dat}]},
 Row[{
   Dynamic@
    Graphics[Append[g, pos], ImageSize -> 400, Axes -> True, 
     Frame -> True, FrameLabel -> {"F1", "F2"}, 
     PlotRange -> {{-1, 1}, {-1, 1}}], Column[f @@@ dat]}]]

enter image description here

Or with a legend. Using LineLegend causes flashing thick red arrow, so custom legend:

With[{g = 
   MapThread[{#1, 
      Tooltip[{Arrow[{{0, 0}, {#2[[2]], #2[[3]]}}]}, #2[[1]], 
       TooltipStyle -> Directive[Red, Bold, 16]]} &, {col, dat}]}, 
 Row[{Dynamic@
    Graphics[Append[g, pos], ImageSize -> 400, Axes -> True, 
     Frame -> True, FrameLabel -> {"F1", "F2"}, 
     PlotRange -> {{-1, 1}, {-1, 1}}], 
   Grid@Transpose[{Graphics[{#, Line[{{0, 0}, {2, 0}}]}, 
         PlotRange -> {-0.1, 0.1}, ImageSize -> {30, 2}] & /@ col, 
      f @@@ dat}]}]]

enter image description here

|improve this answer
$\endgroup$
2
$\begingroup$ 
FkFl2 = {{0.108705, 0.505448}, {0.358493, 0.0753008}, {-0.418082, 
    0.0156307}, {-0.00893736, -0.519801}, {0.341173, -0.170573}, \
{0.139561, 0.546447}, {0.0991457, 0.236118}, {-0.408699, 
    0.060441}, {-0.371379, 0.0200262}, {-0.411535, 
    0.0433609}, {0.254496, -0.28112}};

elements = {"SiO2", "Al2O3", "FeO", "MgO", "CaO", "Na2O", "K2O", 
   "TiO2", "P2O5", "MnO", "Cr2O3"};

Grid[({#, ChemicalData[#, "Name"]} & /@ elements) /. 
   ChemicalData[__] :> "", Frame -> All] // Quiet

enter image description here

Graphics[
 {Line[{{0, 0}, #}] & /@ FkFl2,
  Text[#[[1]], #[[2]], -Sign[#[[2]]]] & /@ 
   Transpose[{elements, FkFl2}]},
 Frame -> True,
 PlotRange -> ((MinMax[#] + {-.1, .1}) & /@ {FkFl2[[All, 1]], 
     FkFl2[[All, 2]]})]

enter image description here

|improve this answer
$\endgroup$
2
$\begingroup$

Suppose you are using 10.4 or later version.

ListPlot[MapThread[Labeled,{FkFl2,Flatten[elements]}],AxesLabel->
{"F1","F2"},PlotRange->CoordinateBounds[FkFl2,Scaled[1/7]],ImageSize->Large,
Epilog->{Line[{{0,0},#}&/@FkFl2]},PlotStyle->Black]

|improve this answer
$\endgroup$
1
$\begingroup$ 
Show[ListPlot[FkFl2, PlotRange -> {{-1, 1}, {-1, 1}}, 
AxesLabel -> {"F" <> ToString[k], 
  "F" <> ToString[l]}], #] &@({Graphics[
  Line[{{0, 0}, {FkFl2[[#, 1]], FkFl2[[#, 2]]}}]], 
 Graphics[Text[elements[[1, #]], {FkFl2[[#, 1]], FkFl2[[#, 2]]}]]} & /@ Range[1, Length[FkFl2]])

You will need to read about Map. Also this post is extremely useful.

|improve this answer
$\endgroup$
1
$\begingroup$

Using what you already have done just make these functions and then use Table inside Show

 blabelEl[i_] := 
 Graphics[Text[elements[[1, i]], {FkFl2[[i, 1]], FkFl2[[i, 2]]}], 
 PlotRange -> {{-1, 1}, {-1, 1}}];

blineEl[i_] := 
Graphics[Line[{{0, 0}, {FkFl2[[i, 1]], FkFl2[[i, 2]]}}]];

Show[dataPlot2, Table[{blabelEl[i], blineEl[i]}, {i, 1, Length[FkFl2]}]]
|improve this answer
$\endgroup$
  • $\begingroup$ I believe Flatten is not necessary . $\endgroup$ – BlacKow Apr 11 '16 at 14:07
  • $\begingroup$ Yes you r right. I should have checked. $\endgroup$ – Hubble07 Apr 11 '16 at 14:09
1
$\begingroup$

You can use Epilog to add labels to a plot,

ListPlot[
 FkFl2,
 Epilog -> {
   {Text[#1, 1.2*#2], 
      Line[{{0, 0}, #2}]} & @@@ (Transpose@{First@elements, FkFl2})
   }
 , PlotRange -> {{-1, 1}, {-1, 1}}
 ]
|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.