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.
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áš")
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
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
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
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
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)
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))
dalsi <- cos(0.11*x)
dygraph(data.frame(x, y, dalsi)) %>% dyRangeSelector()
dygraph(data.frame(x, y, dalsi), main = "Vývoj hodnoty v čase") %>%
dyRangeSelector() %>%
dyAxis("x", label = "Čas (s)") %>%
dyAxis("y", label = "Hodnota")
dygraph(data.frame(x, y, dalsi)) %>%
dyRangeSelector() %>%
dySeries("dalsi", stemPlot = TRUE)
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()
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))
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)}')
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")
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