MASTER DOE VISITING PROFESSORSHIP WORKFLOW
Gerard G. Dumancas
2026-08-04
1 Project Overview
This workflow automates the complete MILK Ti-6Al-4V analysis.
| Phase | Description |
|---|---|
| Phase 1 | Dataset Understanding and Preparation |
| Phase 2 | Exploratory Diffraction Analysis |
| Phase 3 | Principal Component Analysis (PCA) |
| Phase 4 | Peak Tracking and Region Identification |
| Phase 5 | Similarity and Transition Analysis |
| Phase 6 | Automated Peak Ranking |
| Phase 7 | Full-Pattern PLS Prediction of Phase Composition |
| Phase 8 | Phase Evolution and Interpretation |
| Phase 9 | Window-Based PLS Prediction of Phase Composition |
| Phase 10 | Experimental Condition Integration (Future) |
| Phase 11 | Microstructural Evolution Analysis (Future) |
2 User Settings
# User Settings
data_dir <- "C:/Users/gerar/MILK/examples/Synchrotron/sequential_refinement/my_scripts"
# Create output folders automatically
dir.create(
"Figures",
showWarnings = FALSE
)
dir.create(
"Results",
showWarnings = FALSE
)
# Input files
XFILE <- file.path(
data_dir,
"X_matrix.csv"
)
YFILE <- file.path(
data_dir,
"Y_matrix.csv"
)
# Verify files exist
if(!file.exists(XFILE)){
stop("X_matrix.csv not found.")
}
if(!file.exists(YFILE)){
stop("Y_matrix.csv not found.")
}
cat("Input files verified.\n")## Input files verified.3 Global Diagnostic Windows
windows <- list(
W1 = c(4.0,4.2),
W2 = c(4.6,4.8),
W3 = c(6.8,7.1),
W4 = c(9.0,9.3),
W5 = c(10.4,10.6)
)4 Common Functions
load_milk_data <- function(XFILE,YFILE){
raw <- read.csv(
XFILE,
header = FALSE,
check.names = FALSE,
stringsAsFactors = FALSE
)
theta <- as.numeric(
unlist(raw[1,-1])
)
run_names <- raw[-1,1]
X <- raw[-1,-1]
X <- apply(
X,
2,
as.numeric
)
X <- as.matrix(X)
rownames(X) <- run_names
Y <- read.csv(
YFILE,
check.names = FALSE,
stringsAsFactors = FALSE
)
list(
X = X,
Y = Y,
theta = theta
)
}
build_phase_dataset <- function(Y){
data.frame(
Run = Y$Title,
Alpha = Y[[4]],
Steel = Y[[13]],
Beta = Y[[21]]
)
}
assign_phase_state <- function(alpha,beta){
case_when(
alpha > 70 ~ "Alpha Rich",
beta > 70 ~ "Beta Rich",
TRUE ~ "Mixed Alpha-Beta"
)
}
normalize <- function(x){
(x - min(x)) /
(max(x) - min(x))
}5 Load Data
milk <- load_milk_data(
XFILE,
YFILE
)
X <- milk$X
Y <- milk$Y
theta <- milk$theta
phase_data <- build_phase_dataset(Y)6 PHASE 1: DATASET UNDERSTANDING AND PREPARATION
6.1 Objective
Construct X and Y matrices and verify data integrity.
cat(
"Number of Runs:",
nrow(X),
"\n"
)## Number of Runs: 28cat(
"Number of Variables:",
ncol(X),
"\n"
)## Number of Variables: 1500cat(
"Missing Values in X:",
sum(is.na(X)),
"\n"
)## Missing Values in X: 0cat(
"Missing Values in Y:",
sum(is.na(Y)),
"\n"
)## Missing Values in Y: 06.2 Phase Fraction Dataset
head(phase_data)## Run Alpha Steel Beta
## 1 run000Ti64_test_data03 82.70725 17.29275 0.00000
## 2 run001Ti64_test_data03 82.65025 17.34976 0.00000
## 3 run002Ti64_test_data03 82.49252 17.50747 0.00000
## 4 run003Ti64_test_data03 82.64799 17.35202 0.00000
## 5 run004Ti64_test_data03 70.97442 16.95435 12.07123
## 6 run005Ti64_test_data03 69.17553 17.08608 13.73840summary(phase_data)## Run Alpha Steel Beta
## Length :28 Min. : 0.00 Min. : 7.101 Min. : 0.00
## N.unique :28 1st Qu.: 0.00 1st Qu.:14.554 1st Qu.:14.72
## N.blank : 0 Median :62.76 Median :16.701 Median :20.92
## Min.nchar:22 Mean :43.74 Mean :15.868 Mean :40.39
## Max.nchar:22 3rd Qu.:64.87 3rd Qu.:17.431 3rd Qu.:85.45
## Max. :82.71 Max. :21.520 Max. :92.907 PHASE 2: EXPLORATORY DIFFRACTION ANALYSIS
7.1 Objective
Visualize diffraction-pattern evolution across runs.
7.1.1 First Diffraction Pattern
plot(
theta,
X[1,],
type = "l",
lwd = 2,
col = "black",
xlab = expression(2*theta),
ylab = "Intensity",
main = rownames(X)[1]
)
7.1.2 Overlay of First Four Runs
plot(
theta,
X[1,],
type = "l",
lwd = 2,
col = "black",
xlab = expression(2*theta),
ylab = "Intensity",
main = "First Four Runs"
)
lines(theta,X[2,],col="red",lwd=2)
lines(theta,X[3,],col="blue",lwd=2)
lines(theta,X[4,],col="green",lwd=2)
legend(
"topright",
legend = rownames(X)[1:4],
col = c("black","red","blue","green"),
lwd = 2
)
7.1.3 All Diffraction Patterns
matplot(
theta,
t(X),
type = "l",
lty = 1,
col = rainbow(nrow(X)),
xlab = expression(2*theta),
ylab = "Intensity",
main = "All Diffraction Patterns"
)
7.1.4 Waterfall Plot
offset <- 20
plot(
theta,
X[1,],
type = "l",
lwd = 1.5,
xlab = expression(2*theta),
ylab = "Offset Intensity",
main = "Waterfall Plot"
)
for(i in 2:nrow(X)){
lines(
theta,
X[i,] + (i-1)*offset,
col = i,
lwd = 1
)
}
7.1.5 Difference Plot
plot(
theta,
X[2,] - X[1,],
type = "l",
lwd = 2,
col = "red",
xlab = expression(2*theta),
ylab = expression(Delta*Intensity),
main = "Run001 - Run000"
)
abline(h=0,lty=2)
8 PHASE 3: PRINCIPAL COMPONENT ANALYSIS (PCA)
8.1 Objective
Identify dominant diffraction-state evolution.
pca <- prcomp(
X,
center = TRUE,
scale. = TRUE
)
var_exp <- pca$sdev^2 /
sum(pca$sdev^2)8.1.1 Scree Plot
plot(
var_exp,
type = "b",
pch = 19,
xlab = "Principal Component",
ylab = "Variance Explained",
main = "Scree Plot"
)
8.1.2 Cumulative Variance
plot(
cumsum(var_exp),
type = "b",
pch = 19,
xlab = "Principal Component",
ylab = "Cumulative Variance Explained",
main = "Cumulative Variance"
)
abline(
h = 0.90,
lty = 2,
col = "red"
)
8.1.3 PCA Scores
plot(
pca$x[,1],
pca$x[,2],
pch = 19,
xlab = "PC1",
ylab = "PC2",
main = "PCA Scores"
)
text(
pca$x[,1],
pca$x[,2],
labels = rownames(X),
pos = 3,
cex = 0.7
)
8.1.4 PCA Trajectory
plot(
pca$x[,1],
pca$x[,2],
type = "b",
pch = 19,
xlab = "PC1",
ylab = "PC2",
main = "PCA Trajectory"
)
text(
pca$x[,1],
pca$x[,2],
labels = rownames(X),
pos = 3,
cex = 0.7
)
8.1.5 PC1 Loadings
plot(
theta,
pca$rotation[,1],
type = "l",
lwd = 2,
col = "blue",
xlab = expression(2*theta),
ylab = "Loading",
main = "PC1 Loadings"
)
abline(h=0,lty=2)
8.1.6 PC2 Loadings
plot(
theta,
pca$rotation[,2],
type = "l",
lwd = 2,
col = "red",
xlab = expression(2*theta),
ylab = "Loading",
main = "PC2 Loadings"
)
abline(h=0,lty=2)
# PHASE 4: PEAK TRACKING AND REGION IDENTIFICATION
8.2 Objective
Track peak position, peak intensity, peak area, and peak width (FWHM) for all PCA-selected diffraction windows.
peak_results <- data.frame()
for(w in seq_along(windows)){
rng <- windows[[w]]
idx <- which(
theta >= rng[1] &
theta <= rng[2]
)
theta_window <- theta[idx]
X_window <- X[,idx]
for(i in 1:nrow(X_window)){
intensity <- X_window[i,]
peak_index <- which.max(intensity)
peak_position <- theta_window[peak_index]
peak_intensity <- max(intensity)
peak_area <- sum(intensity)
half_max <- peak_intensity/2
above_half <- which(
intensity >= half_max
)
if(length(above_half) >= 2){
peak_fwhm <-
theta_window[max(above_half)] -
theta_window[min(above_half)]
} else {
peak_fwhm <- NA
}
peak_results <- rbind(
peak_results,
data.frame(
Window = names(windows)[w],
Run = rownames(X_window)[i],
Peak_Position = peak_position,
Peak_Intensity = peak_intensity,
Peak_Area = peak_area,
Peak_FWHM = peak_fwhm
)
)
}
}
head(peak_results)## Window Run Peak_Position Peak_Intensity Peak_Area Peak_FWHM
## 1 W1 run000_ Intensity 4.153467 259.3615 3766.498 0.0601333
## 2 W1 run001_ Intensity 4.153467 255.9989 3716.876 0.0601333
## 3 W1 run002_ Intensity 4.153467 257.6476 3745.153 0.0601333
## 4 W1 run003_ Intensity 4.153467 257.9053 3745.285 0.0601333
## 5 W1 run004_ Intensity 4.115200 240.1876 3464.321 0.0492000
## 6 W1 run005_ Intensity 4.115200 245.8973 3545.128 0.04920008.3 Peak Intensity Evolution
ggplot(
peak_results,
aes(
x = seq_along(Run),
y = Peak_Intensity,
color = Window,
group = Window
)
)+
geom_line()+
geom_point()+
labs(
title = "Peak Intensity Evolution",
x = "Run Number",
y = "Peak Intensity"
)
8.4 Peak Position Evolution
ggplot(
peak_results,
aes(
x = seq_along(Run),
y = Peak_Position,
color = Window,
group = Window
)
)+
geom_line()+
geom_point()+
labs(
title = "Peak Position Evolution",
x = "Run Number",
y = "Peak Position"
)
8.5 Peak Area Evolution
ggplot(
peak_results,
aes(
x = seq_along(Run),
y = Peak_Area,
color = Window,
group = Window
)
)+
geom_line()+
geom_point()+
labs(
title = "Peak Area Evolution",
x = "Run Number",
y = "Peak Area"
)
8.6 Peak FWHM Evolution
ggplot(
peak_results,
aes(
x = seq_along(Run),
y = Peak_FWHM,
color = Window,
group = Window
)
)+
geom_line()+
geom_point()+
labs(
title = "Peak Width Evolution",
x = "Run Number",
y = "FWHM"
)
9 PHASE 5: SIMILARITY AND TRANSITION ANALYSIS
9.1 Objective
Determine whether transition regions can be identified automatically using similarity and distance metrics.
reference <- X[1,]
pearson_similarity <- apply(
X,
1,
function(x)
cor(reference,x)
)
euclidean_distance <- apply(
X,
1,
function(x)
sqrt(sum((x-reference)^2))
)
cosine_similarity <- apply(
X,
1,
function(x){
sum(reference*x) /
(
sqrt(sum(reference^2)) *
sqrt(sum(x^2))
)
}
)
consecutive_change <- rep(
NA,
nrow(X)
)
for(i in 2:nrow(X)){
consecutive_change[i] <-
sqrt(
sum(
(X[i,]-X[i-1,])^2
)
)
}9.2 Correlation to Run000
plot(
pearson_similarity,
type = "b",
pch = 19,
xlab = "Run Number",
ylab = "Pearson Correlation",
main = "Similarity to Run000"
)
abline(
h = mean(pearson_similarity),
lty = 2
)
9.3 Euclidean Distance
plot(
euclidean_distance,
type = "b",
pch = 19,
xlab = "Run Number",
ylab = "Euclidean Distance",
main = "Distance from Run000"
)
9.4 Cosine Similarity
plot(
cosine_similarity,
type = "b",
pch = 19,
xlab = "Run Number",
ylab = "Cosine Similarity",
main = "Cosine Similarity"
)
9.5 Consecutive Pattern Change
plot(
consecutive_change,
type = "b",
pch = 19,
xlab = "Run Number",
ylab = "Pattern Change",
main = "Consecutive Run Changes"
)
9.6 Transition Interpretation
The combined PCA, correlation, cosine similarity, Euclidean distance, and consecutive-change analyses should be used to assess evidence for the reversible diffraction pathway:
A → B → C → B → A10 PHASE 6: AUTOMATED PEAK RANKING
10.1 Objective
Automatically rank diffraction windows according to their contribution to diffraction evolution.
ranking_results <- data.frame()
for(w in seq_along(windows)){
rng <- windows[[w]]
idx <- which(
theta >= rng[1] &
theta <= rng[2]
)
loading_score <- max(
abs(
pca$rotation[idx,1]
)
)
temp <- peak_results[
peak_results$Window ==
names(windows)[w],
]
ranking_results <- rbind(
ranking_results,
data.frame(
Window = names(windows)[w],
Loading_Score = loading_score,
Intensity_SD =
sd(temp$Peak_Intensity),
Area_SD =
sd(temp$Peak_Area),
Position_SD =
sd(temp$Peak_Position),
FWHM_SD =
sd(
temp$Peak_FWHM,
na.rm = TRUE
)
)
)
}
ranking_results## Window Loading_Score Intensity_SD Area_SD Position_SD FWHM_SD
## 1 W1 0.02962684 97.516936 923.3300 0.026670889 0.06795714
## 2 W2 0.02958119 463.315714 4805.2992 0.032949120 0.07208287
## 3 W3 0.02970296 13.737580 257.2323 0.001948049 0.01249253
## 4 W4 0.02969446 11.037415 354.5706 0.039737797 0.01906608
## 5 W5 0.02971677 5.902495 177.3840 0.080026580 0.0000000010.2 Normalize Metrics
ranking <- ranking_results
ranking$Loading_Norm <-
normalize(
ranking$Loading_Score
)
ranking$Intensity_Norm <-
normalize(
ranking$Intensity_SD
)
ranking$Area_Norm <-
normalize(
ranking$Area_SD
)
ranking$Position_Norm <-
normalize(
ranking$Position_SD
)
ranking$FWHM_Norm <-
normalize(
ranking$FWHM_SD
)10.3 Window Importance Score
ranking$Importance_Score <-
ranking$Loading_Norm +
ranking$Intensity_Norm +
ranking$Area_Norm +
ranking$Position_Norm +
ranking$FWHM_Norm
ranking <- ranking[
order(
ranking$Importance_Score,
decreasing = TRUE
),
]
ranking## Window Loading_Score Intensity_SD Area_SD Position_SD FWHM_SD
## 2 W2 0.02958119 463.315714 4805.2992 0.032949120 0.07208287
## 5 W5 0.02971677 5.902495 177.3840 0.080026580 0.00000000
## 1 W1 0.02962684 97.516936 923.3300 0.026670889 0.06795714
## 4 W4 0.02969446 11.037415 354.5706 0.039737797 0.01906608
## 3 W3 0.02970296 13.737580 257.2323 0.001948049 0.01249253
## Loading_Norm Intensity_Norm Area_Norm Position_Norm FWHM_Norm
## 2 0.0000000 1.00000000 1.00000000 0.3970499 1.0000000
## 5 1.0000000 0.00000000 0.00000000 1.0000000 0.0000000
## 1 0.3367132 0.20028814 0.16118404 0.3166407 0.9427641
## 4 0.8353951 0.01122600 0.03828649 0.4839967 0.2645022
## 3 0.8981312 0.01712912 0.01725363 0.0000000 0.1733078
## Importance_Score
## 2 3.397050
## 5 2.000000
## 1 1.957590
## 4 1.633406
## 3 1.10582210.4 Ranked Diffraction Windows
ranking_display <- data.frame(
Rank = 1:nrow(ranking),
Window = ranking$Window,
Importance_Score =
round(
ranking$Importance_Score,
3
)
)
kable(
ranking_display
)| Rank | Window | Importance_Score |
|---|---|---|
| 1 | W2 | 3.397 |
| 2 | W5 | 2.000 |
| 3 | W1 | 1.958 |
| 4 | W4 | 1.633 |
| 5 | W3 | 1.106 |
10.5 Ranking Plot
barplot(
ranking$Importance_Score,
names.arg = ranking$Window,
las = 2,
col = "steelblue",
ylab = "Importance Score",
main = "Automated Peak Ranking"
)
10.6 Top Ranked Windows
head(
ranking_display,
n = 3
)## Rank Window Importance_Score
## 1 1 W2 3.397
## 2 2 W5 2.000
## 3 3 W1 1.95811 PHASE 7: FULL-PATTERN PLS PREDICTION OF PHASE COMPOSITION
11.1 Objective
Determine whether the complete diffraction pattern can predict:
- Alpha Vol.%
- Beta Vol.%
- Steel Vol.%
using PLS regression.
X_df <- as.data.frame(X)
fit_pls <- function(response){
dat <- data.frame(
Response = response,
X_df
)
model <- plsr(
Response ~ .,
data = dat,
scale = TRUE,
validation = "LOO"
)
pred <- as.vector(
predict(
model,
ncomp = 5
)
)
r2 <- cor(
response,
pred
)^2
rmse <- sqrt(
mean(
(response - pred)^2
)
)
list(
model = model,
pred = pred,
r2 = r2,
rmse = rmse
)
}
alpha_model <- fit_pls(
phase_data$Alpha
)
beta_model <- fit_pls(
phase_data$Beta
)
steel_model <- fit_pls(
phase_data$Steel
)11.2 Model Performance
full_pattern_results <- data.frame(
Phase = c(
"Alpha",
"Beta",
"Steel"
),
R2 = c(
alpha_model$r2,
beta_model$r2,
steel_model$r2
),
RMSE = c(
alpha_model$rmse,
beta_model$rmse,
steel_model$rmse
)
)
kable(
full_pattern_results,
digits = 4
)| Phase | R2 | RMSE |
|---|---|---|
| Alpha | 0.9984 | 1.3451 |
| Beta | 0.9980 | 1.5919 |
| Steel | 0.9684 | 0.6056 |
11.3 Alpha Prediction
plot(
phase_data$Alpha,
alpha_model$pred,
pch = 19,
xlab = "Measured Alpha %",
ylab = "Predicted Alpha %",
main = "Alpha Prediction"
)
abline(
0,
1,
col = "red",
lwd = 2
)
11.4 Beta Prediction
plot(
phase_data$Beta,
beta_model$pred,
pch = 19,
xlab = "Measured Beta %",
ylab = "Predicted Beta %",
main = "Beta Prediction"
)
abline(
0,
1,
col = "red",
lwd = 2
)
11.5 Steel Prediction
plot(
phase_data$Steel,
steel_model$pred,
pch = 19,
xlab = "Measured Steel %",
ylab = "Predicted Steel %",
main = "Steel Prediction"
)
abline(
0,
1,
col = "red",
lwd = 2
)
12 PHASE 8: PHASE EVOLUTION AND INTERPRETATION
12.1 Objective
Interpret diffraction evolution in terms of phase evolution.
13 Phase 8A: Diagnostic Windows
window_df <- data.frame(
Run = phase_data$Run
)
for(i in seq_along(windows)){
rng <- windows[[i]]
cols <- which(
theta >= rng[1] &
theta <= rng[2]
)
window_df[[paste0("W",i,"_Mean")]] <-
rowMeans(X[,cols])
window_df[[paste0("W",i,"_Max")]] <-
apply(X[,cols],1,max)
window_df[[paste0("W",i,"_Area")]] <-
rowSums(X[,cols])
}
phase_results <- left_join(
phase_data,
window_df,
by = "Run"
)14 Phase 8B: Window–Phase Correlations
window_cols <- names(phase_results)[
grepl("_Max",names(phase_results))
]
corr_summary <- data.frame()
for(w in window_cols){
corr_summary <- rbind(
corr_summary,
data.frame(
Window = w,
Alpha_r = cor(
phase_results[[w]],
phase_results$Alpha
),
Beta_r = cor(
phase_results[[w]],
phase_results$Beta
),
Steel_r = cor(
phase_results[[w]],
phase_results$Steel
)
)
)
}
kable(
corr_summary,
digits = 3
)| Window | Alpha_r | Beta_r | Steel_r |
|---|---|---|---|
| W1_Max | 0.984 | -0.987 | 0.724 |
| W2_Max | 0.969 | -0.962 | 0.610 |
| W3_Max | 0.166 | -0.188 | 0.349 |
| W4_Max | -0.747 | 0.782 | -0.894 |
| W5_Max | -0.407 | 0.376 | 0.040 |
15 Phase 8C: Run-Based Phase State Mapping
phase_results$PhaseState <-
assign_phase_state(
phase_results$Alpha,
phase_results$Beta
)
table(
phase_results$PhaseState
)##
## Alpha Rich Beta Rich Mixed Alpha-Beta
## 5 10 1315.1 Phase State Map
ggplot(
phase_results,
aes(
x = Run,
y = 1,
fill = PhaseState
)
)+
geom_tile()+
scale_fill_manual(
values = c(
"Alpha Rich" = "blue",
"Mixed Alpha-Beta" = "gold",
"Beta Rich" = "red"
)
)+
theme(
axis.text.y =
element_blank(),
axis.ticks.y =
element_blank()
)+
labs(
title =
"Run-Based Phase State Map"
)
16 Phase 8D: Temperature-Cycle Interpretation
n <- nrow(phase_results)
turn_point <- 14
phase_results$TempCycle <- c(
seq(
0,
1,
length.out = turn_point
),
seq(
1,
0,
length.out =
n - turn_point + 1
)[-1]
)16.1 Phase Evolution vs Temperature Cycle
phase_long <-
phase_results %>%
select(
Run,
Alpha,
Beta,
Steel,
TempCycle
) %>%
pivot_longer(
c(
Alpha,
Beta,
Steel
),
names_to = "Phase",
values_to = "Fraction"
)
ggplot(
phase_long,
aes(
TempCycle,
Fraction,
color = Phase
)
)+
geom_line(
linewidth = 1.2
)+
geom_point(
size = 2
)+
labs(
title =
"Phase Evolution vs Temperature Cycle"
)
17 PHASE 9: WINDOW-BASED PLS PREDICTION OF PHASE COMPOSITION
17.1 Objective
Determine whether diagnostic diffraction windows can reproduce full-pattern predictive performance.
window_predictors <-
data.frame(
Run = phase_data$Run
)
for(i in seq_along(windows)){
rng <- windows[[i]]
cols <- which(
theta >= rng[1] &
theta <= rng[2]
)
window_predictors[[names(windows)[i]]] <-
rowMeans(
X[,cols,drop=FALSE]
)
}
pls_data <- left_join(
phase_data,
window_predictors,
by = "Run"
)17.2 Evaluation Function
evaluate_pls <- function(
Xvars,
yvar,
data
){
form <- as.formula(
paste(
yvar,
"~",
paste(
Xvars,
collapse = "+"
)
)
)
model <- plsr(
form,
data = data,
validation = "LOO",
scale = TRUE
)
pred <- as.vector(
predict(
model,
ncomp =
model$ncomp
)
)
obs <- data[[yvar]]
r2 <- cor(
obs,
pred
)^2
rmse <- sqrt(
mean(
(obs-pred)^2
)
)
data.frame(
Predictors =
paste(
Xvars,
collapse = ", "
),
Target = yvar,
R2 = r2,
RMSE = rmse
)
}17.3 Predictor Sets
predictor_sets <- list(
W1 = c("W1"),
W2 = c("W2"),
W4 = c("W4"),
W1_W2 = c(
"W1",
"W2"
),
W1_W2_W4 = c(
"W1",
"W2",
"W4"
),
All_Windows = c(
"W1",
"W2",
"W3",
"W4",
"W5"
)
)17.4 Alpha Window Models
alpha_results <- bind_rows(
lapply(
predictor_sets,
evaluate_pls,
yvar = "Alpha",
data = pls_data
),
.id = "Model"
)17.5 Beta Window Models
beta_results <- bind_rows(
lapply(
predictor_sets,
evaluate_pls,
yvar = "Beta",
data = pls_data
),
.id = "Model"
)17.6 Steel Window Models
steel_results <- bind_rows(
lapply(
predictor_sets,
evaluate_pls,
yvar = "Steel",
data = pls_data
),
.id = "Model"
)17.7 Combined Results
window_results <-
bind_rows(
alpha_results,
beta_results,
steel_results
)
kable(
window_results,
digits = 4
)| Model | Predictors | Target | R2 | RMSE |
|---|---|---|---|---|
| W1 | W1 | Alpha | 0.9623 | 6.4626 |
| W2 | W2 | Alpha | 0.9729 | 5.4781 |
| W4 | W4 | Alpha | 0.7627 | 16.2142 |
| W1_W2 | W1, W2 | Alpha | 0.9839 | 4.2252 |
| W1_W2_W4 | W1, W2, W4 | Alpha | 0.9850 | 4.0813 |
| All_Windows | W1, W2, W3, W4, W5 | Alpha | 0.9893 | 3.4397 |
| W1 | W1 | Beta | 0.9708 | 6.0951 |
| W2 | W2 | Beta | 0.9606 | 7.0870 |
| W4 | W4 | Beta | 0.7482 | 17.9079 |
| W1_W2 | W1, W2 | Beta | 0.9819 | 4.7987 |
| W1_W2_W4 | W1, W2, W4 | Beta | 0.9821 | 4.7726 |
| All_Windows | W1, W2, W3, W4, W5 | Beta | 0.9879 | 3.9239 |
| W1 | W1 | Steel | 0.5445 | 2.2991 |
| W2 | W2 | Steel | 0.3975 | 2.6442 |
| W4 | W4 | Steel | 0.2801 | 2.8904 |
| W1_W2 | W1, W2 | Steel | 0.6549 | 2.0011 |
| W1_W2_W4 | W1, W2, W4 | Steel | 0.8735 | 1.2117 |
| All_Windows | W1, W2, W3, W4, W5 | Steel | 0.8976 | 1.0902 |
17.8 Window-Based Model Comparison
ggplot(
window_results,
aes(
x = Model,
y = R2,
fill = Target
)
)+
geom_col(
position = "dodge"
)+
labs(
title =
"Window-Based PLS Performance",
y = expression(R^2)
)
18 PHASE 10: EXPERIMENTAL CONDITION INTEGRATION (FUTURE)
18.1 Future Inputs
- Temperature
- Pressure
- Stress
- Load
- Time
18.2 Goal
Develop phase-boundary interpretations and relate diffraction-state transitions to experimental conditions.
19 PHASE 11: MICROSTRUCTURAL EVOLUTION ANALYSIS (FUTURE)
19.1 Future Inputs
- Grain Size
- Microstrain
- Texture
- Microstructural Features
19.2 Goal
Relate phase evolution to microstructural evolution.
20 Final Results Summary
kable(
full_pattern_results,
digits = 4,
caption =
"Full Pattern PLS Results"
)| Phase | R2 | RMSE |
|---|---|---|
| Alpha | 0.9984 | 1.3451 |
| Beta | 0.9980 | 1.5919 |
| Steel | 0.9684 | 0.6056 |
20.1 Top Ranked Diffraction Windows
head(
ranking_display,
n = 5
)## Rank Window Importance_Score
## 1 1 W2 3.397
## 2 2 W5 2.000
## 3 3 W1 1.958
## 4 4 W4 1.633
## 5 5 W3 1.10620.2 Project Conclusions
PCA identified multiple diffraction states.
Similarity metrics supported a reversible pathway:
A → B → C → B → APeak tracking identified highly variable diffraction regions.
Automated ranking objectively prioritized diffraction windows.
Full-pattern PLS accurately predicted phase fractions.
Diagnostic windows revealed relationships between diffraction evolution and phase evolution.
Run-based classification identified:
- Alpha Rich
- Mixed Alpha-Beta
- Beta Rich
Window-based PLS demonstrated that a reduced set of diffraction windows retained substantial predictive information.
Future work should integrate:
- Temperature
- Stress
- Pressure
- Microstructure
to develop physically based phase-boundary interpretations.
21 Export Results
write.csv(
peak_results,
"PeakResults.csv",
row.names = FALSE
)
write.csv(
ranking,
"WindowRanking.csv",
row.names = FALSE
)
write.csv(
full_pattern_results,
"FullPatternPLS.csv",
row.names = FALSE
)
write.csv(
window_results,
"WindowPLS.csv",
row.names = FALSE
)
write.csv(
phase_results,
"PhaseEvolution.csv",
row.names = FALSE
)`