wolfram-mathematica - legends - plot mathematica

Mathematica: Rasters en gráficos 3D

Question

Hay ocasiones en que la exportación a una imagen pdf es simplemente problemática. Si los datos que está dibujando contienen muchos puntos, entonces su figura tendrá un tamaño grande y el visor de pdf que elija pasará la mayor parte del tiempo renderizando esta imagen de alta calidad. Por lo tanto, podemos exportar esta imagen como un jpeg, png o tiff. La imagen estará bien desde una vista determinada, pero al acercarla se verá distorsionada. Esto está bien hasta cierto punto para la figura que estamos trazando, pero si su imagen contiene texto, este texto se verá pixelado.

Para intentar obtener lo mejor de ambos mundos, podemos separar esta figura en dos partes: Ejes con etiquetas y la imagen en 3D. Por lo tanto, los ejes se pueden exportar como pdf o eps y la figura 3D como ráster. Ojalá supiera cómo luego combinar los dos en Mathematica, así que por el momento podemos usar un editor de gráficos vectoriales como Inkscape o Illustrator para combinar los dos.

Logré lograr esto para una trama que hice en una publicación, pero esto me impulsó a crear rutinas en Mathematica para automatizar este proceso. Aquí está lo que tengo hasta ahora:

SetDirectory[NotebookDirectory[]];
SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];

Me gusta iniciar mi cuaderno configurando el directorio de trabajo en el directorio del cuaderno. Como quiero que mis imágenes tengan el tamaño que especifico, configuro el entorno de estilo de impresión para que funcione, verifique this para obtener más información.

in = 72;
G3D = Graphics3D[
  AlignmentPoint -> Center,
  AspectRatio -> 0.925,
  Axes -> {True, True, True},
  AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}},
  AxesStyle -> Directive[10, Black],
  BaseStyle -> {FontFamily -> "Arial", FontSize -> 12},
  Boxed -> False,
  BoxRatios -> {3, 3, 1},
  LabelStyle -> Directive[Black],
  ImagePadding -> All,
  ImageSize -> 5 in,
  PlotRange -> All,
  PlotRangePadding -> None,
  TicksStyle -> Directive[10],
  ViewPoint -> {2, -2, 2},
  ViewVertical -> {0, 0, 1}
 ]

Aquí configuramos la vista de la trama que queremos realizar. Ahora vamos a crear nuestra trama.

g = Show[
  Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, 
   Mesh -> None,
   AxesLabel -> {"x", "y", "z"}
   ], 
  Options[G3D]
 ]

Ahora necesitamos encontrar una forma de separarnos. Comencemos dibujando los ejes.

axes = Graphics3D[{}, AbsoluteOptions[g]]

fig = Show[g, 
  AxesStyle -> Directive[Opacity[0]],
  FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}
 ]

Incluí los facegrids para que podamos relacionar la figura con el eje en el proceso de edición posterior. Ahora exportamos ambas imágenes.

Export["Axes.pdf", axes];
Export["Fig.pdf", Rasterize[fig, ImageResolution -> 300]];

Obtendrá dos archivos pdf que puede editar y juntar en un pdf o eps. Ojalá fuera así de simple, pero no lo es. Si realmente hiciste esto obtendrás esto:

Las dos figuras son de diferentes tamaños. Sé que axes.pdf es correcto porque cuando lo abro en Inkspace, el tamaño de la figura es de 5 pulgadas como lo había especificado anteriormente.

Mencioné antes que logré obtener esto con una de mis parcelas. Limpiaré el archivo y cambiaré los gráficos para que sea más accesible para cualquier persona que quiera ver que esto es cierto. En cualquier caso, ¿alguien sabe por qué no puedo conseguir que los dos archivos PDF tengan el mismo tamaño? Además, tenga en cuenta que queremos obtener una trama bonita para la figura rasterizada. Gracias por tu tiempo.

PD. Como beneficio adicional, ¿podemos evitar la edición posterior y simplemente combinar las dos figuras en matemáticas? La versión rasterizada y la versión de gráficos vectoriales que es.

EDITAR:

Gracias a rcollyer por su comentario. Estoy publicando los resultados de su comentario.

Una cosa a mencionar es que cuando exportamos los ejes necesitamos establecer Background en None para que podamos tener una imagen transparente.

Export["Axes.pdf", axes, Background -> None];
Export["Fig.pdf", Rasterize[fig, ImageResolution -> 300]];
a = Import["Axes.pdf"];
b = Import["Fig.pdf"];
Show[b, a]

Y luego, exportando la figura da el efecto deseado.

Export["FinalFig.pdf", Show[b, a]]

Los ejes conservan los agradables componentes de los gráficos vectoriales, mientras que la figura ahora es una versión rasterizada de lo que trazamos. Pero la cuestión principal sigue siendo. ¿Cómo haces que las dos figuras coincidan?

ACTUALIZAR:

Mi pregunta ha sido respondida por Alexey Popkov. Me gustaría agradecerle por tomarse el tiempo para investigar mi problema. El siguiente código es un ejemplo para aquellos de ustedes que desean usar la técnica que mencioné anteriormente. Consulte la respuesta de Alexey Popkov para obtener comentarios útiles en su código. Se las arregló para que funcione en Mathematica 7 y funciona aún mejor en Mathematica 8. Aquí está el resultado:

SetDirectory[NotebookDirectory[]];
SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];
$HistoryLength = 0;
in = 72;
G3D = Graphics3D[
 AlignmentPoint -> Center, AspectRatio -> 0.925, Axes -> {True, True, True},
 AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, AxesStyle -> Directive[10, Black],
 BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, Boxed -> False, 
 BoxRatios -> {3, 3, 1}, LabelStyle -> Directive[Black], ImagePadding -> 40,
 ImageSize -> 5 in, PlotRange -> All, PlotRangePadding -> 0,
 TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, ViewVertical -> {0, 0, 1}
];
axesLabels = Graphics3D[{
 Text[Style["x axis (units)", Black, 12], Scaled[{.5, -.1, 0}], {0, 0}, {1, -.9}],
 Text[Style["y axis (units)", Black, 12], Scaled[{1.1, .5, 0}], {0, 0}, {1, .9}],
 Text[Style["z axis (units)", Black, 12], Scaled[{0, -.15, .7}], {0, 0}, {-.1, 1.5}]
}];
fig = Show[
  Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None],
  ImagePadding -> {{40, 0}, {15, 0}}, Options[G3D]
];
axes = Show[
  Graphics3D[{}, FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}, 
    AbsoluteOptions[fig]], axesLabels, 
    Epilog -> Text[Style["Panel A", Bold, Black, 12], ImageScaled[{0.075, 0.975}]]
];
fig = Show[fig, AxesStyle -> Directive[Opacity[0]]];
Row[{fig, axes}]

En este punto deberías ver esto:

La ampliación se encarga de la resolución de tu imagen. Debes probar diferentes valores para ver cómo esto cambia tu imagen.

fig = Magnify[fig, 5];
fig = Rasterize[fig, Background -> None];

Combina los gráficos

axes = First@ImportString[ExportString[axes, "PDF"], "PDF"];
result = Show[axes, Epilog -> Inset[fig, {0, 0}, {0, 0}, ImageDimensions[axes]]];

Exportarlos

Export["Result.pdf", result];
Export["Result.eps", result];

La única diferencia que encontré entre M7 y M8 usando el código anterior es que M7 no exporta el archivo eps correctamente. Aparte de eso, todo está funcionando bien ahora. :)

La primera columna muestra la salida obtenida de M7. La parte superior es la versión eps con un tamaño de archivo de 614 kb, la parte inferior es la versión pdf con un tamaño de archivo de 455 kb. La segunda columna muestra la salida obtenida de M8. Top es la versión eps con un tamaño de archivo de 643 kb, y la parte inferior es la versión pdf con un tamaño de archivo de 463 kb.

Espero que encuentres esto útil. Por favor verifique la respuesta de Alexey para ver los comentarios en su código, ellos lo ayudarán a evitar problemas con Mathematica.

Answer 1

La solución completa para Mathematica 7.0.1: corregir errores

El código con comentarios:

(*controls the resolution of rasterized graphics*)
magnification = 5;

SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"]
(*Turn off history for saving memory*)
$HistoryLength = 0;
(*Epilog will give us the bounding box of the graphics*)
g1 = Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, 
   AlignmentPoint -> Center, AspectRatio -> 0.925, 
   Axes -> {True, True, True}, 
   AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, 
   Boxed -> False, BoxRatios -> {3, 3, 1}, 
   LabelStyle -> Directive[Black], ImagePadding -> All, 
   ImageSize -> 5*72, PlotRange -> All, PlotRangePadding -> None, 
   TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, 
   ViewVertical -> {0, 0, 1}, AxesStyle -> Directive[Opacity[0]], 
   FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}, Mesh -> None, 
   ImagePadding -> 40, 
   Epilog -> {Red, AbsoluteThickness[1], 
     Line[{ImageScaled[{0, 0}], ImageScaled[{0, 1}], 
       ImageScaled[{1, 1}], ImageScaled[{1, 0}], 
       ImageScaled[{0, 0}]}]}];
(*The options list should NOT contain ImagePadding->Full.Even it is /
before ImagePadding->40 it is not replaced by the latter-another bug!*)
axes = Graphics3D[{Opacity[0], 
    Point[PlotRange /. AbsoluteOptions[g1] // Transpose]}, 
   AlignmentPoint -> Center, AspectRatio -> 0.925, 
   Axes -> {True, True, True}, 
   AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
   AxesStyle -> Directive[10, Black], 
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, 
   Boxed -> False, BoxRatios -> {3, 3, 1}, 
   LabelStyle -> Directive[Black], ImageSize -> 5*72, 
   PlotRange -> All, PlotRangePadding -> None, 
   TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, 
   ViewVertical -> {0, 0, 1}, ImagePadding -> 40, 
   Epilog -> {Red, AbsoluteThickness[1], 
     Line[{ImageScaled[{0, 0}], ImageScaled[{0, 1}], 
       ImageScaled[{1, 1}], ImageScaled[{1, 0}], 
       ImageScaled[{0, 0}]}]}];
(*fixing bug with ImagePadding loosed when specifyed as option in /
Plot3D*)
g1 = AppendTo[g1, ImagePadding -> 40];
(*Increasing ImageSize without damage.Explicit setting for /
ImagePadding is important (due to a bug in behavior of /
ImagePadding->Full)!*)
g1 = Magnify[g1, magnification];
g2 = Rasterize[g1, Background -> None];
(*Fixing bug with non-working option Background->None when graphics /
is Magnifyed*)
g2 = g2 /. {255, 255, 255, 255} -> {0, 0, 0, 0};
(*Fixing bug with icorrect exporting of Ticks in PDF when Graphics3D /
and 2D Raster are combined*)
axes = First@ImportString[ExportString[axes, "PDF"], "PDF"];
(*Getting explicid ImageSize of graphics imported form PDF*)
imageSize = 
 Last@Transpose[{First@#, Last@#} & /@ 
    Sort /@ Transpose@
      First@Cases[axes, 
        Style[{Line[x_]}, ___, RGBColor[1.`, 0.`, 0.`, 1.`], ___] :> 
         x, Infinity]]
(*combining Graphics3D and Graphics*)
result = Show[axes, Epilog -> Inset[g2, {0, 0}, {0, 0}, imageSize]]
Export["C://result.pdf", result]

Aquí está lo que veo en el cuaderno:

Y aquí está lo que obtengo en el PDF:

Answer 2

Aquí presento otra versión de la solución original que usa el segundo argumento de Raster lugar de Inset . Creo que de esta manera es un poco más sencillo.

Aquí está el código de la sección ACTUALIZACIÓN de la pregunta (modificado un poco):

SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];
$HistoryLength = 0;
in = 72;
G3D = Graphics3D[AlignmentPoint -> Center, AspectRatio -> 0.925, 
   Axes -> {True, True, True}, 
   AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
   AxesStyle -> Directive[10, Black], 
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, 
   Boxed -> False, BoxRatios -> {3, 3, 1}, 
   LabelStyle -> Directive[Black], ImagePadding -> 40, 
   ImageSize -> 5 in, PlotRange -> All, PlotRangePadding -> 0, 
   TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, 
   ViewVertical -> {0, 0, 1}];
axesLabels = 
  Graphics3D[{Text[Style["x axis (units)", Black, 12], 
     Scaled[{.5, -.1, 0}], {0, 0}, {1, -.9}], 
    Text[Style["y axis (units)", Black, 12], 
     Scaled[{1.1, .5, 0}], {0, 0}, {1, .9}], 
    Text[Style["z axis (units)", Black, 12], 
     Scaled[{0, -.15, .7}], {0, 0}, {-.1, 1.5}]}];
fig = Show[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None], 
   ImagePadding -> {{40, 0}, {15, 0}}, Options[G3D]];
axes = Show[
   Graphics3D[{}, FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}, 
    AbsoluteOptions[fig]], axesLabels, 
   Prolog -> 
    Text[Style["Panel A", Bold, Black, 12], 
     ImageScaled[{0.075, 0.975}]]];
fig = Show[fig, AxesStyle -> Directive[Opacity[0]]];
fig = Magnify[fig, 5];
fig = Rasterize[fig, Background -> None];
axes2D = First@ImportString[ExportString[axes, "PDF"], "PDF"];

El resto de la respuesta es la nueva solución.

Al principio, establecemos el segundo argumento de Raster para que complete el PlotRange completo de axes2D . La forma general de hacer esto es:

fig = fig /. 
   Raster[data_, rectangle_, opts___] :> 
    Raster[data, {Scaled[{0, 0}], Scaled[{1, 1}]}, opts];

Otra forma es hacer una asignación directa a la Part correspondiente de la expresión original:

fig[[1, 2]] = {Scaled[{0, 0}], Scaled[{1, 1}]}

Tenga en cuenta que este último código se basa en el conocimiento de la estructura interna de la expresión generada por Rasterize que es potencialmente dependiente de la versión.

Ahora combinamos dos objetos gráficos de una manera muy sencilla:

result = Show[axes2D, fig]

Y exportar el resultado:

Export["C:/Result.pdf", result];
Export["C:/Result.eps", result];

Tanto .eps como .pdf se exportan perfectamente con Mathematica 8.0.4 bajo Windows XP 32 bit y se ven idénticos a los archivos exportados con el código original:

result = Show[axes2D, 
  Epilog -> Inset[fig, Center, Center, ImageScaled[{1, 1}]]]
Export["C:/Result.pdf", result];
Export["C:/Result.eps", result];

Tenga en cuenta que no es necesario convertir los axes en contornos al menos al exportar a PDF. El código

result = Show[axes, 
  Epilog -> Inset[fig, Center, Center, ImageScaled[{1, 1}]]]
Export["C:/Result.pdf", result];

y el código

fig[[1, 2]] = {ImageScaled[{0, 0}], ImageScaled[{1, 1}]};
result = Show[axes, Epilog -> First@fig]
Export["C:/Result.pdf", result];

Produce archivos PDF que parecen idénticos a las dos versiones anteriores.

Answer 3

En Mathematica 8, el problema puede resolverse aún más simple utilizando la nueva función de Overlay .

Aquí está el código de la sección ACTUALIZACIÓN de la pregunta:

SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];
$HistoryLength = 0;
in = 72;
G3D = Graphics3D[AlignmentPoint -> Center, AspectRatio -> 0.925, 
   Axes -> {True, True, True}, 
   AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
   AxesStyle -> Directive[10, Black], 
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, 
   Boxed -> False, BoxRatios -> {3, 3, 1}, 
   LabelStyle -> Directive[Black], ImagePadding -> 40, 
   ImageSize -> 5 in, PlotRange -> All, PlotRangePadding -> 0, 
   TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, 
   ViewVertical -> {0, 0, 1}];
axesLabels = 
  Graphics3D[{Text[Style["x axis (units)", Black, 12], 
     Scaled[{.5, -.1, 0}], {0, 0}, {1, -.9}], 
    Text[Style["y axis (units)", Black, 12], 
     Scaled[{1.1, .5, 0}], {0, 0}, {1, .9}], 
    Text[Style["z axis (units)", Black, 12], 
     Scaled[{0, -.15, .7}], {0, 0}, {-.1, 1.5}]}];
fig = Show[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None], 
   ImagePadding -> {{40, 0}, {15, 0}}, Options[G3D]];
axes = Show[
   Graphics3D[{}, FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}, 
    AbsoluteOptions[fig]], axesLabels, 
   Epilog -> 
    Text[Style["Panel A", Bold, Black, 12], 
     ImageScaled[{0.075, 0.975}]]];
fig = Show[fig, AxesStyle -> Directive[Opacity[0]]];

Y aquí está la solución:

gr = Overlay[{axes, 
   Rasterize[fig, Background -> None, ImageResolution -> 300]}]
Export["Result.pdf", gr]

En este caso, no necesitamos convertir las fuentes a contornos.

ACTUALIZAR

Como señaló en los comentarios a esta respuesta, la opción Background -> None no funciona correctamente en Mac OS X en Mathematica 8.0.1. Una solución es reemplazar los puntos blancos no transparentes por transparentes:

gr = Overlay[{axes, 
   Rasterize[fig, Background -> None, 
     ImageResolution -> 300] /. {255, 255, 255, 255} -> {0, 0, 0, 0}}]
Export["Result.pdf", gr]

Answer 4

Esto parece mucho alboroto sobre nada. Mientras lo leo, el problema que quieres resolver es el siguiente:

• Desea exportar en un formato vectorial, de modo que cuando se imprime la resolución óptima se utiliza para fuentes, líneas y gráficos
• En su programa de edición, no debe preocuparse por la lentitud de representar un dibujo vectorial complejo

Estos requisitos se pueden cumplir exportando como .eps y usando una imagen de vista previa rasterizada incrustada.

Export["file.eps","PreviewFormat"->"TIFF"]

Esto funcionará en muchas aplicaciones. Desafortunadamente, el filtro de eps de MS Word ha estado cambiando enormemente en las últimas cuatro versiones, y aunque una vez funcionó para mí en una de las funciones más antiguas, ya no lo hace en W2010. He escuchado rumores de que podría funcionar en la versión mac, pero no puedo verificarlo ahora.

Answer 5

Solo comprobando (Mma8):

SetOptions[$FrontEnd, PrintingStyleEnvironment -> "Working"];
in = 72;
G3D = Graphics3D[AlignmentPoint -> Center, AspectRatio -> 0.925, 
   Axes -> {True, True, True}, 
   AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
   AxesStyle -> Directive[10, Black], 
   BaseStyle -> {FontFamily -> "Arial", FontSize -> 12}, 
   Boxed -> False, BoxRatios -> {3, 3, 1}, 
   LabelStyle -> Directive[Black], ImagePadding -> All, 
   ImageSize -> 5 in, PlotRange -> All, PlotRangePadding -> None, 
   TicksStyle -> Directive[10], ViewPoint -> {2, -2, 2}, 
   ViewVertical -> {0, 0, 1}];
g = Show[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}, Mesh -> None, 
    AxesLabel -> {"x", "y", "z"}], Options[G3D]];
axes = Graphics3D[{}, AbsoluteOptions[g]];
fig = Show[g, AxesStyle -> Directive[Opacity[0]], 
   FaceGrids -> {{-1, 0, 0}, {0, 1, 0}}];
Export["c://Axes.pdf", axes, Background -> None];
Export["c://Fig.pdf", Rasterize[fig, ImageResolution -> 300]];
a = Import["c://Axes.pdf"];
b = Import["c://Fig.pdf"];
Export["c://FinalFig.pdf", Show[b, a]]

Answer 6

Mathematica 9.0.1.0 / 64-bit Linux: en general, parece ser muy difícil colocar los ejes vectorizados en la posición correcta. En la mayoría de las aplicaciones será suficiente simplemente rasterizar todo con una alta resolución:

fig = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}, Mesh -> None];

Export["export.eps", fig, "AllowRasterization" -> True, 
  ImageResolution -> 600];

El código exporta el gráfico a un archivo EPS utilizando una rasterización de alta calidad tanto del contenido 3D como del eje. Finalmente, puede convertir el archivo EPS a un PDF utilizando, por ejemplo, el comando de Linux epspdf:

epspdf export.eps

Probablemente esto sea suficiente para la mayoría de los usuarios y le ahorra mucho tiempo. Sin embargo, si realmente desea exportar el texto como gráfico vectorial, puede intentar la siguiente función:

ExportAsSemiRaster[filename_, dpi_, fig_, plotrange_, 
   plotrangepadding_] := (
   range = 
    Show[fig, PlotRange -> plotrange, 
     PlotRangePadding -> plotrangepadding];
   axes = Show[Graphics3D[{}, AbsoluteOptions[range]]];
   noaxes = Show[range, AxesStyle -> Transparent];
   raster = 
    Rasterize[noaxes, Background -> None, ImageResolution -> dpi];
   result = 
    Show[raster, 
     Epilog -> Inset[axes, Center, Center, ImageDimensions[raster]]];
   Export[filename, result];
   );

Debe especificar explícitamente PlotRange y PlotRangePadding. Ejemplo:

fig = Graphics3D[{Opacity[0.9], Orange, 
    Polygon[{{0, 0, 0}, {4, 0, 4}, {4, 5, 7}, {0, 5, 5}}], 
    Opacity[0.05], Gray, CuboidBox[{0, 0, 0}, {4, 5, 7}]}, 
   Axes -> True, AxesStyle -> Darker[Orange], 
   AxesLabel -> {"x1", "x2", "x3"}, Boxed -> False, 
   ViewPoint -> {-8.5, -8, 6}];
ExportAsSemiRaster["export.pdf", 600, 
  fig, {{0, 4}, {0, 5}, {0, 7}}, {.0, .0, .0}];
Print[Import["export.pdf"]];