experimental_cores
geometries <- experimental_cores %>%
transmute(
Experimental_data = Original_Volume / 1000,
Prism = corrected_width * corrected_thickness * corrected_length / 1000,
Cube = corrected_length^3 / 1000,
Sphere = 4/3 * pi * ((corrected_length/2)^3) / 1000,
Cylinder = pi * ((corrected_width/2)^2) * corrected_length / 1000,
Ellipsoid = 4/3 * pi * ((corrected_length/2) * (corrected_width/2) * (corrected_thickness/2)) / 1000
)
geometries
geometries_summary <- data.frame(
length = round(sapply(geometries, length), 2),
mean = round(sapply(geometries, mean), 2),
median = round(sapply(geometries, median), 2),
min= round(sapply(geometries, min), 2),
max= round(sapply(geometries, max), 2),
sd = round(sapply(geometries, sd), 2),
cv = round(sapply(geometries, function(x) sd(x) / mean(x)), 2),
shapiro_wilk = round(sapply(geometries, function(x) shapiro.test(x)$p.value), 7)
)
geometries_summary
Perc_remaining_volume <- (experimental_cores$Volume / geometries * 100)
Perc_extracted_volume <- 100 - Perc_remaining_volume
Perc_extracted_volume_summary <- data.frame(
length = round(sapply(Perc_extracted_volume, length), 2),
mean = round(sapply(Perc_extracted_volume, mean), 2),
median = round(sapply(Perc_extracted_volume, median), 2),
min= round(sapply(Perc_extracted_volume, min), 2),
max= round(sapply(Perc_extracted_volume, max), 2),
sd = round(sapply(Perc_extracted_volume, sd), 2),
cv = round(sapply(Perc_extracted_volume, function(x) sd(x) / mean(x)), 2),
shapiro_wilk = round(sapply(Perc_extracted_volume, function(x) shapiro.test(x)$p.value), 6)
)
Perc_extracted_volume_summary
correlations_pearson <- rcorr(as.matrix(geometries), type = "pearson")
correlations_spearman <- rcorr(as.matrix(geometries), type = "spearman")
experimental_cores <- experimental_cores %>%
mutate(SDI = Scars_number_all / Surface,
perc_remaining_volume = (Volume / Original_Volume) * 100,
perc_extracted_volume = 100 - perc_remaining_volume,
no_cortical_surface = Surface - Cortical_surface,
perc_nco = 100 - ((no_cortical_surface / Original_surface) * 100),
logSDI = log(SDI))
individual_error <- geometries[-1] - geometries$Experimental_data
AE <- apply(individual_error, 2, mean)
Perc_AE <- (AE / mean(geometries$Experimental_data)) * 100
MAE <- apply(abs(individual_error), 2, mean)
Perc_MAE <- (MAE / mean(geometries$Experimental_data)) * 100
RMSE <- sqrt(apply(individual_error^2, 2, mean))
Perc_RMSE <- (RMSE / mean(geometries$Experimental_data)) * 100
Accuracy_table <- data.frame(round(AE, 2), round(Perc_AE, 2), round(MAE, 2), round(Perc_MAE, 2), round(RMSE, 2), round(Perc_RMSE, 2))
Accuracy_table
individual_error_2 <- Perc_extracted_volume[-1] - Perc_extracted_volume$Experimental_data
AE_2 <- apply(individual_error_2, 2, mean)
Perc_AE_2 <- (AE_2 / mean(Perc_extracted_volume$Experimental_data)) * 100
MAE_2 <- apply(abs(individual_error_2), 2, mean)
Perc_MAE_2 <- (MAE_2 / mean(Perc_extracted_volume$Experimental_data)) * 100
RMSE_2 <- sqrt(apply(individual_error_2^2, 2, mean))
Perc_RMSE_2 <- (RMSE_2 / mean(Perc_extracted_volume$Experimental_data)) * 100
Accuracy_table_percentage <- data.frame(round(AE_2, 2), round(Perc_AE_2, 2), round(MAE_2, 2), round(Perc_MAE_2, 2), round(RMSE_2, 2), round(Perc_RMSE_2, 2))
Accuracy_table_percentage
# Crea un vector con los nombres de las variables de interés
variables_interes <- c("Scars_number_all", "SDI", "logSDI", "perc_nco",
"Number_of_Exploitation_Surface_Convergences",
"Number_of_Exploitation_Surfaces", "Number_of_rotations",
"Platform_number", "Average_Platform_angle")
# Crea una matriz para almacenar los valores de las correlaciones y las pruebas
tabla_cor <- matrix(NA, nrow = length(variables_interes), ncol = 5)
colnames(tabla_cor) <- c("Pearson R", "Coef_det", "P value", "Spearman rho", "P value")
rownames(tabla_cor) <- variables_interes
# Rellena la matriz con los valores de correlación y pruebas
for (i in 1:length(variables_interes)) {
for (j in 1:5) {
if (j == 1) {
# Pearson R
tabla_cor[i, j] <- cor(experimental_cores[[variables_interes[i]]], experimental_cores$perc_extracted_volume, use = "pairwise.complete.obs")
} else if (j == 2) {
# Coef_det
modelo <- lm(experimental_cores$perc_extracted_volume ~ experimental_cores[[variables_interes[i]]], data = experimental_cores)
tabla_cor[i, j] <- summary(modelo)$r.squared
} else if (j == 3) {
# P value Pearson
tabla_cor[i, j] <- cor.test(experimental_cores[[variables_interes[i]]], experimental_cores$perc_extracted_volume)$p.value
} else if (j == 4) {
# Spearman rho
tabla_cor[i, j] <- cor(experimental_cores[[variables_interes[i]]], experimental_cores$perc_extracted_volume, method = "spearman", use = "pairwise.complete.obs")
} else {
# P value Spearman
tabla_cor[i, j] <- cor.test(experimental_cores[[variables_interes[i]]], experimental_cores$perc_extracted_volume, method = "spearman")$p.value
}
}
}
tabla_cor
geometries2<- geometries %>% gather(key = Geometry,
value = Value,
Experimental_data,  Prism, Cube, Sphere, Cylinder,Ellipsoid)%>%
mutate(Geometry = factor(Geometry, levels = c("Prism", "Cube", "Sphere", "Cylinder", "Ellipsoid", "Experimental_data")))
geometries_reduction<- Perc_extracted_volume %>% gather(key = Geometry,
value = Value,
Experimental_data,  Prism, Cube, Sphere, Cylinder,Ellipsoid)
geometries_reduction_error<-Perc_extracted_volume[-1] - Perc_extracted_volume$Experimental_data
geometries_reduction_error<- geometries_reduction_error %>% gather(key = Geometry,
value = Value,
Prism, Cube, Sphere, Cylinder,Ellipsoid)
ggplot(geometries2, aes(x = Geometry, y = Value, fill=Geometry)) +
scale_fill_brewer(palette = "PRGn") +
scale_color_brewer("Geometry",palette="PRGn",drop=TRUE) +
ggdist::stat_halfeye(
adjust = .5,
width = .6,
.width = 0,
justification = 0) +
geom_boxplot(
width = .15,
outlier.shape = NA
) +
## add justified jitter from the {gghalves} package
gghalves::geom_half_point(
aes( color = Geometry),side = "l")+
coord_flip(xlim = c(1.2, NA), clip = "off") +
theme_classic() +
theme(
legend.position = "none",
legend.text = element_text(size = 12),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14)
)+
labs(x= "", y = "Estimated Volume (cm3)") +
scale_y_continuous(breaks = seq(from= 0, to=1100, by=100), limits =c(0,1100))
geometries_reduction$Geometry <- factor(geometries_reduction$Geometry,
levels = c("Ellipsoid", "Cylinder", "Sphere", "Prism", "Cube","Experimental_data"))
geometries_reduction_error$Geometry <- factor(geometries_reduction_error$Geometry,
levels = c("Experimental_data", "Ellipsoid", "Cylinder", "Sphere", "Prism", "Cube"))
real_ellipsoid<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Ellipsoid")
real_cylinder<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Cylinder")
real_sphere<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Sphere")
real_cube<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Cube")
real_prism<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Prism")
figure2a<-ggplot(real_ellipsoid, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#7fbf7bff", "#1b7837ff"))+
scale_color_manual(values=c("#7fbf7bff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2b<-ggplot(real_cylinder, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#d9f0d3ff", "#1b7837ff"))+
scale_color_manual(values=c("#d9f0d3ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2c<-ggplot(real_sphere, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#af8dc3ff", "#1b7837ff"))+
scale_color_manual(values=c("#af8dc3ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2d<-ggplot(real_prism, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#e7d4e8ff", "#1b7837ff"))+
scale_color_manual(values=c("#e7d4e8ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2e<-ggplot(real_cube, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#762a83ff","#1b7837ff"))+
scale_color_manual(values=c("#762a83ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2f <- ggplot(geometries_reduction_error, aes(Geometry, Value)) +
geom_jitter(aes(colour = factor(Geometry)), size = 4, show.legend = FALSE) +
ylim(-200,100) +
theme_classic() +
scale_color_manual(values=c("#7fbf7bff","#d9f0d3ff","#e7d4e8ff","#af8dc3ff","#762a83ff")) +
geom_hline(yintercept = 0, linetype = "dashed")
library(ggpubr)
ggarrange(figure2a,figure2b, figure2c, figure2d,figure2e,figure2f, labels = c("A", "B", "C", "D","E","F"), nrow=2, ncol=3, common.legend = FALSE)
geometries_reduction$Geometry <- factor(geometries_reduction$Geometry,
levels = c("Ellipsoid", "Cylinder", "Sphere", "Prism", "Cube","Experimental_data"))
geometries_reduction_error$Geometry <- factor(geometries_reduction_error$Geometry,
levels = c("Experimental_data", "Ellipsoid", "Cylinder", "Sphere", "Prism", "Cube"))
real_ellipsoid<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Ellipsoid")
real_cylinder<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Cylinder")
real_sphere<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Sphere")
real_cube<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Cube")
real_prism<- geometries_reduction %>% filter (Geometry =="Experimental_data" | Geometry =="Prism")
figure2a<-ggplot(real_ellipsoid, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#7fbf7bff", "#1b7837ff"))+
scale_color_manual(values=c("#7fbf7bff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2b<-ggplot(real_cylinder, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#d9f0d3ff", "#1b7837ff"))+
scale_color_manual(values=c("#d9f0d3ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2c<-ggplot(real_sphere, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#e7d4e8ff", "#1b7837ff"))+
scale_color_manual(values=c("#e7d4e8ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2d<-ggplot(real_prism, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#af8dc3ff", "#1b7837ff"))+
scale_color_manual(values=c("#af8dc3ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2e<-ggplot(real_cube, aes(x=Value, color=Geometry, fill= Geometry)) +
geom_density(alpha=.5)+ theme_classic() +xlim(0,100)+ ylim(0,.05)+ theme(legend.position="bottom")+
theme (text = element_text(size=14))+ scale_fill_manual(values=c("#762a83ff","#1b7837ff"))+
scale_color_manual(values=c("#762a83ff", "#1b7837ff"))+
labs(x= "Percentage of Extracted Volume", y = "", color="", fill = "")
figure2f <- ggplot(geometries_reduction_error, aes(Geometry, Value)) +
geom_jitter(aes(colour = factor(Geometry)), size = 4, show.legend = FALSE) +
ylim(-200,100) +
theme_classic() +
scale_color_manual(values=c("#7fbf7bff","#d9f0d3ff","#e7d4e8ff","#af8dc3ff","#762a83ff")) +
geom_hline(yintercept = 0, linetype = "dashed")
library(ggpubr)
ggarrange(figure2a,figure2b, figure2c, figure2d,figure2e,figure2f, labels = c("A", "B", "C", "D","E","F"), nrow=2, ncol=3, common.legend = FALSE)
# crear el gráfico para la figura A
Figure5a <- blandr.draw(Perc_extracted_volume$Ellipsoid, Perc_extracted_volume$Experimental_data) +
theme_classic() +
theme(plot.title = element_blank()) + # eliminar el título del gráfico
scale_x_continuous(breaks = seq(from = 0, to = 100, by = 5), limits = c(0, 100)) +
scale_y_continuous(breaks = seq(from = -45, to = 45, by = 5), limits = c(-45, 45))
# modificar el objeto ggplot para cambiar el color del relleno
p_build <- ggplot_build(Figure5a)
p_build$data[[12]][["fill"]] <- "#6078b0ff"
p_build$data[[13]][["fill"]] <- "#c7dd0dff"
p_build$data[[14]][["fill"]] <- "#c7dd0dff"
# guardar el objeto ggplot modificado en una nueva variable
Figure5aa <- ggplot_gtable(p_build)
# crear el gráfico para la figura B
Figure5b <- blandr.draw(Perc_extracted_volume$Cylinder, Perc_extracted_volume$Experimental_data) +
theme_classic() +
theme(plot.title = element_blank()) + # eliminar el título del gráfico
scale_x_continuous(breaks = seq(from = 0, to = 100, by = 5), limits = c(0, 100)) +
scale_y_continuous(breaks = seq(from = -45, to = 45, by = 5), limits = c(-45, 45))
# modificar el objeto ggplot para cambiar el color del relleno
p_build <- ggplot_build(Figure5b)
p_build$data[[12]][["fill"]] <- "#6078b0ff"
p_build$data[[13]][["fill"]] <- "#c7dd0dff"
p_build$data[[14]][["fill"]] <- "#c7dd0dff"
# guardar el objeto ggplot modificado en una nueva variable
Figure5bb <- ggplot_gtable(p_build)
# combinar las dos figuras en una sola
grid.arrange(Figure5aa, Figure5bb, ncol = 2, widths = c(1, 1))
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(ggplot2)
library(readxl)
library(gridExtra)
library(plyr)
library(viridis)
library(survminer)
install.packages("survminer")
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(ggplot2)
library(readxl)
library(gridExtra)
library(plyr)
library(viridis)
library(survminer)
library(ggpubr)
library(readr)
library(fitdistrplus)
install.packages("fitdistrplus")
library(dplyr)
library(ggplot2)
library(readxl)
library(gridExtra)
library(plyr)
library(viridis)
library(survminer)
library(ggpubr)
library(readr)
library(fitdistrplus)
library(fitdistrplus)
fumane_flakes <- readxl::read_xlsx("fumane_flakes.xlsx")
fumane_cores <- readxl::read_xlsx("fumane_cores.xlsx")
# corrdimslength takes gen (generation) and median as inputs and returns the corrected length of the core by multiplying gen and median
corrdimslength<-function(gen,median){
corrected_dim_length<- (gen*median)
return(corrected_dim_length)
}
# corrdimslength2 takes gen1, gen2, and dim as inputs and returns the corrected length of the core by adding gen1, gen2, and dim.
corrdimslength2<-function(gen1,gen2, dim){
corrected_dim_length2<- (gen1+gen2)+dim
return(corrected_dim_length2)
}
# corrdims takes gen, median, and dim as inputs and returns the corrected dimensions of the core by multiplying gen and median and adding dim.
corrdims<-function(gen,median,dim){
corrected_dim<- (gen*median)+dim
return(corrected_dim)
}
# The code filters a dataset called "fumane_flakes" based on specific conditions and creates two separate subsets of data named "group1" and "group2".
fumane_flakes <- subset(fumane_flakes, !is.na(Thickness) & Group == "1")
group1 <- filter(fumane_flakes, Basic_Blank %in% c("Flake", "Tablet"))
group2 <- filter(fumane_flakes, Basic_Blank %in% c("Flake", "Blade", "Bladelet"))
#The code filters a dataset called "fumane_cores" to create a subset called "cores_final". It also transforms the "Classification_B" and "Production" columns in the "cores_final" dataframe by changing their data type and modifying their levels. Additionally, the "Volume" column values are divided by 1000.
(cores_final <- fumane_cores %>%
filter(Group == "1") %>%
mutate(Classification_B = factor(Classification_B, levels = c("Initial", "Carinated", "Narrow", "Wide", "Semicircumferential", "Multiplatform")),
Production = factor(Production, levels = c("Blade", "Blade-flake", "Blade-bladelet", "Bladelet")),
Volume = Volume / 1000))
# The code below calculates the mean and median of the "Thickness" variable grouped by "Group" and "Raw_material" in two separate datasets, "group1" and "group2" respectively. The results are then joined with the "cores_final" dataset.
summarymedianplatform <- group1 %>%
group_by(Raw_material) %>%
dplyr::summarise(meanplatform = mean(Thickness), medianplatform = median(Thickness))
summarymedianbase <- group2 %>%
group_by(Raw_material) %>%
dplyr::summarise(meanbase = mean(Thickness), medianbase = median(Thickness))
cores_final <- cores_final %>%
left_join(summarymedianplatform, by = c("Raw_material")) %>%
left_join(summarymedianbase, by = c("Raw_material"))
cores_final
cores_final <- cores_final %>%
mutate(corrected_length_platform = corrdimslength(Gen_Length_platform, medianplatform),
corrected_length_base = corrdimslength(Gen_Length_base, medianbase),
corrected_length = corrdimslength2(corrected_length_platform, corrected_length_base, L),
corrected_width = corrdims(Gen_Width, medianbase, W),
corrected_thickness = corrdims(Gen_Thickness, medianbase,T))
# The code calculates additional variables in the "cores_final" dataset, including estimated volume, percentages of remaining and extracted volume, scar density index, logarithm of scar density index, non-cortical area, and percentage of non-cortical surface
cores_final <- cores_final %>%
mutate(est_vol = (pi * ((corrected_width/2)^2) * corrected_length) / 1000,
Perc_remaining_volume = (Volume / est_vol) * 100,
Perc_extracted_volume = 100 - Perc_remaining_volume,
SDI = Scars / Surface,
logSDI = log(SDI),
no_cortical_area = Surface - Co_Area,
perc_nco = (no_cortical_area / Surface) * 100)
coresvrm <- cores_final %>%
filter(Blank %in% c("Nodule", "Slab", "Block", "Undetermined"))
Figure6a<-ggplot(coresvrm, aes(x=Raw_material, y=Perc_extracted_volume, fill=Raw_material)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Raw_material)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Raw material", y="Percentage of Extracted Volume (%)") +
scale_y_continuous(breaks=seq(from=0, to=100, by=10), limits=c(0, 100)) +
scale_fill_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff")) +
scale_color_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff"))
Figure6b<- ggplot(cores_final, aes(x=Raw_material, y=SDI, fill=Raw_material)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Raw_material)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Raw material", y="SDI") +
scale_y_continuous(breaks = seq(from= 0, to=0.015, by=0.001), limits =c(0,0.015)) +
scale_fill_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff")) +
scale_color_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff"))
Figure6c<-ggplot(cores_final, aes(x=Raw_material, y=perc_nco, fill=Raw_material)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Raw_material)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Raw material",y = "Percentage of Non cortical surface(%)") +
scale_y_continuous(breaks = seq(from= 0, to=100, by=10), limits =c(0,100)) +
scale_fill_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff")) +
scale_color_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff"))
Figure6d<-ggplot(cores_final, aes(x=Raw_material, y=Volume, fill=Raw_material)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Raw_material)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Raw material",y = "Volume (cm3)") +
scale_y_continuous(breaks = seq(from= 0, to=150, by=10), limits =c(0,150)) +
scale_fill_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff")) +
scale_color_manual(values=c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff"))
Figure6az <- ggarrange(Figure6a, labels = "a")
Figure6bz <- ggarrange(Figure6b, labels = "b")
Figure6cz <- ggarrange(Figure6c, labels = "c")
Figure6dz <- ggarrange(Figure6d, labels = "d")
Figure6 <- grid.arrange(arrangeGrob(Figure6az, Figure6bz, ncol = 2), arrangeGrob(Figure6cz, Figure6dz, ncol = 2), nrow = 2)
#To save the figure run the code below
#ggsave("Figure 6 Raw material", plot = Figure6, width = 40, height = 40, device = "png", units = "cm", dpi = 600)
# The code calculates summary statistics for the variable "Perc_extracted_volume" grouped by "Raw_material" using the ddply() function from the plyr package. The resulting summary includes the number of observations (N), mean, median, minimum (Min), maximum (Max), standard deviation (SD), and coefficient of variation (CV). The summary results are stored in the object "Summary_results" and displayed.
Summary_results <- ddply(coresvrm, .(Raw_material), summarise,
N = length(Perc_extracted_volume),
Mean = round(mean(Perc_extracted_volume), 2),
Median = round(median(Perc_extracted_volume), 2),
Min = round(min(Perc_extracted_volume), 2),
Max = round(max(Perc_extracted_volume), 2),
SD = round(sd(Perc_extracted_volume), 2),
CV = round(sd(Perc_extracted_volume) / mean(Perc_extracted_volume), 2))
Summary_results
#The code performs the Kruskal-Wallis tests to assess the equality of medians among different groups for the variables "Perc_extracted_volume," "SDI," and "perc_nco" based on the levels of the "Raw_material" column in the respective datasets "coresvrm" and "cores_final."
kruskal.test(Perc_extracted_volume ~ Raw_material, data = coresvrm)
kruskal.test(SDI ~ Raw_material, data = cores_final)
kruskal.test(perc_nco ~ Raw_material, data = cores_final)
dummymat <- data.frame(Raw_material = c("Maiolica", "Other", "S_Rossa", "S_Variegata", "S_Variegata 3"),
Perc_extracted_volume = rep(100, 5))
reduction_cores <- cores_final[c(4, 35)]
weibull_cores <- rbind(reduction_cores, dummymat)
materials <- unique(weibull_cores$Raw_material)
weibull_results <- data.frame(Raw_material = character(),
shape = numeric(),
scale = numeric(),
stringsAsFactors = FALSE)
for (material in materials) {
subset_data <- filter(weibull_cores, Raw_material == material)
if (nrow(subset_data) > 1) {
w <- suppressWarnings(fitdist(subset_data$Perc_extracted_volume, "weibull"))
weibull_results <- rbind(weibull_results, data.frame(Raw_material = material,
shape = w$estimate[1],
scale = w$estimate[2]))
}
}
weibull_results
km_rm <- survfit(Surv(Perc_extracted_volume) ~ Raw_material , data = cores_final)
Figure7 <- ggsurvplot(
fit = km_rm,
risk.table = FALSE,
pval = FALSE,
conf.int = FALSE,
xlim = c(0, 100),
break.time.by = 5,
ggtheme = theme_classic(),
risk.table.y.text.col = T,
risk.table.y.text = FALSE,
surv.median.line = "hv",
palette = c("#295673ff", "#4f90a6ff", "#68abb8ff", "#84c3c9ff", "#a7dcd8ff")  # Specify desired colors
)
Figure7
Figure8a<-ggplot(coresvrm, aes(x=Classification_B, y=Perc_extracted_volume, fill=Classification_B)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Classification_B)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Core type", y="Percentage of Extracted Volume (%)") +
scale_y_continuous(breaks=seq(from=0, to=100, by=10), limits=c(0, 100)) +
scale_fill_manual(values=c("#52499fff", "#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff")) +
scale_color_manual(values=c("#52499fff","#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff"))
Figure8b<- ggplot(cores_final, aes(x=Classification_B, y=SDI, fill=Classification_B)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Classification_B)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Core type", y="SDI") +
scale_y_continuous(breaks = seq(from= 0, to=0.015, by=0.001), limits =c(0,0.015)) +
scale_fill_manual(values=c("#52499fff", "#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff")) +
scale_color_manual(values=c("#52499fff","#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff"))
Figure8c<-ggplot(cores_final, aes(x=Classification_B, y=perc_nco, fill=Classification_B)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Classification_B)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Core type",y = "Percentage of Non cortical surface(%)") +
scale_y_continuous(breaks = seq(from= 0, to=100, by=10), limits =c(0,100)) +
scale_fill_manual(values=c("#52499fff", "#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff")) +
scale_color_manual(values=c("#52499fff","#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff"))
Figure8d<-ggplot(cores_final, aes(x=Classification_B, y=Volume, fill=Classification_B)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Classification_B)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Core type",y = "Volume (cm3)") +
scale_y_continuous(breaks = seq(from= 0, to=150, by=10), limits =c(0,150)) +
scale_fill_manual(values=c("#52499fff", "#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff")) +
scale_color_manual(values=c("#52499fff","#63589fff", "#826dbaff", "#9f82ceff", "#b998ddff", "#d1afe8ff"))
Figure8az<-ggarrange(Figure8a, labels = "a")
Figure8bz<-ggarrange(Figure8b, labels = "b")
Figure8cz<-ggarrange(Figure8c, labels = "c")
Figure8dz<-ggarrange(Figure8d, labels = "d")
Figure8<-grid.arrange(arrangeGrob(Figure8az,Figure8bz, ncol=2),arrangeGrob(Figure8cz,Figure8dz, ncol=2),  nrow= 2)
#To save the figure run the code below
#ggsave("Figure 8 Core Type", plot = Figure8, width=40, height = 40, device = "png", units = "cm",dpi=600)
Figure9a<-ggplot(coresvrm, aes(x=Production, y=Perc_extracted_volume, fill=Production)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Production)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Production", y="Percentage of Extracted Volume (%)") +
scale_y_continuous(breaks=seq(from=0, to=100, by=10), limits=c(0, 100)) +
scale_fill_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff")) +
scale_color_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff"))
Figure9b<- ggplot(cores_final, aes(x=Production, y=SDI, fill=Production)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Production)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x="Production", y="SDI") +
scale_y_continuous(breaks = seq(from= 0, to=0.015, by=0.001), limits =c(0,0.015)) +
scale_fill_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff")) +
scale_color_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff"))
Figure9c<-ggplot(cores_final, aes(x=Production, y=perc_nco, fill=Production)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Production)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Production",y = "Percentage of Non cortical surface(%)") +
scale_y_continuous(breaks = seq(from= 0, to=100, by=10), limits =c(0,100)) +
scale_fill_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff")) +
scale_color_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff"))
Figure9d<-ggplot(cores_final, aes(x=Production, y=Volume, fill=Production)) +
geom_boxplot(alpha=.7) +
geom_jitter(aes(colour=factor(Production)), position=position_jitter(0.2)) +
theme_classic() +
theme(legend.position="none", text=element_text(size=14)) +
labs(x = "Production",y = "Volume (cm3)") +
scale_y_continuous(breaks = seq(from= 0, to=150, by=10), limits =c(0,150)) +
scale_fill_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff")) +
scale_color_manual(values=c("#ff6600ff", "#ff7f2aff", "#45708eff", "#4570abff"))
Figure9az<-ggarrange(Figure9a, labels = "a")
Figure9bz<-ggarrange(Figure9b, labels = "b")
Figure9cz<-ggarrange(Figure9c, labels = "c")
Figure9dz<-ggarrange(Figure9d, labels = "d")
Figure9<-grid.arrange(arrangeGrob(Figure9az,Figure9bz, ncol=2),arrangeGrob(Figure9cz,Figure9dz, ncol=2),  nrow= 2)
gg_tbl1 <- cores_final %>%
dplyr::group_by(Raw_material) %>%
dplyr::summarise(total_count = dplyr::n(), .groups = 'drop')
4676/91
517/2
397/6
621/9
468/16
