POMOCNICZEK:

1. uruchomienie linijki kodu - ctrl + enter
2. zakomentowanie - ctrl + shift + c

Korzystanie z pomocy (HELP)

?summary

## starting httpd help server ... done

KALKULATOR

a<-3  # a=3
b<-15  # b=15
a+b

## [1] 18

a-b

## [1] -12

a*b

## [1] 45

a/b

## [1] 0.2

a<-c(1,5,3)
prod(a) # iloraz z wektora 

## [1] 15

GENEROWANIE CIĄGÓW

Ciąg liczb od 1 do 5

1:5

## [1] 1 2 3 4 5

Przypisanie do zmiennej “a” ciągu liczb od 1 do 30

a<-1:30
a1<-c(1:30)

Przypisanie do zmiennej “a1” ciągu złożonego z 4 elemntów zmiennej jakościowej, gdzie “M” to mężczyzna, a “K” to kobieta

a1<-c("M", "K","M","K")

Dlugość ciągu

length(a)

## [1] 30

Generowanie ciągu składającego się z elemntów od 1 do 5 powtórzony 5 razy

rep(1:5,5) ### od 1 do 5 powtarzamy 5 razy

##  [1] 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5

Generowanie ciągu skłądającego się z elementów od 1 do 5, gdzie każdy z elemntów jest powtórzony 2 razy

rep(1:5,each=2)

##  [1] 1 1 2 2 3 3 4 4 5 5

INDEKSOWANIE ELEMENTÓW CIĄGU

Wyświetlenie ciągu 10 liczb z zakresu od -1 do 1

a=seq(-1,1,length=10)
a

##  [1] -1.0000000 -0.7777778 -0.5555556 -0.3333333 -0.1111111  0.1111111
##  [7]  0.3333333  0.5555556  0.7777778  1.0000000

Wyświetlenie piątego elementu z ciągu “a”

a[5]

## [1] -0.1111111

Wyświetlenie pierwszego i szóstego elementu z ciągu “a”

a[c(1,6)]

## [1] -1.0000000  0.1111111

Usunięcie pierwszego elementu z ciągu “a”

a

##  [1] -1.0000000 -0.7777778 -0.5555556 -0.3333333 -0.1111111  0.1111111
##  [7]  0.3333333  0.5555556  0.7777778  1.0000000

a[-1]

## [1] -0.7777778 -0.5555556 -0.3333333 -0.1111111  0.1111111  0.3333333  0.5555556
## [8]  0.7777778  1.0000000

Usunięcie drugiego i szóstego elementu z ciągu “a”

a

##  [1] -1.0000000 -0.7777778 -0.5555556 -0.3333333 -0.1111111  0.1111111
##  [7]  0.3333333  0.5555556  0.7777778  1.0000000

a[-c(2,6)]

## [1] -1.0000000 -0.5555556 -0.3333333 -0.1111111  0.3333333  0.5555556  0.7777778
## [8]  1.0000000

INSTALOWANIE PAKIETÓW

Instalowanie pakietu “readxl” zwierającego między innymi funkcję do otwierania plików o rozszerzeniu xlsx. Instalacje uruchamiamy raz!

#install.packages("readxl")

Załadowanie pakietu. Wywołanie pakietu uruchamiane jest przy każdym ponownym uruchomieniu R Studio

library(readxl)

Ładowanie zbioru za pomoca funkcji “read_excel”, znajdującej się w bibliotece “readxl” UWAGA! Prosze podać własną ścieżkę do danych.

dane <- read_excel("C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/PRZYGOTOWANIE_DANYCH_WALIDACJA_DATA_MANAGMENT/Dane_AW_zanieczyszczenie.xlsx", 
                                       sheet = "Dane")

Zamiana danych na data frame czyli ramkę danych

dane<-as.data.frame(dane)

Sprawdzenie typu zmiennych ze zbioru “dane”

str(dane)

## 'data.frame':    16 obs. of  8 variables:
##  $ Województwo: chr  "DOLNOŚLĄSKIE" "KUJAWSKO-POMORSKIE" "LUBELSKIE" "LUBUSKIE" ...
##  $ NO         : num  3.81 5.94 2.9 2.65 14.56 ...
##  $ CO         : num  2.55 7.46 2.78 2.41 12.72 ...
##  $ CO2        : num  4.4 4.45 2.38 2.14 16.14 ...
##  $ PYŁ %      : num  6.31 5.13 4.48 2.4 5.85 5.36 7.24 3.26 3.41 2.11 ...
##  $ PALIWA     : num  4.49 4.87 3.75 7.2 6.74 ...
##  $ ŚCIEKI     : num  7.99 7 2.74 2.62 5.27 ...
##  $ ZIELEŃ     : num  4.18 3.3 4.16 3.75 3.8 ...

INDEKSOWANIE - WYBÓR WIERSZY I KOLUMN

Wyświetlenie pierwszego wiersza ze zbioru “dane:

dane [ 1, ]

##    Województwo    NO    CO   CO2 PYŁ % PALIWA ŚCIEKI ZIELEŃ
## 1 DOLNOŚLĄSKIE 3.813 2.546 4.399  6.31  4.494   7.99  4.177

Wyświetlenie drugiej kolumny ze zbioru “dane”

dane [ , 2]

##  [1]  3.813  5.936  2.903  2.655 14.561  4.432  5.463 13.284  2.254  1.992
## [11]  3.247  9.376 17.349  1.676  6.368  5.730

Wyświetlenie drugiego wiersza i trzeciej kolumny ze zbioru “dane”

dane [ 2,3]

## [1] 7.464

Wyodrębnienie pierwszej kolumny ze zbioru “dane” zawierającej nazwy województw. Przypisanie nazw województw do zmiennej “woje”

woje<-dane[ ,1]

Przypisanie nazw województw jako nazwy wierszy w ramce danych

row.names(dane)<-woje

Usunięcie kolumny z nazwami województw, która nie jest już potrzebna ze względu na przypisanie województw jako nazwy wierszy ramce danych

dane<-dane[,-1]

FILTROWANIE

Skrót klawiszowy: ctrl+shift+m -> %>%

wines%>%
  filter( points >= 94, price < 25)

## # A tibble: 66 x 14
##     ...1 country description designation points price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1  5011 US      Truly stun~ Lewis Esta~     95    20 Washing~ Columbi~ Columbi~
##  2  6267 US      This taste~ Lucille La~     94    18 Washing~ Yakima ~ Columbi~
##  3 10763 Portug~ His skills~ Rapariga d~     94    23 Alentej~ <NA>     <NA>    
##  4 12944 France  The Côte d~ Côte du Py~     94    24 Beaujol~ Morgon   <NA>    
##  5 12945 France  Be gratefu~ Vieilles V~     94    24 Beaujol~ Moulin-~ <NA>    
##  6 12967 France  A firm and~ <NA>            94    24 Beaujol~ Moulin-~ <NA>    
##  7 15196 France  The home v~ Château Bo~     95    20 Southwe~ Madiran  <NA>    
##  8 15211 US      The deep g~ <NA>            94    22 Oregon   Willame~ Willame~
##  9 17294 US      Opulento i~ Opulento D~     94    20 Washing~ Yakima ~ Columbi~
## 10 17983 France  This is on~ <NA>            94    20 Provence Coteaux~ <NA>    
## # i 56 more rows
## # i 5 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>

LOSOWANIE

Losowanie próbki 15% obserwacji ze zbioru.

wines%>%
sample_frac( 0.15)

## # A tibble: 19,496 x 14
##      ...1 country   description       designation points price province region_1
##     <dbl> <chr>     <chr>             <chr>        <dbl> <dbl> <chr>    <chr>   
##  1  91741 Italy     Aromas of scorch~ Le Valenta~     86    30 Tuscany  Morelli~
##  2  72623 US        Solid and elegan~ Estate Bot~     90    50 Califor~ Chalk H~
##  3  70316 Italy     From the tiny is~ Capofaro        93    66 Sicily ~ Salina  
##  4  88574 US        This racy, vivid~ <NA>            90    16 Oregon   Oregon  
##  5     17 Argentina Raw black-cherry~ Winemaker ~     87    13 Mendoza~ Mendoza 
##  6  14442 France    From the plateau~ Les Picass~     91    20 Loire V~ Chinon  
##  7  79345 Portugal  This is fairly t~ <NA>            85     8 Vinho V~ <NA>    
##  8 106481 US        Apples and pears~ Charval Wh~     85    20 Virginia Virginia
##  9 128250 US        While a bit rest~ Reserve         87    25 New York New York
## 10   7230 US        This is a sophis~ <NA>            87    14 Washing~ Rattles~
## # i 19,486 more rows
## # i 6 more variables: region_2 <chr>, taster_name <chr>,
## #   taster_twitter_handle <chr>, title <chr>, variety <chr>, winery <chr>

WYŚWIETLENIE TOPOWYCH OBSERWACJI ZE WZGLEDU NA ZMIENNĄ

wines%>%
top_n( 3, points)

## # A tibble: 19 x 14
##      ...1 country   description       designation points price province region_1
##     <dbl> <chr>     <chr>             <chr>        <dbl> <dbl> <chr>    <chr>   
##  1    345 Australia This wine contai~ Rare           100   350 Victoria Rutherg~
##  2   7335 Italy     Thick as molasse~ Occhio di ~    100   210 Tuscany  Vin San~
##  3  36528 France    This is a fabulo~ Brut           100   259 Champag~ Champag~
##  4  39286 Italy     A perfect wine f~ Masseto        100   460 Tuscany  Toscana 
##  5  42197 Portugal  This is the late~ Barca-Velha    100   450 Douro    <NA>    
##  6  45781 Italy     This gorgeous, f~ Riserva        100   550 Tuscany  Brunell~
##  7  45798 US        Tasted in a flig~ <NA>           100   200 Califor~ Napa Va~
##  8  58352 France    This is a magnif~ <NA>           100   150 Bordeaux Saint-J~
##  9  89728 France    This latest inca~ Cristal Vi~    100   250 Champag~ Champag~
## 10  89729 France    This new release~ Le Mesnil ~    100   617 Champag~ Champag~
## 11 111753 France    Almost black in ~ <NA>           100  1500 Bordeaux Pauillac
## 12 111754 Italy     It takes only a ~ Cerretalto     100   270 Tuscany  Brunell~
## 13 111755 France    This is the fine~ <NA>           100  1500 Bordeaux Saint-É~
## 14 111756 France    A hugely powerfu~ <NA>           100   359 Bordeaux Saint-J~
## 15 113929 US        In 2005 Charles ~ Royal City     100    80 Washing~ Columbi~
## 16 114972 Portugal  A powerful and r~ Nacional V~    100   650 Port     <NA>    
## 17 118058 US        This wine dazzle~ La Muse        100   450 Califor~ Sonoma ~
## 18 122935 France    Full of ripe fru~ <NA>           100   848 Bordeaux Pessac-~
## 19 123545 US        Initially a rath~ Bionic Frog    100    80 Washing~ Walla W~
## # i 6 more variables: region_2 <chr>, taster_name <chr>,
## #   taster_twitter_handle <chr>, title <chr>, variety <chr>, winery <chr>

TOP NAJTAŃSZYCH WIN

wines%>%
top_n( 100, -price)

## # A tibble: 177 x 14
##     ...1 country description designation points price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1  1620 Portug~ The very l~ Brado Bran~     85     6 Alentej~ <NA>     <NA>    
##  2  1987 Spain   Berry and ~ Flirty Bird     85     4 Central~ Vino de~ <NA>    
##  3  2335 US      Reserved a~ <NA>            85     6 Washing~ Washing~ Washing~
##  4  2618 Argent~ Lightly br~ <NA>            83     6 Mendoza~ Mendoza  <NA>    
##  5  2780 Portug~ This feels~ Morgado da~     84     5 Alentej~ <NA>     <NA>    
##  6  3167 Italy   Packaged i~ Mini            86     5 Veneto   Prosecco <NA>    
##  7  3948 Portug~ Soft, swee~ Coreto          83     6 Lisboa   <NA>     <NA>    
##  8  3950 Portug~ On the dry~ Escolha         83     5 Vinho V~ <NA>     <NA>    
##  9  5152 Spain   A steal fo~ Vina Borgia     87     6 Norther~ Campo d~ <NA>    
## 10  5789 France  This is a ~ <NA>            83     5 France ~ Vin de ~ <NA>    
## # i 167 more rows
## # i 5 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>

SORTOWANIE

wines%>%
  arrange( desc(points))

## # A tibble: 129,971 x 14
##     ...1 country description designation points price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1   345 Austra~ This wine ~ Rare           100   350 Victoria Rutherg~ <NA>    
##  2  7335 Italy   Thick as m~ Occhio di ~    100   210 Tuscany  Vin San~ <NA>    
##  3 36528 France  This is a ~ Brut           100   259 Champag~ Champag~ <NA>    
##  4 39286 Italy   A perfect ~ Masseto        100   460 Tuscany  Toscana  <NA>    
##  5 42197 Portug~ This is th~ Barca-Velha    100   450 Douro    <NA>     <NA>    
##  6 45781 Italy   This gorge~ Riserva        100   550 Tuscany  Brunell~ <NA>    
##  7 45798 US      Tasted in ~ <NA>           100   200 Califor~ Napa Va~ Napa    
##  8 58352 France  This is a ~ <NA>           100   150 Bordeaux Saint-J~ <NA>    
##  9 89728 France  This lates~ Cristal Vi~    100   250 Champag~ Champag~ <NA>    
## 10 89729 France  This new r~ Le Mesnil ~    100   617 Champag~ Champag~ <NA>    
## # i 129,961 more rows
## # i 5 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>

wines%>%
  arrange( -points)

## # A tibble: 129,971 x 14
##     ...1 country description designation points price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1   345 Austra~ This wine ~ Rare           100   350 Victoria Rutherg~ <NA>    
##  2  7335 Italy   Thick as m~ Occhio di ~    100   210 Tuscany  Vin San~ <NA>    
##  3 36528 France  This is a ~ Brut           100   259 Champag~ Champag~ <NA>    
##  4 39286 Italy   A perfect ~ Masseto        100   460 Tuscany  Toscana  <NA>    
##  5 42197 Portug~ This is th~ Barca-Velha    100   450 Douro    <NA>     <NA>    
##  6 45781 Italy   This gorge~ Riserva        100   550 Tuscany  Brunell~ <NA>    
##  7 45798 US      Tasted in ~ <NA>           100   200 Califor~ Napa Va~ Napa    
##  8 58352 France  This is a ~ <NA>           100   150 Bordeaux Saint-J~ <NA>    
##  9 89728 France  This lates~ Cristal Vi~    100   250 Champag~ Champag~ <NA>    
## 10 89729 France  This new r~ Le Mesnil ~    100   617 Champag~ Champag~ <NA>    
## # i 129,961 more rows
## # i 5 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>

WYŚWIETLANIE ZMIENNYCH

wines%>%
  select( country, province:region_2)

## # A tibble: 129,971 x 4
##    country  province          region_1            region_2         
##    <chr>    <chr>             <chr>               <chr>            
##  1 Italy    Sicily & Sardinia Etna                <NA>             
##  2 Portugal Douro             <NA>                <NA>             
##  3 US       Oregon            Willamette Valley   Willamette Valley
##  4 US       Michigan          Lake Michigan Shore <NA>             
##  5 US       Oregon            Willamette Valley   Willamette Valley
##  6 Spain    Northern Spain    Navarra             <NA>             
##  7 Italy    Sicily & Sardinia Vittoria            <NA>             
##  8 France   Alsace            Alsace              <NA>             
##  9 Germany  Rheinhessen       <NA>                <NA>             
## 10 France   Alsace            Alsace              <NA>             
## # i 129,961 more rows

ZMIANA NAZWY ZMIENNYCH

wines%>%
  rename( punkty = points)

## # A tibble: 129,971 x 14
##     ...1 country description designation punkty price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1     0 Italy   Aromas inc~ Vulka Bian~     87    NA Sicily ~ Etna     <NA>    
##  2     1 Portug~ This is ri~ Avidagos        87    15 Douro    <NA>     <NA>    
##  3     2 US      Tart and s~ <NA>            87    14 Oregon   Willame~ Willame~
##  4     3 US      Pineapple ~ Reserve La~     87    13 Michigan Lake Mi~ <NA>    
##  5     4 US      Much like ~ Vintner's ~     87    65 Oregon   Willame~ Willame~
##  6     5 Spain   Blackberry~ Ars In Vit~     87    15 Norther~ Navarra  <NA>    
##  7     6 Italy   Here's a b~ Belsito         87    16 Sicily ~ Vittoria <NA>    
##  8     7 France  This dry a~ <NA>            87    24 Alsace   Alsace   <NA>    
##  9     8 Germany Savory dri~ Shine           87    12 Rheinhe~ <NA>     <NA>    
## 10     9 France  This has g~ Les Natures     87    27 Alsace   Alsace   <NA>    
## # i 129,961 more rows
## # i 5 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>

DODANIE KOLUMNY Z CENĄ WINA W ZŁOTÓWKACH

usd_to_pln = 3.95
wines<-wines%>%
  mutate( price_pln = price * usd_to_pln)
wines

## # A tibble: 129,971 x 15
##     ...1 country description designation points price province region_1 region_2
##    <dbl> <chr>   <chr>       <chr>        <dbl> <dbl> <chr>    <chr>    <chr>   
##  1     0 Italy   Aromas inc~ Vulka Bian~     87    NA Sicily ~ Etna     <NA>    
##  2     1 Portug~ This is ri~ Avidagos        87    15 Douro    <NA>     <NA>    
##  3     2 US      Tart and s~ <NA>            87    14 Oregon   Willame~ Willame~
##  4     3 US      Pineapple ~ Reserve La~     87    13 Michigan Lake Mi~ <NA>    
##  5     4 US      Much like ~ Vintner's ~     87    65 Oregon   Willame~ Willame~
##  6     5 Spain   Blackberry~ Ars In Vit~     87    15 Norther~ Navarra  <NA>    
##  7     6 Italy   Here's a b~ Belsito         87    16 Sicily ~ Vittoria <NA>    
##  8     7 France  This dry a~ <NA>            87    24 Alsace   Alsace   <NA>    
##  9     8 Germany Savory dri~ Shine           87    12 Rheinhe~ <NA>     <NA>    
## 10     9 France  This has g~ Les Natures     87    27 Alsace   Alsace   <NA>    
## # i 129,961 more rows
## # i 6 more variables: taster_name <chr>, taster_twitter_handle <chr>,
## #   title <chr>, variety <chr>, winery <chr>, price_pln <dbl>

STATYSTYKI

wines%>%
  summarise(mean_price = mean(price, na.rm = T),
          std_price = sd(price, na.rm = T))

## # A tibble: 1 x 2
##   mean_price std_price
##        <dbl>     <dbl>
## 1       35.4      41.0

KWANTYLE

quantile(wines$price, na.rm = T, probs = c(0, 0.1, 0.25, 0.50, 0.75, 0.9, 1))

##   0%  10%  25%  50%  75%  90% 100% 
##    4   12   17   25   42   65 3300

MEDIANA

wines%>%
  summarise(median_price = median(price, na.rm = T))

## # A tibble: 1 x 1
##   median_price
##          <dbl>
## 1           25

SPRAWDZENIE STOSUNKU CENY DO JAKOŚCI

Czy drogie wino oznacza dobre?

wines %>% 
  mutate(price_score_ratio = price_pln/points) %>% 
  select(title, price_pln, points, price_score_ratio) %>% 
  arrange(price_score_ratio)

## # A tibble: 129,971 x 4
##    title                                      price_pln points price_score_ratio
##    <chr>                                          <dbl>  <dbl>             <dbl>
##  1 Bandit NV Merlot (California)                   15.8     86             0.184
##  2 Cramele Recas 2011 UnWineD Pinot Grigio (~      15.8     86             0.184
##  3 Felix Solis 2013 Flirty Bird Syrah (Vino ~      15.8     85             0.186
##  4 Dancing Coyote 2015 White (Clarksburg)          15.8     85             0.186
##  5 Broke Ass 2009 Red Malbec-Syrah (Mendoza)       15.8     84             0.188
##  6 Bandit NV Chardonnay (California)               15.8     84             0.188
##  7 Terrenal 2010 Cabernet Sauvignon (Yecla)        15.8     84             0.188
##  8 Bandit NV Merlot (California)                   15.8     84             0.188
##  9 Terrenal 2010 Estate Bottled Tempranillo ~      15.8     84             0.188
## 10 Pam's Cuties NV Unoaked Chardonnay (Calif~      15.8     83             0.190
## # i 129,961 more rows

SPRAWDZENIE OBSERWACJI, KTÓRE UZYSKAŁY POWYŻEJ 90 PUNKTÓW

wines %>% 
  mutate(price_score_ratio = price_pln/points) %>% 
  select(title, price_pln, points, price_score_ratio) %>% 
  filter(points >= 90) %>% 
  arrange(price_score_ratio) 

## # A tibble: 49,045 x 4
##    title                                      price_pln points price_score_ratio
##    <chr>                                          <dbl>  <dbl>             <dbl>
##  1 Herdade dos Machados 2012 Toutalga Red (A~      27.6     91             0.304
##  2 Snoqualmie 2006 Winemaker's Select Riesli~      31.6     91             0.347
##  3 Esser Cellars 2001 Chardonnay (California)      31.6     90             0.351
##  4 Aveleda 2013 Quinta da Aveleda Estate Bot~      31.6     90             0.351
##  5 Rothbury Estate 2001 Chardonnay (South Ea~      31.6     90             0.351
##  6 Chateau Ste. Michelle 2011 Riesling (Colu~      35.6     91             0.391
##  7 Chateau Ste. Michelle 2010 Dry Riesling (~      35.6     91             0.391
##  8 Barnard Griffin 2012 Fumé Blanc Sauvignon~      35.6     91             0.391
##  9 Mano A Mano 2011 Tempranillo (Vino de la ~      35.6     90             0.395
## 10 Aveleda 2014 Quinta da Aveleda Estate Bot~      35.6     90             0.395
## # i 49,035 more rows

MEDIANA - GRUPOWANIE

Mediana ze względu na wartośc zmiennej coutry.

wines %>% 
  group_by(country) %>% 
  summarise(median_price_pln = median(price_pln, na.rm = T))

## # A tibble: 44 x 2
##    country                median_price_pln
##    <chr>                             <dbl>
##  1 Argentina                          67.2
##  2 Armenia                            57.3
##  3 Australia                          83.0
##  4 Austria                            98.8
##  5 Bosnia and Herzegovina             49.4
##  6 Brazil                             79  
##  7 Bulgaria                           51.4
##  8 Canada                            118. 
##  9 Chile                              59.2
## 10 China                              71.1
## # i 34 more rows

wines %>% 
  group_by(country) %>% 
  summarise(median_price_pln = median(price_pln, na.rm = T),
            sred_punkty = mean(points, na.rm = T),
            liczba_of_wines = n()) %>% 
  arrange(median_price_pln) %>% 
  filter(liczba_of_wines >= 20)

## # A tibble: 30 x 4
##    country   median_price_pln sred_punkty liczba_of_wines
##    <chr>                <dbl>       <dbl>           <int>
##  1 Romania               35.6        86.4             120
##  2 Bulgaria              51.4        87.9             141
##  3 Moldova               51.4        87.2              59
##  4 Chile                 59.2        86.5            4472
##  5 Portugal              63.2        88.3            5691
##  6 Argentina             67.2        86.7            3800
##  7 Georgia               69.1        87.7              86
##  8 Morocco               71.1        88.6              28
##  9 Spain                 71.1        87.3            6645
## 10 Greece                75.0        87.3             466
## # i 20 more rows

# TWORZENIE SZEREGÓW ROZDZIELCZYCH


```r
n = length(wines$price)
y1=cut(wines$price, sqrt(n))
# y1
head(table(y1),30)

## y1
## (0.704,13.16] (13.16,22.31] (22.31,31.47] (31.47,40.62] (40.62,49.78] 
##         15821         35109         22801         15944          8192 
## (49.78,58.93] (58.93,68.09] (68.09,77.24]  (77.24,86.4]  (86.4,95.56] 
##          7330          5179          3105          1997          1350 
## (95.56,104.7] (104.7,113.9]   (113.9,123]   (123,132.2] (132.2,141.3] 
##           858           464           446           532           262 
## (141.3,150.5] (150.5,159.6] (159.6,168.8]   (168.8,178]   (178,187.1] 
##           354            59           122           135            66 
## (187.1,196.3] (196.3,205.4] (205.4,214.6] (214.6,223.7] (223.7,232.9] 
##            62           110            29            25            64 
##   (232.9,242]   (242,251.2] (251.2,260.4] (260.4,269.5] (269.5,278.7] 
##            40            65            30             7            23

y2=cut(wines$price,breaks=c(1,20,100,300,500))
head(y2, 10)

##  [1] <NA>     (1,20]   (1,20]   (1,20]   (20,100] (1,20]   (1,20]   (20,100]
##  [9] (1,20]   (20,100]
## Levels: (1,20] (20,100] (100,300] (300,500]

levels(y2)=c("bardzo tanie", "tanie", "drogie", "bardzo drogie")
table(y2)

## y2
##  bardzo tanie         tanie        drogie bardzo drogie 
##         46341         71268          3050           225

BIBLIOTEKI

library(dplyr)
library(ggplot2)
library(car)
library("VIM")
library(readxl)

ZAŁADOWANIE DANYCH

dane <- read.csv("C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/PRZYGOTOWANIE_DANYCH/Insurance/train3.csv", sep = ";")
head(dane,10)

##    Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 1    Male  44               1          28                  0   > 2 Years
## 2    Male  76               1           3                  0    1-2 Year
## 3    Male  47               1          28                  0   > 2 Years
## 4    Male  21               1          11                  1    < 1 Year
## 5  Female  NA               1          41                  1    < 1 Year
## 6  Female  24               1          33                  0    < 1 Year
## 7    Male  23               1          11                  0    < 1 Year
## 8  Female  56               1          28                  0    1-2 Year
## 9  Female  24               1           3                  1    < 1 Year
## 10 Female  32               1           6                  1    < 1 Year
##    Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 1             Yes          40454                   26     217        1
## 2              No          33536                   26     183        0
## 3             Yes          38294                   26      27        1
## 4              No          28619                  152     203        0
## 5              No          27496                  152      39        0
## 6             Yes           2630                  160     176        0
## 7             Yes          23367                  152     249        0
## 8             Yes          32031                   26      72        1
## 9              No          27619                   NA      28        0
## 10             No          28771                   NA      80        0
##    Year_Birth
## 1        1978
## 2        1946
## 3        1975
## 4        2001
## 5        1993
## 6        1998
## 7        1999
## 8        1966
## 9        1998
## 10       1990

SKALA NOMINALNA

table(dane$Gender)

## 
##        Female   Male 
##      4 175018 206087

ggplot(dane , aes(x=factor(Gender), fill=factor(Gender))) + 
  geom_bar() +
  theme(legend.position="none")

table(dane$Region_Code)

## 
##      0      1      2      3      4      5      6      7      8      9     10 
##   2021   1008   4038   9251   1801   1279   6280   3279  33877   3101   4374 
##     11     12     13     14     15     16     17     18     19     20     21 
##   9232   3198   4036   4678  13308   2007   2617   5153   1535   1935   4266 
##     22     23     24     25     26     27     28     29     30     31     32 
##   1309   1960   2415   2503   2587   2823 106415  11065  12191   1960   2787 
##     33     34     35     36     37     38     39     40     41     42     43 
##   7654   1664   6942   8797   5501   2026   4644   1295  18263    591   2639 
##     44     45     46     47     48     49     50     51     52 
##    808   5605  19749   7436   4681   1832  10243    183    267

ggplot(dane , aes(x=factor(Region_Code), fill=factor(Region_Code))) +
  geom_bar() +
  theme(legend.position="none")

SKALA PORZĄDKOWA

vehicle_age

table(dane$Vehicle_Age)

## 
##            < 1 Year > 2 Years  1-2 Year 
##         4    164784     16007    200314

ggplot(dane , aes(x=factor(Vehicle_Age), fill=factor(Vehicle_Age))) +
  geom_bar() +
  theme(legend.position="none")

SKALA PEZEDZIAŁOWA

table(dane$Year_Birth)

## 
##  1937  1938  1939  1940  1941  1942  1943  1944  1945  1946  1947  1948  1949 
##    11    11    22    29    56   909   915  1216  1388  1396  1605  1832  1925 
##  1950  1951  1952  1953  1954  1955  1956  1957  1958  1959  1960  1961  1962 
##  2035  2051  2349  2530  2440  2624  2725  2791  2850  3084  3104  3341  3534 
##  1963  1964  1965  1966  1967  1968  1969  1970  1971  1972  1973  1974  1975 
##  3614  3822  3944  4063  4495  4997  5331  5590  5915  6263  6615  7113  7351 
##  1976  1977  1978  1979  1980  1981  1982  1983  1984  1985  1986  1987  1988 
##  7879  8183  8357  8437  8007  7736  7168  6460  5710  5408  5066  4936  4895 
##  1989  1990  1991  1992  1993  1994  1995  1996  1997  1998  1999  2000  2001 
##  5010  4998  5512  6258  7429  8974 10760 13535 20636 25960 24256 20964 16457 
##  2002 
##  6232

ggplot(dane , aes(x=factor(Year_Birth), fill=factor(Year_Birth))) +
  geom_bar() +
  theme(legend.position="none")

SKALA ILORAZOWA

age

mean(dane$Age)

## [1] NA

ggplot(dane, aes(x=Age)) + 
  geom_histogram(color="white", fill="darkgrey")

## 

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 18 rows containing non-finite outside the scale range
## (`stat_bin()`).

ZADANIE 1

Określ skale pomiarowe dla wszystkich zmiennych w zbiorze. Zwizualizuj je.

SKALA ILORAZOWA NA SKALĘ PORZĄDKOWĄ

dane$age_1 <- recode(dane$Age, "18:24 ='<25'; 25:35= '25-35' ; 36:46='36-46' ; ;else = '>46'")

table(dane$age_1)

## 
##    <25    >46  25-35  36-46 
##  93864 115899  92936  78410

ZADANIE

Zmień skalę pomiarową dla zmiennej “Region_Code”.

PODSTAWOWE STATYSTYKI

summary(dane)

##     Gender               Age        Driving_License   Region_Code   
##  Length:381109      Min.   :20.00   Min.   :0.0000   Min.   : 0.00  
##  Class :character   1st Qu.:25.00   1st Qu.:1.0000   1st Qu.:15.00  
##  Mode  :character   Median :36.00   Median :1.0000   Median :28.00  
##                     Mean   :38.82   Mean   :0.9979   Mean   :26.39  
##                     3rd Qu.:49.00   3rd Qu.:1.0000   3rd Qu.:35.00  
##                     Max.   :85.00   Max.   :1.0000   Max.   :52.00  
##                     NA's   :18                                      
##  Previously_Insured Vehicle_Age        Vehicle_Damage     Annual_Premium  
##  Min.   :0.0000     Length:381109      Length:381109      Min.   :  2630  
##  1st Qu.:0.0000     Class :character   Class :character   1st Qu.: 24405  
##  Median :0.0000     Mode  :character   Mode  :character   Median : 31668  
##  Mean   :0.4582                                           Mean   : 30564  
##  3rd Qu.:1.0000                                           3rd Qu.: 39400  
##  Max.   :1.0000                                           Max.   :540165  
##                                                           NA's   :17      
##  Policy_Sales_Channel    Vintage         Response        Year_Birth  
##  Min.   :  1          Min.   : 10.0   Min.   :0.0000   Min.   :1937  
##  1st Qu.: 29          1st Qu.: 82.0   1st Qu.:0.0000   1st Qu.:1973  
##  Median :133          Median :154.0   Median :0.0000   Median :1986  
##  Mean   :112          Mean   :154.3   Mean   :0.1226   Mean   :1983  
##  3rd Qu.:152          3rd Qu.:227.0   3rd Qu.:0.0000   3rd Qu.:1997  
##  Max.   :163          Max.   :299.0   Max.   :1.0000   Max.   :2002  
##  NA's   :3                                                           
##     age_1          
##  Length:381109     
##  Class :character  
##  Mode  :character  
##                    
##                    
##                    
## 

Analiza braków danych

dane<-as.data.frame(dane)
head(dane,10)

##    Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 1    Male  44               1          28                  0   > 2 Years
## 2    Male  76               1           3                  0    1-2 Year
## 3    Male  47               1          28                  0   > 2 Years
## 4    Male  21               1          11                  1    < 1 Year
## 5  Female  NA               1          41                  1    < 1 Year
## 6  Female  24               1          33                  0    < 1 Year
## 7    Male  23               1          11                  0    < 1 Year
## 8  Female  56               1          28                  0    1-2 Year
## 9  Female  24               1           3                  1    < 1 Year
## 10 Female  32               1           6                  1    < 1 Year
##    Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 1             Yes          40454                   26     217        1
## 2              No          33536                   26     183        0
## 3             Yes          38294                   26      27        1
## 4              No          28619                  152     203        0
## 5              No          27496                  152      39        0
## 6             Yes           2630                  160     176        0
## 7             Yes          23367                  152     249        0
## 8             Yes          32031                   26      72        1
## 9              No          27619                   NA      28        0
## 10             No          28771                   NA      80        0
##    Year_Birth age_1
## 1        1978 36-46
## 2        1946   >46
## 3        1975   >46
## 4        2001   <25
## 5        1993   >46
## 6        1998   <25
## 7        1999   <25
## 8        1966   >46
## 9        1998   <25
## 10       1990 25-35

plot_missing<-aggr(dane, col=c('darkgrey','tomato'),
                   numbers=TRUE, sortVars=TRUE,
                   labels=names(dane), cex.axis=0.6,
                   cex.lab=1.5,
                   gap=1, ylab=c('Braki',"Wzór braków"))

## 
##  Variables sorted by number of missings: 
##              Variable        Count
##                   Age 4.723058e-05
##        Annual_Premium 4.460666e-05
##  Policy_Sales_Channel 7.871764e-06
##                Gender 0.000000e+00
##       Driving_License 0.000000e+00
##           Region_Code 0.000000e+00
##    Previously_Insured 0.000000e+00
##           Vehicle_Age 0.000000e+00
##        Vehicle_Damage 0.000000e+00
##               Vintage 0.000000e+00
##              Response 0.000000e+00
##            Year_Birth 0.000000e+00
##                 age_1 0.000000e+00

 summary(aggr(dane, plot=FALSE))

## 
##  Missings per variable: 
##              Variable Count
##                Gender     0
##                   Age    18
##       Driving_License     0
##           Region_Code     0
##    Previously_Insured     0
##           Vehicle_Age     0
##        Vehicle_Damage     0
##        Annual_Premium    17
##  Policy_Sales_Channel     3
##               Vintage     0
##              Response     0
##            Year_Birth     0
##                 age_1     0
## 
##  Missings in combinations of variables: 
##               Combinations  Count      Percent
##  0:0:0:0:0:0:0:0:0:0:0:0:0 381071 9.999003e+01
##  0:0:0:0:0:0:0:0:1:0:0:0:0      3 7.871764e-04
##  0:0:0:0:0:0:0:1:0:0:0:0:0     17 4.460666e-03
##  0:1:0:0:0:0:0:0:0:0:0:0:0     18 4.723058e-03

Imputacja

dane$Age<-as.numeric(dane$Age)
dane<-dane%>%
  mutate(age3=if_else(is.na(Age), mean(Age,na.rm = T), Age))

dane<-dane%>%
  mutate(age3=if_else(is.na(Age), median(Age,na.rm = T), Age))

ZADANIE 2

Sprawdź podstawowe statytyki po imputacji. Co się zmieniło?

ZADANIE 3

Proszę dokonać imputacji zmiennej “Annual_Premium” za pomocą średniej i mediany. Jak zmieni się rozkład zmiennej?

SKALA ILORAZOWA:

SKALI PRZEDZIAŁOWA BĄDŹ PRZEDZIAŁOWA I ILORAZOWA

library(clusterSim)

## Warning: pakiet 'clusterSim' został zbudowany w wersji R 4.1.3

## Ładowanie wymaganego pakietu: cluster

## Ładowanie wymaganego pakietu: MASS

## 
## Dołączanie pakietu: 'MASS'

## Następujący obiekt został zakryty z 'package:dplyr':
## 
##     select

PRZEKSZTAŁCENIA ILORAZOWE

#baza_n1<-data.Normalization(baza,type='n6',normalization='column')

Mediana i odchylenie medianowe

# dane
x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)

# mediana
med = median(x)
# odchyelnie od mediany dla każej wartości z bazy danych
abs_dev = abs(x-med)
# odchylenie medianowe
mad = 1.4826 * median(abs_dev)

Tmin = med-(3*mad) 
Tmax = med+(3*mad) 

# znalezienie wartości skrajnych
x[which(x < Tmin | x > Tmax)]

## [1] 24 28

# usunięcie wartości skrajnych
x[which(x > Tmin & x < Tmax)]

##  [1] 10  4  6  8  9  8  7  6 12 14 11  9  8  4  5 10 14 12 15  7 10 14

The interquartile range (IQR)

boxplot(x, horizontal = TRUE)

x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)

# statystyki opisowe, podstawowe
summary(x)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00    7.00    9.50   10.62   12.50   28.00

# IQR
IQR(x)

## [1] 5.5

# 
Tmin = 7-(1.5*5.5) 
Tmax = 12.50+(1.5*5.5) 

# znalezienie wartości skrajnych
x[which(x < Tmin | x > Tmax)]

## [1] 24 28

# remove outlier
x[which(x > Tmin & x < Tmax)]

##  [1] 10  4  6  8  9  8  7  6 12 14 11  9  8  4  5 10 14 12 15  7 10 14

TESTY STATYSTYCZNE: IDENTYFIKACJA WARTOŚCI SKARJNYCH, NIETYPOWYCH

Dixon’s Q Test

library(outliers)

## Warning: pakiet 'outliers' został zbudowany w wersji R 4.1.3

x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)

dixon.test(x)

## 
##  Dixon test for outliers
## 
## data:  x
## Q = 0.56522, p-value < 2.2e-16
## alternative hypothesis: highest value 28 is an outlier

dixon.test(x, opposite = TRUE)

## 
##  Dixon test for outliers
## 
## data:  x
## Q = 0.090909, p-value = 0.2841
## alternative hypothesis: lowest value 4 is an outlier

Grubb’s Test

library(outliers)
x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)

grubbs.test(x)

## 
##  Grubbs test for one outlier
## 
## data:  x
## G = 3.0354, U = 0.5820, p-value = 0.007692
## alternative hypothesis: highest value 28 is an outlier

grubbs.test(x, opposite = TRUE)

## 
##  Grubbs test for one outlier
## 
## data:  x
## G = 1.15737, U = 0.93923, p-value = 1
## alternative hypothesis: lowest value 4 is an outlier

Rosner’s test

library(EnvStats)

## Warning: pakiet 'EnvStats' został zbudowany w wersji R 4.1.3

## 
## Dołączanie pakietu: 'EnvStats'

## Następujący obiekt został zakryty z 'package:MASS':
## 
##     boxcox

## Następujący obiekt został zakryty z 'package:car':
## 
##     qqPlot

## Następujące obiekty zostały zakryte z 'package:stats':
## 
##     predict, predict.lm

## Następujący obiekt został zakryty z 'package:base':
## 
##     print.default

# parameter k mówi ile potencjalnych wartości skrajnych wystepuje w zbiorze
# default k = 3
rosnerTest(x, k = 3)$all.stats

## Warning in rosnerTest(x, k = 3): The true Type I error may be larger than
## assumed. See the help file for 'rosnerTest' for a table with information on the
## estimated Type I error level.

##   i    Mean.i     SD.i Value Obs.Num    R.i+1 lambda.i+1 Outlier
## 1 0 10.625000 5.724186    28      24 3.035366   2.801551    TRUE
## 2 1  9.869565 4.465060    24      23 3.164669   2.780277    TRUE
## 3 2  9.227273 3.308457    15      19 1.744840   2.757735   FALSE

ANALIZA KORELACJI

#cor(baza)

ANALIZA WARIANCJI

LOSOWANIE PROSTE

 los_1=sample(length(dane$Gender),10)

 sample(c('red','green'),10,replace=T,prob=c(0.6,0.4))

##  [1] "red"   "red"   "green" "green" "red"   "green" "red"   "green" "red"  
## [10] "green"

LOSOWANIE SYSTEMATYCZNE

library(TeachingSampling)

## Warning: pakiet 'TeachingSampling' został zbudowany w wersji R 4.1.3

## Ładowanie wymaganego pakietu: magrittr

## Warning: pakiet 'magrittr' został zbudowany w wersji R 4.1.3

P <- c("Mon-8", "Tues-4", "Wed-4", "Thurs-6", "Fri-7","Sat-45","Sun-34","Mon-21", "Tues-11","Wed-34","Thurs-16","Fri-10","Sat-17","Sun-19")

#losuj systematycznie co drugi elementz 14 elementów
systematic_sample <- S.SY(14,2)
systematic_sample

##      [,1]
## [1,]    1
## [2,]    3
## [3,]    5
## [4,]    7
## [5,]    9
## [6,]   11
## [7,]   13

P[systematic_sample]

## [1] "Mon-8"    "Wed-4"    "Fri-7"    "Sun-34"   "Tues-11"  "Thurs-16" "Sat-17"

systematic_sample <- S.SY(length(dane$Gender),2)

head(dane[systematic_sample,],10)

##    Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 1    Male  44               1          28                  0   > 2 Years
## 3    Male  47               1          28                  0   > 2 Years
## 5  Female  NA               1          41                  1    < 1 Year
## 7    Male  23               1          11                  0    < 1 Year
## 9  Female  24               1           3                  1    < 1 Year
## 11 Female  47               1          35                  0    1-2 Year
## 13 Female  41               1          15                  1    1-2 Year
## 15   Male  71               1          28                  1    1-2 Year
## 17 Female  25               1          45                  0            
## 19   Male  42               1          28                  0            
##    Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 1             Yes          40454                   26     217        1
## 3             Yes          38294                   26      27        1
## 5              No          27496                  152      39        0
## 7             Yes          23367                  152     249        0
## 9              No          27619                   NA      28        0
## 11            Yes          47576                   NA      46        1
## 13             No          31409                   14     221        0
## 15             No          46818                   30      58        0
## 17            Yes          26218                  160     256        0
## 19            Yes          33667                  124     158        0
##    Year_Birth age_1 age3
## 1        1978 36-46   44
## 3        1975   >46   47
## 5        1993   >46   36
## 7        1999   <25   23
## 9        1998   <25   24
## 11       1975   >46   47
## 13       1981 36-46   41
## 15       1951   >46   71
## 17       1997 25-35   25
## 19       1980 36-46   42

LOSOWANIE WARSTWOWE

library(dplyr)

# losuje po 3 rekordy z każdej kategorii
set.seed(1)
dane %>%
  group_by (Gender) %>%
  sample_n(., 3)

## # A tibble: 9 x 14
## # Groups:   Gender [3]
##   Gender     Age Driving_License Region_Code Previously_Insured Vehicle_Age
##   <chr>    <dbl>           <int>       <int>              <int> <chr>      
## 1 ""          26               1           8                  1 < 1 Year   
## 2 ""          26               1           8                  1 < 1 Year   
## 3 ""          54               1          28                  1 1-2 Year   
## 4 "Female"    58               1          18                  0 1-2 Year   
## 5 "Female"    42               1          28                  0 1-2 Year   
## 6 "Female"    58               1          28                  0 1-2 Year   
## 7 "Male"      26               1           6                  1 < 1 Year   
## 8 "Male"      53               1          24                  1 1-2 Year   
## 9 "Male"      77               1          28                  0 1-2 Year   
## # i 8 more variables: Vehicle_Damage <chr>, Annual_Premium <int>,
## #   Policy_Sales_Channel <int>, Vintage <int>, Response <int>,
## #   Year_Birth <int>, age_1 <chr>, age3 <dbl>

library(sampling)  

## Warning: pakiet 'sampling' został zbudowany w wersji R 4.1.3

stratas = strata(dane, c("Gender"),size = c(5,3,3), method = "srswor")
stratas

##        Gender ID_unit         Prob Stratum
## 15214    Male   15214 2.426160e-05       1
## 25773    Male   25773 2.426160e-05       1
## 46874    Male   46874 2.426160e-05       1
## 215581   Male  215581 2.426160e-05       1
## 241510   Male  241510 2.426160e-05       1
## 48487  Female   48487 1.714109e-05       2
## 197067 Female  197067 1.714109e-05       2
## 228099 Female  228099 1.714109e-05       2
## 385               385 7.500000e-01       3
## 421               421 7.500000e-01       3
## 428               428 7.500000e-01       3

1. IF

if -> pozwala na warunkowe wykonywanie fragmentu kodu

Czy liczba jest większa od 5?

x <- 10
if (x > 5) {
  print("x jest większe od 5")
}

## [1] "x jest większe od 5"

Czy liczba jest dodatnia?

y <- -2
if (y >= 0) {
  print("y jest dodatnie")
} else {
  print("y jest ujemne")
}

## [1] "y jest ujemne"

Instrukcja warunkowa, która sprawdza kategorię temepratury

temperature <- 18
if (temperature < 0) {
  print("Mróz")
} else if (temperature < 15) {
  print("Chłodno")
} else if (temperature < 25) {
  print("Ciepło")
} else {
  print("Gorąco!")
}

## [1] "Ciepło"

Czy liczba jest parzysta?

liczba<-56
if(liczba%%2==0){
  cat("liczba jest parzysta\n")
}else{                         # ważne by "else" było od razu po "}"
  cat("liczba jest nieparzysta\n")}

## liczba jest parzysta

2. IFELSE

ifelse -> pozwala na skrócenie zapisu instrukcji warunkowej Wykorzystywnay gdy kod warunkowy jest krótki Świetnie się sprawdza do porownywania wektorów

Porównanie dwóch zmiennych

jeden<-"mama"
dwa<-"tata"
ifelse(jeden==dwa,"to samo", "inne" )

## [1] "inne"

Porównanie liczb rzeczywistych

a<-9
b<-17
ifelse(25==a+b, "prawda", "nie prawda")

## [1] "nie prawda"

wektor<-rnorm(10)
wektor

##  [1]  0.82122120  0.59390132  0.91897737  0.78213630  0.07456498 -1.98935170
##  [7]  0.61982575 -0.05612874 -0.15579551 -1.47075238

ifelse(wektor<0, -1, 1)

##  [1]  1  1  1  1  1 -1  1 -1 -1 -1

1. FOR

for -> stosowany, gdy liczba powtórzeń pętli jest z góry znana

Wypisz liczby od 1 do 5

for (i in 1:5) {
  print(i)
}

## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5

Wypisz liczby od 1 do 5 i dopisz, który to krok iteracji

for(i in 1:5){
  cat(paste("krok iteracji"), paste(i, "\n" ))
}

## krok iteracji 1 
## krok iteracji 2 
## krok iteracji 3 
## krok iteracji 4 
## krok iteracji 5

Suma elementów wektora

numbers <- c(2, 4, 6, 8, 10)
sum_val <- 0
for (n in numbers) {
  sum_val <- sum_val + n
}
print(paste("Suma =", sum_val))

## [1] "Suma = 30"

liczby<- c("mama", "tata","kot")
for( i in liczby){
  cat(paste(i, "\n"))
}

## mama 
## tata 
## kot

liczby<- c("mama", "tata","kot", "pies")
for( i in (length(liczby)-1)){
  cat(paste(i, "\n"))
}

## 3

liczby<- c("mama", "tata","kot", "pies")
for( i in 1:(length(liczby)-1)){
  cat(paste(i, "\n"))
}

## 1 
## 2 
## 3

Warunek w pętli

wektor<-c(1:10)
for (n in wektor) {
  if (n %% 2 == 0) {
    print(paste(n, "jest parzyste"))
  }
}

## [1] "2 jest parzyste"
## [1] "4 jest parzyste"
## [1] "6 jest parzyste"
## [1] "8 jest parzyste"
## [1] "10 jest parzyste"

2. WHILE

while-> stosowany, gdy powtórzenia maja być wykonywane tak długo, jak długo prawdziwy jest podany warunek

Wyświetl liczby od 1 do 5

i <- 1
while (i <= 5) {
  print(i)
  i <- i + 1
}

## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5

Losuj liczby do momentu trafienia 7

number <- 0
while (number != 7) {
  number <- sample(1:10, 1)
  print(paste("Wylosowano:", number))
}

## [1] "Wylosowano: 8"
## [1] "Wylosowano: 6"
## [1] "Wylosowano: 10"
## [1] "Wylosowano: 7"

print("Trafiono 7!")

## [1] "Trafiono 7!"

liczba<-7
while (liczba>0){
  cat(paste("liczba= ", liczba, "\n"))
  liczba<-liczba-2
}

## liczba=  7 
## liczba=  5 
## liczba=  3 
## liczba=  1

i <- 1
while (i < 6) {
print(i)
i = i+1
}

## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5

Zatrzymaj pętle gdy i=4

i <- 1
while (i < 6) {
  print(i)
  i <- i + 1
  if (i == 4) {
    break
  }
} 

## [1] 1
## [1] 2
## [1] 3

data(iris)                                               # Loading exemplifying data set
head(iris) 

##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

running_index <- 1   

while(is.numeric(iris[ , running_index])) {              # zaczynamy pętle
 
  iris[ , running_index] <- iris[ , running_index] + 50  # blok pętli, jeśli kolumna/zmienna jest "numeric" to dodaj 50 do wartości zmiennej
  running_index <- running_index + 1                     # przejście z jednej do drugiej kolumny/zmiennej
 
}

Wyświetl liczby od 1 do 5 omijając liczbę 3

number = 1


while(number <= 5) {
  if (number == 3) {  
    number = number + 1
                 # jesli warunek spełniony, wartość pomijana
  }
    
  # wyświetl liczby
  print(number)
    
  # przyrost wektora numer o 1
  number = number + 1  
}

## [1] 1
## [1] 2
## [1] 4
## [1] 5

Zadanie 1

Wyświetl liczby nieparzyste od 1 do 1000 używając pętli while i instrukcji warunkowej if

Zadanie 2

Wyświetl liczby parzyste od 60 do 195 używając pętli while i instrukcji warunkowej if

Zadanie 3

Napisz pętlę for, która wypisze liczby od 1 do 10 oraz informację, czy są parzyste czy nie.

Zadanie 4

Napisz pętlę while, która będzie losować liczby z zakresu 1–6, aż wypadnie 6.

Zadanie 5

Utwórz funkcję square_plus_one(x), która zwraca wartość x^2 + 1.

square_plus_one <- function(x) {
  return(x^2 + 1)
}
square_plus_one(4)

Zadanie 6

Napisz funkcję describe_number(x), która wypisze, czy liczba jest dodatnia, ujemna, czy równa zero.

Zadanie 7

Napisz funkcję sum_positive(vec), która zwraca sumę tylko dodatnich wartości wektora.

Zadanie 8

Napisz funkcję avg_even(vec), która oblicza średnią z liczb parzystych w wektorze.

Zadanie 9

Napisz funkcję simulate_game(), która losuje liczby z zakresu 1–10 aż wypadnie 10 i zwraca liczbę prób potrzebnych do trafienia.

simulate_game = function() {
  count = 0
  while (TRUE) {
    i = sample(1:10,1)
    if (i == 10) {
      count = count + 1
      return(count)
      break
    }
    else {
      count = count + 1
    }
  }
}
simulate_game()

## [1] 34