I am trying to create a triangular plot,that three dimensions of which represent three herbal strategies.
One dimension represents the strategy of C (competitive plant), the second dimension “S” (stress tolerant plants) and the third dimension ”R” (ruderal plants), the points on it represent the plant species.
I want to write the species name outside the triangle and connect it to the points inside the triangle with an arrow. How do I draw this ternary plot?
The following is the data structure and my code
require(Ternary)
TernaryPlot()
#Plot two stylised plots side by side, and plot data
par(mfrow=c(1, 1), mar=rep(0.3, 4))
TernaryPlot(atip='C%', btip='R%', ctip='S%',
point='UP', lab.cex=0.8, grid.minor.lines=0,
grid.lty='solid', col='#FFFFFF', grid.col='GREY',
axis.col=rgb(0.1, 0.1, 0.1), ticks.col=rgb(0.1, 0.1, 0.1),
padding=0.08)
data_points <- list("Bromus dantonia" = c(47, 59, 149),
"Calamagrosis psoudo phragmatis" = c(90, 102, 63),
"Carex diluta" = c(109, 64, 82),
"Carex divisa" = c(96, 99, 59),
"Carex pseudocyperus" = c(130, 71, 54),
"Carex stenophylla" = c(97, 98, 59),
"Catabrosa aquatica" = c(100, 5, 150),
"Centaurea iberica" = c(124, 85, 46),
"Cirsium hygrophilum" = c(158, 42, 55),
"Cladium mariscus" = c(159, 96, 0),
"cod2" = c(54, 82, 119),
"Cynodon dactylon" = c(121, 54, 80),
"Eleocharis palustri" = c(124, 100, 31),
"Epilobium parviflorum" = c(67, 80, 107),
"Eromopoa persica" = c(83, 15, 157),
"Funaria cf.microstoma" = c(8, 0, 247),
"Glaux maritime" = c(4, 196, 55),
"Hordeum brevisubulatum" = c(76, 70, 109),
"Hordeum glaucum" = c(40, 79, 136),
"Inula britannica" = c(95, 108, 51),
"Juncus articulatus" = c(107, 79, 69),
"Blysmus compressus" = c(81, 127, 47),
"Juncusinflexus"= c(149, 106, 0),
"Medicago polymorpha" = c(60, 86, 109),
"Mentha spicata" = c(150, 23, 82),
"Ononis spinosa" = c(66, 112, 77),
"Phragmites australis" = c(234, 0, 21),
"Plantago amplexicaulis" = c(108, 83, 64),
"Poa trivialis" = c(90, 28, 138),
"Polygonum paronychioides" = c(20, 12, 223),
"Potentila reptans" = c(106, 41, 108),
"Potentilla anserina" = c(105, 58, 91),
"Ranunculus grandiflorus" = c(129, 25, 101),
"Schoenus nigricans" = c(143, 91, 21),
"Setaria viridis" = c(10, 7, 238),
"Sonchus oleraceus" = c(178, 0, 77),
"Taraxacum officinale" = c(117, 28, 110),
"Trifolium repens" = c(94, 4, 157),
"Triglochin martima" = c(63, 96, 95),
"Veronica anagallis-aquatica" = c(55, 37, 163)
)
AddToTernary(points, data_points, pch=21, cex=1.2,
bg=vapply(data_points,
function (x) rgb(x[1], x[2], x[3], 128,
maxColorValue=255),
character(1))
)
AddToTernary(text, data_points, names(data_points), cex=0.8, font=1)
Related
I am struggling to plot the following data and think it is because of the format of the data.
structure(list(HE_Provider = c("Coventry University", "The University of Leicester",
"Total"), Bath_and_North_East_Somerset = c(15, 20, 205), Bedford = c(85,
90, 1040), Blackburn_with_Darwen = c(10, 20, 95), Blackpool = c(10,
5, 60), `Bournemouth,_Poole_and_Christchurch` = c(35, 15, 285
), Bracknell_Forest = c(15, 10, 210), Buckinghamshire = c(195,
145, 1835), Cambridgeshire = c(130, 160, 2500), Central_Bedfordshire = c(115,
70, 1120), Cheshire_East = c(45, 55, 935), Cheshire_West_and_Chester = c(25,
40, 535), City_of_Bristol = c(40, 35, 390), City_of_Derby = c(65,
135, 4115), City_of_Kingston_upon_Hull = c(25, 20, 265), City_of_Leicester = c(315,
1275, 6860), City_of_Nottingham = c(65, 145, 5405), City_of_Plymouth = c(15,
10, 135), City_of_Portsmouth = c(15, 15, 130), City_of_Southampton = c(15,
20, 140), `City_of_Stoke-on-Trent` = c(50, 15, 475), City_of_York = c(35,
20, 350), Cornwall = c(25, 25, 300), County_Durham = c(20, 40,
330), Cumbria = c(30, 20, 305), Darlington = c(0, 15, 110), Derbyshire = c(100,
145, 6925), Devon = c(50, 50, 630), Dorset = c(30, 20, 285),
East_Riding_of_Yorkshire = c(75, 45, 760), East_Sussex = c(55,
50, 650), Essex = c(365, 180, 3320), Gloucestershire = c(150,
85, 905), Greater_London = c(5550, 1930, 18285), Greater_Manchester = c(245,
280, 2820), Halton = c(5, 10, 80), Hampshire = c(180, 120,
1485), Hartlepool = c(5, 10, 55), Herefordshire = c(50, 15,
235), Hertfordshire = c(385, 270, 4815), Isle_of_Wight = c(10,
5, 90), Isles_of_Scilly = c(0, 0, 0), Kent = c(365, 195,
2590), Lancashire = c(75, 125, 985), Leicestershire = c(540,
980, 8010), Lincolnshire = c(145, 190, 7710), Luton = c(105,
75, 685), Medway = c(95, 35, 425), Merseyside = c(75, 120,
975), Middlesbrough = c(10, 5, 65), Milton_Keynes = c(265,
170, 2205), Norfolk = c(120, 115, 2410), North_East_Lincolnshire = c(20,
10, 810), North_Lincolnshire = c(20, 20, 810), North_Somerset = c(25,
15, 205), North_Yorkshire = c(500, 80, 1160), Northamptonshire = c(680,
510, 7505), Northumberland = c(10, 25, 235), Nottinghamshire = c(140,
185, 9410), Oxfordshire = c(280, 135, 1785), Peterborough = c(85,
135, 1560), Reading = c(75, 25, 260), Redcar_and_Cleveland = c(5,
5, 90), Rutland = c(5, 35, 345), Shropshire = c(60, 30, 500
), Slough = c(95, 40, 270), Somerset = c(40, 40, 490), South_Gloucestershire = c(40,
25, 310), South_Yorkshire = c(105, 180, 3220), `Southend-on-Sea` = c(35,
25, 345), Staffordshire = c(370, 150, 3825), `Stockton-on-Tees` = c(20,
15, 145), Suffolk = c(115, 115, 1935), Surrey = c(195, 155,
2900), Swindon = c(50, 25, 225), Telford_and_Wrekin = c(60,
20, 360), Thurrock = c(140, 40, 370), Torbay = c(5, 5, 65
), Tyne_and_Wear = c(45, 60, 680), Warrington = c(20, 20,
290), Warwickshire = c(2080, 210, 2825), West_Berkshire = c(35,
25, 300), West_Midlands = c(8315, 915, 8220), West_Sussex = c(105,
95, 1115), West_Yorkshire = c(200, 245, 3005), Wiltshire = c(90,
55, 630), Windsor_and_Maidenhead = c(40, 25, 405), Wokingham = c(70,
35, 395), Worcestershire = c(350, 110, 1350), `England_(county_unitary_authority_unknown)` = c(0,
10, 770), Total_England = c(24990, 11530, 154930), Total = c(25380,
11845, 158480)), row.names = c(NA, -3L), class = "data.frame")
I would like to plot the Region on the bottom but don't have a title for these regions, with the numbers up the y axis and the fill being the university.
This type of problems generally has to do with reshaping the data. The format should be the long format and the data is in wide format. See this post on how to reshape the data from wide to long format.
Reshape the data and plot with geom_col.
suppressPackageStartupMessages({
library(dplyr)
library(tidyr)
library(ggplot2)
})
df1 %>%
select(-matches("England"), -matches("Total")) %>%
pivot_longer(-HE_Provider, names_to = "Region") %>%
ggplot(aes(Region, value, fill = HE_Provider)) +
geom_col() +
theme_bw(base_size = 10) +
theme(axis.text.x = element_text(size = 7, angle = 75, vjust = 1, hjust = 1),
legend.position = "bottom")
Created on 2022-12-06 with reprex v2.0.2
We could bring the data in long format. For y we used log scale:
library(tidyverse)
df %>%
pivot_longer(-HE_Provider) %>%
group_by(HE_Provider, name) %>%
summarise(sum_value = sum(value)) %>%
ggplot(aes(x=name, y=log(sum_value), fill=HE_Provider))+
geom_col(position=position_dodge())+
theme(axis.text.x = element_text(angle = 45, vjust = 0.5, hjust=1))
I have this dataframe:
df <- structure(list(a = c(2, 5, 90, 77, 56, 65, 85, 75, 12, 24, 52,
32), b = c(45, 78, 98, 55, 63, 12, 23, 38, 75, 68, 99, 73), c = c(77,
85, 3, 22, 4, 69, 86, 39, 78, 36, 96, 11), d = c(52, 68, 4, 25,
79, 120, 97, 20, 7, 19, 37, 67), e = c(14, 73, 91, 87, 94, 38,
1, 685, 47, 102, 666, 74)), class = "data.frame", row.names = c(NA,
-12L))
and the script:
R <- Map(`+`, list(1:3), 0:3)
df_cum <- as.matrix(rep(NA, ncol(df)))
for (r in seq(R)) {
for (f in seq(ncol(df))) {
df_cum <- sapply(df[R[[r]],], function(x) (cumprod(1 + x) - 1)*100)
}
}
I want to change all the first row values to "0", for each loop (1:3, 2:4, 3:5,...), before
df_cum <- sapply(df[R[[r]],], function(x) (cumprod(1 + x) - 1)*100)
I.e. for the first cicle 1:3 (df rows), the first row values change from "2, 45, 77, 52, 14" to "0, 0, 0, 0, 0".
How can I do?
Thx
Here is my data:
How do I make it so that the column names appear on the x axis? I will probably use the facet function so that the number values aren't next to the duration values, so one graph will have these on the x axis: "Number Looks", "Number Gesture", "Number Reach", "Number Other" for group A, and another graph will have these on the x axis: "Duration Looks", "Duration Gesture", "Duration Reach", "Duration Other" for group A, with the data below the column titles as the y-axis values. I will also have to generate the data for group B in the same way
Here is how we could achieve your task:
Bring your data in the correct format with pivot_longer
Use filter for each number and Duration
Now you have to separate dataframes
plot them individually with ggplot2 using facet_wrap for group A and B
The output arranged with plot_grid from cowplot package!
library(cowplot)
library(tidyverse)
df_number <- df %>%
pivot_longer(
cols = 3:12,
names_to = "names",
values_to = "values"
) %>%
filter(grepl('Number', names))
df_Duration <- df %>%
pivot_longer(
cols = 3:12,
names_to = "names",
values_to = "values"
) %>%
filter(grepl('Duration', names))
plot_number <- ggplot(df_number, aes(x=factor(names), y=values)) +
geom_bar(stat = "identity") +
xlab("Number") +
ylab("Value") +
facet_wrap(~Group) +
theme_bw()
plot_Duration <- ggplot(df_Duration, aes(x=factor(names), y=values)) +
geom_bar(stat = "identity") +
xlab("Duration") +
ylab("Value") +
facet_wrap(~Group) +
theme_bw()
plot_grid(plot_number, plot_Duration, labels = "AUTO")
data:
df <- structure(list(Participant = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
11, 12, 13, 14, 15, 16, 17), Group = c("A", "A", "A", "A", "A",
"A", "A", "A", "B", "B", "B", "B", "B", "B", "B", "B", "B"),
Number_Looks = c(47, 94, 23, 64, 99, 38, 85, 38, 20, 10,
34, 54, 87, 78, 45, 63, 32), Duration_Look = c(247, 294,
223, 264, 299, 238, 285, 238, 220, 210, 234, 254, 287, 278,
245, 263, 232), Number_Gesture = c(39, 86, 15, 56, 91, 30,
77, 30, 12, 20, 26, 46, 79, 70, 37, 55, 24), Duration_Gesture = c(29,
76, 5, 46, 81, 20, 67, 20, 20, 10, 16, 36, 69, 60, 27, 45,
14), Number_Reach = c(40, 87, 16, 57, 92, 31, 78, 31, 13,
21, 27, 47, 80, 71, 38, 56, 25), Duration_Reach = c(89, 136,
65, 106, 141, 80, 127, 80, 80, 70, 76, 96, 129, 120, 87,
105, 74), Number_Other = c(52, 99, 28, 69, 104, 43, 90, 43,
25, 33, 39, 59, 92, 83, 50, 68, 37), Duration_Other = c(339,
386, 315, 356, 391, 330, 377, 330, 330, 320, 326, 346, 379,
370, 337, 355, 324), Number_Sound = c(152, 199, 128, 169,
204, 143, 190, 143, 125, 133, 139, 159, 192, 183, 150, 168,
137), Duration_Sound = c(319, 366, 295, 336, 371, 310, 357,
310, 310, 300, 306, 326, 359, 350, 317, 335, 304)), class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -17L))
I have a data such that produced from special function:
where t0=1, alpha, q, gamma, C and beta are unknown parameters.
The question is how to fit the above function to following data, in R?
mydata<-structure(list(x = 1:100, y = c(0, 0, 2, 1, 3, 4, 4, 3, 7, 8,
9, 11, 12, 11, 15, 15, 17, 21, 49, 43, 117, 75, 85, 97, 113,
129, 135, 147, 149, 149, 123, 129, 127, 122, 143, 157, 144, 139,
123, 117, 141, 138, 124, 134, 158, 151, 136, 133, 121, 117, 122,
125, 117, 111, 98, 94, 92, 89, 73, 87, 91, 88, 94, 90, 93, 76,
60, 96, 71, 80, 71, 63, 65, 47, 74, 63, 78, 68, 55, 48, 51, 45,
48, 50, 71, 48, 35, 51, 69, 62, 64, 66, 51, 59, 58, 34, 57, 56,
63, 50)), class = "data.frame", row.names = c(NA, -100L))
I defined the function as follows:
t0<<-1
fyy<-function(t,cc0,alpha0,qq0,beta0,gamma0){
ret<-cc0*((t-t0)^alpha0)/(((1+(qq0-1)*beta0*(t-t0)^gamma0))^(1/(qq0-1)))
return(ret)
}
but I don't know how to continue?
as #mhovd mentioned I used "nls" function but I got an error as follows:
> fit <- nls(y~fyy(x,cc0 ,alpha0 ,beta0 ,gamma0 ,qq0 ),
data=data.frame(mydata), start=list(cc0 = .01,alpha0 =1,beta0 =.3,gamma0
= 2,qq0 = 1))
Error in numericDeriv(form[[3L]], names(ind), env) :
Missing value or an infinity produced when evaluating the model
In the comments #masoud references a paper about the specific function in the question. It suggests fixing gamma0 and qq0 and if we do that we do get a solution -- fm shown in red in the plot. We have also shown an alternate parametric curve as fm2 in blue. It also has 3 optimized parameters but has lower residual sum of squares (lower is better).
fyy <- function(t,cc0,alpha0,qq0,beta0,gamma0){
cc0 * ((t-t0)^alpha0) / (((1+(qq0-1)*beta0*(t-t0)^gamma0))^(1/(qq0-1)))
}
mydata0 <- subset(mydata, y > 0)
# fixed values
t0 <- 1
gamma0 <- 3
qq0 <- 1.2
st <- list(cc0 = 1, alpha0 = 1, beta0 = 1) # starting values
fm <- nls(y ~ fyy(x, cc0, alpha0, qq0, beta0, gamma0), mydata0,
lower = list(cc0 = 0.1, alpha0 = 0.1, beta0 = 0.00001),
start = st, algorithm = "port")
deviance(fm) # residual sum of squares
## [1] 61458.5
st2 <- list(a = 1, b = 1, c = 1)
fm2 <- nls(y ~ exp(a + b/x + c*log(x)), mydata0, start = st2)
deviance(fm2) # residual sum of squares
## [1] 16669.24
plot(mydata0, ylab = "y", xlab = "t")
lines(fitted(fm) ~ x, mydata0, col = "red")
lines(fitted(fm2) ~ x, mydata0, col = "blue")
legend("topright", legend = c("fm", "fm2"), lty = 1, col = c("red", "blue"))
I have a list of 10 plots/graphs from model_list for which I used the following code below. I stored these plots in the list var_list.
library(mixOmics)
var_list<-lapply(model_list, function(x) plotVar(x))
var_list contains thus 10 plots, for example below the first element of the list:
> var_list[[1]]
x y Block names pch cex col font Overlap
TPI200 -0.6975577 -0.5582925 X TPI200 1 5 #388ECC 1 Correlation Circle Plots
TPI350 -0.8561514 -0.4101970 X TPI350 1 5 #388ECC 1 Correlation Circle Plots
TPI500 -0.9403552 -0.1074518 X TPI500 1 5 #388ECC 1 Correlation Circle Plots
TPI700 -0.9256605 0.3070954 X TPI700 1 5 #388ECC 1 Correlation Circle Plots
TPI900 -0.8697037 0.4699423 X TPI900 1 5 #388ECC 1 Correlation Circle Plots
I want to save these plots from this list as a jpeg (resulting in 10 different jpeg's). I used the following code and R creates 10 images, but all the images are the same (so only the first plot is created and duplicated for the rest).
lapply(1:length(model_list), function (x) {
jpeg(paste0(names(model_list)[x], ".jpg"))
lapply(model_list, function(x) plotVar(x))
dev.off()
})
I have seen similar questions, but I can't find the right solution to have a jpg for each plot for each dataframe in the list! How can I solve this? Many thanks in advance!
Via this link you can find the dput(model_list[[1]]).
With data provided in a similar post by you, here a possible solution to your issue. It is better if you work around model_list because when you transform to var_list all data become graphical elements. Next code contains a replicate of model_list using datalist but in your real problem you must have it, also must include names for each of the components of the list:
library(mixOmics)
#Data
datalist <- list(df1 = structure(list(OID = c(-1, -1, -1, -1, -1, -1), POINTID = c(1,
2, 3, 4, 5, 6), WETLAND = c("no wetl", "no wetl", "no wetl",
"wetl", "wetl", "wetl"), TPI200 = c(70, 37, 45, 46, 58, 56),
TPI350 = c(67, 42, 55, 58, 55, 53), TPI500 = c(55, 35, 45,
51, 53, 51), TPI700 = c(50, 29, 39, 43, 49, 49), TPI900 = c(48,
32, 41, 46, 47, 46), TPI1000 = c(46, 16, 41, 36, 46, 46),
TPI2000 = c(53, 17, 53, 54, 54, 54), TPI3000 = c(47, 35,
47, 47, 47, 47), TPI4000 = c(49, 49, 49, 49, 49, 49), TPI5000 = c(63,
63, 63, 62, 62, 61), TPI2500 = c(48, 26, 48, 49, 49, 49)), row.names = c(NA,
6L), class = "data.frame"), df2 = structure(list(OID = c(-1,
-1, -1, -1, -1, -1), POINTID = c(1, 2, 3, 4, 5, 6), WETLAND = c("no wetl",
"no wetl", "no wetl", "wetl", "wetl", "wetl"), TPI200 = c(70,
37, 45, 46, 58, 56), TPI350 = c(67, 42, 55, 58, 55, 53), TPI500 = c(55,
35, 45, 51, 53, 51), TPI700 = c(50, 29, 39, 43, 49, 49), TPI900 = c(48,
32, 41, 46, 47, 46), TPI1000 = c(46, 16, 41, 36, 46, 46), TPI2000 = c(53,
17, 53, 54, 54, 54), TPI3000 = c(47, 35, 47, 47, 47, 47), TPI4000 = c(49,
49, 49, 49, 49, 49), TPI5000 = c(63, 63, 63, 62, 62, 61), TPI2500 = c(48,
26, 48, 49, 49, 49)), row.names = c(NA, 6L), class = "data.frame"))
#Function
custom_splsda <- function(datalist, ncomp, keepX, ..., Xcols, Ycol){
Y <- datalist[[Ycol]]
X <- datalist[Xcols]
res <- splsda(X, Y, ncomp = ncomp, keepX = keepX, ...)
res
}
#Create model_list, you must have the object
model_list <- lapply(datalist, custom_splsda,
ncomp = 2, keepX = c(5, 5),
Xcols = 4:8, Ycol = "WETLAND")
Next the loop for plots:
#Loop
for(i in 1:length(model_list))
{
jpeg(paste0(names(model_list)[i], ".jpg"))
plotVar(model_list[[i]],title = names(model_list)[i])
dev.off()
}
That will produce plots in your folder as you can see here:
And also the plots that change (see titles):