---
lang: cs
format:
  revealjs:
    slide-number: true
    theme: [default, ../theme/presentation_theme.scss, ../theme/presentation_components.scss]
    embed-resources: true
    preview-links: false
    output-file: "presentation"
    output-ext: "html"
    highlight-style: github-light
    include-in-header: "../theme/fonts-include.html"
filters:
  - ../theme/rn-shorthand.lua
  - ../_extensions/EmilHvitfeldt/roughnotation/rough.lua
---

```{r}
#| label: setup
#| include: false
options(htmltools.dir.version = FALSE)
knitr::opts_chunk$set(
  fig.width = 7,
  fig.height = 5,
  fig.align = "center",
  out.width = "100%"
)

library(here)

here::i_am("Presentation/presentation.qmd")

path_materials <-
  "Presentation/Materials"

dir.create(
  here::here(path_materials),
  recursive = TRUE,
  showWarnings = FALSE
)

source(here::here("R", "set_r_theme.R"))
# Pixel canvases use 150 DPI; match showtext font metrics to the save device.
showtext::showtext_opts(dpi = 150)
source(here::here("R", "Functions", "format_cz.R"))
source(here::here("R", "Functions", "format_cz_math.R"))
source(here::here("R", "Functions", "include_local_figure.R"))
source(here::here("R", "save_local_figure.R"))
source(here::here("R", "Functions", "save_local_gif.R"))
source(here::here("R", "Functions", "make_sse_frame.R"))

barvy <-
  c(
    data = biostat_cols[["grey_olive"]],
    model = biostat_cols[["indigo_velvet"]],
    interpretace = biostat_cols[["orange"]]
  )
stopifnot(identical(names(barvy), c("data", "model", "interpretace")), !anyNA(barvy))

```

```{r}
#| label: dynamic-link-generation
#| include: false
project_name <-
  basename(here::here())

display_name <-
  "Biostatistika"

github_url <-
  paste0(
    "https://github.com/CUNI-NATUR-Biostatistics/",
    project_name
  )

slides_url <-
  paste0(
    "https://CUNI-NATUR-Biostatistics.github.io/",
    project_name,
    "/"
  )
```

## Mají širší korunní lístky kosatců také větší délku — a pokud ano, o kolik? {.course-title .course-title-illustrated .bg-indigo}

::: {.course-title-illustration}
```{r}
#| label: zobrazit-titulni-ilustraci
#| echo: false
#| fig-alt: "Botanička měří délku a šířku korunního lístku kosatce; vedle květů je ilustrační náčrt bodů, přímky a čtverců residuí. Ilustrace vytvořená pomocí AI."
#| out-width: "100%"
include_local_figure("kosatce_titulni_ilustrace.png")
```
:::

::: {.course-title-mark}
![Logo kurzu Biostatistika](../theme/course-logo-reversed.svg) BIOSTATISTIKA
:::

::: {.course-title-number}
L03
:::

::: {.course-title-formal}
Lineární model s jedním numerickým prediktorem
:::

::: {.course-title-link}
[cuni-natur-biostatistics.github.io/materialy.html](https://cuni-natur-biostatistics.github.io/materialy.html)
:::

::: {.course-title-caption}
Ilustrace vytvořená pomocí AI.
:::

::: {.notes}
Titulní ilustrace propojuje kosatce, botaničku s pravítkem a motiv bodů, přímky a čtverců residuí z této přednášky. Měříme korunní lístky, nikoli výšku rostlin. Náčrt na desce je pouze ilustrační: nepředstavuje skutečná měření ani výsledek modelu. Původ a úplné zadání jsou zaznamenány v `Workflow/records/2026-10-06-title-illustration.md`.
:::

## Jakou délku odhadneme z naměřené šířky?

```{r}
#| label: nacist-data-kosatcu
#| include: false
# Same base-R reader as the visible code shown later on the slides.
data_kosatce <-
  read.csv(file = here::here("data", "kosatce.csv"))
```

:::: {.columns .align-center}

::: {.column width="42%"}
```{r}
#| label: zobrazit-kosatec
#| echo: false
#| fig-alt: "Květ kosatce s korunními lístky, jejichž šířku a délku budeme porovnávat."
#| out-width: 100%
include_local_figure("iris_versicolor.jpg")
```
:::

::: {.column width="58%"}
::: {.box-question}
[Biologická otázka]{.panel-title}

**Mají širší korunní lístky kosatců také větší délku — a pokud ano, o kolik?**
:::

<br>

::: {.panel-data}
[Co budeme sledovat]{.panel-title}

**`r format_cz(nrow(data_kosatce))` květů**

šířka a délka korunního lístku v centimetrech
:::
:::

::::

::: {.footer}
Foto: [Danielle Langlois / Wikimedia Commons](https://commons.wikimedia.org/wiki/File:Iris_versicolor_4.jpg), CC BY-SA 3.0
:::

::: {.notes}
Otevírám výzkumnou otázkou ještě před výsledky učení. Nechám studenty krátce odhadnout směr vztahu a zeptám se, jaký typ odpovědi by od modelu potřebovali. Otázka pak zůstává páteří celé prezentace.
:::

{{< include ../pollslive/generated/active.qmd >}}

## Výsledky učení

<br>

Po absolvování této přednášky budete schopni:

::: {.incremental}
- převést otázku „když změříme jednu veličinu, jakou hodnotu druhé můžeme čekat?“ na [lineární model]{.text-hgl-indigo_velvet} s [odezvou a prediktorem]{.text-hgl-graphite}
- fitovat `lm(odezva ~ prediktor)` a interpretovat [směr i velikost efektu]{.text-hgl-indigo_velvet}
- vysvětlit [residuum]{.text-hgl-orange} jako rozdíl mezi [naměřenou]{.text-hgl-graphite} a [odhadnutou]{.text-hgl-indigo_velvet} hodnotou
- číst graf residuí a rozpoznat v něm [zbývající vzor]{.text-hgl-orange}
:::

::: {.notes}
Výsledky učení navážu přímo na úvodní otázku. Zdůrazním, že dnešním cílem je bodový odhad efektu. Následující lekce přidá výběrovou variabilitu a interval spolehlivosti; testování hypotéz a p-hodnota přijdou až později.
:::

# Změříme šířku — jakou délku čekáme?

## Příští sezónu stihneme změřit jen šířku

```{r}
#| label: pripravit-ctyri-kvety-a-novy-kvet
#| include: false
# Four real flowers spread across the widths; their residuals from
#   candidate line B have mixed signs, so squaring is needed later.
vec_radky_ctyri_kvety <- c(3, 82, 117, 101)
data_ctyri_kvety <-
  data_kosatce[vec_radky_ctyri_kvety, c("sirka_listku", "delka_listku", "druh")]
rownames(data_ctyri_kvety) <- NULL

# Teaching scenario: a new flower with only its width measured. At this
#   width, the full-data line and the mean length of equally wide flowers
#   nearly coincide, so the later model estimate matches students' guess.
sirka_novy_kvet <- 2

table_ukazka_kvetu <-
  data.frame(
    kvet = c(as.character(seq_len(nrow(data_ctyri_kvety))), "nový"),
    sirka = c(
      format_cz(data_ctyri_kvety$sirka_listku),
      format(sirka_novy_kvet, nsmall = 1, decimal.mark = ",")
    ),
    delka = c(format_cz(data_ctyri_kvety$delka_listku), "?"),
    druh = c(data_ctyri_kvety$druh, "–")
  )
names(table_ukazka_kvetu) <- c("Květ", "Šířka (cm)", "Délka (cm)", "Druh")

# Same row count as the full table, with a blank last row, so the table
#   does not shift when the new-flower row is revealed.
table_ukazka_letos <- table_ukazka_kvetu
table_ukazka_letos[nrow(table_ukazka_letos), ] <- " "
```

::: {.takeaway-strip}
Letos botanička změřila u každého květu šířku i délku korunního lístku. Ukázka čtyř květů: jeden řádek = jeden květ.
:::

<br>

:::: {.columns .align-center}

::: {.column width="52%"}
::: {.r-stack}
::: {.fragment .fade-out fragment-index=2}
```{r}
#| label: zobrazit-ukazku-mereni-letos
#| echo: false
tinytable::tt(table_ukazka_letos)
```
:::

::: {.fragment fragment-index=2}
```{r}
#| label: zobrazit-ukazku-mereni-s-novym-kvetem
#| echo: false
tinytable::tt(table_ukazka_kvetu) |>
  tinytable::style_tt(
    i = nrow(table_ukazka_kvetu),
    bold = TRUE,
    color = barvy[["interpretace"]]
  )
```
:::
:::
:::

::: {.column width="48%"}
::: {.panel-data .fragment fragment-index=1}
[Letošní měření]{.panel-title}

`r format_cz(nrow(data_kosatce))` květů · `r format_cz(sum(is.na(data_kosatce)))` chybějících hodnot

Šířky `r format_cz(min(data_kosatce$sirka_listku))`–`r format_cz(max(data_kosatce$sirka_listku))` cm · délky `r format_cz(min(data_kosatce$delka_listku))`–`r format_cz(max(data_kosatce$delka_listku))` cm
:::

::: {.panel-question .fragment fragment-index=2}
[Příští sezóna]{.panel-title}

U nových květů stihneme změřit jen [šířku]{.text-hgl-graphite}. Jakou [délku]{.text-hgl-orange} můžeme čekat?
:::
:::

::::

::: {.notes}
Postup klikání: nejprve čtyři letos změřené květy (jeden řádek = jeden květ), pak souhrn celých dat, nakonec přibude nový květ s otazníkem a otázka. Scénář: botanička letos změřila u každého květu šířku i délku korunního lístku. Příští sezónu bude mít čas jen na rychlé měření šířky. Jakou délku může u nového květu čekat? Navážu na L02: minule jsme vztah dvou měření popsali, dnes ho chceme použít. Odpověď zatím neprozrazuji. První čtyři řádky jsou skutečné květy z různých částí rozsahu šířek; se stejnými čtyřmi květy budeme později ručně počítat odhady a residua.
:::

## Jaký vztah vidíte?

```{r}
#| label: vytvorit-bodovy-graf-kosatcu
#| include: false
#| message: false
#| warning: false
plot_data_kosatce <-
  ggplot2::ggplot(
    data = data_kosatce,
    mapping = ggplot2::aes(
      x = sirka_listku,
      y = delka_listku
    )
  ) +
  ggplot2::geom_point(
    color = barvy["data"],
    alpha = 0.72,
    size = 2.7
  ) +
  ggplot2::scale_x_continuous(
    limits = c(0, 2.7),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 7.2),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::labs(
    x = "Šířka korunního lístku (cm)",
    y = "Délka korunního lístku (cm)"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_data_kosatce,
  filename = "data_kosatce.png",
  width = 1300,
  height = 900
)
```

:::: {.columns .align-center}

::: {.column width="60%"}
```{r}
#| label: zobrazit-data-pro-otazku-o-vztahu
#| echo: false
#| fig-alt: "Šířka a délka každého květu kosatce v cm, rostoucí vztah s rozptýlením."
#| out-width: 100%
include_local_figure("data_kosatce.png")
```
:::

::: {.column width="40%"}
::: {.panel-question}
[Vyberte nejlepší popis]{.panel-title}

**A)** bez zřetelného vztahu

[**B)** přibližně lineární růst]{.rn-circle-orange}

**C)** výrazně zakřivený růst
:::
:::

::::

<br>

::: {.takeaway-strip}
Zvolte A/B/C a zdůvodněte odpověď podle bodů v grafu.
:::

::: {.notes}
Studenti nejprve pojmenují viditelný tvar. Správně je B: vztah je rostoucí a přibližně lineární, ale kolem něj zůstává variabilita.
:::

## Jakou délku čekáte u květu širokého `r format_cz(sirka_novy_kvet)` cm?

```{r}
#| label: vytvorit-otazku-noveho-kvetu
#| include: false
#| message: false
#| warning: false
# Extra headroom above the data keeps the question label off the points.
plot_novy_kvet_otazka <-
  plot_data_kosatce +
  ggplot2::scale_y_continuous(
    limits = c(0, 8),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::geom_vline(
    xintercept = sirka_novy_kvet,
    color = barvy["interpretace"],
    linetype = "dashed",
    linewidth = 1.1
  ) +
  ggplot2::annotate(
    geom = "label",
    x = sirka_novy_kvet,
    y = 7.6,
    label = "nový květ: délka?",
    color = barvy["interpretace"],
    fill = "white",
    label.size = 0,
    size = 6
  )

save_local_figure(
  plot = plot_novy_kvet_otazka,
  filename = "novy_kvet_otazka.png",
  width = 1600,
  height = 760
)
```

```{r}
#| label: zobrazit-otazku-noveho-kvetu
#| echo: false
#| fig-alt: !expr paste0("Bodový graf šířky a délky korunních lístků se svislou oranžovou čárkovanou čarou u šířky ", format_cz(sirka_novy_kvet), " cm, kde leží nový květ s neznámou délkou.")
#| out-width: 88%
include_local_figure("novy_kvet_otazka.png")
```

::: {.takeaway-strip .text-center}
Odhadněte délku nového květu v cm a porovnejte ji se sousedem.
:::

::: {.notes}
Nechám 30 sekund na vlastní odhad a krátké porovnání se sousedem. Zatím nic neodhaluji; odpověď ukáže další snímek.
:::

## Jakou délku čekáte u květu širokého `r format_cz(sirka_novy_kvet)` cm?

```{r}
#| label: vytvorit-pasmo-noveho-kvetu
#| include: false
#| message: false
#| warning: false
# Widths are recorded to 0.1 cm; rounding avoids floating-point edge misses.
sirka_pasmo <- 0.1

data_pasmo_novy_kvet <-
  data_kosatce[
    round(abs(data_kosatce$sirka_listku - sirka_novy_kvet), 2) <= sirka_pasmo,
  ]

delka_pasmo_prumer <-
  mean(data_pasmo_novy_kvet$delka_listku)

# A width inside the gap of the data: no flower is similarly wide.
sirka_bez_kvetu <- 0.8
pocet_kvetu_bez_kvetu <-
  sum(
    round(abs(data_kosatce$sirka_listku - sirka_bez_kvetu), 2) <= sirka_pasmo
  )
stopifnot(pocet_kvetu_bez_kvetu == 0)

popisek_pasma <-
  paste0(
    "Jen květy ",
    format_cz(sirka_novy_kvet - sirka_pasmo),
    "–",
    format_cz(sirka_novy_kvet + sirka_pasmo),
    " cm"
  )
vec_panely_pasma <- c("Všechny květy", popisek_pasma)

# The slice repeats the band flowers with a small horizontal jitter so that
#   equal lengths stay visible; both panels share one length axis.
set.seed(900723)
data_rez_pasma <-
  rbind(
    data.frame(
      panel = vec_panely_pasma[1],
      sirka = data_kosatce$sirka_listku,
      delka = data_kosatce$delka_listku,
      v_pasmu = round(
        abs(data_kosatce$sirka_listku - sirka_novy_kvet), 2
      ) <= sirka_pasmo
    ),
    data.frame(
      panel = vec_panely_pasma[2],
      sirka = data_pasmo_novy_kvet$sirka_listku +
        stats::runif(nrow(data_pasmo_novy_kvet), -0.02, 0.02),
      delka = data_pasmo_novy_kvet$delka_listku,
      v_pasmu = TRUE
    )
  )
data_rez_pasma$panel <- factor(data_rez_pasma$panel, levels = vec_panely_pasma)

plot_novy_kvet_pasmo <-
  ggplot2::ggplot(
    data = data_rez_pasma,
    mapping = ggplot2::aes(x = sirka, y = delka)
  ) +
  ggplot2::geom_rect(
    data = data.frame(
      panel = factor(vec_panely_pasma[1], levels = vec_panely_pasma),
      xmin = sirka_novy_kvet - sirka_pasmo - 0.04,
      xmax = sirka_novy_kvet + sirka_pasmo + 0.04
    ),
    mapping = ggplot2::aes(xmin = xmin, xmax = xmax),
    ymin = -Inf,
    ymax = Inf,
    inherit.aes = FALSE,
    fill = barvy["interpretace"],
    alpha = 0.12
  ) +
  ggplot2::geom_blank(
    data = data.frame(
      panel = factor(vec_panely_pasma[1], levels = vec_panely_pasma),
      sirka = c(0, 2.7),
      delka = 0
    )
  ) +
  ggplot2::geom_vline(
    data = data.frame(
      panel = factor(vec_panely_pasma[1], levels = vec_panely_pasma),
      sirka = sirka_bez_kvetu
    ),
    mapping = ggplot2::aes(xintercept = sirka),
    color = biostat_cols[["graphite"]],
    linetype = "dotted",
    linewidth = 1
  ) +
  ggplot2::geom_point(
    mapping = ggplot2::aes(color = v_pasmu),
    alpha = 0.8,
    size = 2.7
  ) +
  ggplot2::geom_segment(
    data = data.frame(
      panel = factor(vec_panely_pasma[2], levels = vec_panely_pasma),
      x = sirka_novy_kvet - sirka_pasmo - 0.05,
      xend = sirka_novy_kvet + sirka_pasmo + 0.05,
      y = delka_pasmo_prumer
    ),
    mapping = ggplot2::aes(x = x, xend = xend, y = y, yend = y),
    inherit.aes = FALSE,
    color = barvy["interpretace"],
    linewidth = 1.6
  ) +
  ggplot2::scale_color_manual(
    values = c(`FALSE` = barvy[["data"]], `TRUE` = barvy[["interpretace"]]),
    guide = "none"
  ) +
  ggplot2::scale_x_continuous(
    breaks = function(lim) {
      if (diff(lim) < 1) {
        seq(sirka_novy_kvet - sirka_pasmo, sirka_novy_kvet + sirka_pasmo, by = 0.1)
      } else {
        0:2
      }
    },
    expand = ggplot2::expansion(mult = c(0.02, 0.04))
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 7.2),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::facet_wrap(
    facets = ggplot2::vars(panel),
    scales = "free_x"
  ) +
  ggplot2::labs(
    x = "Šířka korunního lístku (cm)",
    y = "Délka korunního lístku (cm)"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_novy_kvet_pasmo,
  filename = "novy_kvet_pasmo.png",
  width = 1600,
  height = 700
)
```

```{r}
#| label: zobrazit-pasmo-noveho-kvetu
#| echo: false
#| fig-alt: !expr paste0("Dva panely se stejnou osou délky. Vlevo všechna měření, oranžově zvýrazněných ", nrow(data_pasmo_novy_kvet), " květů se šířkou ", format_cz(sirka_novy_kvet - sirka_pasmo), "–", format_cz(sirka_novy_kvet + sirka_pasmo), " cm; tečkovaná čára u šířky ", format_cz(sirka_bez_kvetu), " cm prochází mezerou bez květů. Vpravo jen tyto květy, mírně rozestoupené vodorovně, jejich délky sahají od ", format_cz(min(data_pasmo_novy_kvet$delka_listku)), " do ", format_cz(max(data_pasmo_novy_kvet$delka_listku)), " cm, oranžová úsečka ukazuje průměr ", format_cz(delka_pasmo_prumer), " cm.")
#| out-width: 88%
include_local_figure("novy_kvet_pasmo.png")
```

::: {.takeaway-strip}
Čekáme délku kolem [`r format_cz(delka_pasmo_prumer, digits = 1)` cm]{.text-hgl-orange}; jednotlivé podobně široké květy měří `r format_cz(min(data_pasmo_novy_kvet$delka_listku))`–`r format_cz(max(data_pasmo_novy_kvet$delka_listku))` cm.
:::

::: {.fragment .text-center}
A u květu širokého `r format_cz(sirka_bez_kvetu)` cm (tečkovaná čára)? Podobně široké květy v datech nejsou, potřebujeme [pravidlo pro každou šířku]{.text-hgl-indigo_velvet}.
:::

::: {.notes}
Vlevo stejný graf, oranžově `r nrow(data_pasmo_novy_kvet)` květů se šířkou `r format_cz(sirka_novy_kvet - sirka_pasmo)`–`r format_cz(sirka_novy_kvet + sirka_pasmo)` cm. Vpravo jen tyto květy na stejné ose délky (vodorovně jsou mírně rozestoupené, aby se stejné délky nepřekrývaly): stejně široké květy se liší délkou, proto můžeme čekat jen typickou (průměrnou) délku, ne přesnou hodnotu. Tuto hodnotu si zapamatujeme a na konci ji porovnáme s odhadem modelu. Pak ukážu na prázdné místo vlevo mezi šířkou `r format_cz(max(data_kosatce$sirka_listku[data_kosatce$sirka_listku < sirka_bez_kvetu]))` a `r format_cz(min(data_kosatce$sirka_listku[data_kosatce$sirka_listku > sirka_bez_kvetu]))` cm: pro takový květ nemáme podobné sousedy, a průměrování tedy nestačí. Potřebujeme pravidlo, které dá odhad pro každou šířku — k tomu vedou další snímky.
:::

## Co změříme a co čekáme?

::: {.slide-margin-top-15}
::: {.card-question}
::: {.card-title}
Otázka
:::

V terénu jedno měření korunního lístku změříme a druhé podle něj chceme odhadnout. Které měření budeme odhadovat?
:::

<br>

:::: {.columns}

::: {.column width="50%"}
::: {.card-question}
**A)** šířka korunního lístku
:::
:::

::: {.column width="50%"}
::: {.card-question}
[**B)** délka korunního lístku]{.rn-circle-orange}
:::
:::

::::

<br>

::: {.text-center}
Zvolte A/B a zdůvodněte svou volbu sousedovi.
:::

::: {.fragment .takeaway-strip .text-center}
[prediktor]{.text-hgl-graphite}: šířka — změříme  →  [odezva]{.text-hgl-graphite}: délka — odhadujeme

Opačná otázka, odhad šířky ze známé délky, by byla jiný model.
:::
:::

::: {.notes}
Nechám 20 sekund na volbu a krátké zdůvodnění sousedovi. Odhadujeme délku; teprve po odpovědi pojmenuji odezvu a prediktor. Prediktor je to, co známe nebo změříme; odezva je to, co z něj chceme odhadnout. Na rozdíl od korelace role nejsou zaměnitelné: odhad šířky ze známé délky by byla jiná otázka.
:::

## Jedna přímka shrnuje mnoho květů

```{r}
#| label: zobrazit-kosatce-a-modelove-pravitko
#| echo: false
#| out-width: "78%"
#| fig-alt: "Terénní botanička přikládá rovné pravítko k několika kosatcům s různými rozměry; pravítko představuje jednu přímku shrnující proměnlivá pozorování."
#| fig-cap: "Ilustrační obraz vytvořen AI."
include_local_figure("iris_model_ruler.png")
```

::: {.takeaway-strip .text-center .fragment}
Přímka, která každé šířce ([prediktor]{.text-hgl-graphite}) přiřadí odhadnutou délku ([odezva]{.text-hgl-graphite}), je nejjednodušší [lineární model]{.text-hgl-indigo_velvet}.
:::

::: {.notes}
Pravítko položené přes mnoho květů: jedna přímka nenahrazuje data, jen stručně popisuje jejich systematický vztah. Tady poprvé pojmenuji lineární model. Je to pravidlo, které z hodnoty prediktoru vrátí odhadnutou odezvu, například délku nového květu ze změřené šířky.
:::

## Co přidá [lineární model]{.text-hgl-indigo_velvet}?

<br>

:::: {.columns .align-stretch}

::: {.column width="48%"}
::: {.panel-result}
[Graf a korelace (minulá lekce)]{.panel-title}

- [vztah zobrazit]{.text-hgl-graphite}
- popsat jeho směr
- shrnout jeho těsnost
:::
:::

::: {.column width="52%"}
::: {.panel-indigo .fragment}
[Lineární model]{.panel-title}

- [o kolik]{.text-hgl-orange} se v průměru liší délka dvou květů, jejichž šířky se liší o 1 cm
- [jakou délku čekat]{.text-hgl-orange} u květu dané šířky, třeba u nového květu
:::
:::

::::

<br>

::: {.takeaway-strip .fragment}
Obě odpovědi dostaneme v [centimetrech]{.text-hgl-indigo_velvet}. Jak [přesné]{.text-hgl-orange} jsou, zůstává otevřené do příští lekce.
:::

::: {.notes}
Korelace z L02 nám řekla, že vztah existuje a jak je těsný. Lineární model odpoví na dvě nové otázky v původních jednotkách: velikost efektu a odhad pro novou šířku. K novému květu se vrátíme, až budeme mít přímku odhadnutou ze všech dat.
:::

# Co rozhoduje mezi přímkami?

## Která z mnoha přímek vystihuje měření?

```{r}
#| label: vytvorit-animaci-mnoha-primek
#| include: false
#| message: false
#| warning: false
data_animace_primek <-
  data.frame(
    a = c(0.2, 0.5, 0.8, 1.1, 1.4, 1.7, 1.4, 1.1, 0.8, 0.5),
    b = c(2.5, 2.3, 2.1, 1.9, 1.7, 1.5, 1.8, 2.1, 2.4, 2.5)
  )

vec_soubory_animace_primek <-
  purrr::map_chr(
    .x = seq_len(nrow(data_animace_primek)),
    .f = function(i) {
      soubor_snimku <-
        tempfile(fileext = ".png")

      graf_snimku <-
        plot_data_kosatce +
        ggplot2::geom_abline(
          intercept = data_animace_primek$a[i],
          slope = data_animace_primek$b[i],
          color = barvy["model"],
          linewidth = 1.4
        )

      save_local_figure(
        plot = graf_snimku,
        path = soubor_snimku,
        width = 1300,
        height = 900
      )

      soubor_snimku
    }
  )

save_local_gif(
  frame_files = vec_soubory_animace_primek,
  filename = "mnoho_primek.gif",
  fps = 1
)

unlink(vec_soubory_animace_primek)
```

```{r}
#| label: zobrazit-animaci-mnoha-primek
#| echo: false
#| fig-alt: "Přes stejná měření se střídají přímky s různým interceptem a sklonem."
#| out-width: 82%
include_local_figure("mnoho_primek.gif")
```

::: {.panel-olive}
[Diskuze se sousedem — 30 s]{.panel-title}

Sledujte jeden cyklus. Podle čeho byste mezi přímkami rozhodli?
:::

::: {.notes}
Animace ukazuje vždy právě jednu přímku, aby se graf nezměnil v barevnou spleť. Po jednom cyklu ji zastavím otázkou: podle čeho byste poznali, že je jedna z nich lepší než ostatní?
:::

## Kterou ze tří přímek byste vybrali?

```{r}
#| label: kandidatni-scenare
#| include: false
# Every candidate is a model line, so all use the model colour; line type
#   and a direct label distinguish the alternatives.
kandidati <-
  data.frame(
    model = c("A", "B", "C"),
    a = c(0.5, 1.1, 1.7),
    b = c(1.8, 2.2, 2.6)
  )
vec_typy_car <- c(A = "dotted", B = "solid", C = "dashed")
```

```{r}
#| label: vytvorit-kandidatni-primky
#| include: false
#| message: false
#| warning: false
data_popisky_kandidatu <-
  data.frame(
    model = kandidati$model,
    x = 2.62,
    y = kandidati$a + kandidati$b * 2.62
  )

plot_kandidatni_primky <-
  plot_data_kosatce +
  ggplot2::geom_abline(
    data = kandidati,
    mapping = ggplot2::aes(
      intercept = a,
      slope = b,
      linetype = model
    ),
    color = barvy["model"],
    linewidth = 1.25
  ) +
  ggplot2::geom_label(
    data = data_popisky_kandidatu,
    mapping = ggplot2::aes(x = x, y = y, label = model),
    color = barvy["model"],
    fill = "white",
    fontface = "bold",
    size = 6
  ) +
  ggplot2::scale_linetype_manual(values = vec_typy_car) +
  ggplot2::scale_y_continuous(
    limits = c(0, 9),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::theme(legend.position = "none")

save_local_figure(
  plot = plot_kandidatni_primky,
  filename = "kandidatni_primky.png",
  width = 1300,
  height = 900
)
```

:::: {.columns .align-center}

::: {.column width="62%"}
```{r}
#| label: zobrazit-kandidatni-primky-pro-hlasovani
#| echo: false
#| fig-alt: "Stejná měření se třemi kandidátními přímkami A, B a C, odlišenými typem čáry a popiskem."
#| out-width: 100%
include_local_figure("kandidatni_primky.png")
```
:::

::: {.column width="38%"}
::: {.panel-question}
[Hlasování]{.panel-title}

Zvolte A, B, nebo C a napište, podle čeho posuzujete nejlepší přímku.
:::
:::

::::

::: {.notes}
Nechám hlasovat, ale zatím nepotvrdím odpověď. Přijmu intuitivní argument „body jsou jí celkově nejblíže“ a proměním ho v potřebu residuí.
:::

## Co se změní, když přímku posuneme?

```{r}
#| label: vytvorit-intercepty
#| include: false
#| message: false
#| warning: false
data_intercepty <-
  data.frame(
    a = kandidati$a,
    b = kandidati$b[kandidati$model == "B"],
    popisek = paste0("a = ", format_cz(kandidati$a))
  )

plot_intercepty <-
  plot_data_kosatce +
  ggplot2::geom_segment(
    data = data_intercepty,
    mapping = ggplot2::aes(
      x = 0,
      xend = 2.7,
      y = a,
      yend = a + b * 2.7,
      linetype = popisek
    ),
    color = barvy["model"],
    linewidth = 1.2
  ) +
  ggplot2::geom_vline(
    xintercept = 0,
    color = biostat_cols[["graphite"]],
    linewidth = 0.4
  ) +
  ggplot2::geom_label(
    data = data_intercepty,
    mapping = ggplot2::aes(x = -0.05, y = a, label = popisek),
    hjust = 1,
    color = barvy["model"],
    fill = "white",
    size = 5
  ) +
  ggplot2::geom_point(
    data = data_intercepty,
    mapping = ggplot2::aes(x = 0, y = a),
    color = barvy["model"],
    size = 3.5
  ) +
  ggplot2::scale_linetype_manual(
    values = setNames(c("dotted", "solid", "dashed"), data_intercepty$popisek)
  ) +
  ggplot2::scale_x_continuous(
    breaks = 0:2,
    limits = c(-0.45, 2.7),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 8),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::theme(legend.position = "none")

save_local_figure(
  plot = plot_intercepty,
  filename = "intercepty.png"
)
```

```{r}
#| label: zobrazit-intercepty
#| echo: false
#| fig-alt: "Tři rovnoběžné přímky se liší pouze interceptem."
include_local_figure("intercepty.png")
```

::: {.strip-indigo .fragment}
Intercept (a) posouvá přímku nahoru nebo dolů.
:::

## Co se změní, když přímku nakloníme?

```{r}
#| label: vytvorit-sklony
#| include: false
#| message: false
#| warning: false
data_sklony <-
  data.frame(
    a = kandidati$a[kandidati$model == "B"],
    b = kandidati$b,
    popisek = paste0("sklon = ", format_cz(kandidati$b))
  )

plot_sklony <-
  plot_data_kosatce +
  ggplot2::geom_abline(
    data = data_sklony,
    mapping = ggplot2::aes(
      intercept = a,
      slope = b,
      linetype = popisek
    ),
    color = barvy["model"],
    linewidth = 1.2
  ) +
  ggplot2::geom_label(
    data = data_sklony,
    mapping = ggplot2::aes(x = 2.62, y = a + b * 2.62, label = popisek),
    hjust = 1,
    color = barvy["model"],
    fill = "white",
    size = 5
  ) +
  ggplot2::scale_linetype_manual(
    values = setNames(c("dotted", "solid", "dashed"), data_sklony$popisek)
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 8),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::theme(legend.position = "none")

save_local_figure(
  plot = plot_sklony,
  filename = "sklony.png"
)
```

```{r}
#| label: zobrazit-sklony
#| echo: false
#| fig-alt: "Tři přímky se společným interceptem se liší pouze sklonem."
include_local_figure("sklony.png")
```

::: {.strip-indigo .fragment}
Sklon (b) říká, jak rychle se mění odhadnutá délka s rostoucí šířkou.
:::

## [Dvě čísla]{.text-hgl-indigo_velvet} popíší každou přímku

<br>

::: {.slide-margin-top-15 .text-center .text-size-heading}
$$
\text{odhadnutá délka}
=
\text{intercept }(a)
+
\text{sklon }(b) \cdot \text{šířka}
$$
:::

<br>

:::: {.columns .fragment}

::: {.column width="50%"}
::: {.panel-indigo}
**intercept ($a$)**

Výška přímky při šířce 0 cm.
:::
:::

::: {.column width="50%"}
::: {.panel-indigo}
**sklon ($b$)**

Rozdíl odhadnutých délek dvou šířek, které se liší o 1 cm.
:::
:::

::::

<br>

::: {.takeaway-strip .text-center .fragment}
Intercept a sklon jsou dvě čísla, která popíší [lineární model]{.text-hgl-indigo_velvet}.
:::

::: {.notes}
Název parametrů přichází až po dvojici vizuálních manipulací. Vzorec zde pouze pojmenuje to, co už studenti viděli. Připomenu, že lineární model z úvodu je právě taková přímka: stačí znát intercept a sklon.
:::

# Jak daleko je měření od přímky?

## Jeden květ a přímka B

```{r}
#| label: vytvorit-plot-odhad-s-merenim
#| include: false
# Candidate B is illustrative, not the model fitted from all observations.
a0 <- kandidati$a[kandidati$model == "B"]
b0 <- kandidati$b[kandidati$model == "B"]
data_jeden_odhad <-
  data_ctyri_kvety[4, c("sirka_listku", "delka_listku")]

plot_odhad_s_merenim <-
  ggplot2::ggplot(
    data = data_jeden_odhad,
    mapping = ggplot2::aes(
      x = sirka_listku,
      y = delka_listku
    )
  ) +
  ggplot2::geom_abline(
    intercept = a0,
    slope = b0,
    color = barvy["model"],
    linewidth = 1.3
  ) +
  ggplot2::geom_point(
    color = barvy["data"],
    size = 5
  ) +
  ggplot2::scale_x_continuous(
    breaks = seq(0, 2.5, by = 0.5),
    limits = c(0, 2.7),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 7.2),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::labs(
    x = "Šířka korunního lístku (cm)",
    y = "Délka korunního lístku (cm)"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_odhad_s_merenim,
  filename = "odhad_krok_2_mereni.png"
)
```

```{r}
#| label: zobrazit-mereni-jednoho-kvetu
#| echo: false
#| fig-alt: "Přímka B a šedý bod naměřeného květu se šířkou 2,5 cm."
#| out-width: 84%
include_local_figure("odhad_krok_2_mereni.png")
```

::: {.takeaway-strip}
Přímka B · [šedý bod]{.text-hgl-graphite} = květ 4 z tabulky: šířka **`r format_cz(data_jeden_odhad$sirka_listku)` cm**, naměřená délka **`r format_cz(data_jeden_odhad$delka_listku)` cm**
:::

::: {.notes}
Přímka vrací pro každou šířku na ose x jednu odhadnutou délku na ose y. Šedý bod je skutečné měření čtvrtého květu z tabulky. Než přejdu dál, zeptám se, kde na přímce leží odhad pro stejnou šířku.
:::

## Odhad přímky pro stejnou šířku

```{r}
#| label: vytvorit-plot-odhad-s-odhadem
#| include: false
data_jeden_odhad$odhadnuta_delka <-
  a0 + b0 * data_jeden_odhad$sirka_listku

plot_odhad_s_odhadem <-
  plot_odhad_s_merenim +
  ggplot2::geom_point(
    data = data_jeden_odhad,
    mapping = ggplot2::aes(y = odhadnuta_delka),
    color = barvy["model"],
    size = 5,
    shape = 18
  )

save_local_figure(
  plot = plot_odhad_s_odhadem,
  filename = "odhad_krok_3_odhad.png"
)
```

```{r}
#| label: zobrazit-odhad-pro-jeden-kvet
#| echo: false
#| fig-alt: "Fialový bod na přímce ukazuje odhad délky při stejné šířce jako šedý bod."
#| out-width: 84%
include_local_figure("odhad_krok_3_odhad.png")
```

::: {.takeaway-strip}
[Fialový bod]{.text-hgl-indigo_velvet}: odhadnutá délka na přímce při stejné šířce.
:::

## Mezi [měřením]{.text-hgl-graphite} a [odhadem]{.text-hgl-indigo_velvet} zůstává rozdíl

```{r}
#| label: vytvorit-plot-reziduum-jednoho-kvetu
#| include: false
plot_reziduum_jednoho_kvetu <-
  plot_odhad_s_odhadem +
  ggplot2::geom_segment(
    data = data_jeden_odhad,
    mapping = ggplot2::aes(
      xend = sirka_listku,
      yend = odhadnuta_delka
    ),
    color = barvy["interpretace"],
    linewidth = 2,
    lineend = "round"
  )

save_local_figure(
  plot = plot_reziduum_jednoho_kvetu,
  filename = "odhad_krok_4_residuum.png"
)
```

```{r}
#| label: zobrazit-rozdil-pro-jeden-kvet
#| echo: false
#| fig-alt: "Oranžová svislá úsečka spojuje šedé měření a fialový odhad; měření je pod odhadem."
#| out-width: 84%
include_local_figure("odhad_krok_4_residuum.png")
```

::: {.fragment .strip-orange}
Oranžová úsečka ukazuje [residuum]{.text-hgl-orange}: rozdíl mezi naměřenou a odhadnutou délkou.
:::

## Jaké znaménko má residuum?

```{r}
#| label: vytvorit-plot-reziduum-zblizka
#| include: false
# A zoomed copy keeps the single flower legible in a half-width column.
plot_reziduum_zblizka <-
  plot_reziduum_jednoho_kvetu +
  ggplot2::coord_cartesian(
    xlim = c(1.6, 2.7),
    ylim = c(4.4, 7.2)
  )

save_local_figure(
  plot = plot_reziduum_zblizka,
  filename = "reziduum_zblizka.png",
  width = 1000,
  height = 900
)
```

:::: {.columns .align-center}

::: {.column width="50%"}
```{r}
#| label: zobrazit-residuum-pro-znamenko
#| echo: false
#| out-width: 100%
#| fig-alt: "Zvětšený výřez: šedý bod naměřené délky leží pod fialovou přímkou, oranžová úsečka mezi nimi."
include_local_figure("reziduum_zblizka.png")
```
:::

::: {.column width="50%"}
$$
\begin{aligned}
\text{residuum} &= \text{naměřená délka} \\
&\quad - \text{odhadnutá délka}
\end{aligned}
$$

::: {.card-question .card-compact}
**A)** kladné
:::

::: {.card-question .card-compact}
[**B)** záporné]{.rn-circle-orange}
:::

::: {.card-question .card-compact}
**C)** nulové
:::
:::

::::

::: {.takeaway-strip}
Zvolte znaménko a zdůvodněte je polohou bodu vůči přímce.
:::

::: {.notes}
Nechám studenty rozhodnout před odhalením anotace B. Úsečka sama má kladnou délku; znaménko residua plyne z pořadí odčítání a polohy šedého bodu pod přímkou.
:::

## Odhadnutá délka vybraného květu

```{r}
#| label: vytvorit-plot-odhad-s-popiskem
#| include: false
plot_odhad_s_popiskem <-
  plot_odhad_s_odhadem +
  ggplot2::annotate(
    geom = "label",
    x = 2.54,
    y = data_jeden_odhad$odhadnuta_delka - 0.12,
    hjust = 0,
    label = paste0(
      "odhadnutá délka = ",
      format_cz(data_jeden_odhad$odhadnuta_delka),
      " cm"
    ),
    color = barvy["model"],
    fill = "white",
    label.size = 0,
    size = 6
  ) +
  ggplot2::scale_x_continuous(
    breaks = c(2, 2.5),
    limits = c(0, 4.1),
    expand = ggplot2::expansion(mult = c(0, 0))
  ) +
  ggplot2::coord_cartesian(
    xlim = c(1.6, 4.1),
    ylim = c(4.4, 7.2)
  )

save_local_figure(
  plot = plot_odhad_s_popiskem,
  filename = "odhad_s_popiskem.png",
  width = 1000,
  height = 900
)
```

::: {.takeaway-strip}
Přímka B: **intercept (a) = `r format_cz(a0)` cm** · **sklon (b) = `r format_cz(b0)` cm/cm**
:::

:::: {.columns .align-center}

::: {.column width="48%"}
$$
\begin{aligned}
\text{odhadnutá délka}
&=
\text{intercept} \\
&\quad +
\text{sklon} \cdot \text{šířka} \\
&=
`r format_cz_math(a0)`
+
`r format_cz_math(b0)` \cdot `r format_cz_math(data_jeden_odhad$sirka_listku)` \\
&= `r format_cz_math(a0)` + `r format_cz_math(b0 * data_jeden_odhad$sirka_listku)` \\
&=
`r format_cz_math(data_jeden_odhad$odhadnuta_delka)`\ \text{cm}
\end{aligned}
$$

::: {.fragment}
$$
\hat{y}_i = a + b \cdot x_i
$$

::: {.text-size-smaller .text-center}
$x_i$ = naměřená šířka · $\hat{y}_i$ = odhadnutá délka · $i$ = pořadí květu
:::
:::
:::

::: {.column width="52%"}
```{r}
#| label: zobrazit-popisek-odhadnute-delky
#| echo: false
#| fig-alt: "Zvětšený výřez: odhad délky vybraného květu je popsán na přímce B."
#| out-width: 100%
include_local_figure("odhad_s_popiskem.png")
```
:::

::::

## Residuum vybraného květu

```{r}
#| label: vytvorit-plot-reziduum-s-popisky
#| include: false
data_jeden_odhad$residuum <-
  data_jeden_odhad$delka_listku - data_jeden_odhad$odhadnuta_delka

plot_reziduum_s_popisky <-
  plot_reziduum_jednoho_kvetu +
  ggplot2::annotate(
    geom = "label",
    x = 2.54,
    y = data_jeden_odhad$delka_listku,
    hjust = 0,
    label = paste0(
      "naměřená délka = ",
      format_cz(data_jeden_odhad$delka_listku),
      " cm"
    ),
    color = barvy["data"],
    fill = "white",
    label.size = 0,
    size = 6
  ) +
  ggplot2::annotate(
    geom = "label",
    x = 2.54,
    y = data_jeden_odhad$odhadnuta_delka - 0.12,
    hjust = 0,
    label = paste0(
      "odhadnutá délka = ",
      format_cz(data_jeden_odhad$odhadnuta_delka),
      " cm"
    ),
    color = barvy["model"],
    fill = "white",
    label.size = 0,
    size = 6
  ) +
  ggplot2::scale_x_continuous(
    breaks = c(2, 2.5),
    limits = c(0, 4.1),
    expand = ggplot2::expansion(mult = c(0, 0))
  ) +
  ggplot2::coord_cartesian(
    xlim = c(1.6, 4.1),
    ylim = c(4.4, 7.2)
  )

save_local_figure(
  plot = plot_reziduum_s_popisky,
  filename = "reziduum_s_popisky.png",
  width = 1000,
  height = 900
)
```

:::: {.columns .align-center}

::: {.column width="48%"}
$$
\begin{aligned}
\text{residuum}
&=
\text{naměřená délka} \\
&\quad -
\text{odhadnutá délka} \\
&=
`r format_cz_math(data_jeden_odhad$delka_listku)`
-
`r format_cz_math(data_jeden_odhad$odhadnuta_delka)` \\
&=
`r format_cz_math(data_jeden_odhad$residuum)`\ \text{cm}
\end{aligned}
$$

::: {.fragment}
$$
e_i = y_i - \hat{y}_i
$$

::: {.text-size-smaller .text-center}
$y_i$ = naměřená délka (cm)

$\hat{y}_i$ = odhadnutá délka (cm)

$e_i$ = residuum (cm)
:::
:::
:::

::: {.column width="52%"}
```{r}
#| label: zobrazit-popisky-pro-vypocet-rezidua
#| echo: false
#| fig-alt: "Zvětšený výřez: naměřená i odhadnutá délka a jejich svislý rozdíl jsou popsány ve stejném grafu."
#| out-width: 100%
include_local_figure("reziduum_s_popisky.png")
```
:::

::::

## Residua očekáváme i u užitečného modelu

::: {.slide-margin-top-15}
::: {.card-insight}
::: {.card-title}
Důležitá myšlenka
:::

::: {.panel-lead}
[Biologická variabilita]{.text-hgl-orange} nezmizí jen proto, že jsme nakreslili [modelovou přímku]{.text-hgl-indigo_velvet}
:::
:::

<br>

::: {.text-center}
Model nemusí trefit každý květ přesně. Potřebujeme ale zjistit, zda odchylky působí náhodně, nebo zda v nich zůstává vzor.
:::
:::

## Čtyři květy, stejná přímka

```{r}
#| label: ctyri-kvety-a-primka-b
#| include: false
data_ctyri_kvety$odhadnuta_delka <-
  a0 + b0 * data_ctyri_kvety$sirka_listku
data_ctyri_kvety$residuum <-
  data_ctyri_kvety$delka_listku - data_ctyri_kvety$odhadnuta_delka

table_ctyri_kvety <-
  data.frame(
    kvet = seq_len(nrow(data_ctyri_kvety)),
    sirka = format_cz(data_ctyri_kvety$sirka_listku),
    delka = format_cz(data_ctyri_kvety$delka_listku),
    odhad = format_cz(data_ctyri_kvety$odhadnuta_delka),
    residuum = format_cz(data_ctyri_kvety$residuum)
  )
names(table_ctyri_kvety) <-
  c("Květ", "Šířka (cm)", "Délka (cm)", "Odhad (cm)", "Residuum (cm)")

plot_ctyri_kvety <-
  ggplot2::ggplot(
    data = data_ctyri_kvety,
    mapping = ggplot2::aes(
      x = sirka_listku,
      y = delka_listku
    )
  ) +
  ggplot2::geom_abline(
    intercept = a0,
    slope = b0,
    color = barvy["model"],
    linewidth = 1.3
  ) +
  ggplot2::geom_segment(
    mapping = ggplot2::aes(
      xend = sirka_listku,
      yend = odhadnuta_delka
    ),
    color = barvy["interpretace"],
    linewidth = 1.8
  ) +
  ggplot2::geom_point(
    color = barvy["data"],
    size = 4.5
  ) +
  ggplot2::geom_text(
    mapping = ggplot2::aes(label = seq_len(nrow(data_ctyri_kvety))),
    nudge_x = -0.15,
    size = 9,
    fontface = "bold",
    color = biostat_cols[["graphite"]]
  ) +
  ggplot2::scale_x_continuous(
    limits = c(0, 2.7),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::scale_y_continuous(
    limits = c(0, 7.2),
    expand = ggplot2::expansion(mult = c(0, 0.03))
  ) +
  ggplot2::labs(
    x = "Šířka korunního lístku (cm)",
    y = "Délka korunního lístku (cm)"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_ctyri_kvety,
  filename = "ctyri_kvety.png",
  width = 1100,
  height = 950
)
```

:::: {.columns .align-center}

::: {.column width="58%"}
```{r}
#| label: zobrazit-ctyri-mereni
#| echo: false
tinytable::tt(table_ctyri_kvety)
```

::: {.fragment .takeaway-strip}
Součet residuí: **`r format_cz(sum(data_ctyri_kvety$residuum))` cm**. Kladná a záporná residua se vyruší, přestože přímka žádným bodem neprochází.
:::
:::

::: {.column width="42%"}
```{r}
#| label: zobrazit-ctyri-kvety-s-rozdily
#| echo: false
#| fig-alt: "Čtyři očíslované květy, přímka B a oranžové svislé odchylky; dva body leží nad přímkou a dva pod ní."
#| out-width: 100%
include_local_figure("ctyri_kvety.png")
```
:::

::::

::: {.notes}
Stejné čtyři květy jako v úvodní tabulce. Nechám studenty najít body nad přímkou a pod ní. Teprve potom ukážu, že prostý součet residuí vyjde nula, takže nemůže posoudit, jak daleko body od přímky leží.
:::

## Jak porovnat celé přímky?

::: {.slide-margin-top-15}
:::: {.columns .align-stretch}

::: {.column width="32%"}
::: {.panel-data}
[1 · Změřit rozdíl]{.panel-title}

Pro každý květ určíme [residuum]{.text-hgl-orange}.
:::
:::

::: {.column width="34%"}
::: {.panel-orange .fragment}
[2 · Odstranit znaménko]{.panel-title}

Každé residuum [umocníme]{.text-hgl-orange}.
:::
:::

::: {.column width="32%"}
::: {.panel-result .fragment}
[3 · Shrnout přímku]{.panel-title}

Čtverce sečteme do [jednoho čísla: SSE]{.text-hgl-indigo_velvet}.
:::
:::

::::

<br>

::: {.fragment .takeaway-strip}
Menší SSE znamená, že body leží celkově blíže přímce.
:::
:::

## Jiná přímka, jiné vzdálenosti

```{r}
#| label: vytvorit-animaci-ctvercu-rezidui
#| include: false
data_uzly_animace_sse <-
  data.frame(
    snimek = c(1, 4, 7, 10, 13),
    a = c(0, 1.1, 3.5, 1.1, 0),
    b = c(3.4, 2.2, 0.8, 2.2, 3.4)
  )

data_animace_sse <-
  data.frame(
    a = approx(
      x = data_uzly_animace_sse$snimek,
      y = data_uzly_animace_sse$a,
      xout = seq_len(13)
    )$y,
    b = approx(
      x = data_uzly_animace_sse$snimek,
      y = data_uzly_animace_sse$b,
      xout = seq_len(13)
    )$y
  )

vec_soubory_animace_sse <-
  purrr::map_chr(
    .x = seq_len(nrow(data_animace_sse)),
    .f = ~ {
      path_frame <-
        tempfile(fileext = ".png")

      save_local_figure(
        plot = make_sse_frame(
          data_flowers = data_ctyri_kvety[, c("sirka_listku", "delka_listku")],
          intercept = data_animace_sse$a[.x],
          slope = data_animace_sse$b[.x],
          colours = barvy
        ),
        path = path_frame,
        width = 1700,
        height = 800
      )

      path_frame
    }
  )

save_local_gif(
  frame_files = vec_soubory_animace_sse,
  filename = "ctverce_rezidui.gif",
  fps = 2
)

unlink(vec_soubory_animace_sse)
```

```{r}
#| label: zobrazit-animaci-ctvercu-rezidui
#| echo: false
#| fig-alt: "Stejné čtyři květy, měnící se přímka a čtverce svislých odchylek; sloupce ukazují příspěvky do SSE."
#| out-width: 100%
include_local_figure("ctverce_rezidui.gif")
```

:::: {.columns .align-center}

::: {.column width="48%"}
::: {.panel-question .card-compact .text-size-smaller}
**Sledujte jeden cyklus:** Kdy je celková oranžová plocha nejmenší?
:::
:::

::: {.column width="52%"}
::: {.panel-result .card-compact .text-size-smaller .fragment}
**Stejné květy, jiné parametry přímky:** strana = $|e_i|$ · plocha = $e_i^2$ · součet = **SSE**
:::
:::

::::

::: {.notes}
Čtverce jsou vykreslené v pevném poměru os, takže jejich strana skutečně odpovídá absolutní velikosti residua a jejich plocha druhé mocnině residua. Nechám animaci proběhnout a požádám studenty, aby sledovali, kdy je celková oranžová plocha nejmenší.
:::

## Čtverce residuí čtyř květů

```{r}
#| label: vytvorit-staticke-ctverce
#| include: false
plot_staticke_sse <-
  make_sse_frame(
    data_flowers = data_ctyri_kvety[, c("sirka_listku", "delka_listku")],
    intercept = a0,
    slope = b0,
    colours = barvy
  )

save_local_figure(
  plot = plot_staticke_sse,
  filename = "ctverce_rezidui_static.png",
  width = 1700,
  height = 800
)
```

```{r}
#| label: zobrazit-staticke-ctverce
#| echo: false
#| out-width: 80%
#| fig-alt: "Přímka B a stejné čtyři květy; čtverce residuí a sloupce příspěvků do SSE."
include_local_figure("ctverce_rezidui_static.png")
```

$$
\begin{aligned}
\text{SSE} &= (`r format_cz_math(data_ctyri_kvety$residuum[1], nsmall = 2)`)^2 + (`r format_cz_math(data_ctyri_kvety$residuum[2], nsmall = 2)`)^2 \\
&\quad + (`r format_cz_math(data_ctyri_kvety$residuum[3], nsmall = 2)`)^2 + (`r format_cz_math(data_ctyri_kvety$residuum[4], nsmall = 2)`)^2 \\
&\approx `r format_cz_math(sum(data_ctyri_kvety$residuum^2))`\ \text{cm}^2
\end{aligned}
$$

## Stejná residua v R

```{r}
#| label: sse-ctyr-kvetu-v-r
#| echo: true
# Stejná čtyři měření jako v tabulce (cm)
vec_sirka <- c(0.2, 1.0, 1.8, 2.5)
vec_delka <- c(1.3, 3.7, 5.5, 6.0)

# Přímka B: intercept 1.1 cm, sklon 2.2 cm/cm
vec_odhad <- 1.1 + 2.2 * vec_sirka
vec_residua <- vec_delka - vec_odhad

# Prostý součet residuí, zaokrouhlený na setiny cm
round(
  x = sum(vec_residua),
  digits = 2
)

# Součet čtverců residuí (cm²)
sum(vec_residua^2)
```

```{r}
#| label: kontrola-shody-sse
#| include: false
stopifnot(
  identical(vec_sirka, data_ctyri_kvety$sirka_listku),
  identical(vec_delka, data_ctyri_kvety$delka_listku),
  isTRUE(all.equal(vec_residua, data_ctyri_kvety$residuum))
)
```

::: {.takeaway-strip}
Prostý součet residuí je `r format_cz(round(sum(vec_residua), 2))` cm, součet jejich čtverců ne. SSE má jednotku cm²; stejný princip použijeme pro všechny květy.
:::

## Která přímka je nejlepší podle těchto dat?

```{r}
#| label: spocitat-sse-kandidatu
#| include: false
kandidati$SSE4 <-
  purrr::map_dbl(
    .x = seq_len(nrow(kandidati)),
    .f = ~ sum(
      (data_ctyri_kvety$delka_listku -
        (kandidati$a[.x] + kandidati$b[.x] * data_ctyri_kvety$sirka_listku))^2
    )
  )

table_sse_kandidatu <-
  data.frame(
    primka = kandidati$model,
    intercept = format_cz(kandidati$a),
    sklon = format_cz(kandidati$b),
    sse = format_cz(kandidati$SSE4)
  )
names(table_sse_kandidatu) <-
  c("Přímka", "Intercept (cm)", "Sklon (cm/cm)", "SSE pro 4 květy (cm²)")
```

::: {.slide-margin-top-15}
```{r}
#| label: zobrazit-sse-kandidatu
#| echo: false
tinytable::tt(table_sse_kandidatu, width = 1) |>
  tinytable::style_tt(j = 1:4, align = "c")
```

<br>

::: {.takeaway-strip}
Vyberte přímku s nejmenším SSE a vysvětlete, co toto číslo shrnuje.
:::
:::

::: {.notes}
Studenti se vrátí k předchozí volbě A/B/C. Pro stejné čtyři květy z animace vychází z kandidátů B. Dodám, že skutečný lineární model použije všech 150 květů a není omezen na tyto tři možnosti.
:::

## Počítač hledá nejmenší součet čtverců

::: {.slide-margin-top-15}
:::: {.columns .align-stretch}

::: {.column width="49%"}
::: {.panel-indigo}
[Co hledá `lm()`]{.panel-title}

[Intercept a sklon]{.text-hgl-indigo_velvet}, které dávají [nejmenší SSE]{.text-hgl-orange}.
:::
:::

::: {.column width="49%"}
::: {.panel-result .fragment}
[Proč tuto přímku]{.panel-title}

Přímka leží podle zvoleného pravidla [celkově nejblíže naměřeným bodům]{.text-hgl-indigo_velvet}.
:::
:::

::::

<br>

::: {.takeaway-strip .fragment}
`lm()` použije [statistické pravidlo]{.text-hgl-orange}: nejmenší součet čtverců residuí.
:::
:::

# Přímka odhadnutá ze všech květů

## Stejná měření v R

<br>

:::: {.columns .align-center}

::: {.column width="58%"}
```{r}
#| label: ukazat-nacteni-dat
#| echo: true
#| eval: false
# Načteme tabulku kosatců
data_kosatce <-
  read.csv(file = "data/kosatce.csv")
```
:::

::: {.column width="42%"}
::: {.panel-data}
[Sloupce souboru]{.panel-title}

- `sirka_listku`: prediktor (cm)
- `delka_listku`: odezva (cm)
- `druh`, `delka_kalisniho_listku`: zatím mimo model
:::
:::

::::

::: {.footer}
[kosatce.csv](../data/kosatce.csv): uložte do složky `data` ve svém projektu v R.
:::

## Co obsahuje `data_kosatce`?

```{r}
#| label: shrnout-data-kosatce
#| echo: true
# Názvy, typy a první hodnoty sloupců
str(object = data_kosatce)

# Počet chybějících hodnot v každém sloupci
colSums(x = is.na(x = data_kosatce))
```

::: {.takeaway-strip}
Před modelováním zkontrolujte názvy, typy a chybějící hodnoty. Rozsahy obou měření jsme viděli v úvodní tabulce.
:::

## Jak funkce `lm()` spojuje odezvu a prediktor?

:::: {.columns .align-center}

::: {.column width="50%"}
```r
lm(
  formula = odezva ~ prediktor,
  data = data
)
```

::: {.text-center}
`lm` = **l**inear **m**odel = [lineární model]{.text-hgl-indigo_velvet}
:::

::: {.text-center .fragment}
Znak `~` čteme: **odezvu vysvětlujeme pomocí prediktoru**.
:::
:::

::: {.column width="50%"}
::: {.panel-data .fragment}
[Vzorec modelu (`formula`)]{.panel-title}

`delka_listku ~ sirka_listku`

odezva ~ prediktor
:::

::: {.panel-data .fragment}
[Data (`data`)]{.panel-title}

`data_kosatce`: tabulka se všemi `r format_cz(nrow(data_kosatce))` květy
:::
:::

::::

## Jaké koeficienty model odhadne?

```{r}
#| label: pripravit-tabulku-kandidatu
#| include: false
tabulka_kandidatu <-
  data.frame(
    primka = kandidati$model,
    intercept = format_cz(kandidati$a),
    sklon = format_cz(kandidati$b)
  )
names(tabulka_kandidatu) <- c("Přímka", "Intercept (cm)", "Sklon (cm/cm)")
```

:::: {.columns .align-center}

::: {.column width="60%"}
```{r}
#| label: zobrazit-kandidatni-primky-pred-fitem
#| echo: false
#| fig-alt: "Stejná měření se třemi kandidátními přímkami A, B a C, odlišenými typem čáry a popiskem."
#| out-width: 100%
include_local_figure("kandidatni_primky.png")
```
:::

::: {.column width="40%"}
```{r}
#| label: zobrazit-tabulku-kandidatu
#| echo: false
tinytable::tt(tabulka_kandidatu)
```

<br>

::: {.panel-question}
[Odhadněte předem]{.panel-title}

`lm()` použije všech `r format_cz(nrow(data_kosatce))` květů. Bude [sklon]{.text-hgl-indigo_velvet} odhadnutého modelu nejblíž přímce A, B, nebo C?
:::
:::

::::

::: {.notes}
Vracím na plátno kandidátní přímky z dřívějška, aby studenti mohli odhadovat podle toho, co vidí. Na čtyřech květech měla nejmenší SSE přímka `r kandidati$model[which.min(kandidati$SSE4)]`; teď se ptám, co udělá `lm()` se všemi květy. Nechám krátce hlasovat, odpověď ukáže další snímek.
:::

## Jaké koeficienty model odhadne?

```{r}
#| label: pripravit-tabulku-koeficientu-listku
#| include: false
mod_listky <-
  lm(
    formula = delka_listku ~ sirka_listku,
    data = data_kosatce
  )

koeficienty_listky <-
  broom::tidy(mod_listky)

tabulka_koeficientu_listky <-
  koeficienty_listky |>
  dplyr::transmute(
    Parametr = dplyr::recode(
      term,
      "(Intercept)" = "Intercept",
      "sirka_listku" = "Sklon"
    ),
    Odhad = formatC(estimate, format = "f", digits = 2, decimal.mark = ","),
    Jednotka = c("cm", "cm/cm")
  )

stopifnot(
  isTRUE(all.equal(
    unname(koeficienty_listky$estimate),
    unname(coef(object = mod_listky))
  ))
)

odhad_interceptu_listky <-
  koeficienty_listky |>
  dplyr::filter(term == "(Intercept)") |>
  dplyr::pull(estimate)

odhad_sklonu_listky <-
  koeficienty_listky |>
  dplyr::filter(term == "sirka_listku") |>
  dplyr::pull(estimate)

kandidat_nejblizsi <-
  kandidati[which.min(abs(kandidati$b - odhad_sklonu_listky)), ]
```

:::: {.columns .align-center}

::: {.column width="55%"}
```{r}
#| label: fitovat-model-v-r
#| echo: true
#| eval: false
mod_listky <-
  lm(
    formula = delka_listku ~ sirka_listku,
    data = data_kosatce
  )
```

```{r}
#| label: zobrazit-koeficienty-modelu
#| echo: true
coef(object = mod_listky)
```
:::

::: {.column width="45%"}
```{r}
#| label: zobrazit-tabulku-koeficientu-listku
#| echo: false
tinytable::tt(tabulka_koeficientu_listky)
```
:::

::::

::: {.takeaway-strip .fragment}
Odhadnutý [sklon `r format_cz(odhad_sklonu_listky)` cm/cm]{.text-hgl-indigo_velvet} je nejblíž přímce `r kandidat_nejblizsi$model` (`r format_cz(kandidat_nejblizsi$b)`), ale není s ní totožný.
:::

::: {.notes}
Model ukládáme jako `mod_listky`, abychom se k němu mohli vracet. Odhad leží blízko přímky `r kandidat_nejblizsi$model`, ale není s ní totožný: `lm()` nevybírá ze tří kandidátů, hledá nejmenší SSE mezi všemi přímkami a používá všechny květy.
:::

## Přímka odhadnutá z těchto měření

```{r}
#| label: vytvorit-odhadnutou-primku
#| include: false
plot_fit <-
  plot_data_kosatce +
  ggplot2::geom_abline(
    intercept = odhad_interceptu_listky,
    slope = odhad_sklonu_listky,
    color = barvy["model"],
    linewidth = 1.4
  )

save_local_figure(
  plot = plot_fit,
  filename = "odhadnuta_primka.png"
)
```

```{r}
#| label: zobrazit-odhadnutou-primku
#| echo: false
#| fig-alt: "Přímka odhadnutá ze všech měření kosatců pomocí lm."
#| out-width: 84%
include_local_figure("odhadnuta_primka.png")
```

::: {.takeaway-strip .text-center}
Odhadnutá délka (cm) = `r format_cz(odhad_interceptu_listky)` + `r format_cz(odhad_sklonu_listky)` × šířka (cm)
:::

::: {.notes}
Toto je výsledek lm ze všech květů, nikoli ilustrativní přímka B. Požádám o interpretaci sklonu před odhalením správné možnosti.
:::

## Co znamená odhadnutý [sklon]{.text-hgl-indigo_velvet}?

::: {.slide-margin-top-15}
::: {.text-center .text-size-large}
[Sklon]{.text-hgl-indigo_velvet} je **`r format_cz(round(odhad_sklonu_listky, 2))` cm/cm**. Která interpretace je správná?
:::

<br>

:::: {.columns .align-stretch}

::: {.column width="33%"}
::: {.card-question}
**A)** Přesný rozdíl délky u každé dvojice květů, jejichž šířky se liší o 1 cm.
:::
:::

::: {.column width="33%"}
::: {.card-question}
[**B)** Průměrný rozdíl délky dvou květů, jejichž šířky se liší o 1 cm.]{.rn-circle-orange}
:::
:::

::: {.column width="33%"}
::: {.card-question}
**C)** Podíl variability délky, který vysvětluje šířka korunního lístku.
:::
:::

::::

<br>

::: {.takeaway-strip}
Zvolte A/B/C. Zdůvodněte, jaké dvě veličiny a jaké jednotky sklon spojuje.
:::
:::

::: {.notes}
Po volbě nechám studenty přesvědčit souseda. Správně B. A zaměňuje průměrný vztah za přesné pravidlo pro každou dvojici, C zaměňuje sklon za podíl vysvětlené variability.
:::

## Jakou délku čekáme u nového květu?

```{r}
#| label: vytvorit-odhad-noveho-kvetu
#| include: false
#| message: false
#| warning: false
odhad_delka_novy_kvet <-
  odhad_interceptu_listky + odhad_sklonu_listky * sirka_novy_kvet

stopifnot(
  isTRUE(all.equal(
    odhad_delka_novy_kvet,
    unname(predict(
      object = mod_listky,
      newdata = data.frame(sirka_listku = sirka_novy_kvet)
    ))
  ))
)

plot_novy_kvet_odhad <-
  plot_fit +
  ggplot2::annotate(
    geom = "point",
    x = sirka_novy_kvet,
    y = odhad_delka_novy_kvet,
    color = barvy["model"],
    size = 6
  ) +
  ggplot2::annotate(
    geom = "label",
    x = sirka_novy_kvet - sirka_pasmo - 0.14,
    y = odhad_delka_novy_kvet + 0.35,
    hjust = 1,
    label = paste0("odhad modelu ", format_cz(odhad_delka_novy_kvet), " cm"),
    color = barvy["model"],
    fill = "white",
    label.size = 0,
    size = 6
  )

save_local_figure(
  plot = plot_novy_kvet_odhad,
  filename = "novy_kvet_odhad.png",
  width = 1300,
  height = 900
)
```

:::: {.columns .align-center}

::: {.column width="55%"}
```{r}
#| label: zobrazit-odhad-noveho-kvetu
#| echo: false
#| fig-alt: !expr paste0("Bodový graf s fialovou přímkou lineárního modelu; fialový bod na přímce u šířky ", format_cz(sirka_novy_kvet), " cm ukazuje odhadnutou délku ", format_cz(odhad_delka_novy_kvet), " cm.")
#| out-width: 100%
include_local_figure("novy_kvet_odhad.png")
```
:::

::: {.column width="45%"}
$$
\begin{aligned}
\text{odhadnutá délka}
&=
\text{intercept} \\
&\quad +
\text{sklon} \cdot \text{šířka} \\
&=
`r format_cz_math(odhad_interceptu_listky)`
+
`r format_cz_math(odhad_sklonu_listky)` \cdot `r format_cz_math(sirka_novy_kvet)` \\
&=
`r format_cz_math(odhad_delka_novy_kvet)`\ \text{cm}
\end{aligned}
$$

::: {.panel-data .fragment}
[Váš odhad z úvodu]{.panel-title}

Podobně široké květy měly v průměru [`r format_cz(delka_pasmo_prumer)` cm]{.text-hgl-orange}.
:::
:::

::::

::: {.takeaway-strip .fragment}
[Lineární model]{.text-hgl-indigo_velvet} vrací typickou délku pro danou šířku. Jednotlivé nové květy se od ní budou lišit; jak přesný je samotný odhad, ukáže příští lekce.
:::

::: {.notes}
Vracím se k novému květu z úvodu. Do rovnice dosadíme změřenou šířku a dostaneme odhadnutou délku. Porovnám ji s průměrem podobně širokých květů, který studenti viděli na začátku: obě hodnoty jsou téměř stejné. Při této šířce se odhad modelu a průměr podobně širokých květů téměř shodují; u jiných šířek to platit nemusí, k tomu se vrátíme u residuí. Skutečný nový květ se od odhadu lišit bude; tyto odchylky už známe jako residua. Přesnost odhadu (interval) přijde v L04.
:::

## Co už víme o korunních lístcích?

::: {.box-question}
**Mají širší korunní lístky kosatců také větší délku — a pokud ano, o kolik?**
:::

<br>

:::: {.columns .align-stretch}

::: {.column width="50%"}
::: {.panel-result .fragment}
[Co můžeme říct]{.panel-title}

Ano. Dva květy, jejichž šířky se liší o 1 cm, se podle modelu liší v délce v průměru o **`r format_cz(round(odhad_sklonu_listky, 2))` cm**.

U nového květu širokého `r format_cz(sirka_novy_kvet)` cm [lineární model]{.text-hgl-indigo_velvet} odhaduje délku **`r format_cz(odhad_delka_novy_kvet)` cm**.
:::
:::

::: {.column width="50%"}
::: {.panel-question .fragment}
[Co zatím nevíme]{.panel-title}

- Jak přesný je odhad **`r format_cz(odhad_sklonu_listky)` cm/cm**?
- Nepřehlíží jedna přímka systematický vzor?
:::
:::

::::

## Souvislost délky a šířky není důkaz příčiny

::: {.slide-margin-top-15}
::: {.box-rule}
::: {.card-title}
Biologický závěr
:::

::: {.text-center .text-size-heading .text-bold}
[Asociace]{.text-hgl-indigo_velvet} $\neq$ [příčina]{.text-hgl-orange}
:::

Model popisuje vztah v datech. Bez dalšího výzkumného designu neprokazuje, že větší šířka **způsobuje** větší délku.
:::
:::

# Co zůstává mimo přímku?

## Jak jsou residua rozdělená?

```{r}
#| label: vytvorit-histogram-rezidui
#| include: false
vec_odhadnuta_delka <-
  fitted(object = mod_listky)
vec_rezidua <-
  resid(object = mod_listky)
data_rezidua <-
  data.frame(
    odhadnuta_delka = vec_odhadnuta_delka,
    reziduum = vec_rezidua
  )

sirka_sloupce_rezidui <- 0.25

plot_histogram_rezidui <-
  ggplot2::ggplot(
    data = data_rezidua,
    mapping = ggplot2::aes(x = reziduum)
  ) +
  ggplot2::geom_histogram(
    binwidth = sirka_sloupce_rezidui,
    boundary = 0,
    fill = barvy["interpretace"],
    color = "white",
    alpha = 0.78
  ) +
  ggplot2::geom_vline(
    xintercept = 0,
    linetype = 2,
    color = barvy["model"],
    linewidth = 1
  ) +
  ggplot2::labs(
    x = "Residuum (cm)",
    y = "Počet květů"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_histogram_rezidui,
  filename = "histogram_rezidui.png"
)
```

```{r}
#| label: zobrazit-histogram-rezidui
#| echo: false
#| fig-alt: "Histogram residuí v centimetrech s nulovou referenční čarou."
#| out-width: 86%
include_local_figure("histogram_rezidui.png")
```

::: {.takeaway-strip}
Kde leží většina residuí a jak daleko sahají od nuly?
:::

::: {.notes}
Nejprve se podíváme na rozdělení všech residuí. Histogram ukáže jejich typickou velikost a znaménko, ale skryje, u kterých odhadnutých hodnot jednotlivé odchylky vznikly. Proto v dalším kroku residua vrátíme k odhadnutým hodnotám.
:::

## Stejná residua, ale s křivkou

```{r}
#| label: vytvorit-histogram-rezidui-s-krivkou
#| include: false
# Reference curve: normal shape centred at 0 with the residuals' own spread,
#   scaled from density to counts (n × bin width) to match the histogram.
sd_rezidui <- stats::sd(vec_rezidua)

data_normalni_krivka <-
  data.frame(
    reziduum = seq(
      from = min(vec_rezidua) - 0.3,
      to = max(vec_rezidua) + 0.3,
      length.out = 300
    )
  )
data_normalni_krivka$pocet <-
  length(vec_rezidua) * sirka_sloupce_rezidui *
  stats::dnorm(data_normalni_krivka$reziduum, mean = 0, sd = sd_rezidui)

plot_histogram_rezidui_s_krivkou <-
  plot_histogram_rezidui +
  ggplot2::geom_line(
    data = data_normalni_krivka,
    mapping = ggplot2::aes(x = reziduum, y = pocet),
    color = biostat_cols[["graphite"]],
    linewidth = 1.4
  )

save_local_figure(
  plot = plot_histogram_rezidui_s_krivkou,
  filename = "histogram_rezidui_s_krivkou.png"
)
```

```{r}
#| label: zobrazit-histogram-rezidui-s-krivkou
#| echo: false
#| fig-alt: "Stejný histogram residuí s tmavou hladkou zvonovitou křivkou se středem v nule; sloupce křivku přibližně sledují."
#| out-width: 80%
include_local_figure("histogram_rezidui_s_krivkou.png")
```

::: {.text-center}
Většina residuí leží [blízko nuly]{.text-hgl-orange}. Čím dál od nuly, tím jich je méně, na obě strany podobně.
:::

::: {.fragment .text-center}
Tmavá křivka ukazuje takový symetrický zvonovitý tvar. Říká se mu [normální rozdělení]{.text-hgl-graphite}.
:::

::: {.fragment .takeaway-strip}
[Lineární model]{.text-hgl-indigo_velvet} předpokládá, že residua mají přibližně [normální rozdělení]{.text-hgl-graphite}. Proč na tom záleží, vysvětlíme v dalších lekcích.
:::

::: {.notes}
Stejný histogram, jen přidávám hladkou referenční křivku se středem v nule a se stejným rozptýlením, jaké mají naše residua. Nejprve tvar popíšu slovy, teprve potom ho pojmenuji. Naše residua křivku přibližně sledují; drobné odchylky jsou u skutečných dat běžné. Zde jen pojmenovávám předpoklad. Proč je důležitý (odhad nejistoty a další závěry), vysvětlíme v dalších lekcích, proto se k tomu teď nevracím.
:::

## Mění se residua podél odhadnuté délky?

```{r}
#| label: vytvorit-graf-rezidui
#| include: false
plot_rezidua <-
  ggplot2::ggplot(
    data = data_rezidua,
    mapping = ggplot2::aes(
      x = odhadnuta_delka,
      y = reziduum
    )
  ) +
  ggplot2::geom_hline(
    yintercept = 0,
    linetype = 2,
    color = barvy["model"],
    linewidth = 1
  ) +
  ggplot2::geom_point(
    color = barvy["data"],
    alpha = 0.72,
    size = 2.7
  ) +
  ggplot2::labs(
    x = "Odhadnutá délka (cm)",
    y = "Residuum (cm)"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_rezidua,
  filename = "graf_rezidui.png",
  width = 1300,
  height = 950
)
```

:::: {.columns .align-center}

::: {.column width="60%"}
```{r}
#| label: zobrazit-graf-rezidui-znovu
#| echo: false
#| fig-alt: "Odhadnutá délka proti residuu jednotlivých květů s nulovou referenční čarou."
#| out-width: 100%
include_local_figure("graf_rezidui.png")
```
:::

::: {.column width="40%"}
::: {.incremental}
- každý bod je jeden květ
- nad nulou model délku podhodnotil
- pod nulou model délku nadhodnotil
- hledáme neuspořádaný mrak kolem nuly
:::
:::

::::

## Vidíte neuspořádaný mrak, nebo zbývající vzor?

```{r}
#| label: zobrazit-rezidua-pro-diskuzi
#| echo: false
#| fig-alt: "Odhadnutá délka proti residuu jednotlivých květů s nulovou referenční čarou."
#| out-width: 72%
include_local_figure("graf_rezidui.png")
```

::: {.panel-olive}
[Diskuze se sousedem — 2 min]{.panel-title}

Najděte jednu oblast s převahou residuí nad nebo pod nulou. Co to říká o odhadované délce?
:::

::: {.notes}
Toto je hlavní diagnostická interpretace. Nechám studenty formulovat polohu shluků nebo systematické odchylky kolem nuly, aniž bych vyžadoval pokročilé názvy diagnostických problémů.
:::

## Které stopy by nás u přímky zneklidnily?

::: {.text-center .text-size-smaller}
Schématické vzory; grafy nepředstavují další měření kosatců.
:::

```{r}
#| label: vytvorit-schematicke-stopy
#| include: false
pocet_schematickych_bodu <- 40
poradi_schematickych_bodu <-
  seq_len(pocet_schematickych_bodu)
osa_schematickych_odhadu <-
  seq(
    from = -2,
    to = 2,
    length.out = pocet_schematickych_bodu
  )
schematicky_sum <-
  0.30 * sin(poradi_schematickych_bodu * sqrt(2)) +
  0.16 * cos(poradi_schematickych_bodu * sqrt(3))

nazvy_schematickych_vzoru <-
  c(
    "A · bez zjevného vzoru",
    "B · oblouk",
    "C · trychtýř",
    "D · běhy v pořadí"
  )

data_schematicke_vzory <-
  dplyr::bind_rows(
    tibble::tibble(
      vzor = nazvy_schematickych_vzoru[1],
      osa = osa_schematickych_odhadu,
      residuum = schematicky_sum
    ),
    tibble::tibble(
      vzor = nazvy_schematickych_vzoru[2],
      osa = osa_schematickych_odhadu,
      residuum =
        0.42 * (osa_schematickych_odhadu^2 - mean(osa_schematickych_odhadu^2)) +
        0.10 * sin(poradi_schematickych_bodu * sqrt(2))
    ),
    tibble::tibble(
      vzor = nazvy_schematickych_vzoru[3],
      osa = osa_schematickych_odhadu,
      residuum =
        (0.08 + 0.28 * (osa_schematickych_odhadu - min(osa_schematickych_odhadu))) *
        sin(poradi_schematickych_bodu * sqrt(5))
    ),
    tibble::tibble(
      vzor = nazvy_schematickych_vzoru[4],
      osa = poradi_schematickych_bodu,
      residuum =
        rep(c(-0.55, 0.55, -0.38, 0.38), each = 10) +
        0.08 * sin(poradi_schematickych_bodu)
    )
  ) |>
  dplyr::mutate(
    vzor = factor(vzor, levels = nazvy_schematickych_vzoru)
  )

plot_stopy <-
  ggplot2::ggplot(
    data = data_schematicke_vzory,
    mapping = ggplot2::aes(x = osa, y = residuum)
  ) +
  ggplot2::geom_hline(
    yintercept = 0,
    color = barvy["model"],
    linetype = 2
  ) +
  ggplot2::geom_point(
    color = barvy["data"],
    size = 2.4
  ) +
  ggplot2::facet_wrap(
    facets = ggplot2::vars(vzor),
    ncol = 2,
    scales = "free_x"
  ) +
  ggplot2::labs(
    x = "Odhadnutá hodnota; panel D: pořadí měření",
    y = "Residuum"
  ) +
  theme_biostat(base_size = 20)

save_local_figure(
  plot = plot_stopy,
  filename = "schematicke_stopy.png",
  width = 1500,
  height = 950
)
```

```{r}
#| label: zobrazit-schematicke-stopy
#| echo: false
#| fig-alt: "Schémata neuspořádaného mraku, oblouku, trychtýře a běhů v pořadí měření; panel D používá pořadí."
#| out-width: 88%
include_local_figure("schematicke_stopy.png")
```

::: {.text-center}
Přiřaďte: tvar vztahu · měnící se rozptýlení · pořadí měření.
:::

::: {.fragment .takeaway-strip .text-size-smaller}
B: tvar vztahu · C: měnící se rozptýlení · D: pořadí měření. A model neschvaluje.
:::

::: {.notes}
Jde o schematické obrazy, nikoli další kosatce či formální test. B upozorňuje na zakřivení, C na měnící se rozptýlení, D na možnou závislost v pořadí měření. A model neschvaluje. Nezávislost posuzujeme ze sběru dat; graf ji nemůže dokázat.
:::

## Stejná původní data, ale s druhem

```{r}
#| label: vytvorit-data-podle-druhu
#| include: false
#| message: false
#| warning: false
# Species are groups, not semantic data/model/focus roles: use the _brand
#   categorical palette (clr_skupiny) instead of the semantic colours.
barvy_druhu <-
  c(
    setosa = "#4E9A8A",
    versicolor = "#C2613A",
    virginica = "#2E6CA4"
  )

plot_data_podle_druhu <-
  ggplot2::ggplot(
    data = data_kosatce,
    mapping = ggplot2::aes(
      x = sirka_listku,
      y = delka_listku,
      color = druh
    )
  ) +
  ggplot2::geom_point(
    alpha = 0.78,
    size = 2.8
  ) +
  ggplot2::geom_abline(
    intercept = odhad_interceptu_listky,
    slope = odhad_sklonu_listky,
    color = barvy["model"],
    linewidth = 1.25
  ) +
  ggplot2::scale_color_manual(values = barvy_druhu) +
  ggplot2::scale_x_continuous(limits = c(0, 2.7)) +
  ggplot2::scale_y_continuous(limits = c(0, 7.2)) +
  ggplot2::labs(
    x = "Šířka korunního lístku (cm)",
    y = "Délka korunního lístku (cm)",
    color = "Druh"
  ) +
  theme_biostat(base_size = 20) +
  ggplot2::theme(
    legend.position = "bottom",
    legend.direction = "horizontal"
  )

save_local_figure(
  plot = plot_data_podle_druhu,
  filename = "data_podle_druhu.png",
  width = 1300,
  height = 950
)
```

:::: {.columns .align-center}

::: {.column width="62%"}
```{r}
#| label: zobrazit-data-podle-druhu
#| echo: false
#| fig-alt: "Stejná šířka a délka květů se společnou přímkou a odlišenými druhy."
#| out-width: 100%
include_local_figure("data_podle_druhu.png")
```
:::

::: {.column width="38%"}
::: {.panel-question}
[Co vidíte?]{.panel-title}

Tvoří tři druhy jeden společný mrak kolem přímky, nebo samostatné skupiny?
:::
:::

::::

## Stejná residua, ale s druhem

```{r}
#| label: vytvorit-rezidua-podle-druhu
#| include: false
#| message: false
#| warning: false
data_rezidua$druh <- data_kosatce$druh

plot_rezidua_podle_druhu <-
  ggplot2::ggplot(
    data = data_rezidua,
    mapping = ggplot2::aes(
      x = odhadnuta_delka,
      y = reziduum,
      color = druh
    )
  ) +
  ggplot2::geom_hline(
    yintercept = 0,
    linetype = 2,
    color = barvy["model"],
    linewidth = 1
  ) +
  ggplot2::geom_point(
    alpha = 0.8,
    size = 2.8
  ) +
  ggplot2::scale_color_manual(values = barvy_druhu) +
  ggplot2::labs(
    x = "Odhadnutá délka (cm)",
    y = "Residuum (cm)",
    color = "Druh"
  ) +
  theme_biostat(base_size = 20) +
  ggplot2::theme(
    legend.position = "bottom",
    legend.direction = "horizontal"
  )

save_local_figure(
  plot = plot_rezidua_podle_druhu,
  filename = "rezidua_podle_druhu.png",
  width = 1300,
  height = 950
)
```

:::: {.columns .align-center}

::: {.column width="62%"}
```{r}
#| label: zobrazit-rezidua-podle-druhu
#| echo: false
#| fig-alt: "Stejná residua, jejich druhy odlišené barvami; skupiny neleží vůči nule stejně."
#| out-width: 100%
include_local_figure("rezidua_podle_druhu.png")
```
:::

::: {.column width="38%"}
::: {.panel-olive}
[Diskuze se sousedem — 1 min]{.panel-title}

Který druh model spíše nadhodnocuje a který podhodnocuje? Podle čeho to poznáte?
:::
:::

::::

::: {.notes}
Nechám studenty rozhodnout pro každý druh zvlášť; odpověď s podíly residuí nad a pod nulou je na dalším snímku. Konvence je stejná jako u jednoho květu: naměřená minus odhadnutá délka.
:::

## Co [model]{.text-hgl-indigo_velvet} neviděl?

```{r}
#| label: spocitat-podil-rezidui-nad-nulou
#| include: false
vec_podil_nad_nulou <-
  tapply(
    X = data_rezidua$reziduum > 0,
    INDEX = data_rezidua$druh,
    FUN = mean
  )
```

::: {.slide-margin-top-15}
::: {.panel-result}
[Chybějící prediktor]{.panel-title}

::: {.text-center .text-size-heading .text-bold}
Druh kosatce
:::

Jedna přímka zachytila [celkový růst]{.text-hgl-indigo_velvet}, ale druhy netvoří jeden společný mrak. Jejich [struktura proto zůstává v residuích]{.text-hgl-orange}.
:::

::: {.fragment .text-center}
*versicolor*: `r format_cz(100 * vec_podil_nad_nulou[["versicolor"]], digits = 0)` % residuí nad nulou → podhodnocuje · *setosa*: `r format_cz(100 * (1 - vec_podil_nad_nulou[["setosa"]]), digits = 0)` % pod nulou → nadhodnocuje · *virginica*: `r format_cz(100 * (1 - vec_podil_nad_nulou[["virginica"]]), digits = 0)` % pod nulou, hlavně nejširší květy
:::

<br>

::: {.fragment .takeaway-strip}
[První model]{.text-hgl-indigo_velvet} je začátek argumentu, [ne jeho automatický konec]{.text-hgl-orange}.
:::
:::

# Závěr

## Shrnutí

::: {.slide-margin-top-15}
::: {.blockquote}
::: {.incremental}
- [Lineární model]{.text-hgl-indigo_velvet}: změříme [prediktor]{.text-hgl-graphite} a přímka vrátí odhadnutou [odezvu]{.text-hgl-graphite}.
- `lm()` hledá přímku s [nejmenším součtem čtverců residuí]{.text-hgl-orange}; [sklon]{.text-hgl-indigo_velvet} je průměrný rozdíl odezvy mezi pozorováními, jejichž prediktor se liší o jednu jednotku.
- [Residuum]{.text-hgl-orange} je rozdíl mezi naměřenou a odhadnutou hodnotou; ukazuje, co model u jednotlivých pozorování nevysvětlil.
- [Vzor v residuích]{.text-hgl-orange} upozorňuje na chybějící strukturu nebo omezení modelu.
:::
:::
:::

::: {.notes}
Shrnutí kopíruje výsledky učení.
:::

## Co potřebujete vidět, než napíšete „o centimetr širší lístek, o `r format_cz(round(odhad_sklonu_listky, 2))` cm delší lístek“? {.text-center}

<br>

::: {.text-size-large .text-bold .text-center}
Jaké tři otázky položíte autorovi, který vám ukáže jen sklon `r format_cz(round(odhad_sklonu_listky, 2))` cm/cm bez grafu?
:::

<br>

::: {.panel-olive}
[Řekněte sousedovi jednou větou]{.panel-title}

Kterou z otázek byste položili jako první, a proč?
:::

::: {.fragment .takeaway-strip}
Jak přesný je odhad sklonu? Následující lekce přidá nejistotu odhadu.
:::

::: {.notes}
Otevřená závěrečná otázka bez jedné správné odpovědi. Očekávané otázky: Jak vypadá bodový graf a graf residuí? Jsou v datech skupiny, například druhy? Kolik květů a jak byly měřeny? Jak přesný je odhad? Tvrdí autor příčinu? Následující lekce přidá výběrovou variabilitu a interval spolehlivosti; p-hodnota patří až do pozdější lekce.
:::