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í
1055
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

Príspevok bol vymazaný administrátorom.



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, 11:58,  Herečka Silvana Heißenberg píše Merkelové ?V lednu byl Silvaně Heissenberg uzavřen...
dnes, 11:54,  https://scontent.fprg2-1.fna.fbcdn.net/v/t1.0-9/73390742_461641027793473_118561279420923904_n.jpg...
dnes, 11:54,  Západ potrebuje veľkú vojnu, ako soľ.. Už zase.... Potrebuje vymazať doterajšiu...
dnes, 11:51,  kesha 1uvažuješ logicky a to si vynechal ďalšie dve lietadlá . Na čo by bolo vhodné ešte...
dnes, 11:50,  Tak to si už môžem aj naďalej myslieť, že to bolo myslené na budovu.. Pull the building,...
dnes, 11:46,  Nemyslím, čím vačši útok, tým vačšia emocionálna stopa na ľuďoch a tým vačší...
dnes, 11:44,  46. vypatlané, pull it - tú akciu, operáciu *13 pozeráš moc filmov
dnes, 11:40,  Americký sen v realite Dlh USA prekonal hranicu 23 bilión dolárov a  jeho rast naberá...
dnes, 11:38,  napísal som čo sa stalo a čo sme videli.....az neskôr sa začalo špekuľovat, ako mohli...
dnes, 11:37,  59. Dobre. Hoci v prípade trebárs vojny v Iraku stačilo obyčajné podozrenie na ZHN. Pri...
dnes, 11:34,  Útokov pod falošnou vlajkou máme plné dejiny....
dnes, 11:34,  Vojna proti terorizmu.
dnes, 11:33,  57. Boris a aký bol teda dôvod, pre ktorý niekto zosnoval toto,, samoznicenie " Dvojičiek ?
dnes, 11:30,  A na to si ako prišiel? Nemusí v tom byť ani z ďaleka celá americká vláda, ale len pár...
dnes, 11:28,  aha takže americkas vlada je v tom az po usi.....no to mame dalsích ludí......pokracuj.....
dnes, 11:28,  So zamračeným ksichtom ide všetko ľahšie!!!!!! Ultradezinformačný hovnomet invalidného...
dnes, 11:26,  Áno, následnými konšpiráciami oficiálnej správy.
dnes, 11:25,  https://scontent.fprg2-1.fna.fbcdn.net/v/t1.0-9/76781351_2459799940945875_4988951805359554560_n.p...
dnes, 11:25,  Neskutočné, čo si tu napísal.. Vlastne si napísal, že odmietaš používať svoj rozum. Je...
dnes, 11:24,  samozrejme ludia zo zaciatku to videli a nespekulovali....ale následnými konspiraciami sa dali...
neprehliadnite
df.sk na Facebooku
vyhľadávanie
 
Keď sa vám niekoho výrok zdá byť dvojzmyselný, vždy radšej chápte ten optimistickejší význam. Uľahčíte to sebe aj dotyčnému.
Prevádzkuje df.sk | TOPlist
(151 938 bytes in 0,772 seconds)