');
//-->
');
//-->
Základy jazyka R
13
reakcií |
1296
prečítaní |
Tému 30. marca 2019, 12:54 založil dvdkrs123. |
podobné témy:
názov témy
posledná
reakcií
dvdkrs123
![]() |
30. 3. 2019, 12:54 |
![]() |
---|---|---|
#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" ![]() v <- 10:30 # celočíselný vektor v <- c(1+3i, 2+2i) # komplexny vektor # implicitna korekcia y <- c(1.3, "ok" ![]() 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" ![]() 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" ![]() 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" ![]() ![]() 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 ![]() 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("../" ![]() # testovanie existencie adresára file.exists("nazovAdresara" ![]() dir.create("nazovAdresara" ![]() dir.create("data" ![]() # ziskavanie dat zo suborov na webe fileUrl <- "people.tuke.sk ![]() download.file(fileUrl, destfile = "irisdata.csv" ![]() datum <- date() # nacitanie dat iris = read.table("irisdata.csv", sep = ";", header = TRUE) iris1 = read.csv("irisdata.csv" ![]() iris2 = read.csv2("irisdata.csv" ![]() #head(iris,3) #prvé riadky #tail(iris,4) #posledné list.files("SSvHI" ![]() #nacitavanie excel suborov library(xlsx) library(readxl) fileUrl <- "people.tuke.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 ![]() 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" ![]() ![]() 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" ![]() DB = dbGetQuery(genDB,"show databases;" ![]() dbDisconnect(genDB) # ukoncenie spojenia ######################### hg19 <- dbConnect(MySQL(),user="genome", db="hg19",host="genome-mysql.cse.ucsc.edu" ![]() 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" ![]() dbGetQuery(hg19, "select count(*) from acemblyPep" ![]() ######################### 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" ![]() 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" ![]() ![]() 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" ![]() #DATA.TABLE DF = data.frame(x=rnorm(9),y=rep(c("a","b","c" ![]() DT = data.table(x=rnorm(9),y=rep(c("a","b","c" ![]() 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" ![]() #vytvorenie faktorov yesnofac = factor(yesno,levels=c("yes","no" ![]() relevel(yesnofac,ref="no" ![]() 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="." ![]() toupper("programovanie" ![]() tolower("ABCD" ![]() #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" ![]() ![]() 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" ![]() ![]() pollution <- read.csv("avgpm25.csv", colClasses = c("numeric", "character","factor", "numeric", "numeric" ![]() head(pollution) #zobrazí prvých 6 riadkov #sumar dat summary(pollution$pm25) #1D #BOXPLOT - sumar dat v grafe boxplot(pollution$pm25, col = "blue" ![]() abline(h = 12) # boxplot s pridanou ciarou na cisle 12, h=horizontalna #HISTOGRAM - pocetnosti v intervaloch - frekvencie vyskytu hist(pollution$pm25, col = "green" ![]() 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" ![]() ![]() hist(subset(pollution, region == "west" ![]() ![]() # 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" ![]() 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)" ![]() # default values pomocou funkcie PAR par("lty" ![]() par("col" ![]() par("pch" ![]() par("bg" ![]() par("mar" ![]() par("mfrow" ![]() # 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" ![]() with(subset(airquality, Month != 5), points(Wind, Ozone, col = "red" ![]() legend("topright", pch = 1, col = c("blue", "red" ![]() ![]() 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" ![]() 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" ![]() 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() |
F=G.m1.m2/r^2
![]() |
⇑ 30. 3. 2019, 13:17 | |
---|---|---|
Príspevok bol vymazaný administrátorom. |
gabriel pb | 30. 3. 2019, 15:34 |
|
---|---|---|
najlepšie je mať pod kontrolou vlastný postoj na svet
|
dvdkrs123
![]() |
2. 4. 2019, 20:20 |
![]() |
---|---|---|
##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" ![]() 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" ![]() |
dvdkrs123
![]() |
2. 4. 2019, 21:08 |
![]() |
---|---|---|
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" ![]() # [1] 1 4 grep("^a", c("abc", "def", "cba a", "aa" ![]() 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)) |
dvdkrs123
![]() |
23. 4. 2019, 18:54 |
![]() |
---|---|---|
---
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> ![]() 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 ![]() [názov](example.com) ![]() > 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" ![]() ``` |
dvdkrs123
![]() |
23. 4. 2019, 18:55 |
![]() |
---|---|---|
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" ![]() ![]() sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30), hr(), selectInput("select",label = h3("Vyber data pre summary" ![]() ![]() ![]() hr(), checkboxGroupInput("checkbox", "Výber možnosti", choices = c("ano", "nie", "mozno" ![]() ![]() 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) |
dvdkrs123
![]() |
23. 4. 2019, 18:57 |
![]() |
---|---|---|
# 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" ![]() 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" ![]() 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" ![]() ![]() # 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" ![]() ![]() 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" ![]() ![]() ![]() # Lineárne programovanie install.packages("lpSolveAPI" ![]() library(lpSolveAPI) lpmodel <- make.lp(0, 2) # prazdny LP solver s 2 premennymi lp.control(lpmodel, sense="max" ![]() 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" ![]() |
dvdkrs123
![]() |
23. 4. 2019, 22:03 |
![]() |
---|---|---|
---
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) |
dvdkrs123
![]() |
23. 4. 2019, 22:08 |
![]() |
---|---|---|
---
title: "Skupina B" output: html_document --- # Prečo R? -- Statisticky **softver** + jazyk -- [link R](www.rproject.org ![]() -- Je volne dostupny ---- *open source* ### Kvadraticka rovnica Diskriminant vypocitame pomocou vzorca $D= b^{2} -4*a*c$ > Citacia na vzorec: sk.wikipedia.org ![]() ## 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 ![]() # 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 ![]() # 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) |
dvdkrs123
![]() |
23. 4. 2019, 22:11 |
![]() |
---|---|---|
---
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" ![]() ) ) )) |
dvdkrs123
![]() |
23. 4. 2019, 22:13 |
![]() |
---|---|---|
---
title: "Skupina D" output: html_document --- # Preco R? -- statisticky *softver* + jazyk -- [adresa](www.rproject.org ![]() --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) |
dvdkrs123
![]() |
2. 5. 2019, 00:52 |
![]() |
---|---|---|
#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(title = "Fuel economy data from..." ![]() |
dvdkrs123
![]() |
2. 5. 2019, 00:52 |
![]() |
---|---|---|
#------------------------------------------------------------------------
#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ý
najnovšie príspevky na celom fóre
dnes, 07:55, Shagara, ty nerobiš nič iné, len bojuješ proti trojjedinnosti Božej, a tak máš to...
dnes, 05:01, Samozrejme, u Jána 1,18 sa môže použiť aj výraz boh, ale s malým písmenom - b, aby bolo...
včera, 18:11, Slniečkari nechcú aby sa afričania, arabi vzdali identity chcú len aby sa bieli identity vzdali
včera, 18:08, Osvietený je vyššie !!!!!!!!!! Lebo povedal, že on je pán !!!!!!!!!!!!!!!!! *15*15*15
včera, 18:07, 79/ Ja som vitac migrantov??? Co si sa s konom zrazil???:)))
včera, 18:07, pred Bohom sme všetci stejní.....bez ohľadu na rasu.....
včera, 18:06, Budeš orodovať aby si zdochol !!!!!!!!!!!!!!!!!
včera, 18:06, Ondrej, ruku na srdce, ak by sa u nás napríklad začalo nejako ubližovať cigánom, tak by sa...
včera, 18:06, 80Dakujem ti ,
včera, 18:05, Popiči, toto si ešte nevidel !!!!!!!!!!!!!!!!!!!!!
včera, 18:04, Oúkéj ako chceš, oddnes budeš mať tvoje zajebané témy tisícami príspevkov, bude horúco.
včera, 18:04, Pokora je pravda o sebe. Neviem ale ako si ju jednoznačne udržať. Podľa mňa má každý...
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, No a hlavne po tvojej osratej liberálnej rozpálenej !!!!!!!!!!!!!!!! *39*39*39*39*39*39*39
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
dnes, 05:01, Samozrejme, u Jána 1,18 sa môže použiť aj výraz boh, ale s malým písmenom - b, aby bolo...
včera, 18:11, Slniečkari nechcú aby sa afričania, arabi vzdali identity chcú len aby sa bieli identity vzdali
včera, 18:08, Osvietený je vyššie !!!!!!!!!! Lebo povedal, že on je pán !!!!!!!!!!!!!!!!! *15*15*15
včera, 18:07, 79/ Ja som vitac migrantov??? Co si sa s konom zrazil???:)))
včera, 18:07, pred Bohom sme všetci stejní.....bez ohľadu na rasu.....
včera, 18:06, Budeš orodovať aby si zdochol !!!!!!!!!!!!!!!!!
včera, 18:06, Ondrej, ruku na srdce, ak by sa u nás napríklad začalo nejako ubližovať cigánom, tak by sa...
včera, 18:06, 80Dakujem ti ,
včera, 18:05, Popiči, toto si ešte nevidel !!!!!!!!!!!!!!!!!!!!!
včera, 18:04, Oúkéj ako chceš, oddnes budeš mať tvoje zajebané témy tisícami príspevkov, bude horúco.
včera, 18:04, Pokora je pravda o sebe. Neviem ale ako si ju jednoznačne udržať. Podľa mňa má každý...
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, No a hlavne po tvojej osratej liberálnej rozpálenej !!!!!!!!!!!!!!!! *39*39*39*39*39*39*39
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....
včera, 18:03, najnovšie príspevky od tohto účastníka To je jedno, ale čím hlbšie, tým lepšie....