Hello I have been trying to create a 3D surface plot with color representing a fourth variable. I have seen in threads on similar questions (here, here & here) that the persp function may be suitable for this matter.
However, I want the legend to represent the values of z_perc_diff not z_abs. The legend should be based around zero, so that positive values are represented in blue and negative ones are shown in red.
# My data
my_predictions <- structure(list(x = c(15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 18,
18, 18, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 20, 20, 20,
20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26,
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27,
27, 27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 30, 30, 30, 30, 30,
30, 30, 30, 30, 30, 30), y = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5,
6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3,
4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8,
9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6,
7, 8, 9, 10, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 0, 1, 2, 3, 4,
5, 6, 7, 8, 9, 10), z_abs = c(5.89166468662797, 5.71620477294708,
5.58788336363503, 5.53270398714009, 5.56546653858478, 5.68342133665583,
5.87218359073286, 6.11616406250311, 6.39777721054453, 6.6948141489067,
6.9860537204931, 5.39084997268418, 5.18447060891215, 5.06611974736902,
5.05075093844761, 5.14083166394895, 5.32870615805878, 5.5985017027444,
5.92779768435751, 6.29238950293484, 6.66793117670472, 7.03298204408324,
4.95653965694727, 4.7201086564947, 4.61480313575268, 4.64210971213064,
4.79047427954843, 5.04685231896118, 5.39548242946584, 5.80689146180237,
6.24996353898745, 6.69863843503938, 7.13191977541987, 4.64349151345873,
4.3813155170918, 4.29167517000888, 4.36216601705974, 4.56533037621608,
4.88310350730247, 5.30286040109652, 5.78703626665416, 6.2985097044599,
6.80988120783696, 7.30132906244365, 4.51154727409438, 4.23073821797019,
4.15854107473001, 4.26878934910127, 4.51798461407076, 4.88613817165596,
5.36094446401933, 5.90080872941022, 6.46448442210873, 7.02292641564077,
7.55775948840835, 4.61292568988059, 4.32507754750285, 4.26865597663617,
4.41008780184542, 4.6929100839265, 5.09614963145159, 5.60427338841452,
6.17534998926212, 6.76908828925627, 7.35452667149962, 7.91346606720368,
4.9753260711446, 4.69588399333344, 4.65475068309446, 4.81371724113417,
5.11437712173564, 5.53272532866221, 6.0484175670245, 6.62476913845804,
7.22335838291607, 7.81254366865306, 8.3738269431778, 5.60569497498954,
5.34785911948806, 5.32333516039646, 5.48927127025166, 5.78797585594766,
6.19531699139295, 6.69382015172285, 7.25054778841329, 7.82693134543372,
8.39443251400023, 8.93623441442297, 6.49158407263714, 6.27115324385354,
6.26151299468792, 6.422816894535, 6.7018558318732, 7.07402287605816,
7.53213005441985, 8.04277431372036, 8.57058750914082, 9.09206029329992,
9.59247435372804, 7.61240997323185, 7.44115030318242, 7.44379765058154,
7.58744143657664, 7.82808733399817, 8.14750787068668, 8.53909801474392,
8.97861443975292, 9.43532939424452, 9.88959953483834, 10.3284770236408,
8.92394937199725, 8.81086054834368, 8.82321640103571, 8.93818150369879,
9.12499157686584, 9.37318975819927, 9.68003486446225, 10.0269790914747,
10.3929730388823, 10.7616293567185, 11.1226201190418, 10.3712483746667,
10.3234108220576, 10.3435258045377, 10.4214375724401, 10.5426393201315,
10.7059853803208, 10.9109947969652, 11.1497118719974, 11.4094098184639,
11.6786118672507, 11.9490255615482, 11.8887255053356, 11.9086496168692,
11.934785192405, 11.9700207074413, 12.0181188024101, 12.0864895097675,
12.1807184656665, 12.3012160515108, 12.4446783000884, 12.6055375734207,
12.7777833711724, 13.4042784224739, 13.4916045348718, 13.5217402312418,
13.5110508490485, 13.4824532270308, 13.4527571217012, 13.4326577589613,
13.431591868524, 13.4557730469364, 13.505528343313, 13.5772898734717,
14.8446701299156, 14.9954392456614, 15.0273941315244, 14.9704701616451,
14.8666619887902, 14.7414587466546, 14.6098827085824, 14.4908729477804,
14.3994241171268, 14.3416767614794, 14.3162484009104, 16.1383527788051,
16.3443675699097, 16.3768858295625, 16.2778130284893, 16.1045505862423,
15.8917019503952, 15.6587768285966, 15.4317358581075, 15.2347126709423,
15.0786301284417, 14.964770211412), z_perc_diff = c(0, -3.02312003579871,
-5.29256590351525, -6.28412317106163, -5.69423779183659, -3.59813049429173,
-0.331202773714748, 3.73921681538612, 8.23654203585939, 12.7620992776987,
16.9966293603681, 0, -3.90303749526381, -6.21079020038523, -6.51430823934265,
-4.74792758386405, -1.15944753434667, 3.77914432431019, 9.48784215116509,
15.4330403332402, 21.1809334326506, 26.4351943777542, 0, -4.88663001473628,
-7.14082712522282, -6.55154559201976, -3.40751287483119, 1.80564077127878,
8.48032913482058, 15.8007571279721, 23.0834518034026, 29.8939881371674,
35.9910231844426, 0, -5.81011860928264, -7.87486917509452, -6.24775027132952,
-1.69752739664305, 5.03038059918695, 13.2585071049594, 21.9268818856078,
30.250740390906, 37.8297248696042, 44.5019250326266, 0, -6.42415662080771,
-8.14308194246352, -5.52958127714146, 0.142584135171283, 7.97198203161749,
17.2073517498276, 26.6848627697371, 35.5854866689191, 43.5456217439958,
50.4786608586009, 0, -6.4409943637927, -7.75244153960337, -4.49601207448427,
1.71901580879046, 9.95406721192679, 19.4054689731923, 28.9652275460889,
37.8871894434132, 45.817620974475, 52.6973839127532, 0, -5.77884413528626,
-6.65779507746964, -3.30183093188919, 2.75629615525582, 10.6089937384178,
19.4687309702012, 28.4384401594915, 36.8569630641303, 44.3735767604614,
50.9171011582073, 0, -4.70780265980463, -5.16715227417771, -2.09867614131442,
3.19968662712593, 9.99273652264851, 17.6937898042842, 25.5883906938357,
33.0722573152648, 39.8387449143425, 45.8060185859283, 0, -3.45428763935744,
-3.60808165631693, -1.06496891767484, 3.18751986984344, 8.58699217254015,
14.8398059509087, 21.3451491954295, 27.6056267878243, 33.3744297495256,
38.5585552960673, 0, -2.27533775272767, -2.23977148646158, -0.328536588707702,
2.79365821546852, 6.79061785415733, 11.4749414383097, 16.4691996408832,
21.3860545579483, 26.0220354760575, 30.2779572814035, 0, -1.27533166875238,
-1.13520065400643, 0.159355362476933, 2.22774516730026, 4.91049866326503,
8.12821041831724, 11.6409042607444, 15.2097071742408, 18.6703170889313,
21.9356309120861, 0, -0.462317858481415, -0.267659882643973,
0.482758195848795, 1.63901564324992, 3.17628973085539, 5.0722700417025,
7.23446805726413, 9.53287485246492, 11.8582474286945, 14.13761490016,
0, 0.167447976353206, 0.386674219881325, 0.681470865071801, 1.08247910438433,
1.649737066444, 2.42625430552338, 3.41043028323062, 4.5694617916871,
5.85289760120903, 7.20862340339978, 0, 0.649364161321318, 0.872478105868887,
0.793394912598341, 0.581512141944205, 0.361013032488915, 0.211494607995026,
0.203559234367959, 0.383429082563038, 0.752513176481438, 1.28244176987912,
0, 1.01051315763124, 1.22337713262576, 0.843866777076174, 0.148036841880626,
-0.697701167269985, -1.59423517729535, -2.41207180789635, -3.0450319919469,
-3.44677167243881, -3.62417753368461, 0, 1.26845774548987, 1.46720775221974,
0.860436428621641, -0.209672138889854, -1.5401211799062, -3.01647322339994,
-4.47649627357374, -5.7606108609966, -6.78939828049445, -7.54639698246566
)), .Names = c("x", "y", "z_abs", "z_perc_diff"), row.names = c(81L,
82L, 83L, 84L, 85L, 86L, 87L, 88L, 89L, 90L, 91L, 97L, 98L, 99L,
100L, 101L, 102L, 103L, 104L, 105L, 106L, 107L, 113L, 114L, 115L,
116L, 117L, 118L, 119L, 120L, 121L, 122L, 123L, 129L, 130L, 131L,
132L, 133L, 134L, 135L, 136L, 137L, 138L, 139L, 145L, 146L, 147L,
148L, 149L, 150L, 151L, 152L, 153L, 154L, 155L, 161L, 162L, 163L,
164L, 165L, 166L, 167L, 168L, 169L, 170L, 171L, 177L, 178L, 179L,
180L, 181L, 182L, 183L, 184L, 185L, 186L, 187L, 193L, 194L, 195L,
196L, 197L, 198L, 199L, 200L, 201L, 202L, 203L, 209L, 210L, 211L,
212L, 213L, 214L, 215L, 216L, 217L, 218L, 219L, 225L, 226L, 227L,
228L, 229L, 230L, 231L, 232L, 233L, 234L, 235L, 241L, 242L, 243L,
244L, 245L, 246L, 247L, 248L, 249L, 250L, 251L, 257L, 258L, 259L,
260L, 261L, 262L, 263L, 264L, 265L, 266L, 267L, 273L, 274L, 275L,
276L, 277L, 278L, 279L, 280L, 281L, 282L, 283L, 289L, 290L, 291L,
292L, 293L, 294L, 295L, 296L, 297L, 298L, 299L, 305L, 306L, 307L,
308L, 309L, 310L, 311L, 312L, 313L, 314L, 315L, 321L, 322L, 323L,
324L, 325L, 326L, 327L, 328L, 329L, 330L, 331L), class = "data.frame")
This is how I create the plot:
# Rearranging data
x = unique(my_predictions$x)
nx = length(x)
y = unique(my_predictions$y)
ny = length(y)
zmat <- matrix(my_predictions$z_abs, nrow=nx, byrow=TRUE)
# Create color variable
library(grDevices) # for the colorRampPalette function
colfunc = colorRampPalette(c("red","white","blue"))
class_borders = seq(-50, 50, 5)
cols = cut(unique(my_predictions$z_perc_diff), breaks = class_borders)
cols = colfunc(21)[as.numeric(cols)]
# plot using persp (base package)
persp(x, y, zmat, col = cols,
ticktype = "detailed",
theta=-35, phi=10)
# plot using persp3D (plot3D)
library(plot3D)
persp3D(x, y, zmat, col = cols,
ticktype = "detailed",
theta=-35, phi=10)
I am surprised to see that the persp and the persp3D functions give differently colored plots. In addition none of them represents the z_perc_diff variable correctly. Why is that?
Ideally I would add symbols that indicate where z_perc_diff is significantly different from zero judged by a p-values.
my_predictions$p_val = runif(nrow(my_predictions), min = 0, max = 1)
class_borders = c(-1,0.001,0.01,0.05,1)
my_predictions$p_cut = cut(my_predictions[,"p_val"], breaks = class_borders)
my_predictions$p_cut[my_predictions$p_val > 0.05 ] <- NA
Q1: How can I color the plot based on z_perc_diff
Q2: How can I add a legend based on z_perc_diff
Q3: Is it possible to add different kind of symbols based on the p-value to the plot or is there another way to indicate the uncertainty of the estimates?
PS: In case you looked in here earlier, I have changed the quite a few things because I have been figuring out some of the problems I had, but I still don't achieve what I want to do.
UPDATE: Using some of the code of @csgillespie from this link seems to solve Q1.
persp4d <- function(data, x, y, z, color_var, colors = c("red","white","blue"), class_borders = seq(-100, 100, 2), ...){
x = sort(unique(data[,x]))
nx = length(x)
y = sort(unique(data[,y]))
ny = length(y)
z = matrix(data[,z], nrow = nx, byrow = FALSE)
z_col = matrix(data[,color_var], nrow = length(x), byrow = FALSE)
## Average the values at the corner of each facet
hgt = 0.25 * (z_col[-nx,-ny] + z_col[-1,-ny] + z_col[-nx,-1] + z_col[-1,-1])
require(grDevices)
colfunc = colorRampPalette(colors)
cols = cut(hgt, breaks = class_borders)
cols = colfunc(length(class_borders))[as.numeric(cols)]
persp(x, y, z, col = cols, ...)
}
