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

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 i break
### 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 packages
  • dplyr 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

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

Date: 2021-02-22 Mon 00:00

Author: Michał Ramsza

Created: 2021-04-12 Mon 16:16

Validate