6  Laser auf Erdbeeren

Letzte Änderung am 13. January 2024 um 17:53:03

Genutzte R Pakete

pacman::p_load(tidyverse, readxl, parameters,
               effectsize, magrittr, multcomp,
               multcompView, rcompanion, rstatix,
               emmeans, see, performance, fs,
               janitor, broom,
               conflicted)
## resolve some conflicts with same function naming
conflicts_prefer(dplyr::select)
conflicts_prefer(dplyr::filter)
conflicts_prefer(effectsize::eta_squared)
conflicts_prefer(magrittr::set_names)

Abbildung 6.1— Vogelperspektive für unseren Versuch mit Pilzbefall. Leider finden wir nur den Block I und II auf dem Grün 1 sowie die Blöcke III und IV auf dem Grün 2.

berry_files <- list.files("data/strawberry",
                          pattern = "^E", full.names = TRUE)

berry_lst <- map(berry_files, read_table, 
                 skip = 2, col_names = FALSE, col_types = cols())

berry_lst <- map(berry_files, function(x){
  tmp_tbl <- read_table(x, 
                        skip = 2, col_names = FALSE, col_types = cols()) 
  file_name <- basename(x) %>% 
    path_ext_remove() %>% 
    str_replace_all("\\s", "_")
  tmp_tbl <- tmp_tbl %>% 
    set_names(c("wave", file_name)) 
  return(tmp_tbl)
})

berry_tbl <- berry_lst %>% 
  reduce(left_join, by = "wave") %>% 
  pivot_longer(cols = E_1.1._w1:last_col(),
               names_sep = "\\._",
               values_to = "values",
               names_to = c("E", "rep")) %>% 
  group_by(wave, E) %>% 
  summarise(mean = mean(values))

ggplot(berry_tbl, aes(wave, mean, color = E)) +
  theme_bw() +
  geom_line() +
  theme(legend.position = "none") 

Abbildung 6.2— Korrelation zwischen den beiden Jahren der Messung.

sugar_tbl <- read_excel("data/strawberry_sugar.xlsx") %>% 
  clean_names() %>% 
  select(-brixwert, -brix_mittel_note, -messwiederholung,
         -g_zucker_l_saft_mittel_note, -oe_einzelfrucht) %>% 
  filter(!is.na(brix_einzelfrucht)) %>% 
  mutate(E = str_c("E_", boniturnote, ".", fruchtnummer))

berry_sugar_tbl <- left_join(berry_tbl, sugar_tbl,
                             by = c("E" = "E")) %>% 
  filter(boniturnote %in% c(1, 2, 3, 4, 5)) %>% 
  mutate(boniturnote = as_factor(boniturnote))

wave_vec <- berry_sugar_tbl %>% pull(wave) %>% unique()

Wir haben insgesamt 1740 Wellenlängen.

wave_vec <- wave_vec[1:20]

berry_sugar_tbl %>% 
  filter(wave == 231) %>% 
  ggplot(aes(x = brix_einzelfrucht, y = mean,
             color = boniturnote)) +
  theme_bw() +
  geom_point() +
  stat_smooth(method = "lm", se = FALSE) +
  facet_wrap(~ wave) +
  scale_color_okabeito() 

Abbildung 6.3— Korrelation zwischen den beiden Jahren der Messung.

berry_sugar_tbl %>% 
  filter(wave == 231) %$% 
  lm(mean ~ brix_einzelfrucht) %>% 
  glance() %>% 
  pull(r.squared)

[1] 0.01267805

rsquare_vec <- map_dbl(wave_vec, function(x){
  rsquare <- berry_sugar_tbl %>% 
    filter(wave == x) %$% 
    lm(brix_einzelfrucht ~ mean + boniturnote) %>%
    glance() %>% 
    pull(adj.r.squared)
  return(rsquare)
}, .progress = TRUE) %>% 
  set_names(wave_vec)

which.max(rsquare_vec)

238 
 15 

rsquare_vec[15]

      238 
0.6111646 

berry_sugar_tbl %>% 
  filter(wave == wave_vec[15]) %>% 
  ggplot(aes(x = mean, y = brix_einzelfrucht,
             color = boniturnote)) +
  theme_bw() +
  geom_text(aes(label = E)) +
  stat_smooth(method = "lm", se = FALSE) +
  facet_wrap(~ wave) +
  scale_color_okabeito() 

Abbildung 6.4— Korrelation zwischen den beiden Jahren der Messung.