In kdschneider/tpt-goldbonder: Prozessoptimierung am tpt-Goldbonder

knitr::opts_chunk$set(
  comment = "#>", 
  echo = TRUE,
  message = FALSE,
  warning = FALSE,
  error = FALSE
)

#####################################################
###                                               ###
###   File created automatically. Do not change!  ###
###   Changes will be overwritten!                ###
###                                               ###
#####################################################

Load custom functions

source(here::here("R/custom_functions.R"))

Load packages

library(tidyverse)
library(rsm)
library(parsnip)

Create Box-Behnken design

set.seed(9393)

coding_bbd <-
  list(
    ultrasound.coded ~ (ultrasound - 160)/50,
    time.coded ~ (time - 200)/50,
    force.coded ~ (force - 200)/50,
    gold.coded ~ (gold - 70)/30,
    chrome.coded ~ (chrome - 6)/4,
    temperature.coded ~ (temperature - 100)/50
  )

design_bbd <-
  bbd(
    k = ~ ultrasound.coded + time.coded + force.coded + gold.coded + chrome.coded + temperature.coded,
    n0 = 3,
    coding = coding_bbd,
    randomize = TRUE
  ) |>
  decode.data() |>
  mutate(
    measurement_1 = NA,
    measurement_2 = NA,
    measurement_3 = NA,
    measurement_4 = NA,
    measurement_5 = NA,
    measurement_6 = NA,
    measurement_7 = NA,
    measurement_8 = NA,
    measurement_9 = NA,
    measurement_10 = NA
  )

design_bbd |> head()

Read and wrangle data

data_bbd <-
  read_csv(
    here::here("data-raw/pulltest/box_behnken/pt-bbd.csv")
  ) |>
  pivot_longer(
    cols = measurement_1:measurement_10,
    names_to = "measurement",
    values_to = "rip_force"
  ) |>
  mutate(
    across(
      .cols = ultrasound:temperature,
      .fns = function(x) { scales::rescale(x, to = c(-1,1)) },
      .names = "{.col}.c"
    )
  )

data_bbd |> head()

plot_bbd_runorder <-
  data_bbd |>
  mutate(index = row_number()) |>
  pivot_longer(ultrasound:temperature) |>
  mutate(bondtool = as_factor(bondtool) |> fct_inseq()) |>
  group_by(bondtool) |>
  mutate(bondtool_mean = mean(rip_force)) |>
  ggplot(aes(x = index)) +
  geom_line(
    aes(
      y = bondtool_mean,
      colour = bondtool
    ),
    size = 1
  ) +
  geom_point(
    aes(
      y = rip_force
    ),
    alpha = 0.5,
    size = 1
  ) +
  labs(
    x = "Versuchsreihenfolge",
    y = "Haltekraft in mN",
    colour = "Bondtool"
  )

plot_bbd_runorder

data_bbd_mean <-
  data_bbd |>
  select(-measurement) |>
  group_by(run.order) |>
  mutate(
    rip_force_sd = sd(rip_force),
    rip_force_se = plotrix::std.error(rip_force),
    rip_force = mean(rip_force)
  ) |>
  unique() |>
  ungroup()

data_bbd_mean |> head()

plot_bbd_effect <-
  data_bbd_mean |> 
  pivot_longer(ultrasound.c:temperature.c) |> 
  select(name, value, rip_force) |> 
  mutate(
    name = as_factor(name) |> 
      fct_recode(
        "Ultraschallleistung" = "ultrasound.c",
        "Bondzeit" = "time.c",
        "Bondkraft" = "force.c",
        "Temperatur" = "temperature.c",
        "Schichtdicke: Gold" = "gold.c",
        "Schichtdicke: Chrome" = "chrome.c"
      )
  ) |> 
  group_by(name, value) |> 
  summarise(rip_force = mean(rip_force)) |> 
  ggplot(aes(x = value, y = rip_force)) +
  geom_line() +
  geom_point() +
  labs(
    x = "Level",
    y = "mittlere Haltekraft in mN"
  ) +
  facet_wrap(facet = vars(name))

plot_bbd_effect

plot_bbd_effect

Regression

model_specs <-
  linear_reg() |>
  set_engine("lm")

formula_model_bbd <- 
  rip_force ~ run.order +
    ultrasound + time + force + temperature + chrome + gold +
    ultrasound:time + ultrasound:force + ultrasound:temperature + ultrasound:chrome + ultrasound:gold +
    time:force + time:temperature + time:chrome + time:gold +
    force:temperature + force:chrome + force:gold +
    temperature:chrome + temperature:gold + chrome:gold +
    I(ultrasound^2) + I(time^2) + I(force^2) + I(temperature^2) + I(chrome^2) + I(gold^2)

model_bbd <-
  model_specs |>
  fit(
    formula = formula_model_bbd,
    data = data_bbd_mean
  )

summary(model_bbd$fit)

Save data

write_csv(
  x = design_bbd,
  file = here::here("data/doe/pt_bbd.csv")
)

fs::dir_create(
  path = c(
    here::here("data/doe"),
    here::here("data/pulltest")
  ),
  recurse = TRUE
)

save(
  data_bbd,
  data_bbd_mean,
  file = here::here("data/pulltest/pt_bbd.rda")
)

save(
  model_bbd,
  file = here::here("data/pulltest/pt_bbd_regression.rda")
)

save(
  plot_bbd_effect,
  plot_bbd_runorder,
  file = here::here("data/pulltest/pt_bbd_plots.rda")
)