Skip to main content

How to export this PDF figure with a small size


I want to export a PDF figure with the following codes, but the size of the PDF is too big, about 1.5M. I hope the size can be around 100k. I have tried for a long time but can not find a good solution. Any help or suggestion will be highly appreciated!



\[Rho]2plus = {{0.2011205485336045077` + 
 1.`*^-6 I, -0.017422322154311026` - 
 0.508770348467936524` I, -0.01627481119236278` - 
 0.009599125271231317` I, 
0.00012377921551508936` - 
 0.0001037303194895626` I}, {-0.317422322154311026` + 
 0.008770348467936524` I, 0.5253584399150775` + 1.`*^-6 I, 
0.1810835129135062` - 0.050379441418388037` I, 
0.012122030783398718` - 
 0.00011053335415397864` I}, {-0.01627481119236278` + 

 0.009599125271231317` I, 
0.4810835129135062` + 0.050379441418388037` I, 
0.07251617971431137` + 1.`*^-6 I, 
0.011027619410833644` + 
 0.00549701145732366` I}, {0.20012377921551508936` + 
 0.0001037303194895626` I, 
0.012122030783398718` + 0.00011053335415397864` I, 
0.011027619410833644` - 0.00549701145732366` I, 
0.001004831837006529` + 1.`*^-6 I}};


\[Rho]2minus = {{0.005277185010322719` + 1.`*^-6 I, 
0.0010040157957586214` + 
 0.04371079428674348` I, -0.09005650743684472643` - 
 0.046221573555130006` I, -0.003643884304307673` - 
 0.001085378855037156` I}, {0.2010040157957586214` - 
 0.24371079428674348` I, 
0.0131515781501287` + 1.`*^-6 I, -0.1857896769310657` + 
 0.01114973388880884` I, 
0.008915832323651186` + 
 0.03176372686431984` I}, {0.5005650743684472643` + 

 0.046221573555130006` I, -0.0857896769310657` - 
 0.01114973388880884` I, 
0.07651833701845997` + 1.`*^-6 I, -0.0025963451307736015` - 
 0.034899274546212444` I}, {-0.003643884304307673` + 
 0.001085378855037156` I, 
0.208915832323651186` - 
 0.23176372686431984` I, -0.0025963451307736015` + 
 0.034899274546212444` I, 0.005052899821088675` + 1.`*^-6 I}};




figplus=GraphicsRow[
DiscretePlot3D[#@\[Rho]2plus[[i, j]], {i, 1, 4}, {j, 1, 4}, 
  BoxRatios -> {1., 1., .8}, ExtentSize -> 0.5, 
  PlotRange -> {{.5, 4.5}, {.5, 4.5}, {-.5, .526}}, 
  ColorFunction -> (Blend[{Hue[2/3], Hue[0]}, #] &), 
  ExtentElementFunction -> "ProfileCube", 
  Ticks -> {{{1, "A"}, {2, "B"}, {3, "C"}, {4, "D"}}, {{1, 
      "E"}, {2, "F"}, {3, "G"}, {4, "H"}}, Automatic}, 
  AxesEdge -> {{-1, -1}, {1, -1}, {1, 1}}, 

  FillingStyle -> Opacity[1], 
  LabelStyle -> 
   Directive[FontSize -> 12, FontFamily -> "Helvetica"], 
  Boxed -> True] & /@ {Re, Im} , ImageSize -> 500 ];



figminus =GraphicsRow[DiscretePlot3D[#@\[Rho]2minus[[i, j]], {i, 1, 4}, {j, 1, 4}, 
  BoxRatios -> {1., 1., .8}, ExtentSize -> 0.5, 
  PlotRange -> {{.5, 4.5}, {.5, 4.5}, {-.5, .523}}, 

  ColorFunction -> (Blend[{Hue[2/3], Hue[0]}, #] &), 
  ExtentElementFunction -> "ProfileCube", 
  Ticks -> {{{1, "A"}, {2, "B"}, {3, "C"}, {4, "D"}}, {{1, 
      "E"}, {2, "F"}, {3, "G"}, {4, "H"}}, Automatic}, 
  AxesEdge -> {{-1, -1}, {1, -1}, {1, 1}}, 
  FillingStyle -> Opacity[1], 
  LabelStyle -> 
   Directive[FontSize -> 12, FontFamily -> "Helvetica"], 
  Boxed -> True] & /@ {Re, Im} , ImageSize -> 500 ];
gg = Grid[{{figminus}, {figplus}}, Spacings -> {0, 0}]

Export["Fig8.pdf", gg, ImageResolution -> 600]

enter image description here




Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...
Post a Comment
Read more

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...
Post a Comment
Read more