Pole, adresáře, grafika, datum a čas

Postupné přidávání nebo mazání hodnot

Jsou situace, kdy chceme postupně přidávat do seznamu nalezené hodnoty, vypočtené ukazatele, problémové případy apod. Přitom dopředu nevíme, kolik položek celkem to bude. Z hlediska programové efektivity je je pro velké rozsahy efektivnější dopředu vytvořit prázdný seznam velkého rozsahu a indexem postupně zaplňovat položky. Pro malé rozsahy je však často pohodlnější velikost seznamů postupně rozšiřovat, i když to pro počítač ve skutečnosti znamená neustálé vytvářené nových proměnných a kopírování obsahu těch předchozích.

Vektory (tzv. atomické)

Vektor obsahuje prvky stejného typy (např. jen desetinná čísla numeric, nebo jen znakové řetězce character, případně jen celá čísla integer apod.)

cisla <- numeric(0)  # vytvoření prázdného vektoru čísel

cisla <- c(cisla, 5, 2, 1) # přidání nových čísel

cisla <- cisla[-1] # smazání prvního prvku


jmena <- character(0)  # prázdný vektor řetězců
jmena <- c(jmena, "Tomáš", "Jonáš") 

Seznamy (list)

seznam <- list()  # vytvoření prázdného listu

seznam <- c(seznam, 6.28, "ano", FALSE)  # připojování prvků

seznam[[2]] <- NULL   # odstranění prvku na daném indexu

Data.frame

tab <- data.frame(jmeno = "Jakub", vek = 25, stringsAsFactors = FALSE)

# a) přidání řádku: rychlejší varianta
polozka <- list(jmeno = "Jana", vek = 29)
tab[nrow(tab)+1, ] <- polozka
# b) přidání řádku: pomalejší varianta
polozka <- data.frame(jmeno = "Jana", vek = 29)
tab <- rbind(tab, polozka)

tab$hmotnost <- c(73, 71, 71) # přidání sloupce

tab <- tab[-1, ]  # smazání 1. řádku
tab$vek <- NULL   # odstranění sloupce

Pole array

Občas potřebujeme uložit hodnoty do více rozměrů, takže vektor nelze použít. A ne vždy je data.frame vhodný. Pak nám jistě pomůže array.

Problém se šachovnicí. Na první políčko umístíme 1 zrnko rýže, na další dvojnásobek, tedy 2, na další opět dvojnásobek, tedy 4 atd.

sachovnice <- array(dim = c(8, 8))
sachovnice  # zatím prázdná
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,]   NA   NA   NA   NA   NA   NA   NA   NA
## [2,]   NA   NA   NA   NA   NA   NA   NA   NA
## [3,]   NA   NA   NA   NA   NA   NA   NA   NA
## [4,]   NA   NA   NA   NA   NA   NA   NA   NA
## [5,]   NA   NA   NA   NA   NA   NA   NA   NA
## [6,]   NA   NA   NA   NA   NA   NA   NA   NA
## [7,]   NA   NA   NA   NA   NA   NA   NA   NA
## [8,]   NA   NA   NA   NA   NA   NA   NA   NA
hodnota <- 1

for (radky in 1: 8) {
    for (sloupce in 1: 8) {
        sachovnice[radky, sloupce] <- hodnota
        hodnota <- hodnota * 2   # příprava hodnoty pro další políčko
    }
}

sachovnice  # to bude ale nákup!
##              [,1]         [,2]         [,3]         [,4]         [,5]
## [1,] 1.000000e+00 2.000000e+00 4.000000e+00 8.000000e+00 1.600000e+01
## [2,] 2.560000e+02 5.120000e+02 1.024000e+03 2.048000e+03 4.096000e+03
## [3,] 6.553600e+04 1.310720e+05 2.621440e+05 5.242880e+05 1.048576e+06
## [4,] 1.677722e+07 3.355443e+07 6.710886e+07 1.342177e+08 2.684355e+08
## [5,] 4.294967e+09 8.589935e+09 1.717987e+10 3.435974e+10 6.871948e+10
## [6,] 1.099512e+12 2.199023e+12 4.398047e+12 8.796093e+12 1.759219e+13
## [7,] 2.814750e+14 5.629500e+14 1.125900e+15 2.251800e+15 4.503600e+15
## [8,] 7.205759e+16 1.441152e+17 2.882304e+17 5.764608e+17 1.152922e+18
##              [,6]         [,7]         [,8]
## [1,] 3.200000e+01 6.400000e+01 1.280000e+02
## [2,] 8.192000e+03 1.638400e+04 3.276800e+04
## [3,] 2.097152e+06 4.194304e+06 8.388608e+06
## [4,] 5.368709e+08 1.073742e+09 2.147484e+09
## [5,] 1.374390e+11 2.748779e+11 5.497558e+11
## [6,] 3.518437e+13 7.036874e+13 1.407375e+14
## [7,] 9.007199e+15 1.801440e+16 3.602880e+16
## [8,] 2.305843e+18 4.611686e+18 9.223372e+18
hodnota  # další připravená hodnota, která se už nevyužila
## [1] 1.844674e+19
radky    # poslední hodnota indexové proměnné v cyklu
## [1] 8
sloupce
## [1] 8

Zpracování více souborů v adresáři

adresar <- "tabulky"

# všechny soubory
seznam <- list.files(path = adresar)
seznam
## [1] "nesmysl.aha" "tab1.txt"    "tab2.txt"    "tab3.txt"
# jen soubory s příponou .txt
seznam <- list.files(path = adresar, pattern = "\\.txt$" , ignore.case = TRUE)
seznam
## [1] "tab1.txt" "tab2.txt" "tab3.txt"
prumery <- numeric(0)   # prázdný vektor pro postupné ukládání hodnot

for (soubor in seznam) {
    souborJmeno <- paste0(adresar, "/", soubor)
    print(souborJmeno)
    
    tab <- read.table(souborJmeno, header = TRUE)
    prumer <- mean(tab$hodnoty)
    print(prumer)
    
    prumery <- c(prumery, prumer)
}
## [1] "tabulky/tab1.txt"
## [1] 4.25
## [1] "tabulky/tab2.txt"
## [1] 15.09091
## [1] "tabulky/tab3.txt"
## [1] 8.65625
print(prumery)
## [1]  4.25000 15.09091  8.65625

Základní kreslení – basic plot a plotrix

Basic plot: Více info viz týden 5, poznámky a soubory: ‘poznámky R05 - grafy.docx’, str. 2 až 4.

plotrix: knihovna pro další užitečné funkce (např. kolečka, obloučky), více info viz [https://cran.r-project.org/web/packages/plotrix/plotrix.pdf]

library(plotrix)
## Warning: package 'plotrix' was built under R version 3.2.3
# příprava prázdného obrázku s daným rozsahem os a měřítkem os 1:1 (parametr asp)
plot(c(0, 10), c(0, 10), type="n",xlab="",ylab="", axes = FALSE, asp=1)

draw.circle(2, 4, 1,border="black", col="#ff00ff",lty=1,lwd=1)
draw.circle(2.5, 8, 0.6, border="red",lty=3,lwd=3)
draw.circle(4, 3, 0.7, border="green",lty=1,lwd=1)
draw.circle(3.5, 7, 0.8, border="blue",lty=2,lwd=2)

draw.arc(x = 4, y = 5, radius = 1, deg1 = 45, deg2 = 180, col = "blue", lwd = 5)
draw.arc(x = 4, y = 5, radius = 3, deg1 = 45, deg2 = 180, col = "blue", lwd = 5)
draw.arc(x = 4, y = 5, radius = 5, deg1 = 45, deg2 = 180, col = "blue", lwd = 5)

lines(c(0, 2), c(4, 0), lwd = 3)

# Hangman
plot(c(0, 12), c(0, 12), type="n",xlab="",ylab="", axes = FALSE, asp=1)
lines(c(0, 10), c(0, 0), lwd=3)
lines(c(2, 2), c(0, 10), lwd=3)
lines(c(2, 8), c(10, 10), lwd=3)
lines(c(2, 4), c(8, 10), lwd=3)
lines(c(8, 8), c(10, 8), lwd=3)
draw.circle(x=8, y=7, radius=1, lwd=3)
lines(c(8, 8), c(6, 4), lwd=3)
lines(c(8, 7), c(4, 2), lwd=3)
lines(c(8, 9), c(4, 2), lwd=3)
lines(c(8, 6), c(5.5, 6), lwd=3)
lines(c(8, 10), c(5.5, 6), lwd=3)
draw.circle(x=7.6, y=7.2, radius=0.2, lwd=3)
draw.circle(x=8.4, y=7.2, radius=0.2, lwd=3)
draw.arc(x=8, y=6.3, radius=0.3, deg1=45, deg2=135, lwd=3)

Interaktivní grafy – dyGraphs

Více info viz [https://rstudio.github.io/dygraphs/]

Jednorázová instalace nejaktuálnější verze (podporuje obecné numerické řady).

install.packages("devtools")
devtools::install_github(c("ramnathv/htmlwidgets", "rstudio/dygraphs"))

Po každém spuštění R je potřeba knihovnu nahrát.

library(dygraphs)
x <- 0: 1000
y <- sin(0.1*x)
dygraph(data.frame(x, y))

Interaktivní ovládání

  • Dvojitý klik: základní zoom.
  • Levé tlačítko + táhnout: horizontální nebo vertikální zoom.
  • Shift + tažení levým tlačítkem: posun.

Range selector

dalsi <- cos(0.11*x)
dygraph(data.frame(x, y, dalsi)) %>% dyRangeSelector()

Popisky

dygraph(data.frame(x, y, dalsi), main = "Vývoj hodnoty v čase") %>%
    dyRangeSelector() %>%
    dyAxis("x", label = "Čas (s)") %>% 
    dyAxis("y", label = "Hodnota")

Grafy diskrétních veličin

dygraph(data.frame(x, y, dalsi)) %>%
    dyRangeSelector() %>% 
    dySeries("dalsi", stemPlot = TRUE)

Anotace událostí

dygraph(data.frame(x = 1:10, y = runif(10))) %>%
    dyAxis("y", valueRange = c(0, 1.5)) %>%
    dyEvent(2, label = "test") %>%
    dyAnnotation(5, text = "A") %>%
    dyAnnotation(7, text = "B") %>%
    dyRangeSelector()

Logaritmické osy

data <- data.frame(f = seq(0.01, 1e5, length.out = 1e4), y1 = seq(80, 0.1, length.out = 1e4), y2 = seq(0.001, 0.1, length.out = 1e4))

dygraph(data) %>% dyAxis("x", logscale = TRUE) %>% dyAxis("y", logscale = TRUE) %>% 
    dyAxis("y", valueRange = c(0.0001, 1000))

Vyšší počet desetinných míst na osách / v legendě

data <- data.frame(x = seq(1, 5, length.out = 10000), y1 = seq(6, 2, length.out = 10000),
                   y2 = seq(-2e-5, 2e-5, length.out = 10000))
dygraph(data)  %>% dyLegend(labelsSeparateLines = TRUE) %>% dyOptions(sigFigs = 8)

# nebo takto, pak je to jen v legendě, ale ne na osách
dygraph(data)  %>% dyLegend(labelsSeparateLines = TRUE) %>%
    dyAxis("y", labelWidth = 100, valueFormatter = 'function(d){return d.toPrecision(10)}')

dygraph(data)  %>% dyLegend(labelsSeparateLines = TRUE) %>%
    dyAxis("y", labelWidth = 100, valueFormatter = 'function(d){return d.toFixed(10)}')

Zvýrazňování řad

Nutno vytvořit (např. v poznámkovém bloku) textový soubor ’styl.txt’s tímto jediným řádkem:

.dygraph-legend > span.highlight { border: 1px solid grey; }

Pak můžeme tento styl připojit ke grafům.

dygraph(Seatbelts) %>% dyRangeSelector() %>% 
    dyHighlight() %>% dyCSS("styl.txt")

Hra přistání na měsíci

Podívejte se na logiku členění složitější hry. Rozpoznejte nejdříve hrubý význam jednotlivých bloků, teprve pak zkoumejte detaily konkrétních příkazů.

library(ggplot2)

souborRekordy <- "pristaniNaMesici.txt"

################## vytvoř prázdnou tabulku rekordů
# rekordy <- data.frame(uroven = rep(1:3, each = 5), znamka = rep(0:4, times = 3), palivo = NA, jmeno = NA)
# write.csv(rekordy, souborRekordy, row.names = FALSE, fileEncoding = "UTF-8")


# Zadání úrovně hry a volba počátečních hodnot pro hru
uroven <-
    readline("Zadej úroveň (1 = nízká, 2 = střední, 3 = vysoká, 0 = náhodná bez rekordů, Esc = konec hry): ")
uroven <- trunc(as.numeric(uroven))  # převod na číslo a odříznutí případných desetinných míst
if (is.na(uroven) | uroven < 0 | uroven > 3) {   # špatné zadání
    stop("Špatné zadání.")   # předčasné ukončení skriptu s chybovou hláškou
}

if (uroven == 1) {
    vyska <- 50      # výška (m)
    rychlost <- 8    # rychlost (m*s^-1)
    palivo <- 90     # palivo (kg)
    maxTah <- 36     # maximální tah (kN)
    hmotnost <- 8000 # hmotnost (kg)
} else if (uroven == 2) {
    vyska <- 150
    rychlost <- 14
    palivo <- 130
    maxTah <- 36
    hmotnost <- 8000
} else if (uroven == 3) {
    vyska <- 1000
    rychlost <- 25
    palivo <- 350
    maxTah <- 36
    hmotnost <- 8000
} else {
    uroven <- 0  # úroveň s náhodnými hodnotami: nezapočítává se do rekordů
    vyska <- runif(1, 50, 1000)
    rychlost <- 2*sqrt(vyska) * (1-rbeta(1, 2, 5))
    palivo <- sqrt(vyska)*10 + rychlost # Aproximace, kolik by zhruba mělo stačit
    maxTah <- 36
    hmotnost <- 8000
}

vysky <- vyska   # vektor všech výšek pro zobrazení grafu


## uživatelská funkce pro vykreslení grafu vektoru výšek
zobrazGraf <- function(konec = 0) {   # pro konec == 1 se zobrazí jiný titulek grafu
    g <- ggplot(data.frame(index = 1:length(vysky), vysky),
                aes(x = index, y = vysky)) +
        geom_point(size = 5, shape = 7) +
        coord_cartesian(ylim = c(-10, 1.1*max(vysky)),
                        xlim = c(0.8, max(30, length(vysky)))) +
        ylab("Výška (m)") +
        ggtitle(paste(ifelse(konec == 1, "Konec. Výška:", "Výška:"),
                      round(vyska, 2), "m, rychlost:", round(rychlost, 2),
                      "m/s, palivo:", round(palivo, 2), "kg\n")) +
        geom_abline(intercept = 0, slope = 0, size = 2)
        
    print(g)
}


# Opakování zadání a výpočtů, dokud není konec hry
repeat {
    # Zobrazení aktuálního stavu
    cat("Výška:", vyska, "m, rychlost:", rychlost, "m/s, palivo:", palivo, "kg\n")
    zobrazGraf()
    
    # Zadání od uživatele
    motor <- readline("(Esc = konec hry). Motor (%): ")
    motor <- as.numeric(motor)  # převod řetězcena číslo
    
    # Kontrola zadání
    if (is.na(motor) | motor < 0 | motor > 100) {   # špatné zadání
        next    # skoč znovu na začátek cyklu
    }
    
    # trocha fyziky :-D
    zmenaRychlost <- 1.62 - 10*(motor*maxTah / hmotnost)
    vyska <- vyska - rychlost - zmenaRychlost/2
    rychlost <- rychlost + zmenaRychlost
    palivo <- palivo - (motor*maxTah/240)
    
    vysky <- c(vysky, vyska)   # přidání aktuální výšky do seznamu
    
    
    if (palivo <= 0) {  # došlo palivo, nastavíme maxTah na 0
        maxTah <- 0
        palivo <- 0
    }
    
    # Konec hry? Závěrečné vyhodnocení.
    if (vyska <= 0) {
        cat("Přistání. Rychlost:", rychlost, "m/s, palivo:", palivo, "kg\n")
        
        if (rychlost < 1) {
            znamka <- 0
            cat("Výborně s hvězdičkou :-)\n")
        } else if (rychlost < 2) {
            znamka <- 1
            cat("Výborně.\n")
        } else if (rychlost < 4) {
            znamka <- 2
            cat("Velmi dobře.\n")
        } else if (rychlost < 6) {
            znamka <- 3
            cat("Dobře.\n")
        } else if (rychlost < 10) {
            znamka <- 4
            cat("Dostatečně.\n")
        } else {
            znamka <- 5
            cat("Nedostačně.\n")
        }
        
        break  # ukonči cyklus
    }
}

zobrazGraf(konec = 1)  # zobrazí graf se závěrečnou zprávou


## Uložení rekordů do souboru s tabulkou
if (uroven != 0) {  # úroveň 0 se do rekordů nepočítá, protože je náhodná
    rekordy <- read.csv(souborRekordy, stringsAsFactors = FALSE, fileEncoding = "UTF-8")
    if (znamka != 5) {
        pozice <- which(rekordy$uroven == uroven  &  rekordy$znamka == znamka)
        row.names(rekordy)[pozice] <- "Tady --->"   # do jakého řádku hráč patří
        
        rekordyPalivo <- rekordy$palivo[pozice]
        if (is.na(rekordyPalivo) | rekordyPalivo < palivo) {
            cat("Gratuluji, je to rekord!\n")
            
            # Ukážeme, koho rekordman vystrčí
            print(rekordy)
            
            jmeno <- readline("Zadejte své ctěné jméno: ")
            rekordy$palivo[pozice] <- palivo
            rekordy$jmeno[pozice] <- jmeno
            write.csv(rekordy, souborRekordy, row.names = FALSE, fileEncoding = "UTF-8")
        }
    }
    
    cat("Tabulka rekordů\n")
    print(rekordy)
}

© 2. 12. 2015 Tomáš Bořil, borilt@gmail.com