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))

-1
-0.8
-0.6
-0.4
-0.2
0
0.2
0.4
0.6
0.8
1
0
100
200
300
400
500
600
700
800
900

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()

y
dalsi
-1
-0.8
-0.6
-0.4
-0.2
0
0.2
0.4
0.6
0.8
1
0
100
200
300
400
500
600
700
800
900

Popisky

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

Vývoj hodnoty v čase
Čas (s)
Hodnota
y
dalsi
-1
-0.8
-0.6
-0.4
-0.2
0
0.2
0.4
0.6
0.8
1
0
100
200
300
400
500
600
700
800
900

Grafy diskrétních veličin

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

y
dalsi
-1
-0.8
-0.6
-0.4
-0.2
0
0.2
0.4
0.6
0.8
1
0
100
200
300
400
500
600
700
800
900

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()

0
0.2
0.4
0.6
0.8
1
1.2
1.4
1
2
3
4
5
6
7
8
9
A
B

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))

y1
y2
3.00e-4
1.00e-3
3.00e-3
0.01
0.03
0.1
0.3
1
3
10
30
100
300
0.02
0.1
0.8
4
20
100
800
4000
20000

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)

y1
y2
0.0000000
1.0000000
2.0000000
3.0000000
4.0000000
5.0000000
6.0000000
1.0000000
1.5000000
2.0000000
2.5000000
3.0000000
3.5000000
4.0000000
4.5000000

# 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)}')

y1
y2
0
1
2
3
4
5
6
1
1.5
2
2.5
3
3.5
4
4.5

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

y1
y2
0
1
2
3
4
5
6
1
1.5
2
2.5
3
3.5
4
4.5

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")

DriversKilled
drivers
front
rear
kms
PetrolPrice
VanKilled
law
0
2000
4000
6000
8000
10000
12000
14000
16000
18000
20000
22000
1970
1980

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