Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Making nice-looking Legend for Plot

  • To: mathgroup at smc.vnet.net
  • Subject: [mg89879] Re: Making nice-looking Legend for Plot
  • From: lehin.p at gmail.com
  • Date: Tue, 24 Jun 2008 03:19:37 -0400 (EDT)
  • References: <g35g09$9bm$1@smc.vnet.net>

Hello,
I have developed a method for making the plot I have mentioned before.
The following is the solution I have found (the only worth thing is
changing the Ticks positioning that as I believe is a bug in
AbsoluteOptions[]):

(*Creating the Plot*)
expData = {{{{303.15`, 178.9`}, {308.15`, 171.9`}, {313.15`,
      164.7`}, {318.15`, 157.8`}, {323.15`, 151}, {333.15`, 137.5`}},
    "Author 1"}, {{{313.15`, 165}, {333.15`, 139.5`}, {353.15`,
      118.5`}, {373.15`, 101}, {393.15`, 87.2`}, {413.15`,
      75.5`}, {433.15`, 65}, {453.15`, 56}, {473.15`, 48}},
    "Author 2"}, {{{303.65`, 175.7`}, {305.65`, 172.9`}, {308.15`,
      169.7`}, {310.65`, 166.1`}, {313.15`, 162.7`}}, "Author 3"}};
approxData[
  T_] := (a + b T + c T^2 + d T^3 /. {a -> 0.15975*10^4,
     b -> -0.90451*10^1, c -> 0.18345*10^-1, d -> -0.12998*10^-4}) /;
  303 <= T <= 473
a = Plot[Tooltip[approxData[T], "NMA"], {T, 300, 493},
   AxesLabel -> {"\!\(\*
StyleBox[\"T\",\nFontSlant->\"Italic\"]\), K", "\[CurlyEpsilon]"}];
b = ListPlot[Thread[Tooltip[##]] & @@@ expData,
   PlotMarkers -> {Automatic, 6}];
plot = Show[a, b, PlotRangeClipping -> False, PlotRange -> All];
(*Adding the Legend*)
names = expData[[All, 2]];(*The list of labels of datasets*)
ll = Cases[plot, List[h_, Inset[x_, _], ___] -> Style[x, h],
  Infinity];(*extracting the list of PlotMarkers*)
ins = Grid[Table[{ll[[i]], names[[i]]}, {i, 1, Length[ll]}],
  Frame -> True];
result = Show[plot, ImageSize -> Medium,
  Epilog -> Inset[ins, {450, 160}]]
(*The next section customizes tick lengths*)
TickLengthMultipliers = {3, 3,
  1};(*Multipliers for the length of {x,y,z}-ticks*)
myRound =
 If[TrueQ[Abs[# - Round[#]] < 2 $MachineEpsilon],
   Round[#], #] &;(*Remove the dot "." after integers*)
MyControl =
 Show[#, Ticks -> (ticks = (Ticks /. AbsoluteOptions[#, Ticks])[[All,
       All, {1, 2, 3}]];
     Do[ticks =
       MapAt[myRound, ticks,
        Table[{j, i, 2}, {i, 1, Length[ticks[[j]]]}]], {j, 1,
       Length[ticks]}];
     Do[ticks =
       MapAt[(TickLengthMultipliers[[j]]*#) &, ticks,
        Table[{j, i, 3}, {i, 1, Length[ticks[[j]]]}]], {j, 1,
       Length[ticks]}]; ticks)] &;
result2 = MyControl[result]
(*Exporting the result*)
Export["C:\\1.pdf", result2]
Export["C:\\1.bmp", result2, ImageResolution -> 300]


  • Prev by Date: Re: strange behaviour of background color in Panel[]
  • Next by Date: Re: Mathematica performance improvements
  • Previous by thread: Re: Making nice-looking Legend for Plot
  • Next by thread: Re: Making nice-looking Legend for Plot