Return to Answer

format the code for readability

edited May 13, 2019 at 21:52

72.3k
3
152
317

(Does anyone use GraphicsGrid? It seems like a trainwreck to me, with wild amounts of spacings that you can get rid of by manually tweaking them, but they crop right back up when you try to scale the image to a larger size).

So with the data defined as

getMaxPadding[p_List] := Map[Max, (BorderDimensions@ Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{2}, {3}}, {2}] + 1; combinedplot[data_, xrange_, yrange_, plotopts : OptionsPattern[]] := Module[ Module[ {rightdata, topdata, dy, contourplot, rightplot, topplot,  padding, dimensions},   rightdata = Total /@Map[Total, data;data];   topdata = Total[data];Total @ data;   dy = (yrange[[2]]Part[yrange, 2] + -Part[yrange, yrange[[1]]1]) / (Length[rightdata] - 1.0);   rightdata = Transpose[ Transpose[{rightdata,  {rightdata, Table[n, {n, yrange[[1]], yrange[[2]], dy}]} ];   contourplot = ListContourPlot[data, ListContourPlot[data,  DataRange -> {xrange, yrange},    ContourShading -> None, Contours -> 30,  PlotRange -> {xrange, yrange, All},    ContourStyle -> Table[ Table[ {Thick, Blend[{Blue, Green, Yellow, Red}, n]},  {n, 1 / 30,   1, 1 / 30}  1, 1/30} ],  Evaluate[FilterRules[ Evaluate @ FilterRules[{plotopts}, Options[ListContourPlot]]],Options @ ListContourPlot],   PlotRangePadding -> 0(*,ImageSize->300*) ];   padding = getMaxPadding[getMaxPadding @ {contourplot}];;   dimensions = ImageDimensions[contourplot];ImageDimensions @ contourplot;   rightplot = ListLinePlot[rightdata, ListLinePlot[rightdata,  PlotStyle -> {{Red, Thickness[Thickness[0.04]}},    Axes -> False, PlotRange -> All,  ImageSize -> {Automatic, dimensions[[2]]}Part[dimensions, 2]},   ImagePadding -> {{0, 5}, padding[[2]]Part[padding, 2]},  PlotRangePadding -> 0,  AspectRatio -> 5  AspectRatio -> 5];];   topplot = ListLinePlot[topdata, ListLinePlot[topdata,  PlotRange -> All, DataRange -> xrange,  Axes -> False, PlotStyle -> {{Thickness[Thickness[0.008], Red}},    ImageSize -> {dimensions[[1]]Part[dimensions, 1], Automatic},  AspectRatio -> (1 / 5),    PlotRangePadding -> 0, ImagePadding -> {padding[[1]]Part[padding, 1], {0, 10}} ];   Grid[{{topplot, Null}, {contourplot, rightplot}},    Alignment -> Bottom]];Bottom ] ];

So with the data defined as

getMaxPadding[p_List] := Map[Max, (BorderDimensions@ Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{2}, {3}}, {2}] + 1; combinedplot[data_, xrange_, yrange_, plotopts : OptionsPattern[]] := Module[{rightdata, topdata, dy, contourplot, rightplot, topplot,  padding, dimensions}, rightdata = Total /@ data; topdata = Total[data]; dy = (yrange[[2]] - yrange[[1]])/(Length[rightdata] - 1.0); rightdata = Transpose[{rightdata,  Table[n, {n, yrange[[1]], yrange[[2]], dy}]}]; contourplot = ListContourPlot[data, DataRange -> {xrange, yrange},  ContourShading -> None, Contours -> 30,  PlotRange -> {xrange, yrange, All},  ContourStyle -> Table[{Thick, Blend[{Blue, Green, Yellow, Red}, n]}, {n, 1/30,    1, 1/30}],  Evaluate[FilterRules[{plotopts}, Options[ListContourPlot]]], PlotRangePadding -> 0(*,ImageSize->300*)]; padding = getMaxPadding[{contourplot}]; dimensions = ImageDimensions[contourplot]; rightplot = ListLinePlot[rightdata, PlotStyle -> {{Red, Thickness[.04]}},  Axes -> False, PlotRange -> All,  ImageSize -> {Automatic, dimensions[[2]]}, ImagePadding -> {{0, 5}, padding[[2]]}, PlotRangePadding -> 0,   AspectRatio -> 5]; topplot = ListLinePlot[topdata, PlotRange -> All, DataRange -> xrange,  Axes -> False, PlotStyle -> {{Thickness[.008], Red}},  ImageSize -> {dimensions[[1]], Automatic}, AspectRatio -> 1/5,  PlotRangePadding -> 0, ImagePadding -> {padding[[1]], {0, 10}}]; Grid[{{topplot, Null}, {contourplot, rightplot}},  Alignment -> Bottom]];

So with the data defined as

getMaxPadding[p_List] := Map[Max, (BorderDimensions@ Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{2}, {3}}, {2}] + 1; combinedplot[data_, xrange_, yrange_, plotopts:OptionsPattern[]] := Module[  {rightdata, topdata, dy, contourplot, rightplot, topplot, padding, dimensions},   rightdata = Map[Total, data];   topdata = Total @ data;   dy = (Part[yrange, 2] + -Part[yrange, 1]) / (Length[rightdata] - 1.);   rightdata = Transpose[ {rightdata, Table[n, {n, yrange[[1]], yrange[[2]], dy}]} ];   contourplot = ListContourPlot[data,   DataRange -> {xrange, yrange},   ContourShading -> None, Contours -> 30, PlotRange -> {xrange, yrange, All},   ContourStyle -> Table[  {Thick, Blend[{Blue, Green, Yellow, Red}, n]},  {n, 1 / 30, 1, 1 / 30}   ],  Evaluate @ FilterRules[{plotopts}, Options @ ListContourPlot],   PlotRangePadding -> 0 ];   padding = getMaxPadding @ {contourplot};   dimensions = ImageDimensions @ contourplot;   rightplot = ListLinePlot[rightdata,   PlotStyle -> {{Red, Thickness[0.04]}},   Axes -> False, PlotRange -> All, ImageSize -> {Automatic, Part[dimensions, 2]},   ImagePadding -> {{0, 5}, Part[padding, 2]},  PlotRangePadding -> 0, AspectRatio -> 5  ];   topplot = ListLinePlot[topdata,   PlotRange -> All, DataRange -> xrange, Axes -> False, PlotStyle -> {{Thickness[0.008], Red}},   ImageSize -> {Part[dimensions, 1], Automatic},  AspectRatio -> (1 / 5),   PlotRangePadding -> 0, ImagePadding -> {Part[padding, 1], {0, 10}} ];   Grid[{{topplot, Null}, {contourplot, rightplot}},   Alignment -> Bottom ] ];

deleted 70 characters in body

Source Link

edited Dec 11, 2015 at 15:39

Jason B.

72.3k
3
152
317

xrange={8,19}; yrange={6,16}; twoDlist=Table[Abs[I/(\[Omega]1ω1-14+I) I/(\[Omega]2ω2-11+I)+(I/3)/(\[Omega]1ω1-8+I/3) I/(\[Omega]2ω2-16+I)],{\[Omega]1ω1,yrange[[1]],yrange[[2]],.05},{\[Omega]2ω2,xrange[[1]],xrange[[2]],.05}];

Grid[{{ combinedplot[twoDlist, xrange, yrange, ImageSize -> 250], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30, FrameLabel -> {Style[ "\!\(\*SubscriptBox[\(\[CapitalOmega]\Ω\), \(1\)]\)", 30], Style["\!\(\*SubscriptBox[\(\[CapitalOmega]\Ω\), \(3\)]\)", 30]}, FrameStyle -> Thick] }}]

xrange={8,19}; yrange={6,16}; twoDlist=Table[Abs[I/(\[Omega]1-14+I) I/(\[Omega]2-11+I)+(I/3)/(\[Omega]1-8+I/3) I/(\[Omega]2-16+I)],{\[Omega]1,yrange[[1]],yrange[[2]],.05},{\[Omega]2,xrange[[1]],xrange[[2]],.05}];

Grid[{{ combinedplot[twoDlist, xrange, yrange, ImageSize -> 250], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30, FrameLabel -> {Style[ "\!\(\*SubscriptBox[\(\[CapitalOmega]\), \(1\)]\)", 30], Style["\!\(\*SubscriptBox[\(\[CapitalOmega]\), \(3\)]\)", 30]}, FrameStyle -> Thick] }}]

xrange={8,19}; yrange={6,16}; twoDlist=Table[Abs[I/(ω1-14+I) I/(ω2-11+I)+(I/3)/(ω1-8+I/3) I/(ω2-16+I)],{ω1,yrange[[1]],yrange[[2]],.05},{ω2,xrange[[1]],xrange[[2]],.05}];

Grid[{{ combinedplot[twoDlist, xrange, yrange, ImageSize -> 250], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30, FrameLabel -> {Style[ "\!\(\*SubscriptBox[\(Ω\), \(1\)]\)", 30], Style["\!\(\*SubscriptBox[\(Ω\), \(3\)]\)", 30]}, FrameStyle -> Thick] }}]

Source Link

answered Oct 23, 2012 at 22:34

user4368

72.3k
3
152
317

With help from rm-rf, I was able to figure this out. The key lies in setting the ImagePadding the same for each plot, then combining them with Grid.

So with the data defined as

xrange={8,19}; yrange={6,16}; twoDlist=Table[Abs[I/(\[Omega]1-14+I) I/(\[Omega]2-11+I)+(I/3)/(\[Omega]1-8+I/3) I/(\[Omega]2-16+I)],{\[Omega]1,yrange[[1]],yrange[[2]],.05},{\[Omega]2,xrange[[1]],xrange[[2]],.05}];

and the function defined as

getMaxPadding[p_List] := Map[Max, (BorderDimensions@ Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{2}, {3}}, {2}] + 1; combinedplot[data_, xrange_, yrange_, plotopts : OptionsPattern[]] := Module[{rightdata, topdata, dy, contourplot, rightplot, topplot, padding, dimensions}, rightdata = Total /@ data; topdata = Total[data]; dy = (yrange[[2]] - yrange[[1]])/(Length[rightdata] - 1.0); rightdata = Transpose[{rightdata, Table[n, {n, yrange[[1]], yrange[[2]], dy}]}]; contourplot = ListContourPlot[data, DataRange -> {xrange, yrange}, ContourShading -> None, Contours -> 30, PlotRange -> {xrange, yrange, All}, ContourStyle -> Table[{Thick, Blend[{Blue, Green, Yellow, Red}, n]}, {n, 1/30, 1, 1/30}], Evaluate[FilterRules[{plotopts}, Options[ListContourPlot]]], PlotRangePadding -> 0(*,ImageSize->300*)]; padding = getMaxPadding[{contourplot}]; dimensions = ImageDimensions[contourplot]; rightplot = ListLinePlot[rightdata, PlotStyle -> {{Red, Thickness[.04]}}, Axes -> False, PlotRange -> All, ImageSize -> {Automatic, dimensions[[2]]}, ImagePadding -> {{0, 5}, padding[[2]]}, PlotRangePadding -> 0, AspectRatio -> 5]; topplot = ListLinePlot[topdata, PlotRange -> All, DataRange -> xrange, Axes -> False, PlotStyle -> {{Thickness[.008], Red}}, ImageSize -> {dimensions[[1]], Automatic}, AspectRatio -> 1/5, PlotRangePadding -> 0, ImagePadding -> {padding[[1]], {0, 10}}]; Grid[{{topplot, Null}, {contourplot, rightplot}}, Alignment -> Bottom]];

The result is robust to changing the size of the image, or any other options for ListContourPlot. The following input

Grid[{{ combinedplot[twoDlist, xrange, yrange, ImageSize -> 250], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30], combinedplot[twoDlist, xrange, yrange, ImageSize -> 561, BaseStyle -> 30, FrameLabel -> {Style[ "\!\(\*SubscriptBox[\(\[CapitalOmega]\), \(1\)]\)", 30], Style["\!\(\*SubscriptBox[\(\[CapitalOmega]\), \(3\)]\)", 30]}, FrameStyle -> Thick] }}]

gives this as output. enter image description here