Podstawy programowania w R / Grupa 1
Table of Contents
1 Informacje techniczne
- lab dla osób, które nie miały styczności z R i/lub programowaniem
- strona: michal.ramsza.org
- zaliczenie
- konsultacje
2 Podstawowe informacje
- Instalacja www.r-project.org
- Edytory
- R app dla Win i Mac
- RStudio rstudio.com
- VS Code code.visualstudio.com
- Emacs + ESS
- Terminal (konsola), np. Radian
3 Pierwszy skrypt w R
### Tworzenie próby x <- rnorm( n = 10^3, mean = 0, sd = 1) ### Tworzenie przykładowego histogramu hist( x, col = "lightblue", probability = TRUE, density = 20) lines( density( x, adjust = 1.5), col = "blue", lwd = 2) grid()
4 Podstawowy workflow dla prostej analizy danych
- Zapisywanie i wczytywanie danych liczbowych
- Zapisywanie obrazów
### Generowanie danych x <- data.frame( id = 1:5, value = rnorm( 5)) x ### Zapisaywanie tabel write.csv( file = "./dane.csv", x) ### Wczytywanie tabel y <- read.csv( file = "./dane.csv", header = TRUE) y ### Uwaga dotycząca języka polskiego write.csv2( file = "./dane_pl.csv", x) z <- read.csv2( file = "./dane_pl.csv", header = TRUE) z
### Tworzenie danych x <- rnorm( 100) y <- 1 + 2 * x + rnorm( 100) jpeg( filename = "./rys1.jpg") plot( x, y, pch = 20, cex = 2, col = rgb( 1, 0, 0.5, 0.4), main = "Przykładowy wykres") grid() dev.off() pdf( file = "./rys1.pdf") plot( x, y, pch = 20, cex = 2, col = rgb( 1, 0, 0.5, 0.4), main = "Przykładowy wykres") grid() dev.off() plot( x, y, pch = 20, cex = 2, col = rgb( 1, 0, 0.5, 0.4), main = "Przykładowy wykres") grid() dev.copy( device = png, "./rys2.png") dev.off()
### Tworzenie danych n <- 1000 x <- data.frame( id = 1:n, value = rnorm( n)) ### Zapisywanie do pliku write.csv( file = "./dane.csv", x)
### Wczytanie danych d <- read.csv( file = "./dane.csv", header = TRUE) ### Przeprowadzenie analizy wyniki <- data.frame( "wartość średnia" = mean( d$value), "odchylenie standardowe" = sd( d$value), check.names = FALSE) ### Analiza graficzna hist( d$value, probability = TRUE, breaks = "Scott", col = rgb( 1, 0, .5, 0.5), main = "Przykładowy histogram", xlab = "Wartości", ylab = "Gęstość", xlim = c( -4, 4), ylim = c( 0, .5)) grid( col = rgb( 1, 0, 0, 0.5)) ### Zapisywanie wyników write.csv( file = "./wyniki_analizy.csv", wyniki) dev.copy( device = png, "./wyniki_analizy.png") dev.off()
5 Podstawowe typy bazowe w R
### Język R nie jest typowany x <- 2L x typeof( x) x <- "ala ma kota" x typeof( x) ### Logiczne typeof( TRUE) ### Integers typeof( 2L) ### Double typeof( 2) typeof( 2.48375683) ### Complex typeof( 2 + 2i) ### Stringi typeof( "alal ma kota") ### Lista typeof( list( 1, 2))
6 Wektory
6.1 Tworzenie wektorów
### Tworzenie wektorów c( 2, 4, 7, 9) rbinom( 50, size = 5, prob = 0.5) rnorm( 50) hist( rnorm( 500), xlim = c( -4, 4)) c( "ala", "ma", "kota")
6.2 Generowanie wektorów
### Operator : 1:5 1.1:5 5:1 -3:3 3:-3 2 * 2:5 2^2:5 2:5^2 ### Funkcja seq seq( from = 0, to = 1, by = 0.1) seq( from = 0, to = 1, length.out = 13) seq( from = 0, to = 1, along.with = 1:6) ### Funkcja rep rep( x = 1:4, 10)
6.3 Operacje na wektorach
- Operacje matematyczne na wektorach
- Funkcje podające strukturę wektora (agreagty)
- Operacje algebraiczne i podobne na wektorach
- Recycling rule
### Operacje matematyczne x <- 1:5 x 2 * x x/2 log( x) exp( x) sin( x) x^2 y <- rnorm( 5) y abs( y) round( y, 2) ### Przykład x <- seq( -pi, pi, length.out = 100) y <- sin( x) plot( x, y) plot( x, y, type = "l", col = "blue", lwd = 2) grid() abline( h = 0) abline( v = 0)
x <- 1:5 length( x) max( x) min( x) range( x) mean( x) sd( x)
x <- 1:4 y <- 1:2 z <- 1:3 2 * x + 3 * x x + y ### x -> 1 2 3 4 ### y -> 1 2 1 2 ### -> 2 4 4 6 2 * x - 3 * y x + z 2 * x - 3 * z + 4 * y 1 + x x + 1
6.4 Co może przechowywać wektor?
c( TRUE, F) c( TRUE, F, 4L) c( TRUE, F, 4L, 5) c( TRUE, F, 4L, 5, 1 + 0i) c( TRUE, F, 4L, 5, 1 + 0i, "ala") c( sin, cos) c( c( 1, 2), c( 8, 9)) c( NA, NaN, Inf) sin( c( 1, NA, 2)) sin( sqrt( c( -1, 0, 1))) exp( -1/0) sin( 1/0) NaN/Inf
6.5 Indeksowanie wektorów
- Indeksowanie przez podanie pozycji
- Indeksowanie przez wektory logiczne
- Indeksowanie przez podanie nazwy
### Indeksowanie przez pozycje x <- 5:1 x x[1] x[4] 7[1][1][1] x[2] x[c(1, 3, 5)] x[c(1, 3, 5, 5, 2, 1, 2, 4)] letters[1:5][1 + rbinom( 50, size = 4, .5)] LETTERS ### Indeksowanie przez wektor logiczny x[ c( T, F, T, F, T)] x[x > 3] y <- rnorm( 10) y[y < 0] y[!(y < 0)] x <- rnorm( length( letters)) ind <- x > 0 letters[ind] ### Przykład f(x) = (x - 1) * (x + 1) x <- seq( -2, 2, length.out = 500) y <- (x - 1) * ( x + 1) ind1 <- y < 0 ind2 <- x < 0 plot( x, y, col = "white") lines( x[ind1], y[ind1], col = "red") lines( x[!ind1 & ind2], y[!ind1 & ind2], col = "blue") lines( x[!ind1 & !ind2], y[!ind1 & !ind2], col = "blue") abline( h = 0, lwd = 2 ) abline( v = 0, lwd = 2 ) ### Indeksonowanie przez etykietę x <- round( rnorm( 3), 2) x names( x) <- c( "Obs1", "Obs2", "Obs3") x x["Obs1"] x[ c( "Obs1", "Obs3")] y <- rnorm( 15) names( y) <- LETTERS[1:15] y y[ c( "A", "H", "O")] ### Mutacje x x[1] <- 0 x z <- rnorm( 10) z1 <- sqrt( z) z1[ is.nan( z1)] <- NA z1 z <- rnorm( 10) z[z < 0] <- 0 z
6.6 Macierze
- Tworzenie macierzy
Operacje na macierzach
### Tworzenie macierzy a <- matrix( 1:4, 2, 2) a b <- array( 1:4, c( 2, 2)) b typeof( a) typeof( b) class( a) class( b) attributes( a) attr( a, "dim") <- NULL a attr( a, "dim") <- c( 2, 2) a class( a)
a <- matrix( sample( 1:9), 3, 3) a length( a) dim( a) range( a) mean( a) sd( a) sin( a) a t( a) det( a) sp <- eigen( a) round( solve( a) %*% a, 10) round( solve( sp$vectors) %*% a %*% sp$vectors, 2) round( sp$values, 2) svd( a)
6.7 Indeksowanie macierzy
- Indeksowanie przez podanie pozycji (zarówno na wymiarze jak i jako macierzy)
- Indeksowanie przez podanie wektorów logicznych na wymiarach
- Indeksowanie przez podanie etykiety
- Indeksowanie mieszane
a <- matrix( 1:(3 * 4), 4, 3, byrow = TRUE) a ### Ideksowanie przez podanie pozycji a a[3, 2] a[c( 1,3), c( 2,3)] a[ c( 1, 3), ] a[ , c( 1, 3)] a[ , 1] a[ , 1, drop = FALSE] a[ 3, ] a[ 3, , drop = FALSE] cbind( 1:3, 3:1) rbind( 1:3, 3:1) a[rbind( c( 1,1), c( 3,2), c( 4,1))] ### Indeksowanie przez podanie wektorów logicznych a[ a > 4] a[ a[,1] > 5, ] a[ a[,1] > 5, 1:2] a[ , a[ 3, ] >= 8] ### Indeksonowanie przez etykietę a colnames( a) <- LETTERS[1:3] row.names( a) <- letters[1:4] a[ "b", "A"] a[ c( "a", "d"), c( "A", "C")] ### Indeksowanie mieszane a[1:3, c( "A", "C")] a[ a[,"A"] > 5, c( "A", "B")] a[ a[,"A"] > 5, c( "A", "B")] <- NA a
7 Listy
7.1 Tworzenie list
### Tworzenie list list() a <- list( 1, TRUE, "miejsce trzecie") a b <- list( pierwsze = 1, drugie = TRUE, trzecie = "miejsce trzecie") b
7.2 Operacje na listach
- Łączenie list (dodawanie elementów)
- Usunięcie elementu list
- Zmiana wartości pola
- Zmiana nazwy kluczy
### Łączenie list c() a <- list( pierwsze = "lista a") a b <- list( pierwsze = "lista b") b x <- c( a, b) x y <- x[-2] y d <- list( nazwapola = "lista d") d x <- c( a, d) x x[[1]] <- NULL x x x[[1]] <- 123 x names( x) <- "nowa nazwa pola" x list( "1" = TRUE) funkcje <- list( sin, cos, tan, exp) funkcje x <- seq( -1, 1, length.out = 100) y <- funkcje[[4]]( x) plot( x, y, pch = 20, type = "o", col = "blue") grid() length( funkcje) names( funkcje) <- c( "sin", "cos", "tan", "exp") funkcje names( funkcje)
7.3 Indeksowanie list
- Przez podanie klucza
- Przez podanie pozycji z operatorami
[
i[[
- Przez podanie klucza z operatorami
[
i[[
### Czyszczenie rm(list = ls()) ### Tworzenie przykładowej listy a <- list( value = 123, fun = sin, ids = 1:5, log = TRUE, "wartość inna" = FALSE ) a names( a) a$log a$"log" a$`log` a$"wartość inna" a$`wartość inna` a[[1]] a[[2]] a[["wartość inna"]] a[[`wartość inna`]] # nie chodzi a[[1]] a[1] typeof( a[[1]]) typeof( a[1]) a[c(1, 3, 4)] a[- c( 1, 5)] a[[c(1, 2)]] # nie chodzi
7.4 Ramki danych
- Tworzenie ramki danych
- Ramki danych powstałe z wczytania danych
- Oglądanie ramki danych
### Czyszczenie rm(list = ls()) ### Przykładowe wgrywanie d <- read.csv( file = "./dane.csv", header = TRUE) head( d) typeof( d) class( d) ### Tworzenie a <- data.frame( id = 1:5, value = rnorm( 5)) a attributes( a) attr( a, "class") <- NULL attr( a, "row.names") <- NULL attributes( a) a attr( a, "class") <- "data.frame" attr( a, "row.names") <- 1:5 a matrix( rnorm( 5 * 2), 5, 2) as.data.frame( matrix( rnorm( 5 * 2), 5, 2)) d <- read.csv( "http://michal.ramsza.org/lectures/2_r_programming/data/data_2.csv") names( d) length( d) dim( d) str( d) head( d) tail( d) ### Inna struktura danych library( tibble) dtib <- as_tibble( d) dtib
7.5 Indeksowanie ramek danych
- Indeksowanie jak listy
- Indeksowanie jak macierz
- Przykłady mieszanego ideksowanie
### Czyszczenie rm(list = ls()) ### Tworzenie przykładowej ramki danych a <- data.frame( id = 1:20, value = rnorm( 20), class = sample( letters[1:2], size = 20, replace = TRUE) ) a ### Indeksowanie jak listę names( a) a$id a[["value"]] a[[3]] a[1:2] a[c( 1, 3)] ### Indeksowanie jak macierz a[1:4, 1:2] a[1:7, c( "id", "class")] a[ a$value > 0, c( "id", "class")] ### Uwagi a[1:10, "id"] class( a[1:10, "id"]) a[1:10, "id", drop = FALSE] class( a[1:10, "id", drop = FALSE]) ### Przykład d <- read.csv( "http://michal.ramsza.org/lectures/2_r_programming/data/data_2.csv") names( d) d1 <- d[ c( "Mileage", "Price")] str( d1) class( d1) plot( d1, pch = 20, col = rgb( 0, 0, 1, 0.1)) names( d) sort( unique( d$Brand)) d2 <- d[ d$Brand == "Honda", c( "Mileage", "Price")] str( d2) plot( d2, pch = 20, col = rgb( 0, 0, 1, 0.1)) d3a <- d[ d$Brand == "Honda", c( "Mileage", "Price", "Model")] d3a$Model == "CR-V II" d3b <- d3a[ d3a$Model == "CR-V II", c( "Mileage", "Price")] str( d3b) plot( d3b, pch = 20, col = rgb( 1, 0, 1, 0.5)) m1 <- lm( Price ~ +1 +Mileage, data = d3b) summary( m1) abline( m1, col = "blue") grid()
8 Bloki kodu
- Blok kodu
{}
- Zastosowanie z
with()
### Czyszczenie rm(list = ls()) { x <- 2 print( x) } ### Przykład d <- read.csv( "http://michal.ramsza.org/lectures/2_r_programming/data/data_2.csv") with( d, {hist( Price, main = "Histogram cen", probability = TRUE, col = "lightblue") abline( v = mean( Price), col = "red", lwd = 4) grid()} )
9 Wykonania warunkowe
- Konstrukcja z
if
,if~/~else
- Konstrukcja z
switch
(pozycja bloku oraz etykieta bloku) - Konstrukcja
ifelse()
### Czyszczenie rm(list = ls()) ### Zdania logiczne ### !, ==, &, |, &&, ||, !=, TRUE, FALSE, >, >=, <, <= !TRUE !FALSE TRUE & FALSE TRUE | FALSE c( TRUE, FALSE) == c( TRUE, TRUE) c( TRUE, FALSE) & c( TRUE, TRUE) c( TRUE, FALSE) | c( TRUE, TRUE) c( TRUE, FALSE) && c( TRUE, TRUE) c( TRUE, FALSE) || c( TRUE, TRUE) 2 > 0 2 <= 2 ### Uwagi 2 == 2L "2" == 2 1:10 == seq( 1, 10, by = 1) identical( 2, 2) identical( 2, 2L) identical( "2", 2L) 2 == x
### Podstawowy if x <- 2 if( x > 0){ print( "x jest dodatni") } x <- -2 if( x > 0){ print( "x jest dodatni") } ### Rozbudowany if, if(){} else {} x <- -2 if( x > 0){ print( "x jest dodatni") } else { print( "x nie jest dodatni") } if( x > 0){ print( "x jest dodatni") } else { print( "x nie jest dodatni") } ### switch() id <- 3 switch( id, { print( " Blok 1")}, { print( " Blok 2")}, { print( " Blok 3")} ) id <- "typ3" switch( id, typ1 = { print( " Blok 1")}, typ2 = { print( " Blok 2")}, typ3 = { print( " Blok 3")} ) ### ifelse() ## 1 2 1 3 ## 0 0 0 0 ## T F F T ## 1 0 0 3 x <- rnorm( 5) y <- rep( 0, 5) x[x < 0] <- 0 x ifelse( x > 0, x, y) x s <- rnorm( 10) classDodatnia <- rep( "a", 10) classUjemna <- rep( "b", 10) sDF <- data.frame( value = s, label = ifelse( s > 0, classDodatnia, classUjemna)) sDF
10 Iterowanie (proceduralne)
- Pętle
for
,while
- Konstrukcje z
next
ibreak
### Czyszczenie rm(list = ls()) ### Typowa pętla for() for( k in 1:10){ print( k^2) } ### Typowa pętla while() while( TRUE){ print( "działam") } k <- 1 while( k < 11){ print( k^2) k <- k + 1 } cond <- TRUE while( cond){ x <- rbinom( 1, 10, .5) print( x) cond <- x > 2 } ### Przykład files <- dir() for( f in files){ cat( paste0( "\nNazwa pliku: ", f, " | Wielkość pliku: ", as.character( file.info(f)$size))) } cat( "\n") ### Przykład / generowanie plików z losowymi danymi dirName <- "data" if( !dir.exists( paths = dirName)){ dir.create( path = dirName) } ## Zamiana katlogu roboczego na inny katalog roboczy wd <- setwd( dir = dirName) ## Tworzenie plików z losowymi danymi for( k in 1:100){ fileName <- paste0( "data_", as.character( k), ".csv") d <- data.frame( id = 1:10, value = rnorm( 10)) write.csv( d, file = fileName) } ## Zamiana katalogu roboczego na stary katalog roboczy setwd( wd) ### Przykład / tworzenie analizy na podstawie wielu plików dirName <- "data" ## Stworzenie listy plików, na których będziemy pracować files <- dir( path = dirName, pattern = ".csv", full.names = TRUE) ## Agregacja danych d <- data.frame() for( f in files){ d <- rbind( d, read.csv( file = f)[, c("id", "value")]) } ## Przeprowadzenie analizy na zagregowanych danych hist( d$value, main = "Dane całościowe")
### Czyszczenie rm(list = ls()) ### Konstrukcja z break for( j in 1:10){ print( j) if( j > 5){ break} } for( k in 1:5){ for( j in 1:10){ print( j) if( j > 5){ break} } } ### Konstrukcja z next for( k in 1:10){ if( k == 5){ next} print( k) } for( j in 1:3){ for( k in 1:10){ if( k == 5){ next} print( k) } }
11 Funkcje
- Funkcje bez argumentów
- Funkcje z pojedynczym i wieloma argumentami
- Wartości domyślne argumentów
- Funkcje z nieustalona liczbą argumentów z
...
- Nietypowe nazwy funkcji i definiowanie funkcji o nietypowych nazwach
- Funkcje czyste (pure functions, lambda functions)
- Operatory binarne
- Funkcje jako argumenty funkcji i wartości zwracane przez funkcje (function factories)
- Wprowadzenie do zakresów ważności zmiennych
### Sprzątanie rm(list = ls()) ### Podstawowe funkcje f <- function(){} f() f <- function(){ print( "ala ma kota") return( nchar( "ala ma kota")) } f <- function(){ print( "ala ma kota") nchar( "ala ma kota") } f() f <- function( x){ x^2 } f( 2) f( 4) f <- function( s){ print( s) nchar( s) } f( "ala ma kota") f( "ala ma kota, który siedzi na płocie") f <- function( s){ if( nchar( s) < 20){ print( s) } else { print( "Podane string jest za długi") } } f( "ala ma kota") f( "ala ma kota, który siedzi na płocie") f <- function( x, y){ x^y } f( 2, 2) f( 2, 5) f( 5, 2) ### Przykład: funkcja do tworzenie wykresów innych funkcji myPlot1 <- function( domain, fun){ x <- seq( from = min( domain), to = max( domain), length.out = 10) y <- fun( x) plot( x, y) } myPlot1( c( -pi, pi), sin) myPlot2 <- function( domain, fun, n){ x <- seq( from = min( domain), to = max( domain), length.out = n) y <- fun( x) plot( x, y) } myPlot2( c( -pi, pi), sin, 10) myPlot2( c( -pi, pi), sin, 100) myPlot2( domain = c( -pi, pi), fun = cos, n = 100) myPlot2( n = 100, fun = cos, domain = c( -pi, pi)) myPlot2( 100, f = cos, d = c( -pi, pi)) ### Domyślne wartości argumentów myPlot3 <- function( fun, domain = c( 0, 1), n = 100){ x <- seq( from = min( domain), to = max( domain), length.out = n) y <- fun( x) plot( x, y) } myPlot3( c( -pi, pi), sin) myPlot3( c( -pi, pi), sin, 1000) myPlot3( sin) ### Przelotki ... myPlot4 <- function( fun, domain = c( 0, 1), n = 100, ...){ x <- seq( from = min( domain), to = max( domain), length.out = n) y <- fun( x) plot( x, y, ...) } myPlot4( sin, c( -pi, pi), type = "o", pch = 20, cex = 2, col = "red", main = "Przykładowy wykres", xlab = "Wartości x", ylab = "Wartości y", fg = "blue") ### Nietypowe nazwy funkcji i definiowanie funkcji o nietypowych nazwach x <- 2 `<-`( x, 999) x y <- sample( 1:5) y y[3] `[`( y, 3) `21` <- function( x){ x + 21 } `21`( 21) `ala ma kota` <- function(){ print( "ala ma kota") } `ala ma kota`() ( 2 + 2) `(` <- function( x){ x + 1 } ( 2 + 2) rm( `(`) ( 2 + 2) ### Funkcje czyste (pure functions, lambda functions) (function( x){ x^2})(4) ### Operatory binarne a <- matrix( rnorm( 3 * 2), 3, 2) b <- matrix( rnorm( 3 * 2), 2, 3) a %*% b 7 %/% 3 7 %% 3 `%G%` <- paste0 "ala" %G% "ma" %G% "kota" `%A%` <- function( left, right){ `%G%` <- paste0 print( "Po lewej stronie stoi " %G% as.character( left)) print( "Po prawej stronie stoi " %G% as.character( right)) } 2 %A% 5 `%A%` <- function( left, right){ right( left) } rnorm( 5) %A% abs %A% mean rnorm( 5) %A% abs %A% function( x){ x^2} %A% mean d <- rnorm( 100) %A% cumsum %A% function( x){ plot( x, pch = 20, col = "red"); x} %A% function( x){ lines( x, col = "blue"); grid(); x} d ### Funkcje jako argumenty funkcji i funkcje jako wartości zwracane ### przez funkcje (function factories) makeAddFunction <- function( a){ function( x){ x + a} } f2 <- makeAddFunction( 2) f2 f2( 2) f2( 10) f11 <- makeAddFunction( 11) f11( 10) f11 ### Wprowadzenie do zakresów zmienności zmiennych rm(list = ls()) ls() f <- function(){ x <- "fox" print( x) } ls() f() ls() x <- "brown fox" f() g <- function(){ print( x) } g() h <- function( x){ print( x) x <- "ala ma kota" print( x) } x h( x) x
12 Iterowanie (funkcyjne)
- Wykorzystanie
apply()
,lapply()
i podobnych konstrukcji.
### Czyszczenie rm(list = ls()) ### Iterowaie proceduralne for( i in 1:10){ print( i^2) } lapply( X = 1:10, FUN = function( x){ x^2}) sapply( X = 1:10, FUN = function( x){ x^2}) unlist( lapply( X = 1:10, FUN = function( x){ x^2})) a <- matrix( rnorm( 10 * 5), 10, 5) a apply( X = a, MARGIN = 1, FUN = mean) apply( X = a, MARGIN = 2, FUN = mean) k <- 10^5 a <- matrix( rnorm( k * 5), k, 5) t1Start <- Sys.time() x <- c() for( i in 1:dim( a)[1]){ x <- c( x, mean( a[i,])) } t1End <- Sys.time() t1End - t1Start t2Start <- Sys.time() y <- apply( a, 1, mean) t2End <- Sys.time() t2End - t2Start identical( x, y) t3Start <- Sys.time() x <- rep( NA, dim( a)[1]) for( i in 1:dim( a)[1]){ x[i] <- mean( a[i,]) } t3End <- Sys.time() t3End - t3Start
13 Tematy dodatkowe
13.1 Manipulowanie danymi
- data frames
tibble
packagesdplyr
package
### Czyszczenie rm(list = ls()) ### Ramki danych data.frame( id = 1:5, value = rnorm( 5)) a <- data.frame( id = 1:100, value = rnorm( 100)) a head( a) tail( a) str( a) b <- data.frame( x = rnorm( 100), y = 1 + x + rnorm( 100)) ### Wgrywanie biblioteki library( tibble) a <- tibble( x = rnorm( 100), y = 1 + x + rnorm( 100), class = ifelse( x > 0, "a", "b")) b <- data.frame( id = 1:100, value = rnorm( 100)) class( b) bTB <- as_tibble( b) bTB class( a) a$x a[c( "x", "class")] a["x"] a[a$x > a$y, "class"] a[["x"]] typeof( a)
select()
filter()
arrange()
mutate()
summarise()
group_by()
%>%
### Czyszczenie rm(list = ls()) ### Biblioteki library( dplyr) ### Dane d <- as_tibble( read.csv( "http://michal.ramsza.org/lectures/2_r_programming/data/data_2.csv")) dim( d) d ### select() select( .data = d, "Price", "Mileage") d %>% select( "Price", "Mileage") d %>% select( Price, Mileage) plot( d %>% select( "Price", "Mileage")) plot( d %>% select( "Mileage", "Price"), col = rgb( 0, 0, 1, 0.1), pch = 20) d d %>% select( -Brand, -Model, -Negotiation, -City) d %>% select( Gas_type:Price) d %>% select( starts_with( "M")) d %>% select( one_of( "Price", "Mileage", "Owner")) d[, c( "Price", "Mileage", "Owner")] # fails ### filter d %>% filter( Price < 1000) sort( unique( d$Brand)) d %>% filter( Price < 2000 & Brand == "Audi") d %>% filter( Price < 1000 & Brand == "Fiat" | Price < 2000 & Brand == "Audi") d %>% filter( Brand == "Audi" & Voivodeship == "Mazowieckie") %>% select( Price) ### arrange d %>% arrange( Price) d %>% arrange( desc( Price)) d %>% arrange( Brand, desc( Price)) d %>% filter( Brand %in% c( "Honda", "Fiat")) %>% arrange( desc( Price), Brand) ### mutate x <- d %>% select( Year_prod, Price, Mileage) %>% mutate( MpY = Mileage / (2019 - Year_prod)) %>% select( MpY, Price) plot( x, col = rgb( 0, 0, 1, 0.2), pch = 20, cex = 2) ### summarise d %>% summarise( "średni przebieg" = mean( Mileage), "średnia cena" = mean( Price), "minimalna cena" = min( Price), "maksymalna cena" = max( Price) ) ### group_by d %>% group_by( Brand) %>% summarise( mean_price = mean( Price), std_dev = sd( Price)) %>% arrange( Brand, mean_price) d %>% group_by( Voivodeship) %>% summarise( mean_price = mean( Price)) %>% arrange( desc( mean_price)) d %>% group_by( Voivodeship) %>% summarise( num_of_offers = n()) %>% arrange( desc( num_of_offers)) d %>% mutate( newCar = ifelse( Mileage < 20000, 1, 0)) %>% group_by( Voivodeship, newCar) %>% summarise( num_of_offers = n()) %>% arrange( Voivodeship, desc( num_of_offers)) d %>% mutate( newCar = ifelse( Mileage < 20000, 1, 0)) %>% group_by( Voivodeship, newCar) %>% summarise( num_of_offers = n(), mean_price = mean( Price)) %>% arrange( Voivodeship, desc( num_of_offers)) ### Łączenie tabel *_join a <- tibble( id = (1:5)[-2], name = LETTERS[1:4], value = rnorm( 4)) a b <- tibble( id = 1:4, nameSmall = sample( letters[1:2], 4, replace = TRUE), value2 = rbinom( 4, 10, .5)) a b left_join( a, b, by = "id") right_join( a, b, by = "id") inner_join( a, b, by = "id") full_join( a, b, by = "id") a %>% left_join( b, by = "id") %>% select( id, value, value2)
13.2 Grafika
- standard stack (
par()
,plot()
,lines()
, …) ggplot2
package (https://www.springer.com/gp/book/9783319242750, https://ggplot2-book.org/)
### Czyszczenie rm(list = ls()) ### Pakiety library( dplyr) ### Przykładowe dane data( iris) d <- as_tibble( iris) dd <- d %>% select( -Species) ddd <- cmdscale( dist( dd), eig = TRUE, k = 2)$points ### Przykładowy wykres plot( ddd) plot( ddd, pch = 20, cex = 2, col = rgb( 1, 0, 0, .5), xlab = "wymiar 1", ylab = "wymiar 2", las = 0) grid() graphics::.Pars graphics:::.Pars par() par()$fg par( fg = "magenta") par()$fg ### Przykład bardziej skomplikowany par( mai = c( 1, 1, 2, .5), bg = rgb( .1, .1, .1) ) plot( ddd, main = "Reduced data", xlab = "Reduced dim 1", ylab = "Reduced dim 2", xlim = c( -4, 4), ylim = c( -4, 4), pch = 20, cex = 2, col = rgb( 0, 0, 1, .8), bty = "7", cex.main = 4, cex.axis = .5, cex.lab = 2, col.axis = rgb( 0, 1, 1), col.main = rgb( 0, 0.8, 1), col.lab = "red", fg = "red", las = 1, xaxp = c( -4, 4, 10), yaxp = c( -4, 4, 20) ) grid( col = "white", lty = 2, lwd = 0.5) ### Jeszcze bardziej skomplikowany i ładniejszy przykład names( iris) iris$Species d1 <- iris %>% filter( Species == "setosa") %>% select( Sepal.Length, Sepal.Width) d2 <- iris %>% filter( Species == "versicolor") %>% select( Sepal.Length, Sepal.Width) head( d1) head( d2) xrange <- range( d1$Sepal.Length, d2$Sepal.Length) yrange = range( d1$Sepal.Width, d2$Sepal.Width) s <- 0.8 # margins k <- .9 # color par( mfrow = c( 2, 1), oma = c( 2, 1, 1, 2), mai = c( s, 1, s/2, 1), cex.axis = .9, bg = "white", fg = "black") plot( d1, xlim = xrange, ylim = yrange, pch = 20, col = rgb( k, 0, 1, .5), font.lab = 3 ) mtext( text = "Setosa", outer = FALSE, line = 1, side = 4, cex = 2, col = rgb( k, 0, 1, .2), font = 4) abline( lm( Sepal.Width ~ Sepal.Length, data = d1), col = rgb( k, 0, 1, .4), lty = 4) plot( d2, xlim = xrange, ylim = yrange, pch = 20, col = rgb( 0, k, 1, .5), font.lab = 3 ) mtext( text = "Versicolor", outer = FALSE, line = 1, side = 4, cex = 2, col = rgb( 0, k, 1, .2), font = 4) abline( lm( Sepal.Width ~ Sepal.Length, data = d2), col = rgb( 0, k, 1, .4), lty = 4)
### Czyszczenie rm(list = ls()) ### Pakiety library( dplyr) library( ggplot2) ### Dane d <- as_tibble( read.csv( "http://michal.ramsza.org/lectures/2_r_programming/data/data_2.csv")) ### Pierwszy wykres p1 <- ggplot( data = d, aes( x = Mileage, y = Price)) + geom_point() typeof( p1) names( p1) p1$labels$x <- "Przebieg samochodu" print( p1) ### Bardziej zaawansowane mapowania i geomy ggplot( data = d, aes( x = Mileage, y = Price, color = Brand)) + geom_point() d1 <- d %>% filter( Brand %in% c( "Fiat", "Audi")) ggplot( data = d1, aes( x = Mileage, y = Price, color = Brand, size = Engine_capacity)) + geom_point( alpha = 0.1) ggplot( d, aes( x = Mileage)) + geom_histogram( binwidth = 1000) ggplot( d, aes( x = Mileage)) + geom_freqpoly( binwidth = 1000) d1 <- d %>% select( Brand) %>% filter( Brand %in% c( "Audi", "Fiat", "Honda", "Toyota")) %>% arrange( Brand) ggplot( d1, aes( x = Brand)) + geom_bar( color = "red", fill = "green") d1 <- d %>% select( Brand, Price) %>% filter( Brand %in% c( "Audi", "Fiat", "Honda", "Toyota")) %>% group_by( Brand) %>% summarise( mean_price = mean( Price)) d1 ggplot( d1, aes( x = Brand, y = mean_price)) + geom_bar( stat = "identity") d1 <- d %>% select( Brand, Price) %>% filter( Brand %in% c( "Audi", "Fiat", "Honda", "Toyota")) d1 ggplot( d1, aes( x = Brand, y = Price)) + geom_boxplot() ggplot( d1, aes( x = Brand, y = Price)) + geom_jitter() ggplot( d1, aes( x = Brand, y = Price)) + geom_violin() d1 <- d %>% select( Brand, Price) %>% filter( Brand %in% c( "Audi", "Fiat")) d1 ggplot( d1, aes( x = Price)) + geom_histogram( bins = 200) + facet_wrap( ~ Brand, ncol = 1) d3 <- d %>% select( Year_prod, Price, Brand) %>% group_by( Year_prod, Brand) %>% summarise( meanPrice = mean( Price)) %>% arrange( Brand, Year_prod) d3 g <- ggplot( d3, aes( x = Year_prod, y = meanPrice, color = Brand)) + geom_point() + geom_line() + xlab("year of production") + ylab("average price") + xlim( 1990, 2010) + ylim( NA, 10^6) + labs( title = "Average yearly prices", subtitle = "Data for used cars", caption = "Crash course on R") print( g) g + theme( plot.title=element_text(size=20, face="bold", family="American Typewriter", color="tomato", hjust=0.5, lineheight=1.2), # title plot.subtitle=element_text(size=15, family="American Typewriter", face="bold", hjust=0.5), # subtitle plot.caption=element_text(size=15), # caption axis.title.x=element_text(vjust=10, size=15), # X axis title axis.title.y=element_text(size=15), # Y axis title axis.text.x=element_text(size=10, angle = 30, vjust=.5), # X axis text axis.text.y=element_text(size=10)) # Y axis text
13.3 Import i eksport danych
- text based formats (
read.csv
,write.table
) - XLSX format (
openxlsx
package)
### Czyszczenie rm(list = ls()) ### Przykładowe dane d <- data.frame( id = 1:5, value = rnorm(5), class = sample(letters[1:2], 5, replace = TRUE)) d ### CSV write.csv(file = "./dane.csv", d) system("ls -l", intern = TRUE) system("cat ./dane.csv", intern = TRUE) read.csv(file = "./dane.csv") ### write.table write.table(file = "./dane1.data", x = d, sep = "$", dec = "@", row.names = FALSE, fileEncoding = "UTF-8") system("cat ./dane1.data", intern = TRUE) read.table(file = "./dane1.data", sep = "$", dec = "@", fileEncoding = "UTF-8") ### MR: todo
### Czyszczenie rm(list = ls()) ### Biblioteki library(openxlsx) library( dplyr) ### Czytanie data1 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI", startRow = 1, colNames = TRUE, rowNames = FALSE) data2 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI", startRow = 1, colNames = FALSE, rowNames = FALSE) head(data2) data3 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI", startRow = 2, colNames = FALSE, rowNames = FALSE) head(data3) data4 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI2", startRow = 1, colNames = TRUE, rowNames = TRUE) head(data4) ### Czytanie fragmentów data5 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI2", colNames = TRUE, rows = 1:5) data5 data6 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI2", colNames = TRUE, rows = 1:5, cols = 2:4) data6 data7 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI3", colNames = TRUE, startRow = 1, skipEmptyRows = TRUE) data7 data8 <- read.xlsx(xlsxFile = "./data/data_05.xlsx", sheet = "CPI3", colNames = TRUE, startRow = 1, skipEmptyRows = FALSE) data8 ### Bardziej skomplikowany przykład ### Reading in complicated tables readClientTable <- function( fileName, sheetName, xrow, xcol){ ## reading in client's name klient <- unlist( read.xlsx( xlsxFile = fileName, sheet = sheetName, colNames = FALSE, rowNames = FALSE, rows = xrow, cols = xcol)) ## reading in years' labels lata <- unlist( read.xlsx( xlsxFile = fileName, sheet = sheetName, colNames = FALSE, rowNames = FALSE, rows = xrow + 1, cols = (xcol + 1):(xcol + 5))) ## reading in classes' labels kategorie <- unlist( read.xlsx( xlsxFile = fileName, sheet = sheetName, colNames = FALSE, rowNames = FALSE, rows = (xrow + 2):(xrow + 4), cols = xcol)) ## reading in values wartosci <- as.matrix( read.xlsx( xlsxFile = fileName, sheet = sheetName, colNames = FALSE, rowNames = FALSE, rows = (xrow + 2):(xrow + 4), cols = (xcol + 1):(xcol + 5))) ## creating a matrix colnames( wartosci) <- lata row.names( wartosci) <- kategorie wartosci } readClientTable( fileName = "./data/data_05.xlsx", sheetName = "Data", xrow = 5, xcol = 3) readClientTable( fileName = "./data/data_05.xlsx", sheetName = "Data", xrow = 5, xcol = 11) readClientTable( fileName = "./data/data_05.xlsx", sheetName = "Data", xrow = 12, xcol = 3) readClientTable( fileName = "./data/data_05.xlsx", sheetName = "Data", xrow = 12, xcol = 11) ### Tworzenie raportów w XLSX ### Przykład prosty data <- data.frame( label = letters) %>% mutate( x = rnorm( length( label))) %>% mutate( y = 2 * x + 1 + rnorm( length( x))) head( data) write.xlsx( x = data, file = "./data_3.xlsx") write.xlsx( x = data, file = "./data_3a.xlsx", asTable = TRUE) write.xlsx( x = data, file = "./data_4.xlsx", asTable = TRUE, title = "The X data", creator = "Michał Ramsza", sheetName = "Some data", gridLines = FALSE, tabColour = "red" ) ### Zrobienie znacznie bardziej skomplikowanego raportu data <- data.frame( x = rnorm( 500)) %>% mutate( y = 2 * x + 0.3 * x^2 - 1 + rnorm( 500)) head( data) ### Tworzenie wirtualnego pliku wb <- createWorkbook( creator = "Michał Ramsza", title = "Example workbook", subject = "Linear regression", category = "Workshop" ) wb ### Dodawanie arkuszy addWorksheet( wb = wb, sheetName = "Linear regression", tabColour = "blue", gridLines = FALSE, header = c("Left", "&[Date]", "Right"), footer = c("Left", "Środek", "Right"), visible = TRUE) wb styl1 <- createStyle( fontName = "Calibri", fontSize = 14, fontColour = "tomato1", numFmt = "GENERAL", fgFill = "snow2", borderColour = "snow3", halign = "center", valign = "center", ) styl2 <- createStyle( fontName = "Calibri", fontSize = 11, fontColour = "black", numFmt = "NUMBER", border = "TopBottomLeftRight", borderColour = "black", halign = "center", valign = "center", ) etykiety <- names( data) dim( etykiety) <- c( 1, 2) writeData(wb = wb, sheet = 1, x = etykiety, startCol = 2, startRow = 2,colNames = FALSE, rowNames = FALSE) addStyle(wb = wb, sheet = 1, style = styl1, rows = 2, cols = 2:3, gridExpand = TRUE) setRowHeights( wb = wb, sheet = 1, rows = 2, heights = 40) setColWidths( wb = wb, sheet = 1, cols = 2:3, widths = 20) writeData( wb = wb, sheet = 1, x = data, startCol = 2, startRow = 3, colNames = FALSE, rowNames = FALSE) addStyle( wb = wb, sheet = 1, style = styl2, rows = 3:502, cols = 2:3, gridExpand = TRUE) plot( data, pch = 20, cex = 2, col = rgb( 0, 0, 1, 0.2), main = "Comparison of linear regression\nand polynomial smoothing") grid() abline( lm( y ~ x, data = data), col = "blue", lty = "dashed") lines( lowess( x = data$x, y = data$y, f = 1/2)) legend( x = "topleft", legend = c("linear regression", "LOWESS"), col = c( "blue", "black"), lty = c( "dashed", "solid"), bg = "white", y.intersp = 2, text.width = 2, bty = "o") insertPlot( wb = wb, sheet = 1, startRow = 2, startCol = 5, width = 6, height = 5, dpi = 600) dev.off() saveWorkbook( wb = wb, file = "./data_5.xlsx", overwrite = TRUE)