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]