hoď ma hore
Milí diskutujúci. Pri diskutovaní prosím: 1. nepridávaj témy pozostávajúce len z odkazov alebo jednoslovné témy / 2. nepridávaj uražlivé alebo vulgárne komentáre. Ak tieto pravidlá nedodržíš, tvoja téma pravdepodobne skončí v koši. Príjemné diskutovanie :)
none
ak chceš diskutovať, musíš sa registrovať. registrácia

tu sa nachádzaš : 

hlavná stránka  /  počítače  /  téma

JAZYK R suhrn

príspevkov
23
zobrazení
0
tému vytvoril(a) 8.12.2015 13:46
posledná zmena 25.3.2019 11:20
1
08.12.2015, 13:46
nejake skripta
none
2
08.12.2015, 13:49
MARKDOWN


---
title: "pr1"
runtime: shiny
date: "20.december 2015"
output: html_document
---


```{r}
summary(cars)
```

You can also embed plots, for example:

```{r, echo=FALSE}
plot(cars)
```

Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.

*italic*

**bold**

x^2^

~~slovo~~

#Nadpis1
##Nadpis2
###Nadpis3

- zoznam

1. zlozka1


2. zlozka2
+ odsek1
+ odsek2

-- pomlcka
--- pomlcka dlhsia

odkaz

[Stranka tuke](odkaz

> citacia

********** kva kva

polozka | Polozka2 | polozka3
--------|----------|---------|
zaznam | zaznam2 | zaznam3

$A= \pi*r^{2}$

Tri plus tri je `r 3+3`

```{r}
dim(cars)
```

```{r, eval=FALSE}
dim(cars)
```

```{r scaterplot, fig.height=4, echo=FALSE}
x = rnorm(100); #rozmer grafu dlzka osi y; echo= nevidno kod iba graf
y = x+rnorm(100,sd = 0.5) #nahodne generovanie premennej, sd= chyba
par(mar = c(5,4,1,1), las = 1) #cisla vo vektore predstavuju cisla na osi x,y; las=1 vodorovna orientacia grafu
plot(x,y,main = "My simulated data")
```

#####################################################
---
title: "bla2"
runtime: shiny
output: html_document
---

Histogram trvania erupcie gejzira
```{r, echo=FALSE}
inputPanel( # toto je iba menu z ktoreho vyberam hodnoty
selectInput("nbreaks", label = "number of bins:", #rolovacie menu; radioInput=?
choices = c(10,20,30), selected = 30) #moznosti rolovacieho menu, selected= prednastavena hodnota
)

renderPlot({ #$konkretny stlpec ; renderplot vykresluje graf
hist(faithful$eruptions, breaks = as.numeric(input$nbreaks),
xlab = "Duration (minutes)", main = "geyser eruption duration")
}) # xlab = popis Xovej osi, main= nadpis v grafe
```
##########################################
---
title: "bla3"
output: ioslides_presentation
---

## R Markdown

This is an R Markdown presentation. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <odkaz

When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document.

## Slide s odrazkami

- Bullet 1
- Bullet 2
- Bullet 3

## Slide s R kodom a vystupom

```{r}
summary(cars)
```

## Slide s grafom

```{r, echo=FALSE}
plot(cars)
```

#########################################
none
3
08.12.2015, 13:51
DOPLNUJUCE PRE PRACE S TABULKOU ATD

X <- data.frame("var1"=sample(1:5),"var2"=sample(6:10),"var3"=sample(11:15))
X$var2[c(1,3)] = NA

X[,1] # výber všetkých riadkov a 1 stlpca
## [1] 5 1 3 2 4
X[,"var1"] # výber všetkých riadkov a stlpca s názvom "var1"
## [1] 5 1 3 2 4
X[1:2,"var2"] # výber 1 a 2 riadka a stlpca s názvom "var2"
## [1] NA 9
X[(X$var1 <= 3 & X$var3 > 11),] # výber riadkov, ktorý splňajú dané podmienky a všetky stlpce (& - a zároveň)
## var1 var2 var3
## 2 1 9 15
## 3 3 NA 14
## 4 2 8 12
X[(X$var1 <= 3 | X$var3 > 15),] # výber riadkov, ktorý splňajú jednu z daných podmienok a všetky slpce (| - alebo)
## var1 var2 var3
## 2 1 9 15
## 3 3 NA 14
## 4 2 8 12
X[which(X$var2 > 8),] # v?bersplňajú riadkov kde var2 > 8, which - ignorovanie NA hodnôt
## var1 var2 var3
## 2 1 9 15
X$d = rnorm(5) # pridanie stlpca d
Y = cbind(X,rnorm(5)) # vytvorenie tabulky/matice Y s dátami X a novým stlpcom

sort(X$var1) # usporiadanie premennej var1 zostupne(od najmenšieho po najväčšie)
## [1] 1 2 3 4 5
sort(X$var1,decreasing=TRUE) # usporiadanie premennej var1, vzostupne, default je FALSE
## [1] 5 4 3 2 1
sort(X$var2,na.last=TRUE) # usporiadanie var2, berie do úvahy aj prázdne hodnoty
## [1] 7 8 9 NA NA
X[order(X$var1),] # usporiadanie celého DF podľa premennej var1
## var1 var2 var3 d
## 2 1 9 15 -1.8081159
## 4 2 8 12 0.6881076
## 3 3 NA 14 -1.2450648
## 5 4 7 11 1.9832996
## 1 5 NA 13 0.8335864
X[order(X$var1,X$var3),] # viac premenných pre usporiadanie, usporiada potom podľa poradia v order
## var1 var2 var3 d
## 2 1 9 15 -1.8081159
## 4 2 8 12 0.6881076
## 3 3 NA 14 -1.2450648
## 5 4 7 11 1.9832996
## 1 5 NA 13 0.8335864
none
4
5
08.12.2015, 22:58
# Generovanie 10 náhodných čísel z NR
rnorm(10,mean=0,sd=1)
# Hustota pravdepodobnosti v bude 10 (výška rozdelenia v bode 10)
dnorm(10,mean=0,sd=1,log=FALSE)
dnorm(0,mean=0,sd=1,log=FALSE)
# Sumár hustoty pravdepodobnosti po daný bod (10) z ľava
pnorm(10, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE)

pnorm(0) # 0.5
pnorm(1) # 0.8413447
pnorm(0,lower.tail=FALSE) # 0.5
pnorm(1,lower.tail=FALSE) # 0.1586553

# Inverzná k pnorm, vráti bod pri zadaní určitej pravdepodobnosti
qnorm(0.5) # 0
qnorm(0.85) # 1.036433;
v=c(0.0,0.25,0.5,0.75,1.0)
qnorm(v) # [1] -Inf -0.6744898 0.0000000 0.6744898 Inf

rbinom(20, 100, prob = 0.1)
rbinom(20, 100, prob = 0.5)
dbinom(20, 40, prob = 0.5)
pbinom(30, 40, p = 0.5)
# Generovanie náhodných čísel
x <- rnorm(10)
x <- rnorm(10, 20, 2)
summary(x)

runif(3, min=0, max=100)
floor(runif(3, min=0, max=100))
sample(1:100, 3, replace=TRUE) # 3 krat integer od 1 po 100 s možnosťou znovu vybrať rovnaké číslo
sample(1:100, 3, replace=FALSE)

# Sample - generovanie vzoriek
set.seed(1)
sample(1:10, 4)
sample(1:10, 4)
sample(letters, 5)
sample(1:10) # permutácia prvkov od 1 do 10
sample(1:10)
sample(1:10, replace = TRUE) # výber s nahradením (môžu sa opakovať prvky)

set.seed(158)
rnorm(5)
rnorm(5)
set.seed(158)
rnorm(10)
*********************************************
# Generovanie lineárneho modelu
set.seed(20)
x <- rnorm(100)
e <- rnorm(100, 0, 2)
y <- 0.5 + 2 * x + e
summary(y)
plot(x, y)
abline(lm(y~x))

set.seed(1)
x <- rnorm(100)
log.mu <- 0.5 + 0.3 * x
y <- rpois(100, exp(log.mu))
summary(y)
plot(x, y)

generuj2D2k = function(){
d = 0
while(d<1.0){
s = rnorm(4)
d = sqrt((s[1]-s[2])^2 + (s[3]-s[4])^2)
}
x1 = s[1] + rnorm(50,0,0.5)
x2 = s[2] + rnorm(50,0,0.5)
y1 = s[3] + rnorm(50,0,0.5)
y2 = s[4] + rnorm(50,0,0.5)
data.frame(a = c(x1,x2), b = c(y1,y2),f = factor(c(rep("A",50),rep("B",50))))
}

set.seed(12548)
mydata = generuj2D2k()
plot(mydata$a,mydata$b,col=mydata$f)
****************************************************
x <- rnorm(30)
ks.test(x, pnorm)
ks.test(x, punif)

x = rnorm(50)
y = rnorm(50)
z = runif(50)
ks.test(y,z)

# Lineárne rovnice
A = matrix(nrow = 3, ncol = 3, data = c(6, 1, 2, 3, -3, 1, -2, 2, 1))
b = c(2,5,9)
solve(A,b)
A2 = matrix(nrow = 4, ncol = 4, data=c(4,3,2,5,-3,-2,-1,-3,2,1,0,1,-1,-3,5,-8))
b2 = c(8,7,6,1)
solve(A2,b2)

# Nelineárne rovnice
# PrĂ­klad 2cos(x) - ln(x) = 0
curve(2*cos(x), 0, 10)
curve(log(x), add = TRUE, col="red")
f = function(x) 2*cos(x) - log(x)
uniroot(f,lower=0,upper=2, tol=1e-9)
uniroot(f,lower=4,upper=6, tol=1e-9)
uniroot(f,lower=6,upper=7, tol=1e-9)

## x3+2x+4=0
polyroot(c(4,2,0,1))

# Diferenciálne rovnice
# install.packages("deSolve")
library(deSolve)
logist <- function(t, x, parms) {
with(as.list(parms), {
dx <- r * x[1] * (1 - x[1]/K)
list(dx)
})
}
time <- 0:100
N0 <- 0.1
r <- 0.5
K <- 100
parms <- c(r = r, K = K)
x <- c(N = N0)
plot(time, K/(1 + (K/N0-1) * exp(-r*time)), ylim = c(0, 120),
type = "l", col = "red", lwd = 2)

time <- seq(0, 100, 2)
out <- as.data.frame(rk4(x, time, logist, parms))
points(out$time, out$N, pch = 16, col = "blue", cex = 0.5)
time <- seq(0, 100, 2);
out <- as.data.frame(euler(x, time, logist, parms))
points(out$time, out$N, pch = 1)
legend("bottomright", c("analytical","rk4, h=2", "euler, h=2"),
lty = c(1, NA, NA), lwd = c(2, 1, 1), pch = c(NA, 16, 1),
col = c("red", "blue", "black"))
****************************************************************
# Lineárna regresia
x = c(3,8,9,3,13,6,11,21,1,16)
y = c(30,57,64,72,36,43,59,90,20,83)
mydata = data.frame(x,y)
model = lm(y ~ x, data=mydata)
model
plot(mydata)
abline(model)

pr1 <- data.frame(x = c(10,15,20))
pr1$y <- predict(model, newdata = pr1)

# Viacnásobná regresia
year <- rep(2008:2010, each = 4)
quarter <- rep(1:4, 3)
cpi <- c(162.2, 164.6, 166.5, 166, 166.2, 167,
168.6, 169.5, 171, 172.1, 173.3, 174)
plot(cpi, xaxt = "n", ylab = "CPI", xlab = "")
# vykresli popis x-osi, kde 'las=3' zabezpeci vertikalny text
axis(1, labels = paste(year, quarter, sep = "Q"), at = 1:12, las = 3)
fit <- lm(cpi ~ year + quarter)
data2011 <- data.frame(year = 2011, quarter = 1:4)
cpi2011 <- predict(fit, newdata = data2011)
style <- c(rep(1, 12), rep(2, 4))
plot(c(cpi, cpi2011), xaxt = "n",ylab = "CPI", xlab = "",pch = style, col = style)
axis(1, at = 1:16, las = 3,
labels = c(paste(year, quarter, sep = "Q"), "2011Q1", "2011Q2", "2011Q3", "2011Q4"))
*******************************************************************************
# Interpolácia
set.seed(1)
n <- 500
dat <- data.frame(
x = 1:n,
y = sin(seq(0, 5*pi, length.out = n)) + rnorm(n=n, mean= 0, sd=0.5)
)

approxData <- data.frame(with(dat, approx(x, y, method = "linear")),
metoda = "approx")
splineData <- data.frame(with(dat, spline(x, y) ),metoda = "spline default")
splineData2 <- data.frame(with(dat, spline(x, y, xout = seq(1, n, by = 10), method = "fmm") ), metoda = "spline krok 10")
smoothData <- data.frame(x = 1:n, y = as.vector(smooth(dat$y)), metoda = "smooth")
loessData <- data.frame(x = 1:n, y = predict(loess(y~x, dat, span = 0.1)), metoda = "loess span 0.1")
loessData2 <- data.frame(x = 1:n, y = predict(loess(y~x, dat, span = 0.5)), metoda = "loess span 0.5")
library(ggplot2)
ggplot(rbind(approxData, splineData, splineData2, smoothData, loessData, loessData2), aes(x, y)) + geom_point(dat = dat, aes(x, y), alpha = 0.2, col = "red") + geom_line(col = "blue") + facet_wrap(~metoda) + ggtitle("Príklad - vybrané interpolačné a vyhladzovacie funkcie v R") + theme_bw(16)

# Lineárne programovanie
# install.packages("lpSolveAPI")
library(lpSolveAPI)
lpmodel <- make.lp(0, 2)
lp.control(lpmodel, sense="max") # maximalizacia
set.objfn(lpmodel, c(143, 60)) # definicia KF (v anglictine casto objective function)
add.constraint(lpmodel, c(120, 210), "<=", 15000)
add.constraint(lpmodel, c(110, 30), "<=", 4000)
add.constraint(lpmodel, c(1, 1), "<=", 75)
lpmodel
solve(lpmodel)
get.objective(lpmodel)
get.variables(lpmodel)

# Celočíselné programovanie
# install.packages("lpSolve")
library(lpSolve)
assign.costs <- matrix (c(7, 7, 3, 2, 2, 7, 7, 2, 1, 9, 8, 2, 7, 2, 8, 10), 4, 4)
lp.assign (assign.costs)
lp.assign (assign.costs)$solution

# Optimalizácia v R
library(TSP)
# vytvorenie dát – náhodných „miest“, mená priradené z letters konštanty
df <- data.frame(x = runif(20), y = runif(20), row.names = LETTERS[1:20])
# vytvorenie Euklidovskeho TSP
etsp <- ETSP(df)
# výpis detailov – počet miest, názvy miest
n_of_cities(etsp) # vypíše [1] 20
labels(etsp) # vypíše názvy [1] "A" "B" "C" ....
# nájdenie riešenia a jeho vykreslenie
tour <- solve_TSP(etsp)
tour
plot(etsp, tour, tour_col = "red")
none
6
09.12.2015, 06:25
Milka a nechces nam povedat, aj co to robi?
none
7
10.12.2015, 14:24
LINEARNY MODEL KAMARAT
# Generovanie lineárneho modelu
set.seed(20)
x <- rnorm(100)
e <- rnorm(100, 0, 2)
y <- 0.5 + 2 * x + e
summary(y)
plot(x, y)
abline(lm(y~x))

set.seed(1)
x <- rnorm(100)
log.mu <- 0.5 + 0.3 * x
y <- rpois(100, exp(log.mu))
summary(y)
plot(x, y)

generuj2D2k = function(){
d = 0
while(d<1.0){
s = rnorm(4)
d = sqrt((s[1]-s[2])^2 + (s[3]-s[4])^2)
}
x1 = s[1] + rnorm(50,0,0.5)
x2 = s[2] + rnorm(50,0,0.5)
y1 = s[3] + rnorm(50,0,0.5)
y2 = s[4] + rnorm(50,0,0.5)
data.frame(a = c(x1,x2), b = c(y1,y2),f = factor(c(rep("A",50),rep("B",50))))
}

set.seed(12548)
mydata = generuj2D2k()
plot(mydata$a,mydata$b,col=mydata$f)
none
8
10.12.2015, 14:24
x <- rnorm(30)
ks.test(x, pnorm)
ks.test(x, punif)

x = rnorm(50)
y = rnorm(50)
z = runif(50)
ks.test(y,z)

# Lineárne rovnice
A = matrix(nrow = 3, ncol = 3, data = c(6, 1, 2, 3, -3, 1, -2, 2, 1))
b = c(2,5,9)
solve(A,b)
A2 = matrix(nrow = 4, ncol = 4, data=c(4,3,2,5,-3,-2,-1,-3,2,1,0,1,-1,-3,5,-8))
b2 = c(8,7,6,1)
solve(A2,b2)
none
9
10.12.2015, 14:24
# Lineárna regresia
x = c(3,8,9,3,13,6,11,21,1,16)
y = c(30,57,64,72,36,43,59,90,20,83)
mydata = data.frame(x,y)
model = lm(y ~ x, data=mydata)
model
plot(mydata)
abline(model)

pr1 <- data.frame(x = c(10,15,20))
pr1$y <- predict(model, newdata = pr1)

# Viacnásobná regresia
year <- rep(2008:2010, each = 4)
quarter <- rep(1:4, 3)
cpi <- c(162.2, 164.6, 166.5, 166, 166.2, 167,
168.6, 169.5, 171, 172.1, 173.3, 174)
plot(cpi, xaxt = "n", ylab = "CPI", xlab = "")
# vykresli popis x-osi, kde 'las=3' zabezpeci vertikalny text
axis(1, labels = paste(year, quarter, sep = "Q"), at = 1:12, las = 3)
fit <- lm(cpi ~ year + quarter)
data2011 <- data.frame(year = 2011, quarter = 1:4)
cpi2011 <- predict(fit, newdata = data2011)
style <- c(rep(1, 12), rep(2, 4))
plot(c(cpi, cpi2011), xaxt = "n",ylab = "CPI", xlab = "",pch = style, col = style)
axis(1, at = 1:16, las = 3,
labels = c(paste(year, quarter, sep = "Q"), "2011Q1", "2011Q2", "2011Q3", "2011Q4"))
none
10
10.12.2015, 14:25
# Interpolácia
set.seed(1)
n <- 500
dat <- data.frame(
x = 1:n,
y = sin(seq(0, 5*pi, length.out = n)) + rnorm(n=n, mean= 0, sd=0.5)
)

approxData <- data.frame(with(dat, approx(x, y, method = "linear")),
metoda = "approx")
splineData <- data.frame(with(dat, spline(x, y) ),metoda = "spline default")
splineData2 <- data.frame(with(dat, spline(x, y, xout = seq(1, n, by = 10), method = "fmm") ), metoda = "spline krok 10")
smoothData <- data.frame(x = 1:n, y = as.vector(smooth(dat$y)), metoda = "smooth")
loessData <- data.frame(x = 1:n, y = predict(loess(y~x, dat, span = 0.1)), metoda = "loess span 0.1")
loessData2 <- data.frame(x = 1:n, y = predict(loess(y~x, dat, span = 0.5)), metoda = "loess span 0.5")
library(ggplot2)
ggplot(rbind(approxData, splineData, splineData2, smoothData, loessData, loessData2), aes(x, y)) + geom_point(dat = dat, aes(x, y), alpha = 0.2, col = "red") + geom_line(col = "blue") + facet_wrap(~metoda) + ggtitle("Príklad - vybrané interpolačné a vyhladzovacie funkcie v R") + theme_bw(16)

# Lineárne programovanie
# install.packages("lpSolveAPI")
library(lpSolveAPI)
lpmodel <- make.lp(0, 2)
lp.control(lpmodel, sense="max") # maximalizacia
set.objfn(lpmodel, c(143, 60)) # definicia KF (v anglictine casto objective function)
add.constraint(lpmodel, c(120, 210), "<=", 15000)
add.constraint(lpmodel, c(110, 30), "<=", 4000)
add.constraint(lpmodel, c(1, 1), "<=", 75)
lpmodel
solve(lpmodel)
get.objective(lpmodel)
get.variables(lpmodel)

# Celočíselné programovanie
# install.packages("lpSolve")
library(lpSolve)
assign.costs <- matrix (c(7, 7, 3, 2, 2, 7, 7, 2, 1, 9, 8, 2, 7, 2, 8, 10), 4, 4)
lp.assign (assign.costs)
lp.assign (assign.costs)$solution

# Optimalizácia v R
library(TSP)
# vytvorenie dát – náhodných „miest“, mená priradené z letters konštanty
df <- data.frame(x = runif(20), y = runif(20), row.names = LETTERS[1:20])
# vytvorenie Euklidovskeho TSP
etsp <- ETSP(df)
# výpis detailov – počet miest, názvy miest
n_of_cities(etsp) # vypíše [1] 20
labels(etsp) # vypíše názvy [1] "A" "B" "C" ....
# nájdenie riešenia a jeho vykreslenie
tour <- solve_TSP(etsp)
tour
plot(etsp, tour, tour_col = "red")
none
11
10.12.2015, 14:30
# Nelineárne rovnice
# Príklad 2cos(x) - ln(x) = 0
curve(2*cos(x), 0, 10)
curve(log(x), add = TRUE, col="red")
f = function(x) 2*cos(x) - log(x)
uniroot(f,lower=0,upper=2, tol=1e-9)
uniroot(f,lower=4,upper=6, tol=1e-9)
uniroot(f,lower=6,upper=7, tol=1e-9)
none
21

11. 10.12.2015, 14:30

# Nelineárne rovnice
# Príklad 2cos(x) - ln(x) = 0
curve(2*cos(x), 0, 10)
curve(log(x), add = TRUE, col="red")
f = function(x) 2*cos(x) - log(x)
uniroot(f,lower=0,upper=2, tol=1e-9)
uniroot(f,lower=4,upper=6, tol=1e-9)
uniroot(f,lower=6,upper=7, tol=1e-9)

25.03.2019, 11:18
# vytvorenie funkcie
f2 <- function(x) { #vytvorenie funkcie pomocou funkcie function(), ktora ma sovje argumenty(vstupne hodnoty) a telo funkcie(kod funkcie)
x^2
}

f <- function(x,y) #funkcia moze napriklad pocitat
{
x + y #sucet
x - y #odcitavanie
x * y #nasobenie
x / y #delenie
}


# if, else - testovacia podmienka
x <- 0
if (x > 0) {
print("Kladne cislo")
} else if (x < 0) {
print("Zaporne cislo")
} else
print("Nula")

# FOR - cyklus s poctom opakovani
f = seq(1,100, by = 2)
a = NULL
for (i in 1:50)
{
a[i] = f[i]^2
}
print(a)
#FOR, NEXT - prekoci iteraciu cyklu
for(i in 1:100)
{
if(i <= 50)
{
next
}
print(i)
}

# WHILE - cyklus pokial je spnena podmienka
count <- 0
while(count < 10)
{
print(count)
count <- count + 1
}

# REPEAT - spusta nekonecny cyklus, BREAK - ukonci cyklus
sum <- 1
repeat
{
sum <- sum + 2
print(sum)
if (sum > 11)
break
}

# LAZY - funkcia s nepotrebnymi argumentmi
f <- function(a,b)
{
a^2
}
f(2)

f <- function(x, y = 2) {
x^y
}

# ARGUMENT
args(paste)
paste("a","h","o","j")
paste("a","h","o","j",sep=":")
paste("a","h","o","j",se=":")

# Lexikalny/dynamicky SCOPING
p = 0
f = function(x){ #funkcia f sa odkazuje na funkciu g
p = 10
p + g(x)
}

g = function(x){
x+p
}
f(2)
#
f <- function(x)
{
y <- 5
x + y
}

# funkcie pre cyklické spracovanie
# APPLY - aplikuje funkciu cez ohraničenia poľa
M <- matrix(1:6,3,2)
apply(M,2,sum) # sucet stlpcov
apply(M,1,sum) # sucet riadkov
apply(M,1,mean) # priemer riadkov
apply(M,2,mean) # priemer stlpcov

x <- matrix(rnorm(12), 4, 3)
apply(x, 1, quantile, probs = c(0.25, 0.75)) # vypocet kvantuli

a <- array(rnorm(2*2),c(2,2,10)) # 40 prvkov, velkost 2x2 a 10 krat
apply(a,c(1,2),mean) # vypocet priemeru

m <- matrix(c(1:10, 11:20), nrow = 10, ncol = 2)
m
apply(m, 1:2, function(x) x/2)
#


#LAPPLY, SAPPLY - evaluacia funkcie nad kazdym elementom
X = list(a = 1:5, b = 6:10)
lapply(X,mean)
sapply(X,mean)

lapply(X,quantile)
lapply(X,quantile,c(0,0.5,1))
lapply(X,quantile,probs = seq(0,1,0.5))

sapply(X,quantile)
sapply(X,quantile,c(0,0.5,1))
sapply(X,quantile,probs = seq(0,1,0.5))

##
x <- list(a = 1, b = 1:3, c = 10:100)
lapply(x, FUN = length)
sapply(x, FUN = length)
lapply(x, FUN = sum)
sapply(x, FUN = sum)

#
Y <- list(a = matrix(1:4,2,2),b = matrix(1:8,4,2))
lapply(Y,function(element) element[,1])


x1 <- list(a = matrix(1:4, 2, 2), b = matrix(1:6, 3, 2))
lapply(x1, function(elt) elt[,1])

#TAPPLY - aplikuje funkciu na podmnozinu vektora, SPLIT - pomocna funkcia
x <- 1:20
y <- factor(rep(letters[1:5], each = 4))
tapply(x, y, sum)
tapply(x,y,sum,simplify = FALSE)
split(x,y)
#
attach(iris)
tapply(iris$Petal.Length, Species, mean)
tapply(iris$Petal.Length, Species, mean,simplify = FALSE)

split(iris$Petal.Length,Species,drop=FALSE)

#MAPPLY - multivarietna verzia mapply
l1 <- list(a = c(1:10), b = c(11:20))
l2 <- list(c = c(21:30), d = c(31:40))

mapply(sum, l1$a, l1$b, l2$c, l2$d)

mapply(sum,1:5,1:5,1:5)

mapply(rep, 1:4, 4:1)
none
12
15.11.2016, 14:15
srnka opat zasahuje :D
################################################################################
#1.uloha
pr= data.frame(Poc_rokov= c(3,8,9,13,3,6,11,21,1,16), Prijem= c(30,57,64,72,36,43,59,90,20,83))
#linearny model
model = lm(Prijem ~ Poc_rokov, data = pr)
pr$predicted = predict(model, newdata = pr)
#pre viacero hodnot data frame
pr1 = data.frame(Poc_rokov= c(10,15,20))
pr1$Prijem = predict(model,newdata = pr1)
View(pr1)

###################################################################################
#viacnasobna (linearna)regresia= viac atributov, numericke hodnoty
state= data.frame(state.x77)
model1 = lm(Murder ~ Illiteracy + Life.Exp, data = state)
state$Murder_Predict = predict(model1,newdata = state)
View(state)
#graf y hodnot ktore boli dane a potom predicovane
plot(1:nrow(state),state$Murder, col = "blue", type = "b")
#a potom predicovane
lines(1:nrow(state),state$Murder_Predict, col = "red", type = "b")
#ake este info, dopyty
attributes(model1)
summary(model1)
# *** najvyznamnejsi atribut pre vyslednu hodnotu


#################################################################################
#rozhodovcaci strom pre iris
iris = data.frame(iris)
ind = sample(2,nrow (iris), replace=TRUE, prob = c(0.7,0.3)) # replace moze sa opakovat
train.data = iris[ind == 1,] # 109 zaznamov
test.data = iris[ind == 2,]
myformula = Species ~ Sepal.Length+Sepal.Width+Petal.Length
install.packages("party")
library(party)
iris_ctree = ctree(myformula,data = train.data)
table(predict (iris_ctree), train.data$Species)
plot(iris_ctree)
plot(iris_ctree,type = "simple")
#testujem na testovacich datach
testPred = predict (iris_ctree,newdata= test.data)
test.data$Species
# ctrl + enter spustam script :D
table(testPred,test.data$Species)
#################################################################################
#rozhodovaci strom CO2
CO2 = data.frame(CO2)
CO2$Plant=NULL
set.seed(8)
ind = sample(2,nrow (CO2), replace=TRUE, prob = c(0.6,0.4))
train.data = CO2[ind == 1,]
test.data = CO2[ind == 2,]
myformula = Treatment~.
co2_ctree = ctree(myformula, data = train.data)
table(predict (co2_ctree ), train.data$Treatment)
plot(co2_ctree )
testPred = predict (co2_ctree, newdata = test.data)
test.data$Treatment
table(testPred, test.data$Treatment)
tbl = table(testPred, test.data$Treatment)
P=(tbl[1]+tbl[4])/ (tbl[1]+tbl[2]+tbl[3]+tbl[4])
###########################################################
#bayers
install.packages("e1071")
library(e1071)

classifier = naiveBayes(iris[,1:4], iris[,5])
table(predict(classifier,iris[,-5]), iris[,5])

classifier = naiveBayes(CO2[,3:4],CO2[,2])
table(predict(classifier,CO2[,3:4]), CO2[,2])

classifier = naiveBayes(CO2[,3:4],CO2[,1])
table(predict(classifier,CO2[,3:4]), CO2[,1])



############################################################
#6.uloha
set.seed(1234)
iris1=iris
iris1$Species=NULL
ind = sample(2,nrow (iris), replace=TRUE, prob = c(0.7,0.3))
iris.training = iris1[ind == 1,]
iris.test = iris1[ind == 2,]
iris.test= iris
iris.trainLabels =iris[ind==1,5]
iris.testLabels =iris[ind==2,5]
library(class)
iris_pred= knn(train=iris.training, test=iris.test,cl=iris.trainLabels,k=3)
iris_pred
iris.testLabels
sum(iris.testLabels==iris_pred) / length(iris.testLabels)
#kontingencna tabulka
table(iris_pred,iris.testLabels)

###################################################################
#7.uloha
set.seed(1234)
iris1=iris
iris1$Species=NULL
ind = sample(2,nrow(iris), replace = TRUE, prob = c(0.7,0.3))
iris.training<-iris1[ind==1,]
iris.test<-iris1[ind==2,]
iris.trainLabels=iris[ind==1,5]
iris.testLabels=iris[ind==2,5]
library(class)
iris_pred=knn(train=iris.training, test=iris.test, cl=iris.trainLabels, k=3)
iris_pred
iris.testLabels
sum(iris.testLabels=iris_pred) / lenght(iris.testLabels)
table(iris_pred, iris.testLabels)
none
22

12. 15.11.2016, 14:15

srnka opat zasahuje :D
################################################################################
#1.uloha
pr= data.frame(Poc_rokov= c(3,8,9,13,3,6,11,21,1,16), Prijem= c(30,57,64,72,36,43,59,90,20,83))
#linearny model
model = lm(Prijem ~ Poc_rokov, data = pr)
pr$predicted = predict(model, newdata = pr)
#pre viacero hodnot data frame
pr1 = data.frame(Poc_rokov= c(10,15,20))
pr1$Prijem = predict(model,newdata = pr1)
View(pr1)

################...

25.03.2019, 11:20
#nacitanie dat
download.file("odkaz #stiahnutie dát
pollution <- read.csv("avgpm25.csv", colClasses = c("numeric", "character","factor", "numeric", "numeric")) #uloženie dát
head(pollution) #zobrazí prvých 6 riadkov
#sumar dat
summary(pollution$pm25)
#1D
#BOXPLOT - sumar dat v grafe
boxplot(pollution$pm25, col = "blue") # boxplot atributu pm25, farba modra
abline(h = 12) # boxplot s pridanou ciarou na cisle 12, h=horizontalna
#HISTOGRAM - pocetnosti v intervaloch - frekvencie vyskytu
hist(pollution$pm25, col = "green") # histogram pm25, zelena farba
abline(v = 12, lwd = 2) # pridanie ciary vertikalne na cislo 12, hrubka 2
abline(v = median(pollution$pm25), col = "magenta", lwd = 4) # ciara na mediane, ruzovou farbou, hrubka 4
hist(pollution$pm25, col = "green", breaks = 100) # histogram pm25, breaks = rozdelenie v grafe
#rug(pollution$pm25) #zastupenie cisel - konkretne cislo v intrevale
#BARPLOT - stlpcovy graf - pre stlpec region, s danou farbou a nadpisom
barplot(table(pollution$region), col = "wheat", main = "Number of Counties in Each Region")

#2D extrapolácie dát - pre viacero atributov (viacero boxplotov, histogramov, ...)
# BOXPLOT pre 2 atributy
boxplot(pm25 ~ region, data = pollution, col = "yellow")
boxplot(pollution$pm25 ~ pollution$region, col = "green")
# 2 x HISTOGRAM
par(mfrow = c(2, 1), mar = c(4, 4, 2, 1)) # nastavenie pre rozdelenie grafov, 2 riadky/1stlpec, mar(dole,vlavo,hore,vpravo)
#par(mfcol = c(1, 2), mar = c(5, 4, 2, 1))
hist(subset(pollution, region == "east")$pm25, col = "blue") # histogram pre podmnozinu dat (subset)
hist(subset(pollution, region == "west")$pm25, col = "red")
# BODOVY GRAF - SCATTERPLOT
with(pollution, plot(latitude, pm25)) # scatterplot (bodovy graf) z dat pollution, atributy latitude, pm25
abline(h = 12, lwd = 2, lty = 2) # pridanie horizontalnej ciary, s hrubkou 2 a typ ciary 2(prerusovany)
with(pollution, plot(latitude, pm25, col = region)) # scatterplot (bodovy graf) z dat pollution, pre latitude a pm25, rozdelenie farieb podla hodnoty region
abline(h = 12, lwd = 2, lty = 1)
legend(x="topright", legend = levels(pollution$region), col=c("red","black"), pch=1) # legenda, vpravo hore, nazvy legendy su levely v regione, farby, typ oznacenia
dev.off()

#BASE plot
library(datasets)
data(cars)
#SCATTERPLOT
with(cars, plot(speed, dist)) # scatterplot z dat cars, pre speed a dist
plot(cars)
#data airquality
hist(airquality$Ozone)
with(airquality, plot(Wind, Ozone))
title(main = "Ozone and Wind in New York City")
airquality <- transform(airquality, Month = factor(Month)) # transformacia stlpca Month v datach airquality na faktor
boxplot(Ozone ~ Month, airquality, xlab = "Month", ylab = "Ozone (ppb)") # vytvorenie boxplotu pre stlpce Ozone, Month a oznacenie osi x,y
# default values pomocou funkcie PAR
par("lty") #typ ciary
par("col") #farba
par("pch") #typ oznacenia - symbol body
par("bg") #farba pozadia
par("mar") #pozicia - nastavenie okrajov grafov
par("mfrow") #rozdelenie grafov - 1/2/3/4

# vytvorenie grafu z dat airquality, pre stlpce Wind, Ozone, s nadpisom (main) a typom "n" (bez bodov)
with(airquality, plot(Wind, Ozone, main = "Ozone and Wind in New York City ", type = "n"))
with(subset(airquality, Month == 5), points(Wind, Ozone, col = "blue")) #vsetky rovne 5, points = vykreslovanie bodov
with(subset(airquality, Month != 5), points(Wind, Ozone, col = "red"))
legend("topright", pch = 1, col = c("blue", "red"), legend = c("May", "Other Months"))
model = lm(Ozone ~ Wind, airquality) # vytvorenie modelu pomocou linearnej regresie zo stlpcov Ozone, Wind
abline(model, lwd = 2) # pridanie ciary pomocou vytvoreneho modelu s hrubkou 2

par(mfrow = c(1, 3), mar = c(4, 4, 2, 1), oma = c(0, 0, 2, 0)) #okraje grafu, velkost vonkajsieho grafu
with(airquality, {
plot(Wind, Ozone, main = "Ozone and Wind")
plot(Solar.R, Ozone, main = "Ozone and Solar Radiation")
plot(Temp, Ozone, main = "Ozone and Temperature")
mtext("Ozone and Weather in New York City", outer = TRUE)
})
dev.off()

# LATTICE Plot
library(lattice)
state <- data.frame(state.x77, region = state.region) # vytvorenie data.frame s hodnotami state.x77 a state.region
xyplot(Population~Murder,state) #bodovy graf SCATTER plot
bwplot(Population~region,state) #BOXPLOT
stripplot(Population~region,state) #verzia boxplotu - s konkrétnymi bodmi
histogram(Population~Murder,state) #HISTOGRAM
# xy plot so stlpcami Life.Exp a Income, rozdelenie dat podla regionu, pre data state a s rozmiestnenim 4 grafov v 1 riadku
xyplot(Life.Exp ~ Income | region, data = state, layout = c(4, 1))

p <- xyplot(Ozone ~ Wind, data = airquality) # vytvori graf, ale nevykresli
print(p) #vykresli vytvoreny graf
xyplot(Ozone ~ Wind, data = airquality) # Vykresli

#vykreslenie 2 panelov pre lattice
set.seed(10)
x <- rnorm(100)
f <- rep(0:1, each = 50) # 0 a 1 po 50x
y <- x + f - f * x + rnorm(100, sd = 0.5) # vypocet y podla vzorca
f <- factor(f, labels = c("Group 1", "Group 2")) # nastavenie prem. f na faktor s hodnotami Group1 a Group2
xyplot(y ~ x | f, layout = c(2, 1))

xyplot(y ~ x | f, panel = function(x, y, ...) {
panel.xyplot(x, y, ...) # volanie default panelovu funkciu
panel.abline(h = median(y), lty = 2) # pridanie horizontalnej ciary pre median
})
# pridanie regresnej priamky
xyplot(y ~ x | f, panel = function(x, y, ...) {
panel.xyplot(x, y, ...)
panel.lmline(x, y, col = 2) # pridanie regresnej priamky
})

# GGPLOT2
library(ggplot2)
data(mpg) # nacitanie dat mpg
qplot(displ, hwy, data = mpg) # vytvorenie qplot z atributov displ (x-ovy), hwy (y-ovy) z dat mpg
qplot(displ, hwy, data = mpg, color = drv) # rozdelenie garfu farebne podla stributu drv
qplot(displ, hwy, data = mpg, geom = c("point", "smooth")) # pridanie geom. prvku - vloženie hladkej krivky
qplot(hwy, data = mpg, fill = drv) # histogram pre stlpec hwy, z dat mpg, cez faktor drv
qplot(displ, hwy, data = mpg, facets = . ~ drv) # pouzitie facets na zobrazenie viacero grafov cez faktor drv
qplot(hwy, data = mpg, facets = drv ~ .) # histogram pre hwy pre jednotlive faktory z prvkov drv

#vytvorenie PDF a ulozenie v subore
pdf(file = "myplot.pdf")
png(file = "plot.png")
xyplot(Life.Exp ~ Income | region, data = state, layout = c(4, 1))
dev.off()
#pouzitim dev.copy
with(faithful, plot(eruptions, waiting))
title(main = "Old Faithful Geyser data")
dev.copy(png, file = "geyserplot.png")
dev.off()
none
13
15.11.2016, 14:16
#1uloha - K means
iris2=iris
iris2$Species=NULL
(kmeans.results= kmeans(iris2,3)) #cele do zatvoriek vypise, inak do listu ulozi
table(iris$Species,kmeans.results$cluster) #14+2 chyb
plot(iris2[c("Sepal.Length", "Sepal.Width")], col = kmeans.results$cluster)
points(kmeans.results$centers[, c("Sepal.Length", "Sepal.Width")], col = 1:3,pch = 8,cex=2) #priradime body,typ bodu=pch a velkost bodu=cex
###################################################################
##2. K-means(Mtcars)
mtcars1 = mtcars
kmeans.results1 = kmeans(mtcars1, 2)
table(mtcars1$vs,kmeans.results1$cluster)
plot(mtcars1[c("hp", "drat")], col = kmeans.results1$cluster)
points(kmeans.results1$centers[,c("hp", "drat")], col=1:3, pch=8, cex=2)
##################################################################
#3. Hierarchisck0 zhlukovanie(Iris)
set.seed(2835)
idx=sample(1:dim(iris)[1], 40)
irisSample=iris[idx,]
irisSample$Species=NULL
hc=hclust(dist(irisSample),method="ave")
plot(hc,hang=-1, labels=iris$Species[idx])
rect.hclust(hc, k=3)
irisSample$groups=cutree(hc, k=3)
#########################################################
#4.hierarchicke zhlukovanie= hierarchia rozdelenia a nasledne priradenie tried
mtcars1= mtcars
set.seed(2835)
idx= sample(1:dim(iris)[1],40) # vybera rozne od 1 po pocet dat iris, a 40 nahodnych vzorov
irisSample= iris[idx,]
irisSample$Species=NULL
hc = hclust(dist(irisSample), method = "ave")
plot(hc, hang = -1,labels = iris$Species[idx])
rect.hclust(hc,k=3)
#pridavam stlpec
irisSample$groups = cutree(hc, k = 3)
##############################################################
#asociacne pravidla
download.file("odkaz, destfile = "titanic.csv")
titanic=read.csv("titanic.csv", header = TRUE, sep = ",")
install.packages("arules")
library(arules)
rules = apriori(titanic,control = list(verbose=F),
parameter = list(minlen = 2, supp= 0.005,conf = 0.8),
appearance = list(rhs=c("Survived=No","Survived=Yes"), default = "lhs"))
rules.sorted= sort(rules, by="lift")
inspect(rules.sorted)
subset.matrix = is.subset(rules.sorted,rules.sorted)
subset.matrix[lower.tri(subset.matrix,diag = T)]=NA
redundant = colSums(subset.matrix,na.rm = T)>=1
which(redundant)
rules.prudend= rules.sorted[!redundant]
inspect(rules.prudend)
none
14
15.11.2016, 17:24
#########K-means Mtdata
mtcars1=mtcars
View(mtcars1)
mtcars1 = mtcars1[,4:5] #len urcite stlpce vyberiem
kmeans.results1=kmeans(mtcars1,2) #do dvoch zhlukov
table(mtcars$vs, kmeans.results1$cluster) #kontingencna tab
plot(mtcars1[c("hp", "drat")], col=kmeans.results1$cluster) # graf, farebne podla zhlukov
points(kmeans.results1$centers[,c("hp", "drat")], col=1:3, pch=8, cex=2) #priradime body, velkost pch a typ bodu cex



######Hierarchice zhlukovanie (Mtcars)
View(mtcars2)
mtcars2=mtcars[,c(1,7)] #vyberam vs. riadky mt cars a stlpce mpg(1) a qsec(7)
hc2=hclust(dist(mtcars2), method = "average") #do hc uloz vysled.hierarch.zhlukovania z irisSample, metoda ako priemer vzdialenosti medyi zhlukmi
plot(hc, hang = -1, labels = mtcars2$drat) #dentogram
rect.hclust(hc, k=3) #rozdelit zhluky ci ich spravne, cize orezat na uroven 3 zhlukov #rozdelila som tie stvorceky do skupin , aby som to pekne videla v tab
mtcars$groups=cutree(hc, k=3) #novy stlpec groups, obshuje ID zoskanych zhlukov
none
15
28.03.2018, 20:55
set.seed(10)
install.packages("data.table")
library(data.table)
tabulka = data.table(A = rnorm(10),
B = 1:10,
C= 10:1,
D= rep(c("a","b"),each=5)
)
tabulka[2,1]=NA
tabulka[4,1]=NA
tabulka

tabulka[c(1,3,5,6,7,8,9,10),mean(A)]
tabulka[,E:=B^2]
tabulka[,F:=sum(B),by=D]
none
16
28.03.2018, 21:43
set.seed(10)
tabulka= data.table(A=rnorm(10), B=1:10, C=10:1, D=rep(c("a", "b"), each=5))
tabulka

tabulka$A[c(2,4)]=NA
tabulka[(which(tabulka$A != is.na(A))),mean(A)]
tabulka[,E:=B^2]
tabulka[,F:=sum(B), by=D]
tabulka[(which(tabulka$a == is.na(A)) &sum(A)),summary(tabulka)]
sort(tabulka$A,na.last=TRUE)
tabulka[tabulka$C]

set.seed(12)
tabulka = data.frame(A=rep(c("c", "d"), each=6), B=seq(10, 43, by=3), C=rnorm(12), D=5:16)
tabulka

tabulka$B[c(2, 5, 11)]=NA
sort(tabulka$C, decreasing = TRUE)
quantile(tabulka$D, c(0, 0.15, 0.56))
tabulka[(which(tabulka$B != is.na(B))),mean(B)]
all(tabulka$C=NA)
tabulka[,.N, by=A]
sum(is.na(tabulka))
sort(tabulk$C, decreasing = TRUE)
tabulka[(which(tabulka$D) == is.na(D))]
colSums(is.na(tabulka))

set.seed(18)
tabulka = data.table(A=15:1, B=rep(c("b", "a", "c"), each=5), C=rnorm(15), D=15:1)
tabulka
tabulka$C[c(7, 8)]=NA
tabulka
all(tabulka$D>0)
mean(tabulka$D)
sort(tabulka$C)
tabulka[,E:= sum(D), by=B]
tabulka[,F:= A^3]

----------------------------------------------------------------------------

# nacitat subory z databazy MySQL
install.packages("RMySQL")
library(RMySQL)
library(DBI)
genDB <- dbConnect(MySQL(),user = "genome", host = "genome-mysql.cse.ucsc.edu")
dbs = dbGetQuery(genDB, "show databases;")
dbDisconnect(genDB)
dbs

-----------------------------------------------
grafy

infert=infert
head(infert)
boxplot(age~education,data=infert,col="red",xlab="education",ylab="age",main="Graf zavislosti age od education")
abline(h=30,lwd=3,lty=2, col="blue")

library(datasets)
with(infert,plot(education,age,pch=1))
par(mfrow=c(1,1))
model=lm(age~education,infert)

model=lm(age~education,infert)

abline(model,lwd=3)


library(lattice)
xyplot(stratum~age|education,infert)
xyplot(stratum~age,infert)


CO2=CO2
head(CO2,5)

boxplot(uptake~Type,CO2,col="green",xlab="Type",ylab="uptake",main="Boxplot zavislosti uptake od Type")
abline(h=25,col="red",lty=2,lwd=4)
library(ggplot2)
qplot(uptake,data=CO2,geom="density",color=Type)

------------------------------------
data
getwd() #aktualna cesta adresara
dir.create("Zapocet1") #vytvorit priecinok
setwd("Zapocet1") #nastavit priecinok ako prac.adresar
#kebyze som bol inde davam po jednom
dir.create("data") #vytvorit v nom priecinok data

fileURL="odkaz #zadat adresu do premennej
# dal som tuto, lebo na tamtu nemam lik
download.file(fileURL, destfile="data/SalesJan2009.csv")
data=read.csv2("data/SalesJan2009.csv")
head(data,10)
tail(data,15)
data[1:5,2:3]
none
17
28.03.2018, 21:58
Knižnica XML
> url = "odkaz >
doc <- xmlTreeParse(url,useInternal=TRUE)
> root <- xmlRoot(doc) > xmlName(root)

> mydata = fromJSON("data.JSON")
> names(mydata)
> mydata

uloženie dat do JSON
> myjson = toJSON(iris, pretty=TRUE)
> cat(myjson)

Zapisanie do suboru
write(myjson, file="irisdata.JSON"))

Adresáre
setwd("../")
file.exists("NazovAdresara") … overí existenciu
dir.create("NazovAdresara")
none
18
29.03.2018, 13:02
funkcia=function(c,d,n){
vector=1:n
pocet=0
delitelneC= c()
j=1
for(i in 1:length(vector)){
if(vector[i]%%c == 0 && vector[i]%%d ==0){
pocet=pocet+1
}
if(vector[i]%%c == 0){
delitelneC[j] = vector[i]
j=j+1
}
}

print(pocet)
print(delitelneC)
}
funkcia(2,3,15)
none
19
26.04.2018, 11:35
curve(5 * sin(x), 0, 10)
curve(exp(x),add=TRUE, col = "red")

f = function(x)5*sin(x)-exp(x)
uniroot(f, lower = 0, upper = 1, tol = 1e-4)
uniroot(f, lower = 1, upper = 2, tol = 1e-4)
/////////////////////////////////////////////////////////////////////////
library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output) {

output$distPlot <- renderPlot({

# generate bins based on input$bins from ui.R
x <- faithful[, 2]
x = airquality[,input$id1]

# draw the histogram with the specified number of bins
boxplot(x~airquality$Month, col= input$id2, main = input$id4)




})

output$tabulka = renderTable(
{
tail(airquality, input$id3)
}
)
///////////////////////////////////////////////////////////////////////////////////////
linearna regresia

predaj = c(9,5,18,14,10,12,7,11,5,16,14,11)
cena = c(18,24,9,15,17,16,20,25,22,14,15,19)

mydata=data.frame(predaj,cena)
model = lm(cena~predaj, data =mydata)
model

plot(mydata)
abline(model)


newmodel2= data.frame (cena=c(5,10,25))
newmodel2$predaj=predict(model, newdata = newmodel2)
newmodel2$predaj

///////////////////////////////////////////////////////////////////////////////////////////

linearne programovanie
install.packages("lpSolveAPI")
library(lpSolveAPI)
lpmodel= make.lp(0,2)
lp.control(lpmodel, sense = "max")
set.objfn(lpmodel, c(50,40))
add.constraint(lpmodel, c(2,3),"<=", 1500)
add.constraint(lpmodel, c(2,1), "<=", 1000)
lpmodel
solve(lpmodel)
get.objective(lpmodel)
get.variables(lpmodel)

///////////////////////////////////////////////////
celociselne programovanie

library(lpSolve)
install.packages("lpSolve")
assign.costs=matrix(c(5,12,9,8,7,8,10,13,13,7,9,12,11,12,5,15,16,19,20,11,10,14,10,13,9),5,5)
assign.costs
lp.assign (assign.costs)
lp.assign (assign.costs)$solution
///////////////////////////////////////////
linearne rovnice
#A*x =b

A = matrix(nrow=3, ncol=3, data = c(4,2,5,3,2,3,0, -2,1))
b= c(4,0,-2)
solve(A,b)

//////////////
none
20
26.04.2018, 12:36
library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output) {

output$distPlot <- renderPlot({

# generate bins based on input$bins from ui.R

x <- quakes[,input$id1]
y = quakes[, input$id2]


# draw the histogram with the specified number of bins
plot(x,y, col = input$id3, lwd = input$id4)

})


output$text = renderText(
{
vypis=c("Vybrali ste farbu", input$id3, "a na porovnanie ste zadali atributy:", input$id1, input$id2)
print(vypis)
}
)
none
23

20. 26.04.2018, 12:36

library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output) {

output$distPlot <- renderPlot({

# generate bins based on input$bins from ui.R

x <- quakes[,input$id1]
y = quakes[, input$id2]


# draw the histogram with the specified number of bins
plot(x,y, col = input$id3, lwd = input$id4)

})


output$text = renderText(
...

25.03.2019, 11:20
#DATA.TABLE
DF = data.frame(x=rnorm(9),y=rep(c("a","b","c"),each=3),z=rnorm(9))

DT = data.table(x=rnorm(9),y=rep(c("a","b","c"),each=3),z=rnorm(9)) # odvodene od data.frame, vsetky funkcie pre data.frame funkcne aj pre data.table

tables() #poskytne info o vsetkych tabulkach (data.table)
#operacie s data.table
DT[DT$x > 0] # vyber riadkov - hodnota stlpca X > 0
DT[,mean(x)] # vypis priemeru stlpca X
DT[,table(y)] # vypis v tabulke - pocty hodnot slpca Y (pocetnost)
DT[,w:=z^2] # vytvorenie noveho stlpca w, ktory ma hodnoty z^2
DT[,f:=x>0] # vytvorenie stlpca f, ktory ma hodnotu T/F, podla toho ci X je vacsie ako 0
DT[,y:={tmp = x+z; tmp^2}] # zmena stlpca a viac operacii v jednom expression
DT[,b:=sum(x),by=f] # suma hodnot X podla hodnot stlpca f
DT[,.N,by=f] # vrati pocet elementov podla faktoru f

#PRACA S DATAMI - VYBER A USPORIADANIE
X <- data.frame("var1"=sample(1:5),"var2"=sample(6:10),"var3"=sample(11:15)) #nahodne cisla
X$var2[c(1,3)] = NA

X[,1] # vyber vsetkych riadkov a 1 stlpca
X[,"var1"] # vyber vsetkych riadkov a stlpca s nazvom "var1"
X[1:2,"var2"] # vyber 1 az 2 riadka a stlpca s nazvom "var2"

X[(X$var1 <= 3 & X$var3 > 11),] # vyber riadkov, ktore splnaju dane podmienky a vsetky stlpce (& - a zaroven)
X[(X$var1 <= 3 | X$var3 > 15),] # vyber riadkov, ktore splnaju jednu z danych podmienok a vsetky slpce (| - alebo)

X[X$var2 > 8,]
X[which(X$var2 > 8),] # vyber riadkov kde var2 > 8, which - ignorovanie NA hodnot

X$d = rnorm(5) # pridanie stlpca d
Y = cbind(X,rnorm(5)) # vytvorenie tabulky/matice Y s datami X a novym slpcom

sort(X$var1) # usporiadanie premennej var1 zostupne(od najmensieho po najvacsie)
sort(X$var1,decreasing=TRUE) # usporiadanie premennej var1, vzostupne, default je FALSE
sort(X$var2,na.last=TRUE) # usporiadanie var2, berie do uvahy aj prazdne hodnoty
X[order(X$var1),] # usporiadanie celeho DF podla premennej var1
X[order(X$var1,X$var3),] # viac premenn?ch pre usporiadanie, usporiada potom podla poradia v order

#VYTVARANIE NOVYCH PREMENNYCH
s1 = seq(1,10,by = 2) #vytvori sekvenciu po dvoch (piatich prvkov)
s2 = seq(1,10,length = 3) #vytvori sekvenciu s dlzkou 3

X <- data.frame("var1"=sample(1:5),"var2"=sample(6:10),"var3"=sample(11:15))
X$c = ifelse(X$var1 > 3,TRUE,FALSE) # vytvorenie binarneho stlpca c
X$d = cut(X$var1,breaks = quantile(X$var1)) # vytvorenie kategorialnej premennej z numerickeho atributu

install.packages("Hmisc")
library(Hmisc)
X$e = cut2(X$var1,g=4) # vytvorenie kategorickej premennej cez prikaz cut2
X$f = factor(X$var1) # vytvorenie faktoru z premennej var1

yesno <- sample(c("yes","no"),size=10,replace=TRUE) # vytvorenie vektora s dlzkou 10 z hodnot yes,no
#vytvorenie faktorov
yesnofac = factor(yesno,levels=c("yes","no")) # vytvorenie faktora a zadanie levelov
relevel(yesnofac,ref="no") # zmena poradia levelov

install.packages("plyr")
library(Hmisc)
library(plyr)
X2 = mutate(X,novy = cut2(var1,g=4))


#TRANSFORMACIE

#pomocou numerickych funkcii
abs(-5) #absolutna hodnota
sqrt(9) #odmocnina
ceiling(4.45) # zaokruhli nahor
floor(4.45) # zaokruhli nadol
trunc(4.45) # zaokruhli nadol
round(4.4586325,digits = 5) #zaokruhli na 5 desatinnych miest
signif(4.4586325,digits = 5) #uz iba 5 miest
round(3.475,digits = 2)
signif(3.475,digits = 2)
cos(0.754)
sin(0.754)
log(0.754)
log2(0.754)
log10(0.754)
exp(0.754)

#funkcie na spracovanie retazcov
substr("abcdef", 2, 4) # vytvori podrerazec od 2 az po 4 znak
data <- data.frame(values=c(91, 92, 108, 104, 87, 91, 91, 97, 81, 98),
names = c("fee-", "fi", "fo-", "fum-", "foo-", "foo1234-", "123foo-","fum-", "fum-", "fum-"))
data$values[grep("foo",data$names)]

#nahradzovanie znakov
x <- c("This is a sentence about axis","A second pattern is also listed here")
sub("is", "XY", x)
gsub("is","XY",x)

#rozdelenie retazcov podla split
x <- "Split the words in a sentence."
strsplit(x, "t")
strsplit(x, "l")
strsplit(x, " ")

paste(1,2,3,4,5,sep=".") #pridanie separatora
toupper("programovanie") #zvacsenie pisma
tolower("ABCD") #zmensenie pisma

#SPAJANIE DAT
df1 = data.frame(id=sample(1:10),x=rnorm(10))
df2 = data.frame(id=sample(1:10),y=rnorm(10))
M1 = merge(df1,df2, by="id")
M2 = merge(df1,df2,by.x="id",by.y="id2")
M3 = merge(df1,df2,by.x="id",by.y="id2",all=TRUE) # prida aj nenamapovane riadky
M4 = merge(df1,df2,all=TRUE) # pokusi sa o defaultne spojenie cez vsetky spolocne atributy

library(plyr)
arrange(join(df1,df2),id) # spojenie df1 a df2 pomocou kniznice plyr a stlpca id

df3 = data.frame(id=sample(1:10),z=rnorm(10))
dfList = list(df1,df2,df3) # vytvorenie listu z prvkov df1,df2,df3
join_all(dfList) # spojenie vsetkych prvkov listu

#restruktualizacia dat - zmena struktury

mtcars$carname <- rownames(mtcars)
install.packages("reshape")
library(reshape)

# z dat mtcars vytvorime stlpce id, ktory bude mat hodnoty carname, gear a cyl a nasledne pre stlpce mpg a hp sa vytvoria hodnoty variable a value
carMelt <- melt(mtcars,id=c("carname","gear","cyl"),measure.vars=c("mpg","hp"))
head(carMelt,n=5)

# vstupom su najprv data, na kt. bol aplikovany melt, a nasleduje formula, ktora uruuje ake riadky a stlpce sa kombinuju
cylData <- cast(carMelt, cyl ~ variable)
cylData1 <- cast(carMelt, cyl ~ variable,mean)
none

najnovšie príspevky :

prevádzkuje diskusneforum.sk kontaktuj správcu diskusného fóra vytvoril dzI/O 2023 - 2024 verzia : 1.05 ( 17.4.2024 8:30 ) veľkosť : 173 432 B vygenerované za : 0.091 s unikátne zobrazenia tém : 47 455 unikátne zobrazenia blogov : 788 táto stránka musí používať koláčiky, aby mohla fungovať...

možnosti

hlavná stránka nastavenia blogy todo

online účastníci :

hľadanie :

blog dňa :

Navždy dokonalý skrze Ježišovo dokonalé dielo Ale tento priniesol obeť za hriechy a navždy sa posadil po pravici Boha. ...Lebo jednou obetou navždy zdokonalil tých, čo sú posväcovaní. Hebrejom 10:12,14 Boli ste niekedy ako kresťan sužovaní myšlienk...

citát dňa :

Všetci ľudia sú detailisti. Jedni vedome, iní podvedome.