# Trace of intersecting planes

I have a set of curved planes that intersect each other. I only want all the parts of all planes displayed that are above the intersecting traces. Further, I would like to highlight the intersecting traces. It sounds like a simple enough problem (maybe it is), but I couldn't finde any routine to do this. So, any help is welcome. Here is an example:

    inputData = {
{{0, .5, .5, 1200}, {0, 1, 0, 1500}, {.5, .5, 0, 1150}, {1/3, 1/3,
1/3, 1100}}
, {{0, 0, 0, 1650}, {0, .5, .5, 1200}, {1/3, 1/3, 1/3, 1100}, {.5,
0, .5, 1300}}
, {{1, 0, 0, 1650}, {1/3, 1/3, 1/3, 1100}, {.5, 0, .5,
1300}, {.5, .5, 0, 1150}}
};

coords[{A_, B_, C_}] := {A/2 + B, A Tan[Pi/3]/2};
newCoordinates[data_] := Table[
Join[coords[{data[[i, #, 1]], data[[i, #, 2]],
data[[i, #, 3]]}], {data[[i, #, 4]]}] & /@
Range@Length@data[[i]]
, {i, 1, Length[inputData]}
];
data = newCoordinates[inputData];
quad = Fit[data[[#]], {1, x, y, x^2, x y, y^2}, {x, y}] & /@
Range@Length@data;

Plot3D[quad, {x, 0, 1}, {y, 0, 1}
, MeshFunctions -> {#3 &}
, RegionFunction ->
Function[{x, y, z},
0 < Sqrt[3] x - y && 1.72 > Sqrt[3] x + y && z > 1100]
, PlotStyle -> {Directive[Orange, Opacity[.5]],
Directive[Green, Opacity[.5]]}
, PlotRange -> {{0, 1}, {0, 1}, {0, 2000}}
, BoundaryStyle -> Thick
, BoxRatios -> {1.2, 1.2, 2}
, Boxed -> False
, Axes -> None
, ImageSize -> 500
]

• Adding a definition of your newCoordinates function might help. Jan 6, 2014 at 16:40
• My apologies! I added the required definitions. This are to make a ternary plot. Jan 6, 2014 at 18:38
• Do you really mean (flat) planes? These seem to be quadrics. Which is fine, just a bit confusing. Jan 6, 2014 at 19:09
• You are right, I mean curved planes. I now state this differently in the question. Jan 6, 2014 at 19:20
• This may do what you want.Plot3D[Evaluate[ Map[Piecewise[{{#, # >= Apply[Max, quad]}}] &, quad]], {x, 0, 1}, {y, 0, 1}, MeshFunctions -> {#3 &}, RegionFunction -> Function[{x, y, z}, 0 < Sqrt[3] x - y && 1.72 > Sqrt[3] x + y && z > 1100], PlotStyle -> {Directive[Orange, Opacity[.5]], Directive[Green, Opacity[.5]]}, PlotRange -> {{0, 1}, {0, 1}, {0, 2000}}, BoundaryStyle -> Thick, BoxRatios -> {1.2, 1.2, 2}, Boxed -> False, Axes -> None, ImageSize -> 500] Jan 7, 2014 at 4:03

(This is Daniel's answer from comments; it is interesting, it answers OP's question, and it generates pretty graphics, so it seems worth preserving)

Plot3D[
quad, {x, 0, 1}, {y, 0, 1},
MeshFunctions -> {#3 &},
RegionFunction ->
Function[{x, y, z}, 0 < Sqrt[3] x - y && 1.72 > Sqrt[3] x + y && z > 1100],
PlotStyle -> {Directive[Orange, Opacity[.5]], Directive[Green, Opacity[.5]]},
PlotRange -> {{0, 1}, {0, 1}, {0, 2000}},
BoundaryStyle -> Thick, BoxRatios -> {1.2, 1.2, 2},
Boxed -> False, Axes -> None, ImageSize -> 500
]


Plot3D[