Skip to content

proper handling of NA values #49

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
archaeothommy merged 1 commit into from
May 25, 2026
Merged

proper handling of NA values #49

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
64 changes: 38 additions & 26 deletions R/ASTR_copper_alloy_classification_bb.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@
#' @examples
#' sample_df <- data.frame(
#' ID = 1:5,
#' Sn = c(5, 1, 4, 0.5, 2),
#' Sn = c(5, 1, 4, NA, 2),
#' Zn = c(12, 20, 6, 2, 10),
#' Pb = c(1, 0.5, 5, 9, 12)
#' )
Expand All @@ -35,7 +35,7 @@
#' sample_df <- as_ASTR(
#' data.frame(
#' ID = 1:8,
#' SnO_wtP = c(0.5, 0.5, 5, 5, 0.5, 5, 5, 5),
#' SnO_wtP = c(0.5, 0.5, 5, 5, 0.5, 5, 5, NA),
#' ZnO_wtP = c(0.5, 0.5, 0.5, 0.5, 5, 5, 0.5, 5),
#' PbO_wtP = c(0.5, 5, 0.5, 5, 0.5, 0.5, 5, 5)
#' )
Expand All @@ -61,56 +61,68 @@ copper_alloy_bb <- function(
# Create subset with just ID and classification column
copper_alloy <- data.frame(
ID_sample = df[[id_column]],
Sn = df[[elements["Sn"]]],
Zn = df[[elements["Zn"]]],
Pb = df[[elements["Pb"]]],
result = rep("Unclassified", nrow(df)),
Sn = df[[elements["Sn"]]],
Zn = df[[elements["Zn"]]],
Pb = df[[elements["Pb"]]],
result = rep("Unclassified", nrow(df)),
stringsAsFactors = FALSE
)

# Base alloy classes
# Identify rows where no element is NA — only these will be classified
na_mask <- !is.na(copper_alloy$Sn) & !is.na(copper_alloy$Zn) & !is.na(copper_alloy$Pb)

# Base alloy classes
# Copper: Zn < 3 and Sn < 3
copper_alloy$result[copper_alloy$Zn < 3 & copper_alloy$Sn < 3] <- "Copper"
copper_alloy$result[na_mask &
copper_alloy$Zn < 3 &
copper_alloy$Sn < 3] <- "Copper"

# Copper/brass: 3 ≤ Zn < 8 and Sn < 3
copper_alloy$result[copper_alloy$Zn >= 3 &
# Copper/brass: 3 <= Zn < 8 and Sn < 3
copper_alloy$result[na_mask &
copper_alloy$Zn >= 3 &
copper_alloy$Zn < 8 &
copper_alloy$Sn < 3] <- "Copper/brass"

# Bronze: Sn ≥ 3 and Zn < 3 * Sn
copper_alloy$result[copper_alloy$Sn >= 3 &
# Bronze: Sn >= 3 and Zn < 3 * Sn
copper_alloy$result[na_mask &
copper_alloy$Sn >= 3 &
copper_alloy$Zn < 3 * copper_alloy$Sn] <- "Bronze"

# Bronze/gunmetal: Sn ≥ 3 and Zn between 0.33*Sn and 0.67*Sn
copper_alloy$result[copper_alloy$Sn >= 3 &
# Bronze/gunmetal: Sn >= 3 and Zn between 0.33*Sn and 0.67*Sn
copper_alloy$result[na_mask &
copper_alloy$Sn >= 3 &
copper_alloy$Zn > 0.33 * copper_alloy$Sn &
copper_alloy$Zn < 0.67 * copper_alloy$Sn] <- "Bronze/gunmetal"

# Gunmetal: Zn > 0.67*Sn and Zn < 2.5*Sn and Sn ≥ 3
copper_alloy$result[copper_alloy$Sn >= 3 &
# Gunmetal: Zn > 0.67*Sn and Zn < 2.5*Sn and Sn >= 3
copper_alloy$result[na_mask &
copper_alloy$Sn >= 3 &
copper_alloy$Zn > 0.67 * copper_alloy$Sn &
copper_alloy$Zn < 2.5 * copper_alloy$Sn] <- "Gunmetal"

# Brass/gunmetal: Zn > 2.5*Sn and Zn <= 4*Sn AND (Zn ≥ 8 OR Sn ≥ 3)
copper_alloy$result[(copper_alloy$Zn >= 8 | copper_alloy$Sn >= 3) &
# Brass/gunmetal: Zn > 2.5*Sn and Zn <= 4*Sn AND (Zn >= 8 OR Sn >= 3)
copper_alloy$result[na_mask &
(copper_alloy$Zn >= 8 | copper_alloy$Sn >= 3) &
copper_alloy$Zn > 2.5 * copper_alloy$Sn &
copper_alloy$Zn <= 4 * copper_alloy$Sn] <- "Brass/gunmetal"

# Brass: Zn ≥ 8 and Zn > 4*Sn
copper_alloy$result[copper_alloy$Zn >= 8 &
# Brass: Zn >= 8 and Zn > 4*Sn
copper_alloy$result[na_mask &
copper_alloy$Zn >= 8 &
copper_alloy$Zn > 4 * copper_alloy$Sn] <- "Brass"

# Apply lead modifiers
# Apply lead modifiers only to non-NA rows
## (Leaded): Pb between 4 and 8
copper_alloy$result[copper_alloy$Pb >= 4 &
copper_alloy$Pb <= 8] <- paste(
"(Leaded)",
copper_alloy$result[copper_alloy$Pb >= 4 & copper_alloy$Pb <= 8]
prefix_leaded <- na_mask & copper_alloy$Pb >= 4 & copper_alloy$Pb <= 8
copper_alloy$result[prefix_leaded] <- paste(
"(Leaded)", copper_alloy$result[prefix_leaded]
)

## Leaded: Pb > 8
copper_alloy$result[copper_alloy$Pb > 8] <- paste("Leaded", copper_alloy$result[copper_alloy$Pb > 8])
prefix_high_lead <- na_mask & copper_alloy$Pb > 8
copper_alloy$result[prefix_high_lead] <- paste(
"Leaded", copper_alloy$result[prefix_high_lead]
)

# Merge results back to original dataframe by ID
copper_alloy_bb <- copper_alloy$result[match(df[[id_column]], copper_alloy$ID_sample)]
Expand Down
47 changes: 30 additions & 17 deletions R/ASTR_copper_alloy_classification_pollard.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@
#' @examples
#' sample_df <- data.frame(
#' ID = 1:8,
#' Sn = c(0.5, 0.5, 5, 5, 0.5, 5, 5, 5),
#' Sn = c(0.5, NA, 5, 5, 0.5, 5, 5, 5),
#' Zn = c(0.5, 0.5, 0.5, 0.5, 5, 5, 0.5, 5),
#' Pb = c(0.5, 5, 0.5, 5, 0.5, 0.5, 5, 5)
#' )
Expand All @@ -39,7 +39,7 @@
#' ID = 1:8,
#' SnO_wtP = c(0.5, 0.5, 5, 5, 0.5, 5, 5, 5),
#' ZnO_wtP = c(0.5, 0.5, 0.5, 0.5, 5, 5, 0.5, 5),
#' PbO_wtP = c(0.5, 5, 0.5, 5, 0.5, 0.5, 5, 5)
#' PbO_wtP = c(0.5, 5, 0.5, 5, 0.5, NA, 5, 5)
#' )
#' )
#' copper_alloy_pollard(sample_df, elements = c(Sn = "SnO", Zn = "ZnO", Pb = "PbO"))
Expand All @@ -54,11 +54,9 @@ copper_alloy_pollard <- function(
group_as_symbol = FALSE,
...) {

# convert units to wt%

if (inherits(df, "ASTR")) {
df <- convert_concentration_units(df, elements, "wtP", ...)
elements <- c(Sn = "Sn", Zn = "Zn", Pb = "Pb") # rename in case input was in oxides
elements <- c(Sn = "Sn", Zn = "Zn", Pb = "Pb")
threshold <- units::set_units(1, "wtP")
} else {
threshold <- 1 # wt%, set in Pollard et al. (2015)
Expand All @@ -72,6 +70,13 @@ copper_alloy_pollard <- function(
Pb_flag = df[[elements["Pb"]]] >= threshold
)

# Identify rows where any element is NA — these stay Unclassified
flags$has_na <- apply(
flags[, c("Sn_flag", "Zn_flag", "Pb_flag")],
1,
function(row) any(is.na(row))
)

# Convert flags into a pattern string
flags$pattern <- apply(
flags[, c("Sn_flag", "Zn_flag", "Pb_flag")],
Expand Down Expand Up @@ -107,26 +112,34 @@ copper_alloy_pollard <- function(
)

# Join with lookup table, preserving row order
out <- merge(flags[, c("ID_sample", "pattern")],
lookup,
by = "pattern",
all.x = TRUE)

# Ensure "Unclassified" for any missing matches
out$alloy_name[is.na(out$alloy_name)] <- "Unclassified"
out$alloy_symbol[is.na(out$alloy_symbol)] <- "Unclassified"
out <- merge(
flags[, c("ID_sample", "pattern", "has_na")],
lookup,
by = "pattern",
all.x = TRUE
)

# Add correct output column
# Add correct output column — NA in any element = Unclassified
if (!group_as_symbol) {
copper_alloy_pollard <- out$alloy_name[match(df[[id_column]], out$ID_sample)]
copper_alloy_pollard <- ifelse(
out$has_na[match(df[[id_column]], out$ID_sample)],
"Unclassified",
out$alloy_name[match(df[[id_column]], out$ID_sample)]
)
} else {
copper_alloy_pollard <- out$alloy_symbol[match(df[[id_column]], out$ID_sample)]
copper_alloy_pollard <- ifelse(
out$has_na[match(df[[id_column]], out$ID_sample)],
"Unclassified",
out$alloy_symbol[match(df[[id_column]], out$ID_sample)]
)
}

if (inherits(df, "ASTR")) {
df_out <- df[c(colnames(get_contextual_columns(df)), elements)]
df_out[["copper_alloy_pollard"]] <- copper_alloy_pollard
df_out[["copper_alloy_pollard"]] <- add_ASTR_class(df_out[["copper_alloy_pollard"]], "ASTR_context")
df_out[["copper_alloy_pollard"]] <- add_ASTR_class(
df_out[["copper_alloy_pollard"]], "ASTR_context"
)
} else {
df_out <- df
df_out[["copper_alloy_pollard"]] <- copper_alloy_pollard
Expand Down
41 changes: 31 additions & 10 deletions R/ASTR_copper_classification_Bray.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@
#' sample_df <- data.frame(
#' ID = 1:3,
#' As = c(0.2, 0.01, 0.15),
#' Sb = c(0.00, 0.2, 0.11),
#' Sb = c(0.00, NA, 0.11),
#' Ag = c(0.00, 0.00, 0.12),
#' Ni = c(0.00, 0.05, 0.20)
#' )
Expand All @@ -43,11 +43,11 @@
#' # For ASTR objects, units and oxides are automatically converted
#' sample_df2 <- as_ASTR(
#' data.frame(
#' ID = 1:3,
#' As2O3_wtP = c(0.2, 0.01, 0.15),
#' Sb2O3_wtP = c(0.00, 0.2, 0.11),
#' Ag2O_wtP = c(0.00, 0.00, 0.12),
#' NiO_wtP = c(0.00, 50, 0.20)
#' ID = 1:4,
#' As2O3_wtP = c(0.2, 0.01, 0.15, 2),
#' Sb2O3_wtP = c(0.00, 0.2, 0.11, 0.5),
#' Ag2O_wtP = c(0.00, 0.00, 0.12, NA),
#' NiO_wtP = c(0.00, 5, 0.20, 0.5)
#' )
#' )
#' copper_group_bray(sample_df2, elements = c(As = "As2O3", Sb = "Sb2O3", Ag = "Ag2O", Ni = "NiO"))
Expand Down Expand Up @@ -80,6 +80,12 @@ copper_group_bray <- function(
)

# Convert flags into a pattern string
flags$has_na <- apply(
flags[, c("As_flag", "Sb_flag", "Ag_flag", "Ni_flag")],
1,
function(row) any(is.na(row))
)

flags$pattern <- apply(
flags[, c("As_flag", "Sb_flag", "Ag_flag", "Ni_flag")],
1,
Expand Down Expand Up @@ -130,15 +136,30 @@ copper_group_bray <- function(
)

# Join with lookup table, preserving row order
out <- merge(flags[, c("ID_sample", "pattern")], lookup, by = "pattern", all.x = TRUE, sort = TRUE)
out <- merge(
flags[, c("ID_sample", "pattern", "has_na")],
lookup,
by = "pattern",
all.x = TRUE,
sort = TRUE
)

# Add correct output column
# Add correct output column — NA in any element = Unclassified
if (!group_as_number) {
copper_group_bray <- out$group_name[match(df[[id_column]], out$ID_sample)]
copper_group_bray <- ifelse(
out$has_na[match(df[[id_column]], out$ID_sample)],
"Unclassified",
out$group_name[match(df[[id_column]], out$ID_sample)]
)
} else {
copper_group_bray <- out$group_number[match(df[[id_column]], out$ID_sample)]
copper_group_bray <- ifelse(
out$has_na[match(df[[id_column]], out$ID_sample)],
NA_integer_,
out$group_number[match(df[[id_column]], out$ID_sample)]
)
}

# Return ASTR object or plain data frame
if (inherits(df, "ASTR")) {
df_out <- df[c(colnames(get_contextual_columns(df)), elements)]
df_out[["copper_group_bray"]] <- copper_group_bray
Expand Down
4 changes: 2 additions & 2 deletions man/copper_alloy_bb.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 2 additions & 2 deletions man/copper_alloy_pollard.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

12 changes: 6 additions & 6 deletions man/copper_group_bray.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

41 changes: 23 additions & 18 deletions tests/testthat/test_copper_alloy_bb.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,33 +1,38 @@
test_that("copper_alloy_bb", {
test_data <- data.frame(
ID = 1:8,
Tin = c(1, 1, 5, 5, 5, 5, 0.5, 5),
Zn = c(2, 5, 2, 4, 8, 15, 2, 8),
Lead = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 9, 6)
ID = 1:11,
Tin = c(1, 1, 5, 5, 5, 5, 0.5, 5, NA, 5, 5),
Zn = c(2, 5, 2, 4, 8, 15, 2, 8, 2, NA, 8),
Lead = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 9, 6, 0.5, 0.5, NA)
)

expect_equal(
copper_alloy_bb(test_data, elements = c("Sn" = "Tin", "Zn" = "Zn", "Pb" = "Lead"))$copper_alloy_bb,
c(
"Copper", # ID 1: Copper (Zn<3, Sn<3)
"Copper/brass", # ID 2: Copper/brass (3≤Zn<8, Sn<3)
"Bronze/gunmetal", # ID 3: Bronze (Sn≥3, Zn<3*Sn)
"Gunmetal", # ID 4: Bronze/gunmetal (Sn≥3, 0.33<Zn/Sn<0.67)
"Gunmetal", # ID 5: Gunmetal (Sn≥3, 0.67<Zn/Sn<2.5)
"Brass/gunmetal", # ID 6: Brass/gunmetal (Zn>2.5*Sn, Zn≤4*Sn)
"Leaded Copper", # ID 7: Leaded Copper (Copper + Pb>8)
"(Leaded) Gunmetal" # ID 8: (Leaded) Gunmetal (Gunmetal + 4≤Pb≤8)
"Copper", # ID 1: Copper (Zn<3, Sn<3)
"Copper/brass", # ID 2: Copper/brass (3≤Zn<8, Sn<3)
"Bronze/gunmetal", # ID 3: Bronze (Sn≥3, Zn<3*Sn)
"Gunmetal", # ID 4: Bronze/gunmetal (Sn≥3, 0.33<Zn/Sn<0.67)
"Gunmetal", # ID 5: Gunmetal (Sn≥3, 0.67<Zn/Sn<2.5)
"Brass/gunmetal", # ID 6: Brass/gunmetal (Zn>2.5*Sn, Zn≤4*Sn)
"Leaded Copper", # ID 7: Leaded Copper (Copper + Pb>8)
"(Leaded) Gunmetal", # ID 8: (Leaded) Gunmetal (Gunmetal + 4≤Pb≤8)
"Unclassified", # ID 9: NA Sn
"Unclassified", # ID 10: NA Zn
"Unclassified" # ID 11: NA Pb
)
)
})

test_that("copper_alloy_bb: Handling ASTR object", {
test_data_ASTR <- as_ASTR(
data.frame(
ID = 1:8,
Sn_atP = c(0.5, 0.5, 5, 5, 0.5, 5, 5, 5),
Zn_atP = c(0.5, 0.5, 0.5, 0.5, 5, 5, 0.5, 5),
Pb_atP = c(0.5, 5, 0.5, 5, 0.5, 0.5, 5, 5)
suppressWarnings(
test_data_ASTR <- as_ASTR(
data.frame(
ID = 1:8,
Sn_atP = c(0.5, 0.5, 5, 5, 0.5, 5, NA, 5),
Zn_atP = c(0.5, NA, 0.5, 0.5, 5, 5, 0.5, 5),
Pb_atP = c(0.5, 5, 0.5, 5, NA, 0.5, 5, 5)
)
)
)
test_result_ASTR <- copper_alloy_bb(test_data_ASTR)
Expand Down
Loading
Loading