plot3d: Puntos de Giro en malla Intersecciones

Question

quiero dibujar puntos en las intersecciones malla visibles, como este:

Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {1, 4}, Boxed -> False] 

salida deseada:

que se ha podido calcular donde la malla se va a estar, basado en la cardinalidad de PlotRange y de Mesh, y dibujar puntos allí, pero creo que debería haber una manera alternativa más fácil.

Una gran ventaja es poder elegir el color del punto en función del valor de la función. Además, etiquetar los puntos sería maravilloso.

¿Alguna idea?

Answer 1

Por lo que vale la pena, me gusta la solución simple también.Además de que es fácil de utilizar la misma función de colorear para la superficie y los puntos:

g = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {1, 4}, Boxed -> False, ColorFunction -> "Rainbow"]; 
p = ListPointPlot3D[Table[{x, y, Sin[x + y^2]}, {x, -3, 3, (3 - (-3))/(1 + 1)}, {y, -2, 2, (2 - (-2))/(4 + 1)}], ColorFunction -> "Rainbow", PlotStyle -> PointSize[Large]]; 
Show[g, p] 

Editar: Si queremos hacer esto en un myPlot3D personalizado, creo que el siguiente debería hacer:

myPlot3D[f_, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}, 
    Mesh -> {i_Integer, j_Integer}, opts : OptionsPattern[]] := 
    Module[{g = 
    Plot3D[f, {x, xmin, xmax}, {y, ymin, ymax}, Mesh -> {i, j}, 
     Evaluate@FilterRules[{opts}, Options[Plot3D]]], 
    stx = (xmax - xmin)/(i + 1), 
    sty = (ymax - ymin)/(j + 1), pts}, 
    pts = ListPointPlot3D[ 
    Table[{x, y, f}, {x, xmin + stx, xmax - stx, stx}, {y, 
     ymin + sty, ymax - sty, sty}], 
    Evaluate@FilterRules[{opts}, Options[ListPointPlot3D]]]; 
    Show[g, pts]]; 

Tenga en cuenta que las opciones se aplican a ambos gráficos, pero se filtran primero. También eliminé los puntos en el contorno de la trama. Por ejemplo,

myPlot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {4, 10}, 
Boxed -> False, ColorFunction -> "Rainbow", Axes -> False, 
PlotStyle -> PointSize[Large]] 

dará como resultado

Answer 2

Aquí hay un enfoque muy hackish: tome las líneas de malla en la salida y busque las intersecciones. Es bastante factible ya que la salida es GraphicsComplex.
primer lugar, encontrar los índices de los puntos de la línea de malla en el complejo de gráficos:

g=Plot3D[Sin[x+y^2],{x,-3,3},{y,-2,2},Mesh->{1,4},Boxed->False]; 
meshlineptindices=First/@Cases[g, _Line, Infinity] 

Ahora, ir a través de las líneas pares y buscar intersecciones. Lo siguiente, usa NestWhile para buscar recursivamente todos los pares (primera línea, otra línea) para sublistas más cortas y más cortas de la lista original de líneas de malla. Las intersecciones resultantes se devuelven a través de Sow:

intesectionindices= 
    Flatten@Reap@NestWhile[(
    Sow@Outer[Intersection,{First[#]},Rest[#],1]; 
    Rest[#] 
)&, meshlineptindices, Length[#]>0&] 

Out[4]= {1260,1491,1264,1401,1284,1371,1298,1448,1205,1219,1528,1525,1526,1527} 

Busque los índices en el GraphicsComplex:

intesections = Part[g[[1,1]],intesectionindices] 
Out[5]= {{-3.,-1.2,-0.997667},{3.,-1.2,-0.961188},<...>,{0.,1.2,0.977754}} 

Por último, mostrar los puntos en conjunto con los gráficos originales:

Show[g,Graphics3D[{Red,PointSize[Large],Point[intesections]}]] 

HTH

actualización: Para obtener los puntos de color, es posible que utilices

Graphics3D[{PointSize[Large],({colorfunction[Last@#],Point[#]}&)/@intesections]}] 

Answer 3

Bueno, Janus me pegaba a escribir la respuesta. No pude entender la parte de usar Part. En cualquier caso, aquí es una versión simplificada:

g = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {1, 4}, Boxed -> False]; 
index = Cases[Cases[g, _Line, \[Infinity]], _Integer, \[Infinity]]; 
inter = Part[Select[Tally@index, Part[#, 2] > 1 &], All, 1]; 
Show[g, Graphics3D[{Red, PointSize[Large], Point[Part[g[[1, 1]], inter]]}]] 

Actualización:

Si sólo desea las intersecciones de la malla, entonces usted necesita para eliminar los puntos que están en EL limite. Aquí hago una malla de 4 por 4.

g = Plot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {4, 4}, Boxed -> False]; 
index = Cases[Cases[g, _Line, \[Infinity]], _Integer, \[Infinity]]; 
inter = Part[Select[Tally@index, Part[#, 2] > 1 &], All, 1]; 
range = AbsoluteOptions[g, PlotRange][[1]][[2]]; 
interior = Select[ 
    Part[g[[1, 1]], inter], 
    IntervalMemberQ[Interval[range[[1]]]*0.9999, Part[#, 1]] 
    && 
    IntervalMemberQ[Interval[range[[2]]]*0.9999, Part[#, 2]] 
    & 
    ]; 
Show[g, Graphics3D[{Red, PointSize[Large], Point[interior] }]] 

Answer 4

Siempre que sea posible, prefiero permanecer lejos de echar a perder con los gráficos fullform. Entonces, yendo a mis líneas originales, casi lo mismo que FelixCQ y tratando de obtener una función general.

Options[myPlot3D] = Options[Plot3D]; 
myPlot3D[f_, p__] := 
    Module[ 
    {g = Plot3D[f, p], 
    (*Get the Mesh Divisions*) 
    m = Flatten@Cases[{p}, HoldPattern[Rule[Mesh, r_]] -> r], 
    stx, sty}, 
    (*Get PlotRange*) 
    pr = (List @@@ Options[g, PlotRange])[[1, 2]]; 
    (*Get Mesh steps*) 
    stx = (pr[[1, 2]] - pr[[1, 1]])/(First@m + 1); 
    sty = (pr[[2, 2]] - pr[[2, 1]])/(Last@m + 1); 
    (*Generate points*) 
    pts = Point[ 
    Flatten[Table[{a, b, f /. {x -> a, y -> b}}, {a, 
     pr[[1, 1]] + stx, pr[[1, 2]] - stx, stx}, 
     {b, pr[[2, 1]] + sty, pr[[2, 2]] - sty, sty}], 1]]; 
    Show[g, Graphics3D[{PointSize[Large], pts}]] 
    ]; 

myPlot3D[Sin[x + y^2], {x, -3, 3}, {y, -2, 2}, Mesh -> {1, 2}, 
Boxed -> False, ColorFunction -> "Rainbow", Axes -> False] 

El principal problema aquí es que la función de trazado debe depender de parámetros formales y xy ... debe resolverlo :(