Drawing cuboid with given coordinates in rgl - r

I am trying to draw a cuboid of given coordinates of vertices : (-3,-2,-5), (-3,-2,6), (-3,3,-5), (-3,3,6), (7,-2,-5), (7,-2,6), (7,3,-5), (7,3,6) using rgl package. That I have done in the following manner :
library(rgl)
vertices1 <- c(
-3, -2, -5, 1,
7, -2, -5, 1,
7, 3, -5, 1,
-3, 3, -5, 1
)
vertices2 <- c(
-3, -2, 6, 1,
7, -2, 6, 1,
7, 3, 6, 1,
-3, 3, 6, 1
)
vertices3 <- c(
-3, -2, -5, 1,
-3, -2, 6, 1,
-3, 3, 6, 1,
-3, 3, -5, 1
)
vertices4 <- c(
7, -2, -5, 1,
7, -2, 6, 1,
7, 3, 6, 1,
7, 3, -5, 1
)
vertices5 <- c(
-3, 3, -5, 1,
7, 3, -5, 1,
7, 3, 6, 1,
-3, 3, 6, 1
)
vertices6 <- c(
-3, -2, -5, 1,
7, -2, -5, 1,
7, -2, 6, 1,
-3, -2, 6, 1
)
indices <- c( 1, 2, 3, 4 )
open3d()
wire3d( qmesh3d(vertices1, indices) , col = "blue")
wire3d( qmesh3d(vertices2, indices) , col = "blue" )
wire3d( qmesh3d(vertices3, indices) , col = "blue")
wire3d( qmesh3d(vertices4, indices) , col = "blue")
shade3d(qmesh3d(vertices1, indices) , col = "blue", alpha = 0.1)
shade3d(qmesh3d(vertices2, indices) , col = "blue", alpha = 0.1)
shade3d(qmesh3d(vertices3, indices) , col = "blue", alpha = 0.1)
shade3d(qmesh3d(vertices4, indices) , col = "blue", alpha = 0.1)
shade3d(qmesh3d(vertices5, indices) , col = "blue", alpha = 0.1)
shade3d(qmesh3d(vertices6, indices) , col = "blue", alpha = 0.1)
Is there any better way to do it using rgl ?

More concisely, and avoiding to repeat some vertices:
library(rgl)
vertices <- cbind(
c(-3,-2,-5),
c(-3,-2, 6),
c(-3, 3,-5),
c(-3, 3, 6),
c( 7,-2,-5),
c( 7,-2, 6),
c( 7, 3,-5),
c( 7, 3, 6)
)
indices <- cbind(
c(1, 5, 7, 3),
c(2, 6, 8, 4),
c(1, 2, 4, 3),
c(5, 6, 8, 7),
c(3, 7, 8, 4)
c(1, 5, 6, 2)
)
cuboid <- qmesh3d(
vertices = vertices,
indices = indices,
homogeneous = FALSE
)
shade3d(cuboid, color = "blue", alpha = 0.1)
wire3d(cuboid, color = "blue")

Related

Is there a way, i can order the axis on a melted ggplot? [duplicate]

This question already has answers here:
Order discrete x scale by frequency/value
(7 answers)
How do you specifically order ggplot2 x axis instead of alphabetical order? [duplicate]
(2 answers)
ggplot2, Ordering y axis
(1 answer)
R ggplot ordering bars within groups
(1 answer)
Closed 6 months ago.
I have a Problem with a Plot I want to order, but it seems like it cant be.
install.packages("reshape2")
library(reshape2)
install.packages("ggplot2")
library(ggplot2)
df <- createRegressionTable(data,colname)
gg <- melt(df, id = "colname")
return(
ggplot(gg, aes(
x = colname, y = variable, fill = value
)) +
geom_tile(show.legend = FALSE) +
geom_text(aes(label = value), alpha = 0.6) +
scale_fill_gradient(low = "#D5E8D4", high = "#F8CECC") +
labs(
x = "Regressant",
y = "Regressor"
) +
theme(legend.key = element_blank())
)
I know the function createRegressionTable is a black box but this is the result:
list(colname = c("zielrichtungU", "zielrichtungO",
"imitationU", "imitationO", "steuerungU", "steuerungO", "neuheitU",
"neuheitO", "netzwerkU", "netzwerkO"), zielrichtungU = c(5, 1,
5, 1, 3, 4, 1, 1, 1, 1), zielrichtungO = c(1, 5, 1, 5, 1, 5,
3, 5, 1, 1), imitationU = c(5, 1, 5, 5, 1, 5, 1, 1, 4, 1), imitationO = c(1,
5, 5, 5, 1, 1, 5, 5, 5, 5), steuerungU = c(3, 1, 1, 1, 5, 5,
1, 2, 1, 1), steuerungO = c(4, 5, 5, 1, 5, 5, 3, 5, 1, 3), neuheitU = c(1,
3, 1, 5, 1, 3, 5, 5, 1, 1), neuheitO = c(1, 5, 1, 5, 2, 5, 5,
5, 1, 1), netzwerkU = c(1, 1, 4, 5, 1, 1, 1, 1, 5, 5), netzwerkO = c(1,
1, 1, 5, 1, 3, 1, 1, 5, 5))
I tested whether the output of melt is scrambled, but it seems to be ordered, as I wished, and now I don't know where the problem lies
And here is the Plot, that I'd love to order:

Setting custom labels on stacked ggplot2 plot

This question is a continuation of my previous question here.
I have a heatmap with a dataset available. The dataset is pasted below:
library(ggplot2)
library(colorspace)
library(directlabels)
smalltest <- structure(list(x = c(-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8,
-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8,
-7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7,
-6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6,
-5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6, -5,
-4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8),
y = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5),
z = c(0.353727812855041, 0.512450876310741,
0.668920303216554, 0.770942367746301, 0.829915628317595, 0.873001682466956,
0.900219155289838, 0.918353789896507, 0.936488424503176, 0.954641684205298,
0.961439844045867, 0.972770110446816, 0.975042372092157, 0.981846740297877,
0.986385055223408, 0.986385055223408, 0.986385055223408, 0.33104865495769,
0.464820298870698, 0.62128351741136, 0.752801524774481, 0.804964208774903,
0.850322524569605, 0.879812259037828, 0.913821683336127, 0.934222371222986,
0.950109577644919, 0.959173790765678, 0.970504057166626, 0.975042372092157,
0.981846740297877, 0.986385055223408, 0.986385055223408, 0.986385055223408,
0.31064175870568, 0.428544821292209, 0.589558771488704, 0.725596468681902,
0.786835782533385, 0.838986049803505, 0.872995474101805, 0.897946893644497,
0.920613634811545, 0.943299001074047, 0.956907737485488, 0.970504057166626,
0.970504057166626, 0.981840531932726, 0.986385055223408, 0.986385055223408,
0.986385055223408, 0.29023486245367, 0.419493024901753, 0.569145666871543,
0.702929727514853, 0.775480682671832, 0.827655783402557, 0.866197314261236,
0.891148733803927, 0.916075319886014, 0.931943901212494, 0.952369422559957,
0.970504057166626, 0.970504057166626, 0.981840531932726, 0.981840531932726,
0.986385055223408, 0.986385055223408, 0.272100227847001, 0.396807658639251,
0.557778150279687, 0.691580836018451, 0.766410261185922, 0.807248887150547,
0.857126892775325, 0.888876472158586, 0.911543213325635, 0.929684056297455,
0.941020531063555, 0.959155165670224, 0.968231795521285, 0.977302217007196,
0.981840531932726, 0.984112793578067, 0.984112793578067, 0.265302068006432,
0.396789033543797, 0.557784358644838, 0.680244361252351, 0.761871946260391,
0.800444518944826, 0.841264519813997, 0.882078312318017, 0.909277160045445,
0.931950109577645, 0.941014322698404, 0.954623059109845, 0.961421218950414,
0.972763902081665, 0.977302217007196, 0.984112793578067, 0.984112793578067)),
row.names = c(NA, -102L), class = c("tbl_df", "tbl", "data.frame"))
I can generate a heatmap and contour lines based on the dataset presented above.
ggplot(smalltest, aes(x = x, y = y)) +
geom_tile(aes(fill = z)) +
scale_fill_continuous_divergingx(palette = 'RdBu', rev = FALSE, mid = 0.9, l3 = 0, p3 = 0.95, p4 = 0.85) +
scale_x_continuous(expand = c(0, 0), breaks = -8:8) +
scale_y_continuous(expand = c(0, 0), breaks = 0:5) +
geom_contour(aes(z = z), breaks = c(0.8, 0.9, 0.95), color = 'black', size = 1) +
geom_dl(aes(label = c(rep(NA, 99), 'Low', 'Middle', 'High')), method = 'last.points')
I have the following questions:
How do I have the geom_dl() only look/use the ends or the sides of the contour lines for those labels? I added the rep(NA,99) initially as I get an error stating that the length of label must either be equal to 1 or the length of the dataset (102 here). But how can I simply just pass through a vector of custom strings?
How do I extend the contour lines to the ends of the tile?
Thanks!
Created on 2019-11-07 by the reprex package (v0.3.0)

Understanding parameters inputting for scale_fill_continuous_divergingx for handling color margins

This question is a continuation of my previous question here.
I have a heatmap with a dataset available. The dataset is pasted below:
library(ggplot2)
library(colorspace)
bigtest <- structure(list(x = c(-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8,
-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8,
-7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7,
-6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6,
-5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6, -5,
-4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8),
y = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5),
z = c(1281.35043, 576.76381, 403.46607,
363.28815, 363.13356, 335.04997, 246.93314, 191.56371, 165.35087,
165.35087, 136.33712, 83.91203, 107.5773, 56.91087, 56.91089,
54.16559, 54.18172, 1841.60838, 1098.66304, 424.80686, 363.52776,
363.13355, 335.04998, 246.93314, 191.69473, 165.35087, 165.35087,
136.33712, 83.91204, 107.57729, 56.91087, 56.91088, 54.16421,
54.16794, 2012.52217, 1154.7927, 446.79023, 363.31379, 363.13356,
335.04997, 246.93314, 191.9613, 165.35087, 165.35087, 136.33712,
83.91202, 107.57731, 56.91088, 56.91088, 54.1642, 54.16559, 2077.10354,
1217.43403, 450.18301, 363.44225, 363.13357, 363.13363, 253.99753,
218.43223, 165.35087, 165.35014, 136.33712, 83.91203, 107.57822,
82.87399, 56.91087, 54.1642, 54.1642, 2092.56391, 1229.49925,
451.15179, 392.30728, 363.13356, 363.13282, 264.18944, 218.4308,
165.35087, 165.35044, 136.33712, 83.91202, 83.92709, 82.87353,
82.87406, 56.54491, 54.16421, 2206.93318, 1231.66411, 457.37767,
392.41558, 363.13357, 363.13283, 335.06272, 191.95211, 165.35087,
165.35014, 136.33712, 136.35211, 112.12755, 82.73634, 82.87353,
82.87418, 54.16421)),
row.names = c(NA, -102L),
class = c("tbl_df", "tbl", "data.frame"))
I'm generating a heatmap with the following code section:
ggplot(bigtest, aes(x = x, y = y)) +
geom_tile(aes(fill = z)) +
scale_fill_continuous_divergingx(palette = 'RdBu', rev = TRUE, mid = 347.48, l3 = 54, p3 = 2206, p4 = 325)
What I'm expecting from the plot is for the white color to be centered at a specific value and for the other gradients to diverge based on above or below that value. However, by working with the different parameters, it seems I don't fully understand what the parameters l3, p3, and p4 are referring to. When I was reviewing the documentation for this function it suggested that the parameters to customize the scale is from divergingx_hcl function within the colorspace package.
When reviewing the divergingx_hcl documentation it states they're coordinate corresponding to different input parameters. I'm completely lost and fully unaware of what this is. Any guidance on helping me wrap my head around these parameters (not just l3, p3, and p4 but the other parameters) would be greatly appreciated.
Created on 2019-11-07 by the reprex package (v0.3.0)
First, all colors are specified as HCL (hue, chroma, luminance), which correspond to the type of the color (red, green blue, etc.), how colorful a color is (low chroma is gray, high chroma is very colorful), and how light a color is (high luminance is white, low luminance is black).
The parameter l3 indicates the luminance component of the color at one end of the color scale. (l1 is the luminance at the other end, and l2 is the luminance in the middle.) Luminance goes from 0 to 100. So, if you want the color at the end to be darker, set luminance to a lower value. The parameters p3 and p4 are exponents that govern how quickly the colors transition from the midpoint to the endpoint. In general, values closer to 0 mean quicker transitions, and values greater than 1 mean slower transitions. It's unlikely you'll ever want p3 or p4 values greater than 10.
To get the default parameters for a palette, you can use the divergingx_palettes() command:
library(colorspace)
divergingx_palettes('RdBu')
#> HCL palette
#> Name: RdBu
#> Type: Diverging (flexible)
#> Parameter ranges:
#> h1 h2 h3 c1 c2 c3 l1 l2 l3 p1
#> 20 NA 230 60 0 50 20 98 15 1.4
Created on 2019-11-07 by the reprex package (v0.3.0)
This shows you that the color at the end point specified by l3 is already quite dark. Changing l3 from 15 to 0 will make it a bit darker but not by much. Further, p2, p3, and p4 are not specified, which means they're all taken from p1, and hence are 1.4. Thus, color interpolation is somewhat slower than linear.
With this knowledge, the following examples should make sense. To learn more about this, I recommend reading the various articles on the colorspace website: http://colorspace.r-forge.r-project.org/
First the data:
library(ggplot2)
library(colorspace)
bigtest <- structure(list(x = c(-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8,
-8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8,
-7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7,
-6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6,
-5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, -8, -7, -6, -5,
-4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8),
y = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5),
z = c(1281.35043, 576.76381, 403.46607,
363.28815, 363.13356, 335.04997, 246.93314, 191.56371, 165.35087,
165.35087, 136.33712, 83.91203, 107.5773, 56.91087, 56.91089,
54.16559, 54.18172, 1841.60838, 1098.66304, 424.80686, 363.52776,
363.13355, 335.04998, 246.93314, 191.69473, 165.35087, 165.35087,
136.33712, 83.91204, 107.57729, 56.91087, 56.91088, 54.16421,
54.16794, 2012.52217, 1154.7927, 446.79023, 363.31379, 363.13356,
335.04997, 246.93314, 191.9613, 165.35087, 165.35087, 136.33712,
83.91202, 107.57731, 56.91088, 56.91088, 54.1642, 54.16559, 2077.10354,
1217.43403, 450.18301, 363.44225, 363.13357, 363.13363, 253.99753,
218.43223, 165.35087, 165.35014, 136.33712, 83.91203, 107.57822,
82.87399, 56.91087, 54.1642, 54.1642, 2092.56391, 1229.49925,
451.15179, 392.30728, 363.13356, 363.13282, 264.18944, 218.4308,
165.35087, 165.35044, 136.33712, 83.91202, 83.92709, 82.87353,
82.87406, 56.54491, 54.16421, 2206.93318, 1231.66411, 457.37767,
392.41558, 363.13357, 363.13283, 335.06272, 191.95211, 165.35087,
165.35014, 136.33712, 136.35211, 112.12755, 82.73634, 82.87353,
82.87418, 54.16421)),
row.names = c(NA, -102L),
class = c("tbl_df", "tbl", "data.frame"))
Now the plots:
ggplot(bigtest, aes(x = x, y = y)) +
geom_tile(aes(fill = z)) +
scale_fill_continuous_divergingx(
palette = 'RdBu', rev = TRUE,
mid = 347.48
)
ggplot(bigtest, aes(x = x, y = y)) +
geom_tile(aes(fill = z)) +
scale_fill_continuous_divergingx(
palette = 'RdBu', rev = TRUE,
mid = 347.48,
p3 = .2,
p4 = .2
)
ggplot(bigtest, aes(x = x, y = y)) +
geom_tile(aes(fill = z)) +
scale_fill_continuous_divergingx(
palette = 'RdBu', rev = TRUE,
mid = 347.48,
l3 = 0,
p3 = .2,
p4 = .2
)
Created on 2019-11-07 by the reprex package (v0.3.0)

plot (ggplot ?) smooth + color area between 2 curves

I have a question for you please :
My data :
Nb_obs <- as.vector(c( 2, 0, 6, 2, 7, 1, 8, 0, 2, 1, 1, 3, 11, 5, 9, 6, 4, 0, 7, 9))
Nb_obst <- as.vector(c(31, 35, 35, 35, 39, 39, 39, 39, 39, 41, 41, 42, 43, 43, 45, 45, 47, 48, 51, 51))
inf20 <- as.vector(c(2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 4, 4, 3, 5, 4))
sup20 <- as.vector(c(3, 4, 4, 4, 5, 4, 4, 5, 4, 4, 5, 5, 5, 6, 5, 6, 6, 5, 7, 6))
inf40 <- as.vector(c(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, 3, 3, 4, 3))
sup40 <- as.vector(c(4, 5, 5, 5, 6, 5, 5, 6, 5, 5, 6, 6, 6, 7, 6, 7, 7, 7, 9, 7))
inf60 <- as.vector(c(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 2))
sup60 <- as.vector(c(5, 6, 6, 6, 8, 7, 7, 7, 7, 7, 7, 7, 8, 9, 8, 9, 9, 9, 11, 9))
inf90 <- as.vector(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1))
sup90 <- as.vector(c(10, 11, 11, 11, 15, 13, 13, 14, 12, 13, 13, 13, 14, 17, 15, 17, 17, 16, 21, 18))
data <- cbind.data.frame(Nb_obs, Nb_obst, inf20, sup20, inf40, sup40, inf60 , sup60, inf90 , sup90)
My plot :
plot(data$Nb_obst, data$Nb_obs, type = "n", xlab = "Number obst", ylab = "number obs", ylim = c(0, 25))
lines(data$Nb_obst, data$inf20, col = "dark red")
lines(data$Nb_obst, data$sup20, col = "dark red")
lines(data$Nb_obst, data$inf40, col = "red")
lines(data$Nb_obst, data$sup40, col = "red")
lines(data$Nb_obst, data$inf60, col = "dark orange")
lines(data$Nb_obst, data$sup60, col = "dark orange")
lines(data$Nb_obst, data$inf90, col = "yellow")
lines(data$Nb_obst, data$sup90, col = "yellow")
My question :
There are two things I'd like to do (and so I think it could be done by ggplot):
In the idea of the graph at the top, the "inf" and "sup" are limits of my model in the IC 20%, then 40%, then 60%, and finally 90%. I would first like to smooth each curve, and then I would like to color the surface between two curves of the same IC, for example that the surface between "data$inf90" and "data$sup90" is yellow, the area between "data$inf60" and "data$60" is orange, etc. And I would like to superimpose each of these colored surfaces + put the good legend please.
Thanks for your help !
Cool question since I had to give myself a crash course in using LOESS for ribbons!
First thing I'm doing is getting the data into a long shape, since that's what ggplot will expect, and since your data has some characteristics that are kind of hidden within values. For example, if you gather into a long shape and have, say a column key, with a value of "inf20" and another of "sup20", those hold more information than you currently have access to, i.e. the measure type is either "inf" or "sup", and the level is 20. You can extract that information out of that column to get columns of measure types ("inf" or "sup") and levels (20, 40, 60, or 90), then map aesthetics onto those variables.
So here I'm getting the data into a long shape, then using spread to make columns of inf and sup, because those will become ymin and ymax for the ribbons. I made level a factor and reversed its levels, because I wanted to change the order of the ribbons being drawn such that the narrow one would come up last and be drawn on top.
library(tidyverse)
data_long <- data %>%
as_tibble() %>%
gather(key = key, value = value, -Nb_obs, -Nb_obst) %>%
mutate(measure = str_extract(key, "\\D+")) %>%
mutate(level = str_extract(key, "\\d+")) %>%
select(-key) %>%
group_by(level, measure) %>%
mutate(row = row_number()) %>%
spread(key = measure, value = value) %>%
ungroup() %>%
mutate(level = as.factor(level) %>% fct_rev())
head(data_long)
#> # A tibble: 6 x 6
#> Nb_obs Nb_obst level row inf sup
#> <dbl> <dbl> <fct> <int> <dbl> <dbl>
#> 1 0 35 20 2 2 4
#> 2 0 35 40 2 2 5
#> 3 0 35 60 2 1 6
#> 4 0 35 90 2 0 11
#> 5 0 39 20 8 3 5
#> 6 0 39 40 8 2 6
ggplot(data_long, aes(x = Nb_obst, ymin = inf, ymax = sup, fill = level)) +
geom_ribbon(alpha = 0.6) +
scale_fill_manual(values = c("20" = "darkred", "40" = "red",
"60" = "darkorange", "90" = "yellow")) +
theme_light()
But it still has the issue of being jagged, so for each level I predicted smoothed values of both inf and sup versus Nb_obst using loess. group_by and do yield a nested data frame, and unnest pulls it back out into a workable form. Feel free to adjust the span parameter, as well as other loess.control parameters that I know very little about.
data_smooth <- data_long %>%
group_by(level) %>%
do(Nb_obst = .$Nb_obst,
inf_smooth = predict(loess(.$inf ~ .$Nb_obst, span = 0.35), .$Nb_obst),
sup_smooth = predict(loess(.$sup ~ .$Nb_obst, span = 0.35), .$Nb_obst)) %>%
unnest()
head(data_smooth)
#> # A tibble: 6 x 4
#> level Nb_obst inf_smooth sup_smooth
#> <fct> <dbl> <dbl> <dbl>
#> 1 90 35 0 11.
#> 2 90 39 0 13.4
#> 3 90 48 0.526 16.7
#> 4 90 39 0 13.4
#> 5 90 41 0 13
#> 6 90 41 0 13
ggplot(data_smooth, aes(x = Nb_obst, ymin = inf_smooth, ymax = sup_smooth, fill = level)) +
geom_ribbon(alpha = 0.6) +
scale_fill_manual(values = c("20" = "darkred", "40" = "red",
"60" = "darkorange", "90" = "yellow")) +
theme_light()
Created on 2018-05-26 by the reprex package (v0.2.0).
This produces the plot with shaded areas using base R graphics.
The trick is to pair the x values with the y values.
plot(data$Nb_obst, data$Nb_obs, type = "n", xlab = "Number obst", ylab = "number obs", ylim = c(0, 25))
lines(data$Nb_obst, data$inf20, col = "dark red")
lines(data$Nb_obst, data$sup20, col = "dark red")
lines(data$Nb_obst, data$inf40, col = "red")
lines(data$Nb_obst, data$sup40, col = "red")
lines(data$Nb_obst, data$inf60, col = "dark orange")
lines(data$Nb_obst, data$sup60, col = "dark orange")
lines(data$Nb_obst, data$inf90, col = "yellow")
lines(data$Nb_obst, data$sup90, col = "yellow")
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf90, rev(sup90)), col = "yellow"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf60, rev(sup60)), col = "dark orange"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf40, rev(sup40)), col = "red"))
with(data, polygon(c(Nb_obst, rev(Nb_obst)), c(inf20, rev(sup20)), col = "dark red"))
The code for a ggplot graph is a bit longer. There is a function geom_ribbon perfect for this.
g <- ggplot(data)
g + geom_ribbon(aes(x = Nb_obst, ymin = sup60, ymax = sup90), fill = "yellow") +
geom_ribbon(aes(x = Nb_obst, ymin = sup40, ymax = sup60), fill = "dark orange") +
geom_ribbon(aes(x = Nb_obst, ymin = sup20, ymax = sup40), fill = "red") +
geom_ribbon(aes(x = Nb_obst, ymin = inf20, ymax = sup20), fill = "dark red") +
geom_ribbon(aes(x = Nb_obst, ymin = inf40, ymax = inf20), fill = "red") +
geom_ribbon(aes(x = Nb_obst, ymin = inf60, ymax = inf40), fill = "dark orange") +
geom_ribbon(aes(x = Nb_obst, ymin = inf90, ymax = inf60), fill = "yellow")
Data.
I will redo your dataset, simplifying its creation. You don't need as.vector and if you are creating a data.frame there is no need for the data.frame method of cbind, data.frame(.) is enough.
Nb_obs <- c( 2, 0, 6, 2, 7, 1, 8, 0, 2, 1, 1, 3, 11, 5, 9, 6, 4, 0, 7, 9)
Nb_obst <- c(31, 35, 35, 35, 39, 39, 39, 39, 39, 41, 41, 42, 43, 43, 45, 45, 47, 48, 51, 51)
inf20 <- c(2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 3, 4, 4, 3, 5, 4)
sup20 <- c(3, 4, 4, 4, 5, 4, 4, 5, 4, 4, 5, 5, 5, 6, 5, 6, 6, 5, 7, 6)
inf40 <- c(1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, 3, 3, 4, 3)
sup40 <- c(4, 5, 5, 5, 6, 5, 5, 6, 5, 5, 6, 6, 6, 7, 6, 7, 7, 7, 9, 7)
inf60 <- c(1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 2)
sup60 <- c(5, 6, 6, 6, 8, 7, 7, 7, 7, 7, 7, 7, 8, 9, 8, 9, 9, 9, 11, 9)
inf90 <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1)
sup90 <- c(10, 11, 11, 11, 15, 13, 13, 14, 12, 13, 13, 13, 14, 17, 15, 17, 17, 16, 21, 18)
data <- data.frame(Nb_obs, Nb_obst, inf20, sup20, inf40, sup40, inf60 , sup60, inf90 , sup90)

How to mirror the outer positions with the variable with R

I have a data frame:
tes <- data.frame(x = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
y = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
d = c(10, 20, 30, 100, 11, 12, 403, 43, 21))
They look like this on the plot
ggplot(aes(x = x, y = y), data = tes) + geom_point(aes(color = factor(d)), size = 5)
I'd like to "mirror the outer rows in this data to obtain such data and plot
tes1 <- data.frame(x = c(0, 0, 0, 0,0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4),
y = c(0, 1, 2, 3, 4, 0, 1, 2, 3, 4, 0, 1, 2, 3, 4, 0, 1, 2, 3, 4, 0, 1, 2, 3, 4),
d = c(10, 10, 20, 30, 30, 10, 10, 20, 30, 30, 100, 100, 11, 12, 12, 403, 403, 43, 21, 21, 403, 403, 43, 21, 21))
ggplot(aes(x = x, y = y), data = tes1) + geom_point(aes(color = factor(d)), size = 4)
Does this do what you're after?
Explanation: We first convert tes into a flattened table with ftable(xtabs(...). Then we simply replicate the first and last column, and first and last row. We then give new column and row names to reflect the extra "flanking" rows and columns, and finally convert back to a long dataframe with data.frame(table(...))
# Convert to table then matrix
m <- ftable(xtabs(d ~ x + y, data = tes));
class(m) <- "matrix";
# Replicate first and last column/row by binding to the beginning
# and end, respectively of the matrix
m <- cbind(m[, 1], m, m[, ncol(m)]);
m <- rbind(m[1, ], m, m[nrow(m), ]);
# Set column/row names
rownames(m) <- seq(min(tes$x) - 1, max(tes$x) + 1);
colnames(m) <- seq(min(tes$y) - 1, max(tes$y) + 1);
# Convert back to long dataframe
tes.ext <- data.frame(as.table(m));
colnames(tes.ext) <- colnames(tes);
# Plot
ggplot(aes(x = x, y = y), data = tes.ext) + geom_point(aes(color = factor(d)), size = 5)
Data
tes <- data.frame(x = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
y = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
d = c(10, 20, 30, 100, 11, 12, 403, 43, 21))

Resources