Zrobiono rozdział 8 - finito :D

Rodział 2-3/Kurs_R.R

@@ -0,0 +1,356 @@
+# author: Cezary Pukownik
+# indeks: s444337
+
+library(tidyverse)
+
+#' # 2.3.1
+#' ## Zadanie 1
+
+airquality %>%
+  select(Ozone, Solar.R, Wind, Temp) %>%
+  filter(Ozone>80)
+
+#' ## Zadanie 2
+#install.packages('weathermetrics')
+library(weathermetrics)
+
+airquality %>%
+  mutate(TempC=fahrenheit.to.celsius(Temp))
+
+#' # 2.4.1
+#' ## Zadanie 1
+as_tibble(airquality)
+
+#' ## Zadanie 2
+tibble(litery=letters[6:11],
+            miesiace=month.name[1:6])
+
+#' # 3.2.4
+#' ## Zadanie 1
+ggplot(data=mpg)
+
+#' Co widzisz?
+#' Szare. puste pole
+
+#' ## Zadanie 2
+as_tibble(mtcars)
+
+#' liczba wierszy: 32
+
+#' ## Zadanie 3
+?mpg
+
+#' drv
+#' f = front-wheel drive, r = rear wheel drive, 4 = 4wd
+
+#' ## Zadanie 4
+ggplot(aes(x=hwy, y=cyl), data=as_tibble(mpg)) + geom_point()
+
+#' ## Zadanie 5
+ggplot(aes(x=class, y=drv), data=as_tibble(mpg)) + geom_point()
+
+#' Dlaczego wykres jest bezuzyteczny?
+#' Wykres nie pokazuje żadnych liczbowych informacji na temat danych
+#' Zostały wykorzystane dwie cechy typu categorical
+#' Jedyną informacją jest to, czy dana kombinacja drv i class istanieje.
+
+#' # 3.3.1
+#' ## Zadanie 1
+
+#' ustalenie parametru color wewnątrz funckcji aes 
+#' powinno być nazwą kolumny z categoriami, po których
+#' punkty zostaną pogrupowane, a nie istanieje kolumna "blue"
+#' w zbriorze danych
+#'
+#' parametr color powinien zostać ustalony wewnątrz
+#' funkcji geom_point. Poprawiony kod poniżej.
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = displ, y = hwy), color = "blue")
+
+#' ## Zadanie 2
+mpg
+#' kolumny z danymi kategorialnymi to:
+#' manufacturer, model, trans, frv, fl, class
+#' można zwrócić uwagę na typ danych w kolumnie
+#' jeśli typ to <chr>, to najprawdopodobniej jest to dana kategorialna
+
+#' ## Zadanie 3
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x=displ, y=hwy, color=displ, size=displ))
+
+#' zmienna ciągła jest interpolowania między dwoma kolorami tworząc gradient
+#' tak jak samo z rozmiarem, rozmiar jest skalowany
+#' w przypadku shape powoduje to błąd. Gdyby podać dane kategorialne
+#' podział byłby dyskretny, na różne kolory, wielkości, kształty
+
+
+#' ## Zadanie 4
+#' Przykład w punkcie wyżej
+#' Ta sama zmienna bedzie przedstawiona różnymi metodami
+
+#' ## Zadanie 5
+#' stroke wpływa na grubuść konturu, obrysu, mozna stosować z punktami i liniami
+?geom_point
+
+#' ## Zadanie 6
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x=displ, y=hwy, color=displ < 5))
+
+
+mpg %>%
+  filter(displ < 5) %>%
+  mutate(is_less_than_5=displ < 5)
+
+#' Przypisanie displ < 5 podzieliło data set na dwie grupy
+#' TRUE oraz FALSE, w zalezności od tego czy warunek był spełniony
+#' czy nie.
+
+#' # 3.5.1
+#' ## Zadanie 1
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = displ, y = hwy)) + 
+  facet_grid(drv ~ displ)
+
+#' ggplot potraktuje ją jako zmienną kategorialną,
+#' tworząc siatkę dla kazdej unikatowej wartości zmiennej ciagłęj
+
+#' ## Zadanie 2
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = drv, y = cyl))
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = drv, y = cyl)) +
+  facet_grid(cyl~drv)
+
+#' puste komórki oznacznaczają brak danych
+
+#' ## Zadanie 3
+
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = displ, y = hwy)) +
+  facet_grid(drv ~ .)
+
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = displ, y = hwy)) +
+  facet_grid(. ~ cyl)
+
+#' kropka traktowana jest jako puste pole,
+#' wtedy jedna z osi, nie bedzie kategoryzowana
+
+
+#' ## Zadanie 4
+ggplot(data = mpg) + 
+  geom_point(mapping = aes(x = displ, y = hwy)) + 
+  facet_wrap(~ class, nrow = 2)
+
+
+#' # 3.6.1
+
+#' ## Zadanie 1
+#' liniowy - geom_line()
+#' pudełkowy - geom_boxplot()
+#' histogram - geom_histogram()
+#' warstwowy - geom_area()
+
+#' ## Zadanie 2
+ggplot(data = mpg, mapping = aes(x = displ, y = hwy, color = drv)) + 
+  geom_point() + 
+  geom_smooth(se = FALSE)
+
+#' ## Zadanie 3
+#' show.legend = FALSE, sluży do ukrycia legendy
+
+#' ## Zadanie 4
+#' parametr se w funcji geom_smooth() służy do pokazania, lub ukrycia przedziałów ufnośći na wykresie.
+
+#' ## Zadanie 5
+#' dwa poniższe wyresy są takie same, różnią się tylko sposobem denifincji mapowania.
+#' mapowanie wewnątrz aes w ggplot, przenosi mapowania na wszystkie geometrie, gdy nie sa zdefiniowane inne.
+
+ggplot(data = mpg, mapping = aes(x = displ, y = hwy)) + 
+  geom_point() + 
+  geom_smooth()
+
+ggplot() + 
+  geom_point(data = mpg, mapping = aes(x = displ, y = hwy)) + 
+  geom_smooth(data = mpg, mapping = aes(x = displ, y = hwy))
+
+#' ## Zadanie 6
+
+#' Wykres 1
+
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy)) +
+  geom_point() +
+  geom_smooth(se=FALSE)
+
+#' Wykres 2
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy, group=drv)) +
+  geom_point() +
+  geom_smooth(se=FALSE)
+
+#' Wykres 3
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy, color=drv)) +
+  geom_point() +
+  geom_smooth(se=FALSE)
+
+#' Wykres 4
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy)) +
+  geom_point(aes(color=drv)) +
+  geom_smooth(se=FALSE)
+
+#' Wykres 5
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy)) +
+  geom_point(aes(color=drv)) +
+  geom_smooth(aes(linetype=drv), se=FALSE)
+
+#' Wykres 6
+mpg %>% 
+  ggplot(aes(x=displ, y=hwy)) +
+  geom_point(aes(fill=drv), shape=21, stroke=2, color='white', size=2)
+
+#' # 3.7.1
+
+# Zadanie 1
+?stat_summary
+
+#' Funcja stat_summary jest związana w funcją geom_pointrange()
+diamonds %>% 
+ggplot() + 
+  geom_pointrange(aes(x = cut, y = depth), stat='summary')
+
+#' ## Zadanie 2
+#' funkcja geom_bar służy do wykresów słupkowych/kolumnowych i jej domyslna statystyka do 'count',
+#' funcja geom_col, ma domyślną statystykę 'identity'
+
+#' ## Zadanie 3
+#'
+#' geom_bar : stat_count
+#' geom_col : identity
+#' geom_histogram: stat_bin
+#' geom_line : identity
+#' geom_path : identity
+#' geom_step : identity
+#' geom_segment : identity
+#' geom_curve : identity
+#' geom_spoke : identity
+#' geom_polygon : identity
+#' geom_ribbot : identity
+#' geom_area : identity
+#' geom_freqpoly : stat_bin
+#' 
+
+#' ## Zadanie 4
+#' ?geom_smmoth : stat_smooth
+#' y - predicted value
+#' ymin - lower pointwise confidence interval around the mean
+#' yman - upper pointwise confidence interval around the mean
+#' se = standard error
+#' 
+#' ## Zadanie 5
+
+#' każdy "słupek" jest taki sam
+ggplot(data = diamonds) + 
+  geom_bar(mapping = aes(x = cut, y = ..prop..))
+ggplot(data = diamonds) + 
+  geom_bar(mapping = aes(x = cut, fill = color, y = ..prop..))
+
+# uzyliśmy group=1, aby nadpisać domysle grupowanie funcji geom_bar, które grupuje po x, czyli po cut,
+# dlatego każdy słupek wyglądał identycznie, ponieważ powinniśmy w tym przypadku zgrupować po całym zbiorze, usunąć grupy.
+# równie dobrze będzie działać group=2, albo group='abc'
+
+ggplot(data = diamonds) + 
+  geom_bar(mapping = aes(x = cut, fill = color, y = ..prop..,  group=1))
+
+
+
+#' # 3.8.1
+#' 
+#' ## Zadanie 1
+ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) + 
+  geom_point()
+
+#' ## Zadanie 2
+#' nakładają się na siebie punkty i nie widać dobrze zagęszczenia 
+#' mozna poprawić przez dodanie posiiton='jitter'
+
+ ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) + 
+geom_point(position='jitter')
+ 
+#' ## Zadanie 3
+ ?geom_jitter
+#' paremtry width i height
+#' 
+ ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) + 
+   geom_jitter(position='jitter')
+  
+ ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) + 
+   geom_count(position='jitter')
+ 
+ #' obie funcje pokazują zagęszczenie, geom jitter, rozsuwa je aby było widać kazdy punkt.
+ #' geom count pokazuje zagęszczenie przez parametr size.
+
+#' Zadanie 4
+?geom_boxplot
+ 
+#' domyślne dopasowanie dla geom_boxplot to 'dodge2
+
+mpg %>% 
+  ggplot(aes(x=cty, y=factor(cyl))) +
+  geom_boxplot()
+
+#' # 3.9.1
+#' ## Zadanie 1
+
+mpg %>% 
+  ggplot(aes(x=1, fill=class))+
+  geom_bar() +
+  coord_polar()
+
+
+#' ## Zadanie 2
+#' Funcjka labs, służy do dodania etykiet tetułu, opisy osi, i innnych tektów na wykresie
+
+mpg %>% 
+  ggplot(aes(x=1, fill=class))+
+  geom_bar() +
+  coord_polar() +
+  labs(title='Słupkotwy wykres skumulowany',
+       subtitle='O kordynatach polarnych',
+       y='Liczba',
+       x='Wartość dummy')
+
+#' ## Zadanie 3
+#' coord_map posiada więcej parametrów, np projectiom, parameters i orientation
+#' coord_quickmap, nie posiada tych parametrów.
+#' coord_map nada się do większych powirzchni świata, to jest pojekcją powierzchni sfery
+#' na plaski 2D. coord_quickmap, nadaje się do map o małym rozmiarze i zachowuje proste linie.
+
+#' ## Zadanie 4
+#' 
+#' 
+
+ggplot(data = mpg, mapping = aes(x = cty, y = hwy)) +
+  geom_point() + 
+  geom_abline() +
+  coord_fixed() 
+
+#' Z wykresu wnioskujemy, że spalanie w mieście i na autostradzie są skorelowane.
+#' Jeśli samochód pali dużo w mieście, to pali duzo na autostradzie i odwotnie.
+#' 
+#' Linia ab, pokazuje tam prostą y=x, dzięki temu mamy odniesienie i dodatkowo możemy wywnioskować,
+#' że na galonie paliwa, na autostradzie zawsze przejedziemy wiecej niż w mieście.
+#' 
+#' Coord fixed, sprawia że wartości obu osi są w tej samej skali. Obie wartości to liczba przejechanych kilometrów, więc 
+#' ważne jest zachowanie jednolitej skali.
+#' 
+#' Funckja abline() tworzy linię prostą y=Ax+B stąd nazawa AB Line. Domyslnie A=1, B=0 dlatego abline() to y=x

Rodział 6/flexboard_661.Rmd

@@ -0,0 +1,43 @@
+---
+title: "Zbiory danych"
+output: flexdashboard::flex_dashboard
+---
+
+```{r setup, include = FALSE}
+library(DT)
+library(ggplot2)
+library(dplyr)
+library(plotly)
+#knitr::opts_chunk$set(fig.width = 5, fig.asp = 1/3)
+```
+
+# iris
+
+## Gatunki
+
+### Gatunki
+```{r}
+iris %>% 
+  ggplot(aes(y=Sepal.Width, x=Sepal.Length, color=Species)) +
+    geom_point() 
+```
+
+## Kolumna II
+
+### Szerokość płatka (1)
+```{r}
+iris %>% 
+  ggplot(aes(x=Sepal.Width, fill=Species)) +
+    geom_histogram(bins=13) 
+```
+
+### Szerokość płatka(2)
+```{r}
+iris %>% 
+  ggplot(aes(x=Sepal.Width, y=Sepal.Length, color=Petal.Width)) +
+    geom_point() 
+```
+
+# diamonds
+
+

Rodział 6/flexdashboard_example.Rmd

@@ -0,0 +1,43 @@
+---
+title: "Rozkład danych diamentów"
+output: flexdashboard::flex_dashboard
+---
+
+```{r setup, include = FALSE}
+library(DT)
+library(ggplot2)
+library(dplyr)
+knitr::opts_chunk$set(fig.width = 5, fig.asp = 1/3)
+```
+
+## Kolumna 1
+
+### Karaty (zmienna carat)
+
+```{r}
+ggplot(diamonds, aes(carat)) + geom_histogram(binwidth = 0.1)
+```
+
+### Szlif (zmienna cut)
+
+```{r}
+ggplot(diamonds, aes(cut)) + geom_bar()
+```
+
+### Kolor (zmienna color)
+
+```{r}
+ggplot(diamonds, aes(color)) + geom_bar()
+```
+
+## Kolumna 2
+
+### Największe diamenty
+
+```{r}
+diamonds %>% 
+  arrange(desc(carat)) %>% 
+  head(100) %>% 
+  select(carat, cut, color, price) %>% 
+  DT::datatable()
+```

Rodział 6/plotly_6721.Rmd

@@ -0,0 +1,48 @@
+---
+title: "Zbiory danych"
+output: flexdashboard::flex_dashboard
+---
+
+```{r setup, include = FALSE}
+library(DT)
+library(ggplot2)
+library(dplyr)
+library(plotly)
+#knitr::opts_chunk$set(fig.width = 5, fig.asp = 1/3)
+```
+
+# iris
+
+## Gatunki
+
+### Gatunki
+```{r}
+p <- iris %>% 
+  ggplot(aes(y=Sepal.Width, x=Sepal.Length, color=Species)) +
+    geom_point() 
+
+ggplotly(p)
+```
+
+## Kolumna II
+
+### Szerokość płatka (1)
+```{r}
+p <- iris %>% 
+  ggplot(aes(x=Sepal.Width, fill=Species)) +
+    geom_histogram(bins=13) 
+
+ggplotly(p)
+```
+
+### Szerokość płatka(2)
+```{r}
+p <- iris %>% 
+  ggplot(aes(x=Sepal.Width, y=Sepal.Length, color=Petal.Width)) +
+    geom_point() 
+
+ggplotly(p)
+
+# diamonds
+
+

Rodział 8/shiny_810/app.R

@@ -0,0 +1,100 @@
+library(shiny)
+library(boot)
+library(ggplot2)
+library(plotly)
+library(dplyr)
+
+ui <- fluidPage(
+  
+  titlePanel('Ovarian tumor risk of malignancy index calculator (IOTA LR2)'),
+  
+  sidebarPanel(width = 3,
+    div(sliderInput('age',
+                    p(strong('Age of the patient (years):')),
+                    min = 14, max = 100,
+                    value = 40),
+        selectInput('ascites',
+                     p(strong('Presence of ascites:')),
+                     choices = c('no' = 0, 'yes' = 1),
+                     selected = 0),
+        selectInput('blood',
+                      p(strong('Presence of blood flow within a papillary projection:')),
+                      choices = c('no' = 0, 'yes' = 1),
+                     selected = 0),
+        sliderInput('comp',
+                    p(strong('Largest diameter of the solid component (in mm):')),
+                    min = 0, max = 50,
+                    value = 0),
+        selectInput('cyst',
+                     p(strong('Irregular internal cyst wall:')),
+                     choices = c('no' = 0, 'yes' = 1),
+                     selected = 0),
+        selectInput('shadows',
+                     p(strong('Presence of acoustic shadows:')),
+                     choices = c('no' = 0, 'yes' = 1),
+                     selected = 0),
+        
+        actionButton('calculate', 'Calculate'))),
+  
+ mainPanel(width=8,
+  div(
+     p('This application is designed for gynaecologists and implements ovarian tumor risk malignancy index based on IOTA LR2 algorithm. It also visualises an output of the logistic regression.'),
+     p('For a detailed description of the algorithm please refer to the paper: Timmerman D, Testa AC, Bourne T, [et al.]. Logistic regression model to distinguish between the benign and malignant adnexal mass before surgery: a multicenter study by the International Ovarian Tumor Analysis Group. J Clin Oncol. 2005, 23, 8794-8801.'),
+     h1('Malignancy prediction algorithm'),
+     p('In general, LR2 algorithm predicts a tumor as a benign when a patient is young, a solid component of lesion is small and acoustic shadows are present. You may check it empirically by different combinations of input values.'),
+     p('Fill in the form and click', strong('Calculate'), 'button.'),
+     textOutput('prediction'),
+     textOutput('result'),
+     plotlyOutput('plot')
+    )
+  )
+)
+
+server <- function(input, output) {
+  
+  f <- function(x) {
+    fx <- 1/(1+exp(-x))
+  }
+  
+  iota <- function(age, ascites, blood, comp, cyst, shadows) {
+    z <- -5.3718 + 0.0354*age + 1.6159*ascites + 1.1768*blood + 0.0697*comp + 0.9586*cyst + -2.9486*shadows
+  }
+  
+  get_plot <- eventReactive(input$calculate, {
+    
+  z <- iota(as.integer(input$age),
+            as.integer(input$ascites),
+            as.integer(input$blood),
+            as.integer(input$comp),
+            as.integer(input$cyst),
+            as.integer(input$shadows))
+  
+  fz <- f(z)
+  print(z)
+
+  output$prediction <- renderText(paste('Raw predictor value (the lower, the better):', round(fz, 2)))
+  output$result <- renderText(paste('Class of the tumor:', if (fz>0.1) {'malignant'} else {'benign'}))
+  
+  data <- data.frame(x=c(0,1))
+  
+  p <- ggplot(data) +
+    annotate('text',
+             x = 5, 
+             y = 0.15, 
+             label = 'milignancy thershold: 0.1') + 
+    stat_function(fun = f, color = 'black') + 
+    geom_abline(slope = 0, intercept = 0.1, linetype = 2) +
+    geom_point(aes(z, fz), color = 'red') +
+    labs(y = 'prediction',
+         x= 'premises') +
+    scale_x_continuous(limits = c(-8,8)) +
+    scale_y_continuous(limits = c(0,1)) +
+    theme_classic()
+  
+  ggplotly(p)
+    
+  })
+  output$plot <- renderPlotly(get_plot())
+}
+
+shinyApp(ui=ui, server=server)

Rodział 8/shiny_836/app.R

@@ -0,0 +1,42 @@
+#
+# This is a Shiny web application. You can run the application by clicking
+# the 'Run App' button above.
+#
+# Find out more about building applications with Shiny here:
+#
+#    http://shiny.rstudio.com/
+#
+
+library(shiny)
+
+# Define UI for application that draws a histogram
+ui <- fluidPage(
+    titlePanel("Moja aplikacja Shiny"),
+    sidebarLayout(
+        sidebarPanel(
+            h1('Instalacja'),
+            p('Shiny jest w repozytorium CRAN, więc możesz zainstalowac go w zwykły sposób z konsoli R:'),
+            code("install.packages('shiny')"),
+            img(src = "rstudio.png", height = 70, width = 200),
+            p('Shiny jest produktem ', span('RStudio', style = "color:red"))
+        ),
+        mainPanel(
+            h1('Wprowadzenie do Shiny'),
+            p('Shiny jest nowym pakietem RStudio, ktory' , em('bardzo ułatwia'), 'tworzenie interaktywnych aplikacji internetowych w R'),
+            p('Dużo informacji i przykładów znajduje się na',  a('stronie Shiny')),
+            h2('Ficzery'),
+            p('- Twórz użyteczne aplikacje internetowe zaledwie kilkoma liniami kodu - nie jest wymagana znajomość JavaScript'),
+            p('- Aplikacje Shiny aktualizują się tak samo szybko jak arkusze danych np. Excel. Wyniki zmieniają się natychmiast - gdy uzytkownicy modyfikują dane wejściowe, nie ma konieczności ponownego przeładowania strony')
+            
+        )
+    )
+)
+
+# Define server logic required to draw a histogram
+server <- function(input, output) {
+
+
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)

Rodział 8/shiny_842/app.R

@@ -0,0 +1,29 @@
+library(shiny)
+
+ui <- fluidPage(
+    titlePanel('Spis powszechny'),
+    sidebarPanel(
+        div(style="width:200px;",
+            p('Stwórz mapy demograficzne za pomocą informacji ze spisu powszechnego USA w 2010 r.', style="color:grey"),
+            selectInput("selectInput", 
+                        p(strong('Wybierz zmienną do wyświetlenia')),
+                        choices = list("Procent ludności białej", 
+                                       "Procent Afroamerykanów",
+                                       "Procent Latynosow",
+                                       "Procent Azjatów"),
+                        selected = 1),
+            sliderInput("sliderInput",
+                        p(strong('Zakres:')),
+                        min = 0, 
+                        max = 100,
+                        value = c(0,100))
+        )
+    )
+)
+
+
+server <- function(input, output) {
+    
+}
+
+shinyApp(ui=ui, server=server)

Rodział 8/shiny_855/app.R

@@ -0,0 +1,43 @@
+library(shiny)
+
+ui <- fluidPage(
+    titlePanel('Spis powszechny'),
+    sidebarPanel(
+        div(style="width:200px;",
+            p('Stwórz mapy demograficzne za pomocą informacji ze spisu powszechnego USA w 2010 r.', style="color:grey"),
+            selectInput("selectInput", 
+                        p(strong('Wybierz zmienną do wyświetlenia')),
+                        choices = list("Procent ludności białej", 
+                                       "Procent Afroamerykanów",
+                                       "Procent Latynosow",
+                                       "Procent Azjatów"),
+                        selected = 1),
+            
+            textOutput("selected_select"),
+            
+            sliderInput("sliderInput",
+                        p(strong('Zakres:')),
+                        min = 0, 
+                        max = 100,
+                        value = c(0,100)),
+            
+            textOutput("slider_range")
+        )
+    )
+)
+
+
+
+server <- function(input, output) {
+    
+    output$selected_select <- renderText({ 
+        paste("Zaznaczyłeś opcję: ", input$selectInput)
+    })
+    
+    output$slider_range <- renderText({
+        paste("Wybrałeś zakres od", input$sliderInput[1], "do", input$sliderInput[2])
+    })
+    
+}
+
+shinyApp(ui=ui, server=server)