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(lubridate)
library(FrF2)
library(patchwork)
library(parsnip)

Screening DoE

factors_screening <-
  list(
    ultrasound = c(180, 280),
    time = c(180, 280),
    force = c(180, 280),
    gold = c(40, 160),
    chrome = c(2, 10),
    temperature = c(100, 150)
  )

design_screening <-
  FrF2(
    factor.names = factors_screening,
    resolution = 3,
    replications = 5,
    repeat.only = FALSE,
    randomize = TRUE,
    ncenter = 3,
    seed = 11111
  ) |>
  mutate(
    index = row_number(),
    rep =  rep(x = 1:5, times = 1, each = 11),
    chip = sample(2, size = n(), replace = TRUE),
    gate_break_visual = NA,
    gate_break_measurement = NA,
    gate_break = NA,
    voltage = NA
  ) |>
  as_tibble() |>
  select(index, rep, chip, everything())

design_screening |> head()

Read and wrangle measurement data

with_sample <-
  tibble(
    filename = list.files(
      path = here::here(
        "data-raw/gatebreak/screening/measurements"
      )
    )
  ) |>
  mutate(
    index = as.numeric(
      str_extract(
        filename,
        pattern = "(?<=\\()[^()]*(?=\\))"
      )
    ),
    date = as_datetime(
      str_extract(
        filename,
        pattern = "([0-9]+(_[0-9]+)+) ([0-9]+(_[0-9]+)+) [a-zA-Z]+"
      ),
      format = "%m_%d_%Y %I_%M_%S %p"
    ),
    measurement = map(
      filename,
      ~ read_tsv(
        here::here(
          "data-raw/gatebreak/screening/measurements", .
        )
      )
    )
  ) |>
  right_join(
    read_csv(
      file = here::here(
        "data-raw/gatebreak/screening/gb-screening-data.csv"
      )
    ),
    by = "index"
  ) |>
  arrange(index) |>
  mutate(
    'type' = 'with-sample'
  )

no_sample <-
  tibble(
    filename = list.files(
      path = here::here(
        "data-raw/gatebreak/screening/blind"
      )
    )
  ) |>
  mutate(
    date = as_datetime(
      str_extract(
        filename,
        pattern = "([0-9]+(_[0-9]+)+) ([0-9]+(_[0-9]+)+) [a-zA-Z]+"
      ),
      format = "%m_%d_%Y %I_%M_%S %p"
    ),
    date = date(date),
    measurement = map(
      filename,
      ~ read_tsv(
        here::here(
          "data-raw/gatebreak/screening/blind", .
        )
      )
    ),
    'type' = 'no-sample'
  )


data_screening <-
  full_join(
    x = with_sample,
    y = no_sample
  ) |>
  unnest(measurement) |>
  mutate(
    across(
      .cols = ultrasound:temperature,
      .fns = function(x) {
        scales::rescale(x, to = c(-1,1))
      },
      .names = "{.col}_coded"
    )
  ) |>
  rename(
    "voltage" = "BG_V",
    "current" = "BG_I"
  ) |>
  nest(measurement = c(voltage, current))

remove(no_sample, with_sample)

data_screening |> head()

Kennlinie of gatebreaks

plot_screening_kennlinie <-
  data_screening |>
  filter(gate_break == TRUE) |>
  mutate(
    index = glue::glue("Messung: {index}"),
    index = as_factor(index) |>
      fct_reorder(parse_number(index))
  ) |>
  unnest(measurement) |>
  ggplot() +
  aes(
    x = voltage,
    y = current * 10^6,
    group = index
  ) +
  geom_line() +
  labs(
    x = "Spannung in V",
    y = "Stromstärke in µA"
  ) +
  scale_y_continuous(n.breaks = 3) +
  facet_wrap(
    vars(index),
    ncol = 3,
    scales = 'free'
  )

plot_screening_kennlinie

Effect plot

plot_screening_effect <- 
  data_screening |>
  rescale_factors(ultrasound:temperature) |>
    pivot_longer(cols = ultrasound:temperature) |>
    mutate(
      name = as_factor(name) |> 
        fct_recode(
          "Ultraschallleistung" = "ultrasound",
          "Bondzeit" = "time",
          "Bondkraft" = "force",
          "Temperatur" = "temperature",
          "Schichtdicke: Gold" = "gold",
          "Schichtdicke: Chrom" = "chrome"
        )
    ) |> 
    group_by(name, value) |>
    summarise(gate_break = mean(gate_break)) |>
    ggplot(
      aes(
        x = value,
        y = gate_break
      )
    ) +
    geom_line() +
    geom_point() +
    labs(
      x = "Level",
      y = "P(Gatedurchbruch)"
    ) +
    facet_wrap(vars(name), ncol = 3)

plot_screening_effect

Regression

Create regression data

data_screening_regression <-
  data_screening |>
  filter(type == "with-sample") |>
  rescale_factors(ultrasound:temperature) |>
  select(ultrasound:temperature, gate_break) |>
  mutate(gate_break = as.numeric(gate_break)) |>
  group_by(ultrasound, time, force, gold, chrome, temperature) |>
  summarise(
    gate_break = mean(gate_break)
  ) |>
  mutate(gate_break_asin = asin(sqrt(gate_break)))

data_screening_regression |> head()

Shaprio test

shapiro_data_screening_regression <-
  shapiro.test(
    data_screening_regression$gate_break_asin
  ) |>
  tidy() |>
  pull(p.value) |>
  round(digits = 3)

shapiro_data_screening_regression

Model

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

model_screening <-
  model_specs |>
  fit(
    formula = gate_break_asin ~ ultrasound + force + gold,
    data = data_screening_regression
  )

summary(model_screening$fit)

Extract model parameters

r2_model_screening <-
  model_screening |>
  glance() |>
  pull(r.squared) |>
  scales::percent(accuracy = 0.1)

p_model_screening <-
  model_screening |>
  glance() |>
  pull(p.value) |>
  as.numeric() |> 
  round(digits = 3)

r2_model_screening
p_model_screening

Contour plot

n <- 75
new_data <-
  tibble(
    ultrasound = -1:1,
    force = -1:1,
    gold = -1:1
  ) |>
  modelr::data_grid(
    ultrasound = modelr::seq_range(ultrasound, n = n),
    force = modelr::seq_range(force, n = n),
    gold = modelr::seq_range(gold, n = n),
    .model = model_screening$fit
  )

predict_data <-
  predict.lm(
    object = model_screening$fit,
    newdata = new_data,
    type = "response"
  ) |>
  as_tibble() |>
  mutate(index = row_number())

contour_data <-
  new_data |>
  mutate(index = row_number()) |>
  left_join(predict_data)

p1 <-
  contour_data |>
  filter(gold == 0) |> 
  ggplot() +
  geom_raster(aes(x = ultrasound, y = force, fill = value), show.legend = FALSE) +
  geom_contour(
    aes(x = ultrasound, y = force, z = value), 
    colour = "black", linetype = 2
  ) +
  labs(
    x = "Ultraschallleistung",
    y = "Bondkraft",
    fill = "P(Gatebreak)"
  ) 

p2 <-
  contour_data |>
  filter(force == 0) |> 
  ggplot() +
  geom_raster(aes(x = ultrasound, y = gold, fill = value)) +
  geom_contour(aes(x = ultrasound, y = gold, z = value), colour = "black", linetype = 2) +
  labs(
    x = "Ultraschallleistung",
    y = "Schichtdicke: Gold",
    fill = "P(GD)"
  ) +
  theme(
    axis.text.y = element_blank()
  )

p3 <-
  contour_data |>
  filter(ultrasound == 0) |> 
  ggplot() +
  geom_raster(aes(x = force, y = gold, fill = value), show.legend = FALSE) +
  geom_contour(
    aes(x = force, y = gold, z = value), 
    colour = "black", 
    linetype = 2
  ) +
  labs(
    x = "Bondkraft",
    y = "Schichtdicke: Gold",
    fill = "P(GD)"
  ) +
  theme(
    axis.text.y = element_blank()
  )

plot_screening_contour <-
  (p1 / p2 / p3) &
  viridis::scale_fill_viridis(option = "A") &
  scale_x_continuous(n.breaks = 5) &
  scale_y_continuous(n.breaks = 5)

remove(n, new_data, predict_data, p1, p2, p3)

plot_screening_contour

Save data

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

write_csv(
  x = design_screening,
  file = here::here("data/doe/gb-screening.csv"),
  na = "",
  col_names = TRUE
)

write_rds(
  x = data_screening,
  file = here::here("data/gatebreak/gb-screening.rds")
)

save(
  model_screening,
  p_model_screening,
  r2_model_screening,
  shapiro_data_screening_regression,
  data_screening_regression,
  file = here::here("data/gatebreak/gb_screening_regression.rda")
)

save(
  plot_screening_kennlinie,
  plot_screening_effect,
  plot_screening_contour,
  file = here::here("data/gatebreak/gb_screening_plots.rda")
)

kdschneider/tpt-goldbonder documentation built on Feb. 5, 2022, 5:24 p.m.