Hoď ma hore
prihlásenie:
Registrácia  |  Zabudnuté heslo
tu sa nachádzate: hlavná stránka  počítače  téma
kategórie:  

Základy jazyka R

13
reakcií
377
prečítaní
Tému 30. marca 2019, 12:54 založil dvdkrs123.

podobné témy:

názov témy
posledná
reakcií
25. 04. 2019
40
12. 07. 2013
24
 
 


1.
označiť príspevok

dvdkrs123 muž
   30. 3. 2019, 12:54 avatar
#vytvaranie premennych
a <- 12 #vytvorenie premennej a s hodnotou 12
b = 7 #vytvorenie premennej b s hodnotou 7
a #vypis premennej
print(a) #vypis premennej

c = 11:23 #vytvorenie premennej s viacerými hodnotami
c[6] #vypis prvku, ktory sa nachadza na pozicii 6

#vytvorenie retazca
msg = "hello" #retazec piseme do uvodzoviek
msg

# vytvaranie vektorov
x = vector(mode = "logical", length = 10) #vytvorenie logickeho vektora (logicke hodnoty) a dlzkou 10, pomocou fukcie vektor()

v <- c(5.5, 6.2, 7.8) # vytvorenie numerickeho vektora, pomocou funkcie c()
v <- c(TRUE, FALSE, FALSE) # vektor logickych hodnôt
v <- c(T, F, T) # vektor logickych hodnot
v <- c("ab", "cd", "ef" # vektor znakov
v <- 10:30 # celočíselný vektor
v <- c(1+3i, 2+2i) # komplexny vektor

# implicitna korekcia
y <- c(1.3, "ok" # vysledok – vektor znakov
y <- c(TRUE, 5) # vysledok – numerický vektor
y <- c("jm", TRUE) # vysledok – vektor znakov

# uprava typu vektora - explicitna korekcia
z <- 0:9 #vytvorenie vektora, ktory nadobuda celocislene hodnoty
class(z) #vypise datovy typ vektora z
as.numeric(z) #zmena datoveho typu vektora z na vektor s numerickymi hodnotami
as.logical(z) #vektor s logickymi hodnotami
as.character(z) #vektor znakov

#NA
x <- c(1, NaN, NA)
is.na(x) #chybjuce hodnoty
is.nan(x) #nedefinovane

# vytvaranie matic
M = matrix(nrow = 2, ncol = 3) #vytvorenie prazdnej matice s rozmerom 2x3, pomocou funkcie matrix()
M #vypis
dim(M) #funkcia dim() vrati rozmer matice
K = matrix(1:6,nrow = 2, ncol = 3) #vytvorenie matice s hodnotami od 1 po 6, s rozmerom 2x3
K #vypis

L <- 1:10 # vytvorenie celociselneho vektora
dim(L) <- c(2, 5) #tranfromovanie vektora L na maticu L s rozmerom 2x5
L

#spajanie vektorov (vytvorenie matice)
x <- 9:15
y <- 4:10
cbind(x, y) #spajanie po stlpcoch
rbind(x, y) #spajanie po riadkoch

# vytvorenie zoznamu
zoznam = list(0.2, "h", list("h2", 1 + 2i), TRUE) #vytvorenie zoznamu pomocou fukcie list(); zoznam moze obshovat rozne typy datovych hodnot
zoznam #vypis

# vytvorenie faktora
x = factor(c("ford", "bmw", "ford", "bmw", "bmw") #pomocou funkcie faktor() a funkcie c()
x
table(x) #pocetnost tried
unclass(x) #vypis tried

# funkcie pre vypis aktualneho datumu a casu
x = Sys.Date()
x
y = Sys.time()
y

# vytvorenie tabulky - data frames
tab = data.frame(a1= 1:5, a2 = c(0.2, 0.7, 1.5, 2.2,3.4))
tab

#nazvy objektov
x = 1:2 #vytvorenie vektora
names(x) = c("a1", "a2" #pridanie nazvu jednotlivym prvkom pomocou funkcii names() a c()
x

x = list(a = 1, b = 2, c = 3) #pridanie nazvu uz pri vytvarani zoznamu
x

m = matrix(1:4, nrow = 2, ncol = 2)
dimnames(m) = list(c("a", "b", c("c", "d") #pridanie nazvu v matici pre stlpce aj riadky
m

#pristup k podmnozinam
x <- c("a", "b", "c", "c", "d"
x[1] #vypis prvku na pozicii 1
x[1:4] #vypis prvkov na poziciach od 1 po 4
x[x > "a"] #vypis prvkov, ktore splnaju podmienku
u <- x > "a" #vytvorenie vektora, ktory nadobuda hodnoty, ktore spnaju podmienku
u #vypis iba logickych hodnot podla x
x[u] #vypis hodnot vektora u podla x

x <- list(a1 = 1:3, a2 = 0.3, "d"
x[1] #prvky a1
x[[1]] #prvky a1
x$a2 #prvky a2
x[["a2"]] #prvky a2
x["a2"] #prvky a2
x[c(1,3)] #prvy riadok treti stlpec

#vektorove/maticove operacie
x <- 1:4; y <- 6:9
x + y #sucet
x > 2 #vacsie
x >= 2 #vacsie alebo rovne
y == 8 #rovne
x * y #nasobenie
x / y #delenie

M = matrix(1:4, 2, 2)
N = matrix(c(10,5,5,1), 2, 2)
M
N
M * N # násobenie po elementoch
M %*% N # skutočné násobenie matíc

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

setwd("../" #nastavenie adresára
# testovanie existencie adresára
file.exists("nazovAdresara"
dir.create("nazovAdresara" #vytvori ak neexistuje
dir.create("data"

# ziskavanie dat zo suborov na webe
fileUrl <- "people.tuke.sk Tento odkaz smeruje mimo DF.sk
download.file(fileUrl, destfile = "irisdata.csv"
datum <- date()
# nacitanie dat
iris = read.table("irisdata.csv", sep = ";", header = TRUE)

iris1 = read.csv("irisdata.csv" #separator ,
iris2 = read.csv2("irisdata.csv" #separator ;

#head(iris,3) #prvé riadky
#tail(iris,4) #posledné

list.files("SSvHI" #obsah

#nacitavanie excel suborov
library(xlsx)
library(readxl)

fileUrl <- "people.tuke.sk Tento odkaz smeruje mimo DF.sk
download.file(fileUrl,destfile="irisdata.xlsx",mode = "wb"

iris_excel = read.xlsx("irisdata.xlsx",sheetIndex = 1, header = TRUE)
subdata = read.xlsx("irisdata.xlsx",sheetIndex = 1, colIndex = 2:3, rowIndex = 1:5)

iris_excel1 = read.xlsx2("irisdata.xlsx",sheetIndex = 1, header = TRUE)

#XML

library(XML)
library(RCurl)
fileUrl <- "www.w3schools.com Tento odkaz smeruje mimo DF.sk
xData = getURL(fileUrl)
doc = xmlParse(xData)

#doc <- xmlTreeParse(fileUrl,useInternal=TRUE) # ulozi XML subor, ak je FALSE tak aj dalsie info
root <- xmlRoot(doc) # vypis bez hlavicky <?xml version="1.0" encoding="UTF-8"?>
xmlName(root) # vypis hlavneho tagu

root[[2]] # vypis druheho jedla
root[[2]][[1]] # vypis druheho jedla a prveho prvku (nazov)

xmlSApply(root,xmlValue) # vypise vsetky jedla a informacie o nich do jedneho riadku
xpathSApply(root,"//name",xmlValue) # vypise iba mena jedal
xpathSApply(root,"//price",xmlValue) # vypise iba ceny jedal

#JSON subory
library(jsonlite)
data_json = fromJSON("" target="_blank" rel="nofollow" title="http://people.tuke.sk/peter.butka/res/data.JSON"">people.tuke.sk Tento odkaz smeruje mimo DF.sk # nacitanie dat
names(data_json) # vypis stlpcov
names(data_json$adresa) # vypis prvok, z ktorych sa sklada stlpec adresa

data_json$adresa$mesto # vypis miest v datach

#RMySQL
library(RMySQL) # nacitanie kniznic
library(DBI)
genDB = dbConnect(MySQL(),user="genome", host="genome-mysql.cse.ucsc.edu" # vytvorenie spojenia
DB = dbGetQuery(genDB,"show databases;" # ukazka dabazy
dbDisconnect(genDB) # ukoncenie spojenia

#########################
hg19 <- dbConnect(MySQL(),user="genome", db="hg19",host="genome-mysql.cse.ucsc.edu" # spojenie
vsetky_tabulky <- dbListTables(hg19) # ziskanie nazvov tabuliek v databaze hg19
length(vsetky_tabulky) # pocet vsetkych tabuliek
vsetky_tabulky[1:6] # vypis prvych 6 tabuliek
dbListFields(hg19,"acemblyPep" # stlpce v tabulke acemblyPep
dbGetQuery(hg19, "select count(*) from acemblyPep" # vypis poctu zaznamov v tabulke

#########################
ailMel1 = dbConnect(MySQL(),user="genome", db="ailMel1",host="genome-mysql.cse.ucsc.edu"
vsetky_tabulky1 <- dbListTables(ailMel1)
vsetky_tabulky1[1:4]
dbListFields(ailMel1, "all_est"
dbGetQuery(ailMel1, "select count(*) from all_est"

#nacitanie tabulky cez dbreadtable
databaza1 <- dbReadTable(ailMel1,"all_mrna"

#vyber podmnoziny dat cez query
query = dbSendQuery(ailMel1, "select * from all_mrna where misMatches = 0" # vyber dat z tabulky s podmienkou
subdata = fetch(query) # vytvorenie dat
subdata[1:6,1:4]

query <- dbSendQuery(hg19, "select * from affyU133Plus2 where misMatches between 1 and 3"
subdata1 <- fetch(query)
quantile(subdata1$misMatches)

#nacitavanie dat z WEB stranok

library(XML)
s = htmlParse("" target="_blank" rel="nofollow" title="http://www.catholic-hierarchy.org/bishop/spope0.html"">www.catholic-hierarchy.org Tento odkaz smeruje mimo DF.sk # zadanie odkazu
tabs = readHTMLTable(s, stringsAsFactors=FALSE) # nacitanie HTML do tabulky
popes = tabs[[1]][2:6,c(2,3,5)] # vyber iba papezov (tab.1) v 2 az 6 riadku a k nim 2,3,5 stlpec
names(popes) = c("meno","narodeny", "zvoleny" # pomenovanie stlpcov

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

#nacitanie dat
download.file("" target="_blank" rel="nofollow" title="http://people.tuke.sk/peter.butka/res/avgpm25.csv","avgpm25.csv"">people.tuke.sk Tento odkaz smeruje mimo DF.sk #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()


2.
označiť príspevok

F=G.m1.m2/r^2 muž
   30. 3. 2019, 13:17 avatar
Najlepší jazyk je C++. Doteraz nikto nič lepšie nevymyslel. Aj všetky tie "zjednodušeniny" ako C# sú k ničomu. V C++ urobíš prakticky všetko a máš pod kontrolou skoro každý detail.


3.
označiť príspevok

gabriel pb
   30. 3. 2019, 15:34 avatar
najlepšie je mať pod kontrolou vlastný postoj na svet


4.
označiť príspevok

dvdkrs123 muž
   2. 4. 2019, 20:20 avatar
##PRVA ULOHA
funkcia=function(a,b,c,n){
vektor=a:n
i=0
while(i<4){
print(n:a)
i=i+1
}
for(i in a:n){
if(a[i]==b){
print("B"
}
}

}

funkcia(1,2,3,4)

dev.off()
##DRUHA ULOHA
library(DBI)
library(RMySQL)
cb1=dbConnect(MySQL(),user="genome",db="cb1",host="genome-mysql.cse.ucsc.edu"
tabulky=dbListTables(cb1)
tabulky[15:31]
dbListFields(cb1,"microsat"
dbSendQuery(cb1,"select count(*) from microsat"
dbClearResult(dbListResults(cb1)[[1]])
podmnozina=dbSendQuery(cb1,"select * from microsat where bin between 100 and 600"
podmnozina2=fetch(podmnozina)
podmnozina2
##TRETIA ULOHA
library(data.table)
set.seed(20)
tabulka=data.frame(A=rep(c("a","b",each=10),B=rnorm(20),C=seq(1,100,by=5),D=1:20)
tabulka

tabulka$C[c(1,5,10)]=NA
tabulka
quantile(tabulka$D,probs=c(0,0.48,0.56))
colSums(tabulka[,c(2:4)])
tabulka
sum(is.na(tabulka$C))
tabulka[,mean(C)]
any(is.na(tabulka))
sort(tabulka$B)
E=tabulka$B^2
cbind(tabulka,E)

##STVRTA ULOHA
library(datasets)
data=Theoph

par(mfrow=c(1,2),las=3)
with(data,plot(Wt,Dose,col="blue",main = "Wt and Dose",xlab = "Wt",ylab = "Dose")
with(data,plot(Wt,conc,col="red",main="Wt and conc",xlab = "Wt",ylab = "conc")


5.
označiť príspevok

dvdkrs123 muž
   2. 4. 2019, 21:08 avatar
xt <- xtabs(Freq ~ Gender + Admit,data=DF)
xt
xt2 <- xtabs(Freq ~.,DF)
xt2
summary(xtabs(Freq ~.,DF))
ftable(xt) # flat tabuľka

table(iris$Sepal.Length %in% c(5.1,5.0))
table(iris$Species %in% c("setosa","viginica")
table(iris$Species %in% c("setosa")
iris[iris$Species %in% c("setosa",]

DT2 <- data.table(x=c('a', 'a', 'c', 'dt1'), y=1:4)
DT2
DT3 <- data.table(x=c('a', 'c', 'dt2'), z=5:7)
DT3
setkey(DT2, x)
setkey(DT3, x)
merge(DT2,DT3)

grep("^a", c("abc", "def", "cba a", "aa", value=FALSE)
# [1] 1 4
grep("^a", c("abc", "def", "cba a", "aa", value=TRUE)

head(select(chicago, city:dptp)) # výber stlpcov od city po dptp
head(select(chicago,-(city:dptp))) # výber všetkých stlpcov okrem stlpcov city po dptp

chic.f <- filter(chicago, pm25tmean2 > 30) # výber len tých riadkov, kde p25tmean2 > 30
chic.f <- filter(chicago, pm25tmean2 > 30 & tmpd > 80)

chicago_arrange <- arrange(chicago, date) # usporiadanie podľa date
chicago_arrange1 <- arrange(chicago, desc(date))

chicago_rename <- rename(chicago, dewpoint = dptp,pm25 = pm25tmean2) # premenovanie stlpcov

chicago_mutate <- mutate(chicago_rename, dewpoint_1=dewpoint-mean(dewpoint, na.rm=TRUE)) # transformácia a pridávanie nových stlpcov

chicago_mutate1 <- mutate(chicago,tempcat = factor(tmpd > 80,labels = c("cold", "hot"))
summarize(chicago_mutate1, pm10 = mean(pm10tmean2, na.rm = TRUE),o3 = max(o3tmean2),no2 = median(no2tmean2)) # sumár

###########################
chicago_mutate2 <- mutate(chicago,year = as.POSIXlt(date)$year + 1900)
years <- group_by(chicago_mutate2, year)
summarize(years, pm10 = mean(pm10tmean2, na.rm = TRUE),o3 = max(o3tmean2, na.rm = TRUE),no2 = median(no2tmean2, na.rm = TRUE))


6.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 18:54 avatar
---
title: "Príklad"
output: html_document
---

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <rmarkdown.rstudio.com> Tento odkaz smeruje mimo DF.sk.

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. You can embed an R code chunk like this:

```{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**
~~slovo~~
x^2^

# Rmarkdown
## R
### RStudio

- first item in list
- second item in list
- third item in list

1. Item 1
2. Item 2
+ Item 2a
+ Item 2b

-- pomlčka
--- pomlčky

example.com Tento odkaz smeruje mimo DF.sk

[názov](example.com) Tento odkaz smeruje mimo DF.sk

> Citácia

********************

Názov | Názov 2 | Názov 3
------- | ------- | -------
Hodnota | Hodnota 2 | Hodnota 3

$A = pi*r^{2}$

Dva plus dva je `r 2 + 2`.

```{r}
dim(iris)
```

```{r, echo = FALSE}
dim(iris)
```

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

```{r computetime, echo = FALSE}
time <- format(Sys.time(), "%A %B %D %X %Y"
rand <- rnorm(1)
```

Aktuálny čas je: `r time`. Náhodné číslo je `r rand`.

```{r scatterplot, fig.height= 4}
x <- rnorm(100); y <- x+rnorm(100, sd = 0.5)
par(mar = c(5,4,1,1),las = 1)
plot(x,y,main = "My simulated data"
```


7.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 18:55 avatar
library(shiny)
ui <- fluidPage(

# Application title
titlePanel("Old Faithful Geyser Data",

# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
radioButtons("colour", "Colour of histogram", choices = c("red", "green", "blue", selected = "red",
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),

hr(),
selectInput("select",label = h3("Vyber data pre summary", choices = c("faithful", "cars", "quakes", selected = "faithful",
hr(),

checkboxGroupInput("checkbox", "Výber možnosti",
choices = c("ano", "nie", "mozno", selected = "ano",

checkboxInput("checkbox1", "Zaškrtni možnosť",

dateInput("datum", "Zadajte datum", value = Sys.Date(), format = "dd.mm.yyyy",
min = Sys.Date()-5, max = Sys.Date()+5, language = "sk", startview = "year", weekstart = 3),
dateRangeInput("datum2", "Zadajte rozsah",
start = Sys.Date()-6 , end = Sys.Date()+4, min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",
weekstart = 0, language = "en", separator = "do",
hr(),
fileInput("subor", "Nahrajte subor", multiple = TRUE, accept = NULL),
actionButton("button", "Potvrd",
hr(),
actionLink("link", "Zadajte link: ",
hr(),
numericInput("cislo", "Zadajte cislo", value = 18, min = 1, max = 25, step = 3),

passwordInput("heslo","Zadajte heslo", value = "qwertz",

radioButtons("radio","Vyberte jedn? z mo?nost?", choices = c(1,2,5),
selected = 5),

selectInput("select", "Vyberte možnosť", choices = c("včera","dnes","zajtra",
selected = "zajtra", multiple = TRUE, selectize = TRUE, width = "400px",

#vnoreny panel
wellPanel(
textInput("text", "Zadajte vstup", value = "a",
actionButton("goButton", "Spustit"
),

conditionalPanel(condition = "input.cislo == 18",
selectInput("select2", "Výber", choices = c("rok", "mesiac", "den",
selected = "mesiac"),

submitButton("GO"
),

# Show a plot of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Histogram", plotOutput("distPlot"),
tabPanel("Summary", verbatimTextOutput("summary"),
tabPanel("Table", tableOutput("distTable"),
tabPanel("Data", dataTableOutput("data"),
tabPanel("Text", verbatimTextOutput("distPrint"),
textOutput("distText",
textOutput("Text3")
)
)
)

library(shiny)
server= function(input, output){

output$summary = renderPrint({
if(input$select == "faithful"{
summary(faithful)
}else if (input$select == "cars"{
summary(cars)
}else summary(quakes)
})

x = reactive({as.numeric(input$text)+100})

output$distPlot <- renderPlot({

# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)

if(input$colour == "red"{
mycol = "red"
}else if (input$colour == "green"{
mycol = "green"
}else mycol = "blue"

# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = input$colour, border = 'white')

})

output$value = renderPrint({
input$radio
})

output$distPrint = renderPrint({
print(input$text)
})

output$distTable = renderTable(iris)

output$data = renderDataTable(faithful)

output$distText = renderText({
paste("Zadali ste rozsah datumu ", input$datum2[1], " do ", input$datum2[2])
})

output$Text = renderText({
x()
})

output$Text2 = renderText({
x()+ as.numeric(input$cislo)
})

output$Text3 = renderText({
input$goButton
isolate(paste("Zadali ste ... ", input$text, " a ", input$cislo))
})

}

shinyApp(ui = ui, server = server)


8.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 18:57 avatar
# Generovanie 10 náhodných čísel z NR
rnorm(10,mean=10,sd=1) #mean - priemer, sd - vector of standard deviation (odchýlka)

# Hustota pravdepodobnosti v bode 10 (vráti výšku 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) # lower.tail = TRUE - P[X<=x] _ zľava (default)
# lower.tail = FALSE - P[X>x] _ od daného bodu napravo
# log.p - pre logaritmické hodnoty
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

# Binomické (binom) – počet výskytov konkrétneho javu v sérii n nezávislých pokusov
rbinom(20, 100, prob = 0.1) #rbinom(n, size, prob) - (size - number of trials (zero or more), prob - probability of success on each trial)
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)

# uniformny vyber
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) # detto ale rovnake cislo nemozem vybrat znovu (t.j. nevratim ho spat do mnoziny na dalsi vyber)

# Sample - generovanie vzoriek
# Funkcia sample náhodne vyberá zo špecifikovanej množiny objektov uniformným spôsobom
# Generátory sú v skutočnosti pseudonáhodné => je možné nastaviť tzv. seed a generátor generuje rovnakú postupnosť čísel (kým seed znovu nenastavíme) => užitočné pre reprodukovateľnosť (a overiteľnosť algoritmických) výpočtov
# Pokiaľ sa snažíme o viacero náhodných simulácií, potrebujeme samozrejme seed meniť!
# Ak chceme dať možnosť reprodukovať výsledok nejakého výpočtu, poskytneme nastavenie seed
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))

# linearizovaný model s inou distribúciou, napr. Poisson
set.seed(1)
x <- rnorm(100)
log.mu <- 0.5 + 0.3 * x
y <- rpois(100, exp(log.mu))
summary(y)
plot(x, y)

# Generovanie separovateľných dát
# -------------------------------
# Napr. v 2D (x+y) chceme vytvoriť dáta dvoch tried A a B, tak aby boli relatívne oddelené zhluky
# • 1. Najprv navrhneme stredy dostatočne ďaleko od seba (napr. cez 1.0)
# • 2. Vygenerujeme dáta viazané na dané stredy (napr. cez Gaussovo normálne rozdelenie)

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)

# Testovanie štatistických hypotéz
# Kolmogorovov-Smirnovov (KS) test = testovanie toho či náhodná veličina má dané teoretické rozdelenie
# Konkrétne: vygenerujeme si cez rnorm dáta z normálneho rozdelenia a potom použijeme KS test na overenie, či sú z normálneho a potom napríklad uniformného rozdelenia

# Príklad – jednovýberový KS test
# • Výstup testu z R bude obsahovať:
# • D - testovaciu štatistiku
# • p-value je p hodnota – desatinné číslo (nie %) … na základe p-value sa rozhodneme o zamietnutí hypotézy ... Ak je p < 5% (t.j. pri teste na hladine významnosti 5%), tak zamietneme H0 (x je z teoretického rozdelenia), inak zamietame alternatívnu hypotézu H1 (nie je z tohto rozdelenia)
x <- rnorm(30)
ks.test(x, pnorm)
ks.test(x, punif)

# Príklad – dvojvýberový KS test
# • Dvvojvýberový test umožňuje porovnať dva výbery na to, či môžu byť z rovnakého rozdelenia
# H0 ... y,z sú z rovnakého rozdelenia ... zamietneme ak p < 5%, inak prijmeme hypotézu H1 (y,z nie sú z rovnakého rozdelenia)
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), from=0, to=10)
curve(log(x), add = TRUE, col="red" # add - logical; if TRUE add to an already existing plot
f = function(x) 2*cos(x) - log(x)
# uniroot(f,lower,upper,tol)
# – f – funkcia, lower – ľavá hodnota intervalu hľadania, upper – pravá hodnota intervalu, tol – požadovaná presnosť
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)

# Riešenie polynomiálnej rovnice x3+2x+4=0 (konštanty od najnižšieho stupňa)
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
# Regresia je proces vytvorenia funkcie nezávislých premenných (tzv. prediktorov) pre predikciu závislých premenných („response“)
# • Lineárna regresia predikuje výstupné hodnoty premennej y na základe lineárneho modelu
# • Jednoduchá dvojrozmerná verzia => výstup y (predikovaný atribút) je modelovaný pomocou jednej premennej x (predikujúci atribút)
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) # prazdny LP solver s 2 premennymi
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)
# Default ohraničenia (x,y >=0) sú pridané automaticky (Lower - Upper) … je možné ich zmeniť
lpmodel
solve(lpmodel)
get.objective(lpmodel) # dosiahnuta hodnota KF
get.variables(lpmodel) # hodnoty premennych pre optimum
# Matematicky: Daný problém má optimálne riešenie, konkrétne v bode [21.875,53.125] s hodnotou KF (ktorá je maximálna) 6315.625

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


9.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 22:03 avatar
---
title: "Skupina A"
output: html_document
---

#Štruktúra systému R
**R** systém je rozdelený do *dvoch* konceptuálnych častí.

1. R ,,base" system
- CRAN (priestor pre zdielanie balikov)
2. Vsetko ostatne

********
##Relevantné simulačné nástroje
Názov | Výhody | Nevýhody | Open-source
------|--------|----------|------------
R |Podpora knižníc|Náročnejší|Áno
Matlab|Podpora matíc|Podpora štat. metód|Nie

###Dáta mtcars
Dáta mtcars obsahujú tieto názvy stĺpcov

```{r, echo=TRUE}
tab=mtcars
print(colnames(tab))

```

```{r echo=FALSE}
barplot(table(mtcars$hp,mtcars$wt),col="blue",main="Car Distribution by hp and wt",xlab = "Number of gears",ylab="Name of y"
```
------------------------------------------------------------------------
# Define server logic required to draw a histogram
shinyServer(function(input, output) {

output$distPlot <- renderPlot({

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

#bins <- seq(min(x), max(x), length.out = input$bins + 1)

# draw the histogram with the specified number of bins
x <- state.x77[,input$vyber]
bins <- seq(min(x), max(x), length.out = input$rozdelenie + 1)

hist(x,breaks = bins,col = input$farba)

})
output$distTable= renderTable(head(state.x77,input$kolko))
})

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

# Application title
titlePanel("Data quakes",

# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("vyber", "Vyberte atribut", choices = colnames(state.x77)),
radioButtons("farba","Vyberte farbu grafu0", choices = c("blue","red"),
numericInput("rozdelenie","zadajte rozdelenie v grafe",min = 2,max=20,value = 12),
numericInput("kolko","pocet riadkov tabulky",min = 1,max=50,value = 12)

),

# Show a plot of the generated distribution
mainPanel(

plotOutput("distPlot",
tableOutput("distTable"
)
)
))
---------------------------------------------------------

...korene nelineárnej rovnice s presnosťou na 4 des.m.
curve(5*sin(x),-5,5)
curve(-exp(x),add = TRUE,col="red"
f=function(x){5*sin(x)-exp(x)}
uniroot(f,lower = -4,upper = -2,tol = 1e-4)
uniroot(f,lower = -1,upper = 1,tol = 1e-4)


10.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 22:08 avatar
---
title: "Skupina B"
output: html_document
---
# Prečo R?
-- Statisticky **softver** + jazyk -- [link R](www.rproject.org Tento odkaz smeruje mimo DF.sk

-- Je volne dostupny ---- *open source*

### Kvadraticka rovnica
Diskriminant vypocitame pomocou vzorca $D= b^{2} -4*a*c$

> Citacia na vzorec: sk.wikipedia.org Tento odkaz smeruje mimo DF.sk

## Data statex77
Data statex77 obsahuju spolu `r 25+25`riadkov a `r 4+4` stlpcov

# Graf
```{r, echo=FFALSE}
histogram(state.x77$income, breaks = 10, col = "red", xlab = "X",ylab = "Y", main = "Histogram"
```
---------------------------------------------------

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# shiny.rstudio.com Tento odkaz smeruje mimo DF.sk
#

library(shiny)

shinyServer(function(input, output) {

output$distPlot <- renderPlot({

# generate bins based on input$bins from ui.R
x <- airquality[,input$vyber]
# ZAKOMENTOVAT !!!! bins <- seq(min(x), max(x), length.out = input$bins + 1)

# draw the histogram with the specified number of bins
boxplot(x~airquality$Month, col = input$farba, border = 'white', main=input$nadpis)

})
output$distTable= renderTable(
tail(airquality,input$cislo)
)

})

# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# shiny.rstudio.com Tento odkaz smeruje mimo DF.sk
#

library(shiny)

shinyUI(fluidPage(

# Application title
titlePanel("Data airquality",

# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("vyber","Vyberte atribut",choices = colnames(airquality)),
radioButtons("farba","Vyberte farbu grafu", choices=c("green","yellow"),
numericInput("cislo","Pocet riadkov tabulky",min = 1,max = 100,value = 3,step = 5),
textInput("nadpis","Zadajte nadpis grafu",value = "Nadpis"
),

# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot",
tableOutput("distTable"
)
)
))
--------------------------------------------------
...model lineárnej regresie
predaj=c(9,5,18,14,10,12,7,11,5,16,14,11)
cena=c(18,24,9,15,17,16,20,15,22,14,15,19)

tab=data.frame(predaj,cena)
model=lm(cena~predaj,data = tab)
plot(tab)
abline(model)
pr1=data.frame(cena=c(5,10,25))
pr1$predaj <- predict(model,newdata = pr1)


11.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 22:11 avatar
---
title: "Skupina C"
output: html_document
---
## Struktura systemu R
*R* system je rozdeleny do **dvoch** konceptualnych casti

1. R ,,base" system
+ CRAN (priestor pre zdielanie balikov)
2. vsetko ostatne

### Kvadraticka rovnica
Diskriminant vypocitame podla vzorca $D=b^{2}-4*a*c$

# Data a graf
Pocet riadko a stlpcov airquality
```{r}
nrow(airquality)
ncol(airquality)
```

```{r echo=FALSE}
boxplot(airquality$Ozone~airquality$Month,col="blue", main = "GRAPH",xlab="X",ylab="Y"
```
-----------------------------------------
# Define server logic required to draw a histogram
shinyServer(function(input, output) {

output$distText <- renderText({

vypis = c("Vybrali ste si",input$farba, "farbu vybrali ste atributy",input$vyber,"a",input$vyber2)
})

output$distPlot <- renderPlot({

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

#bins <- seq(min(x), max(x), length.out = input$bins + 1)

# draw the histogram with the specified number of bins
x=quakes[,input$vyber]
y=quakes[,input$vyber2]
hist(x,col=input$farba,lwd=input$hrubka)
})
})

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

# Application title
titlePanel("Data quakes",

# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("vyber", "Vyberte atribut c.1", choices = colnames(quakes)),
selectInput("vyber2","vyberte atribut c.2",choices = colnames(quakes)),
radioButtons("farba","Vyberte farbu grafu0", choices = c("yellow","black"),
numericInput("hrubka","Vyberte hrubku bodov",min = 1,max=3,value = 1)

),

# Show a plot of the generated distribution
mainPanel(

textOutput("distText",
plotOutput("distPlot"
)
)
))


12.
označiť príspevok

dvdkrs123 muž
   23. 4. 2019, 22:13 avatar
---
title: "Skupina D"
output: html_document
---
# Preco R?
-- statisticky *softver* + jazyk -- [adresa](www.rproject.org Tento odkaz smeruje mimo DF.sk

--je volne dostupny --- **open source**

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

# Relevantne simulacne nastroje
Nazov | Vyhody | Nevyhody | Open source
------|---------|-------|----------
SPSS | podobone ako daco | drahssie | nie
excel | jednoduchy, virtualny | horsie | nie

## Data quakes
Data quakes obsahuju tieto nazvy stlpcov
```{r}
tab=quakes
print(colnames(tab))
```

```{r, echo=FALSE}
barplot(table(quakes$depth,quakes$lat), col = "pink", main = "Graf", xlab = "X", ylab = "Y"
```
---------------------------------------

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

output$distPlot <- renderPlot({

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

#bins <- seq(min(x), max(x), length.out = input$bins + 1)

# draw the histogram with the specified number of bins
x=CO2[,input$selectID]
y=CO2[,input$vyber2]
boxplot(x~y,col=input$farba,xlab=input$text)

})
output$distText <- renderText({

vypis = c("Vybrali ste si",input$selectID1, "a zaroven", input$vyber2, "zadali ste text z nazvom",input$text,"a farba je",input$farba)
})

})

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

# Application title
titlePanel("Data quakes",

# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("selectID", "Vyberte atribut", choices = c(colnames(CO2$conc,CO2$uptake))),
selectInput("vyber2","vyberte atribut typu faktor",choices = c(colnames(factor(CO2$Type,CO2$Treatment)))),
textInput("text","Zadajte nazov xovej suradnice",value = "X",
numericInput("farba","Vyberte farbu grafu",min = 1,max=7,value = 1)

),

# Show a plot of the generated distribution
mainPanel(

plotOutput("distPlot",
textOutput("distText"
)
)
))
--------------------------------------
...sústava lin. rovníc
A=matrix(nrow=3, ncol=3, c(4,2,5,3,2,3,0,-2,1))
b=c(4,0,-2)
solve(A,b)


13.
označiť príspevok

dvdkrs123 muž
   2. 5. 2019, 00:52 avatar
#GGPLOT (6 grafov)
mydata = mpg
mydata$year = factor(mpg$year)
g=ggplot(mydata, aes(displ,hwy))
g + geom_point()+facet_wrap(year~drv, nrow = 2, ncol = 3) + geom_smooth(method = "lm", se=FALSE, col="steelblue" +
theme_bw(base_size = 12) + labs(x = "Engine displacement [litres]" + labs(y = "Highway miles pre gallon" +
labs(title = "Fuel economy data from..."


14.
označiť príspevok

dvdkrs123 muž
   2. 5. 2019, 00:52 avatar
#------------------------------------------------------------------------
#Vytvorte funkciu s názvom funkcia, ktorá bude obsahovať premenné c d, n.
#Vytvorte vektor f, ktorý bude nadobúdať hodnoty od 1 po n s krokom 0.5
#Použitím cyklu prejdite všetky čísla vektora f a pomocou vetvenia urobte nasledovné operácie:
# a.Číslo vstupnej premennej c nahraďte na výstupe znakom „A“
# b.Číslo vstupnej premennej d nahraďte na výstupe znakom „B“
# c.Inak vypíšte normálnu hodnotu čísla z vektora f
#Na záver spustite Vami vytvorenú funkciu s potrebnými vstupnými premennými.

funkcia1 = function(c,d,n){
f = seq(1,n,0.5)
s = length(f)
for(i in 1:s){
if(f[i] == c){
f[i] = 'A'
}
if(f[i] == d){
f[i] = 'B'
}
}
print(f)
}

funkcia1(4,3.5,4)

#------------------------------------------------------------

#Vytvorte funkciu s názvom funkcia, ktorá bude mať vstupný parameter n.
#Pomocou cyklu a vetvenia vypočítajte pre čísla 1 až n jeho druhú mocninu
#(ak sa jedná o číslo deliteľné 2), jeho tretiu mocninu
#(ak sa jedná o číslo deliteľné 3 a zároveň 5). Ak číslo nepatrí ani do jednej skupiny,
#tak ho iba vypíšte. Na záver spustite funkciu s názvom funkcia.
#Pomôcka: číslo je deliteľné 2, ak číslo %% 2 == 0.

funkcia <- function(n){
for(i in 1:n){
if(i %% 2 == 0) print(i^2)
else if((i %% 3 == 0) && (i %% 5 == 0)) print(i^3)
}
}
funkcia(4)

#########

funkcia = function(n){
for(i in 1:n){
if(i %%2 == 0){
print(i^2)
}

else if((i %%3 == 0) && (i %%5 == 0)){
print(i^3)
}

else{
print(i)
}
}
}

funkcia(15)

#------------------------------------------------------------
#Vytvorte funkciu, ktorá ude osahovať vstupné premenné a, b, n.
#Použitím cyklu prejdite všetkými číslami od 1 po n, pomocou vetvenia
#urobte nasledovné operácie a hodnoty vypíšte:
# a. Čísla deliteľné a podeľte týmto číslom a
# b. Čísla deliteľné b nahraďte písmenom „B“
# c. Inak vypíšte normálnu hodnotu čísla
#Na záver spusite Vami vytvorenú funkciu so vstupnými premennými a, b, n.
#Pomôcka: číslo je deliteľné napr. 3 ak číslo%%3 == 0.

funkcia = function(a,b,n){
for(i in 1:n){

if(i %% a == 0){
result = i/a
print(result)
}

else if(i%%b == 0){
i = "B"
print(i)
}

else{
print(i)
}

}
}

funkcia(5, 3, 10)
#---------------------------------------------------------

######
funkcia <- function(c, d, n){
i<-1
repeat{
print(i)
i<- i + 0.5
if(i>n) {break}
if(i==c) {print("A"}
if(i==d) {print("B"}
}
}

funkcia(5,6,8)

#---------------------------------------------------------
######
funkcia = function(n){
c = 0
while(c != n){
c = c + 1
if(c%%2 == 0){
d = c^2
print(d)
}
else if(c%%3 ==0 & c%%5 ==0){
e = c^3
print(e)
}
else{
print(c)
}
}
}

funkcia(15)
váš príspevok

Pridávať príspevky môžu iba zaregistrovaní účastníci fóra.

Som zaregistrovaný

nick: heslo:
zostať trvalo prihlásený    
Nie som zaregistrovaný

Vaša prezývka:  

Po zaregistrovaní budete automaticky presmerovaní do tejto témy.

najnovšie príspevky na celom fóre

dnes, 13:06,  Do určitej miery aj laik dokáže na isté veci prísť, keď trochu rozmýšľa a pozrie si...
dnes, 12:50,  isto, ja tu hysačím ako ty , alebo fotón omg *39 ale chápem ze s tvojim neg. nastavanim a...
dnes, 12:50,  https://www.youtube.com/watch?v=H7djqi_A2Ss
dnes, 12:47,  keď sme boli veľmi malí, švehla bol hviezda aj ľudia z miléniovych rokov hrajúci v nhl
dnes, 12:41,  mať život pod psa je krokom spoznávať nové veci
dnes, 12:37,  Kritiku nezvládaš, si na tom obdobne, ako fotón. Kto je slniečkár? Slniečkár desať...
dnes, 12:37,  hurá jedny ľudia zbohatli na neslobode a a socializme, druhí ľudia zbohatli na...
dnes, 12:36,  9. ja to stále píšem, vdaka bohu za migrantov. na čom by si postavili svoju populisticku...
dnes, 12:33,  ja ani neviem kto je slniečkár. ale stači napísat nejaku kritiku a uz trolli ziapu ze som...
dnes, 12:33,  myslí prvé sväté prijímanie
dnes, 12:31,  10. majko1, to bola len čast ich ruskych "kontaktov". zial v tomto prip. bola...
dnes, 12:26,  8. Jj strache hat zurückgetreten.
dnes, 12:24,  -era-, nemusíš sa obhajovať... nemusíš obhajovať ani svoje názory... nepodložené*...
dnes, 12:19,  dostať lásku a dať lásku je základom úspechu, vynaložiť energiu na správnom mieste je...
dnes, 12:12,  7 kesha - myslíš toho pravoslávneho popa? :)
dnes, 12:11,  Až na to, že tí večne nespokojní sú slniečkári. Oni chcú strielať do ludí s iným...
dnes, 12:10,  250. Tull - takže teba to v skutočnosti nezaujíma. Zaujíma ťa iba, že akým spôsobom sa...
dnes, 12:08,  Podozriví nie sú rusi ale nemecký komik čo podobné veci už v minulosti urobil......A...
dnes, 12:08,  To krásne ukazuje, že mesiačikarskym politikom ide veľké H o migrantov a podobné kecy. Im...
dnes, 12:07,  A to neboli hociake mrakodrapy ale najstrazenejsie mrakodrapy sveta a bin ladin zvladol aj tak...
neprehliadnite
df.sk na Facebooku
vyhľadávanie
 
Chceš realizovať svoje sny? Prebuď sa!
Prevádzkuje df.sk | TOPlist
(151 747 bytes in 0,531 seconds)