Jak widzieliście w poprzednich sekcjach, możesz pracować bezpośrednio z naszym plikiem R Markdown do prezentacji (presentation.Rmd w naszym przypadku). Jednak możesz być bardziej produktywny, jeśli najpierw opracujesz zawartość prezentacji, tak jak normalnie pracujesz z R, wykorzystując wszelkie konfiguracje i narzędzia, do których jesteś przyzwyczajony. Po sfinalizowaniu kodu tłumaczysz tylko niezbędne części do pliku R Markdown. Nawet jeśli wydaje się to sprzeczne z intuicją, ponieważ wymagałoby więcej pracy, w rzeczywistości działa to szybciej, tylko dlatego, że jesteś przyzwyczajony do pracy z R bardziej niż z R Markdown i pomyślisz o stworzeniu modularnego kodu, który można podłączyć do Twoja prezentacja. Pozwala to na tworzenie kodu o wyższej jakości i wielokrotnego użytku. Dokładnie to zrobimy tutaj. Zaczniemy pracować z naszymi zwykłymi plikami mai.R i functios.R, aby opracować to, czego potrzebujemy. Następnie w dalszej części dokonamy migracji kodu do naszego pliku presentation.Rmd. Zauważ, że użycie funkcji source(), tak jak zrobiliśmy, ładuje do pamięci wszystkie funkcje, które mamy w pliku funkcji. Może to być to, czego naprawdę potrzebujesz, ale jeśli nie będziesz ostrożny, możesz w rezultacie nadpisać definicję funkcji. W tym konkretnym przypadku nie stanowi to problemu, więc zostawimy to tak, jak jest. Gdyby to był problem, zawsze moglibyśmy przenieść żądaną funkcję do jej własnego pliku i po prostu source tego pliku. Interesująca nas funkcja to:
filter_n_days_back <- function(data,n) {
if (is.null()) {
return(data)
}
n_days_back <- Sys.Date() – n
return(data[data-, „DATE”] >= n_days_back, ])
}
Załóżmy, że minęło dużo czasu od pierwszej symulacji danych. Jeśli wykonasz wywołanie funkcji, takie jak filter_n_days_back(data,7), nie masz gwarancji, że będziesz mieć dane z poprzedniego tygodnia i Ciebie Najprawdopodobniej otrzymasz pusty wynik, ponieważ n_days_back <- Sys.Date() – n zawiera dane z 7 dni wstecz od today , a nie ostatnia data zapisana w danych. To jest problem. Sposób radzenia sobie w takich sytuacjach może zakończyć długą debatę z rówieśnikami. Generalnie mamy dwie możliwości: przepisanie niezależnej funkcji lub naprawienie kodu, który już mamy. Właściwa odpowiedź będzie zależeć od twoich konkretnych okoliczności i kontekstu, a oba mają swoje zalety i
wady. Generalnie, pisząc nową funkcję, będziesz mieć pewność, że twój kod działa i że nie złamałeś przypadkowo kodu innej osoby, co zależało od poprzedniej wersji. Wadą jest to, że będziesz musiał utrzymywać więcej kodu bez uzyskiwania dużej funkcjonalności, a z czasem może to być ogromny ból. Pamiętasz zasadę DRY, o której wspomnieliśmy wcześniej? Nie powtarzaj się (SUCHE). Jeśli zdecydujesz się naprawić obecną wersję kodu, prawdopodobnie otrzymasz bardziej niezawodną bazę kodu, którą możesz ponownie wykorzystać w jeszcze większej liczbie przypadków, niż początkowo przewidywano, bez zbytniego zwiększania (czasami zmniejszania) kodu, który musisz utrzymywać. Istnieje jednak również możliwość, że złamiesz kod, który zależał od poprzedniej funkcjonalności, co może być bardzo trudne do naprawienia w przyszłości, gdy zdasz sobie sprawę, że to zrobiłeś. Istnieją dwie podstawowe zasady, które uchronią Cię przed silnymi bólami głowy w tego typu sytuacjach. Używaliśmy jednej z nich: tworzenia małego i modułowego kodu. Krótko mówiąc, mamy na myśli kod działający zgodnie z zasadą pojedynczej odpowiedzialności, Kiedy to robisz, dzieje się coś magicznego; zaczynasz podłączać kod do innego kodu i możesz łatwo modyfikować te wtyczki i tworzyć nowe, jeśli ich potrzebujesz, bez większych problemów. Innym fundamentem są testy jednostkowe dla twojego kodu. Mówiąc najprościej, testy jednostkowe to fragmenty kodu zaprojektowane do testowania, czy inny kod działa tak, jak powinien. Testy jednostkowe są poza zakresem tej książki, ale zdecydowanie powinieneś się tym zająć, jeśli jeszcze tego nie wiesz.
Wracając do kodu tego konkretnego przykładu, zdecydowaliśmy się naprawić kod, który już mamy. Aby mieć pewność, że przypadkowo nie złamiemy innego kodu zależnego od tej funkcji, stosujemy się do zasady Open-Closed, która mówi, że obiekty powinny być otwarte na rozszerzenia i zamknięte na modyfikacje. Zasadniczo rozszerzymy interfejs bez modyfikowania go w taki sposób, aby wynik był taki sam, gdy używamy tych samych poprzednich wejść, ale rozszerzona wersja pozwoli nam uzyskać nowe wyjścia, które chcemy. Brzmi bardziej uciążliwie niż w rzeczywistości. Jak widać, po prostu dodajemy nowy opcjonalny parametr o domyślnej wartości NULL. Następnie zamiast obliczać_days-back z bieżącą datą, sprawdzamy, czy została wysłana jakakolwiek wartość; jeśli tak, to używamy tego jako punktu wyjścia; jeśli nie, wracamy do starego zachowania:
filter_n_days_back <- function(data, n, from_date = NULL) {
if (is.null(n) ) {
return(data)
}
if (is.null(from_date)) {
from_date <- Sys.Date()
) else if (is.character(from_date)) {
from_date <- as.Date(from_date)
}
n_days_back <- from_date – n
return(data[data[, „DATE”] >= n_days_back, ])
}
Teraz, gdy mamy tę nową wersję funkcji, możemy użyć jej do uwzględnienia ostatniego tygodnia w danych, obliczając maksymalną datę, którą w niej zapisaliśmy, i używając tego jako naszego parametru
from_date . Zwróć także uwagę, jak łatwo jest wziąć dane nie tylko z tego tygodnia, ale także z zeszłego tygodnia. Jednak aby to zadziałało, musimy upewnić się, że obiekt max_date jest obiektem Date w R, abyśmy mogli odjąć od niego 7, a to faktycznie oznacza 7 dni. Jeśli jest to ciąg znaków zamiast daty, wystąpiłby błąd. Na marginesie, pamiętaj, że gdybyśmy korzystali z danych, które są stale rejestrowane, ten i ostatni tydzień miałby sens, ale ponieważ używamy danych, które symulowaliśmy prawdopodobnie dawno temu, ten i ostatni tydzień będą się różnić w zależności od daty w rzeczywistych danych, których używamy. To nie jest problem, ponieważ używamy maksymalnej daty w danych, która zostanie odpowiednio dostosowana dla każdej sytuacji:
max_date <- max(all_time$DATE)
this_week <- filter_n_days_back(all_time, 7, max_date)
last_week <- filter_n_days_back(all_time, 7 , max_date -7)
Teraz, gdy mamy trzy potrzebne nam zbiory danych (all_time, last_week i this_week), możemy rozpocząć tworzenie kodu, który wykorzysta je do tworzenia wykresów, których szukamy. Najpierw musimy uzyskać tabele proporcji dla każdej interesującej nas zmiennej i dla każdego zbioru danych. Tak jak zawsze chcemy opakować kod, który nie jest zbyt jasny na temat jego funkcjonalności, we własną funkcję, abyśmy mogli nadać jej nazwę i szybko wiedzieć, co ma robić. W w tym przypadku tworzymy funkcjęproportio_table(), która powinna być oczywista, i stosujemy to, jak wspomniano. Zauważ, że mnożymy przez 100 , ponieważ chcemy pokazać 10% z zamiast 0.2 na naszych wykresach:
propotions_table <- function(data, variable){
return(prop.table(table(data[, variable])))
}
quantity_all <- proportios_table(all_time, „QUANTITY”)
cotinent_all <- proportions_table(all_time, „CONTINENT”)
protein_all <- proportions_table(all_time, „PROTEIN_SOURCE”)
quantity_last <- proportios_table(last_week, „QUANTITY”)
cotinent_last <- proportions_table(last_week, „CONTINENT”)
protein_last- proportions_table(last_week, „PROTEIN_SOURCE”)
quantity_this <- proportios_table(this_week, „QUANTITY”)
cotinent_this <- proportions_table(this_week, „CONTINENT”)
protein_this <- proportions_table(this_week, „PROTEIN_SOURCE”)
W tym momencie każdy z tych obiektów powinien zawierać tabelę z procentami każdej kategorii w ramach zmiennej będącej przedmiotem zainteresowania. Te kończące się na _all zawierają procenty wszystkich zarejestrowanych danych. Podobnie te kończące się na _last i _this zawierają wartości procentowe odpowiednio dla ostatniego tygodnia i tego tygodnia. Liczba miejsc dziesiętnych zależy od aktualnych danych i konfiguracji. We wszystkich przypadkach liczby powinny sumować się do 100:
quantity_all
#> 1 2 3 4 5 6 7 8 9
#> 13,22 27,78 26,09 18,29 9,19 3,77 1,29 0,30 0,07
quantity_last
#> 1 2 3 4 5 6 7 8
#> 12,1387 33,5260 28,3234 12,7160 5,7803 5,7803 1,1560 0,5780
quantity_this
#> 1 2 3 4 5 6 7 8
#> 12 36 25 14 7 4 1 1
Uważny czytelnik powinien był zauważyć, że quantity_all zawiera jeszcze jedną kategorię niż quantity_last i quantity_this. To dlatego, że w ciągu ostatnich dwóch tygodni w danych nie było sprzedaży dla dziewięciu artykułów. Oznacza to, że gdy spróbujemy porównać zmianę liczby w każdej z tych kategorii, będziemy mieli problem z powodu dodatkowej kategorii w quantity_all. Poradzimy sobie z tym, zachowując tylko kategorie, które są wspólne dla każdej używanej przez nas pary tabel. Funkcja equal_length_data() otrzymuje dwie z tych tabel jako data_1 i data_2, a następnie oblicza minimalną długość (ml) wśród nich i używa go do uzyskania elementów do tego punktu w obu data_1 i data_2. Ponieważ oba są w tym momencie tabelami, chcemy numerycznej tablicy jej wartości, a nie obiektu tabeli, dlatego stosujemy as.numeric(). Jeśli tego nie zrobimy, ggplot2 będzie narzekać, że nie wie, jak postępować z obiektami typu table. Nie tracimy nazw kategorii, stosując funkcję as.numeric do tabel, ponieważ bierzemy je oddzielnie w elemencie names zwracanej listy. Na koniec chcemy wiedzieć, czy jakiekolwiek kategorie zostały usunięte, i możemy to wiedzieć, sprawdzając, czy długość którejkolwiek z tabel danych zawiera mniej kategorii, niż wskazuje liczba ml. W takim przypadku delete będzie TRUE i zostanie wysłane, a będzie FALSE w przeciwnym razie:
equal_legth_data <- function(data_1, data_2) {
ml <- min(length(data_1), length(data_2))
return(list(
names = names(data_1[1:ml]),
data_1 = as.numeric(data_1[1:m;]),
data_2 = as.numeric(datat_2[1:ml]),
deleted = ml != length(data_1) || ml = != length(data_2)
)
}
Mamy teraz dostęp do danych o równej długości, z odpowiednimi nazwami kategorii i wartością logiczną wskazującą, czy jakiekolwiek kategorie zostały usunięte. Możemy użyć tego obiektu w następujący sposób:
parts <- equal_length_data(quantity_all, quantity_this)
parts$names
#> [1] “1” “2” “3” “4” “5” “6” “7” “8”
parts$data_1
#> [1] 0,1322 0,2778 0,2609 0,1829 0,0919 0,0377 0,0129 0,0030
pats$data_2
#> [1] 0,12 0,36 0,25 0,14 0,07 0,04 0,01 0,01
parts$deleted
#> [1] TRUE
Teraz skupimy się na przygotowaniu danych do naszych wykresów. Ponieważ będziemy używać pakietu ggplot2, wiemy, że musimy utworzyć ramkę danych. Ta ramka danych powinna zawierać nazwy kategorii w Category bezwzględne i procentowe różnice między pasującymi kategoriami z dwóch tabel odpowiednio Difference i Percent , Sign i Color w zależności od tego, czy bezwzględna różnica jest dodatnia czy ujemna, a dane przed i po odpowiednio Before i After. Zauważ, że kolejność, w jakiej obliczono parts, jest ważna dla bezwzględnych i procentowych różnic, które z kolei wpływają na kolor i znak. Musimy uważać na przesyłanie najnowszych danych jako data_2, aby otrzymać interpretację podobną do zeszłego tygodnia, w tym tygodniu mieliśmy X więcej. W przeciwnym razie interpretacja byłaby odwrócona:
prepare_data <- function(parts) {
data <- data.frame(„Category” = parts$names)
data$Difference <- parts$data_2 – parts$data_1
data$Percent <- (parts$data_2 – parts$data_1) / parts$data_1 * 100
data$Sign <- ifelse(data$Difference >= -, „Positive”, „Negative”)
data$Color <- ifelse(data$Difference, > = 0, GREEN, RED)
data$Before <- parts$data_1
data$After <- parts$data_2
return(data)
}
Zdefiniujemy dwa kolory za pomocą notacji szesnastkowej, abyśmy mogli wywołać je po nazwie zamiast za każdym razem kopiować ciąg szesnastkowy. Później, jeśli chcemy zmienić kolory, możemy zmienić je w jednym miejscu zamiast zastępować je wszędzie tam, gdzie ich używaliśmy:
RED <- „#F44336”
GREEN <- „#4CAF50”
Funkcja difference_bars() powinna być jasna. Jak widać, obliczamy obiekty parts i data za pomocą funkcji przedstawionych wcześniej, a następnie używamy pakietu ggplot2 do opracowania wykresu. Zwróć uwagę, że dodajemy tylko podtytuł zawierający informację, że niektóre kategorie zostały usunięte, jeśli wartość logiczna delete z parts to TRUE:
differennce_bars <- function(data_1, data_2, before, after) {
parts <- equal_length_data(data_1, data_2)
data <- prepare_data(parts)
p <- ggplot(data, aes(Category, Difference, fill = Sign))
p <- p + geom_bar(stat = „identity” , width = 0.5)
p <- p + scale_fill_manual(values =
c(„Positive” = GREEN, „Negative” = RED))
p <- p + theme(legend.position = „none”,
text = element_text(size = 14))
p <- p + scale_y_cotinuous(labels = scales ::percent)
p <- p + labs(title = paste(before, „vs” , after))
p <- p + labs(x = „” , y = „”)
if (parts$deleted) {
p <- p + labs(subtitle =
„(Extra categories have been deleted)”)
}
return(p)
}
Teraz możemy stworzyć kilka przydatnych wykresów, jak poniżej. Należy pamiętać, że wartości na osi y nie wskazują procentowego wzrostu, ale zmianę w punktach procentowych. Można to od razu zrozumieć, patrząc na kod, ale nie jest to jasne, patrząc na wykres. W rzeczywistości musielibyśmy zawrzeć pewne wyjaśnienie tego w prawdziwej prezentacji:
difference_bars(quantity_all, quantity_this, „This week”, „All-time”)
difference_bars(continent_all, continent_this, „This week”, „All-time”)
difference_bars(protein_all, protein_this, „This week”, „All-time”)
Wynikowe wykresy przedstawiono w następujący sposób:

Drugi typ wykresu, który chcemy opracować, jest nieco bardziej złożony. Utworzymy pionowe linie na 1 i 2 wzdłuż osi x, umieścimy etykiety tekstowe wskazujące, gdzie procent dla każdej kategorii znajduje się w zestawach danych before i after, a procent zmiany w środku. Najpierw tworzymy obiekt data tak jak poprzednio. Następnie tworzymy etykiety, których użyjemy dla każdej kategorii. Te po lewej to before_labels, te w środku to percent_labels, a te po prawej to after_labels. percent_y zawiera wartości dla osi y, na której będzie umieszczony percet_labels. Wartość osi x jest ustalona na 1,5, tak że znajduje się między dwiema pionowymi liniami. Aby obliczyć wartość perent_y, chcemy uzyskać minimum między wartościami przed i po dla każdej kategorii i dodać połowę różnicy między nimi. Zapewni to, że wartość będzie znajdować się w środku linii, która będzie łączyła obie wartości. Jesteśmy teraz gotowi do rozpoczęcia korzystania z pakietu ggplot2. Najpierw definiujemy dane w zwykły sposób i dodajemy segment łączący wartości before i after dla każdej kategorii, zaczynając od krotki $(1,Befoere) i kończąc na krotce $(2,After), gdzie każda krotka ma postać $(x,y). Użyjemy zmiennej Sign jako koloru wypełnienia słupków i unikniemy wyświetlania legendy, ponieważ sami pokażemy niektóre etykiety. Użyjemy funkcji scale_color_manual (), aby określić kolory, które powinny być używane dla każdej linii w zależności od tego, czy różnica bezwzględna była dodatnia czy ujemna. Następnie pojawiają się pionowe linie, które tworzy się funkcją geom_vline(). Jak wspomniano wcześniej, zostaną one umieszczone z wartościami 1 i 2 wzdłuż osi x. Zrobimy linię przerywaną, aby poprawić estetykę i użyć mniejszego rozmiaru niż linie segmentów, które stworzyliśmy wcześniej.
Następnie umieścimy etykiety za pomocą funkcjigeom_text(). Rozpoczynamy tworzenie etykiety dla każdej z linii pionowych, które są tworzone przy wartościach 0,7 i 2,3 osi x oraz nieco zwiększonym maksimum wartości before i after. Następnie umieszczamy etykiety kategorii po lewej stronie, w środku i po prawej stronie za pomocą funkcji geom_text_repel(). Ta funkcja nie jest zawarta w pakiecie ggplot2, a właściwie jest jej rozszerzeniem. Jest przeznaczony do odpychania (stąd nazwa) etykiet, które nakładają się na siebie. W tym celu funkcja odsuwa etykiety od pozycji punktu i rysuje linię wskazującą, która etykieta należy do każdego punktu.
W naszym przypadku usuwamy wspomnianą linię parametrem segment.color = NA i wskazujemy, że kierunek regulacji przebiega tylko wzdłuż osi y. W rzeczywistości bardzo trudno jest komuś wymyślić cały ten kod za pierwszym razem, a nasz przypadek nie był inny. Zaczęliśmy od kilku małych wątków i stale dodawaliśmy elementy, których szukaliśmy, poprzez powtarzane eksperymenty. W szczególności zdaliśmy sobie sprawę, że niektóre etykiety zachodzą na siebie, co nie wygląda dobrze, dlatego zdecydowaliśmy się użyć pakietu geom_text_repl(), którego wcześniej nie robiliśmy Wiem, ale łatwo znaleźć w Internecie, ponieważ wiele osób ma ten sam problem i na szczęście ktoś opracował jego rozwiązanie. Parametr x_adjustment jest wynikiem podobnych eksperymentów. Zdaliśmy sobie sprawę, że etykiety różnych wykresów nakładały się na pionowe linie w zależności od liczby znaków w nazwach kategorii. Aby to naprawić, zdecydowaliśmy się wprowadzić nowy parametr, który dostosowuje położenie wzdłuż osi x, z którym można eksperymentować, dopóki nie znajdziemy dla niego dobrego parametru. Wszystko po to, aby powiedzieć, że powinieneś skorzystać z szybkich cykli eksperymentów R, aby iteracyjnie wytworzyć to, czego szukasz. Na koniec usuwamy dowolny tekst z osi x i y oraz ograniczamy ich zakres wartości, ponieważ nie trzeba ich czytać na wykresie i zapewniać bardziej przejrzystą wizualizację. Zrozumienie, co dokładnie robi każda część kodu, może wymagać trochę eksperymentów, co jest całkowicie w porządku i zdecydowanie powinieneś to zrobić:
change_lines <- function(data_1, data_2, before, after, x_adjustment) {
parts <- equal_length_data(data_1, data_2)
percent_labels <- paste(round(data$Percent, 2), „%”, sep = „”)
befoe_labels < paste(
data$Category, „ ( „, round(data$Before, 2), „%)”, sep = „”)
after_labels <- paste(
data$Category, „ („ round(data$After, 2), „%)”, sep = „”)
percent_y <- (
apply(data[, c(„Before”, „After”)], 1, min) +
abs(data$Before – data$After) / 2
)
p <- ggplot(data)
p <- p + geom_segment (
aes(x = 1, xend = 2, y = Before, yend = After, col = Sign).
show.legend = FALSE,
size – 1.5)
p <- p + sale_color_manual (
values = c(„Positive” = GREEN, „Negative” = RED))
p <- p + geom_vline(xintercept = 1 lietype = „dashed”, size = 0.8)
p <- p + geom_vline(xintercept = 2 , lietype = „dashed” , size = 0.8)
p <- p + geom_text (
label = before,
x = 0.7
y = 1.1 * max(data$Befre data$After),
size = 7)
p <- p + geom_text (
label= after,
x = 2.3,
y = 1.1 * max(data$Before, data$After),
size= 7)
p <- p + geom_text_repel (
label = befoe_labels,
x = rep(1 – x_adjustment, nrow(data)),
y = data$Before, size = 5, direction = „y”,
segmet.color = NA)
p <- p + geom_text_repel (label = after_labels,
x = rep(2 + x_adjustment, nrow(data)),
y = data$After, size = 5,
direction = „y”,
segment.color = NA)
p <- p + geom_text_repel(label = percent_labels,
x = rep(1.5, nrow(data)),
y = perent_y, col – data$Color , size = 5,
direction = „y”
segment.color = NA)
p <- p + theme (
axis.ticks = elelment_blank(),
axis.text.x = element_blank(),
axis.text.y = elemet_blank()
)
p <- p + ylim(0, (1.1 * max(data$Before, data$After)))
p <- p + labs(x = „” , y = „”)
p <- p + xlim(0.5 , 2.5)
retur(p)
}

Teraz możemy przedstawić kilka bardzo przydatnych i ładnie wyglądających wykresów z następującym kodem:
change_lines(quantity_last, quantity_this, „This week”, „Last week”, 0.2)
change_lines(continent_last, continent_this, „This week”, „Last week”, 0.3)
change_lines(protein_last, protein_this, „This week”, „Last week”, 0.5)
Te wykresy można łatwo zinterpretować i nie wydają się być tak podatne na problem z jednostkami procentowymi osi x, o którym wspominaliśmy na poprzednich wykresach. Możesz łatwo sprawdzić, czy kategoria zwiększyła lub zmniejszyła swój procent między okresami oraz o ile procent. Pamiętaj, że wątki wszech czasów zawierają również ten tydzień podczas ich interpretacji. W rzeczywistości może to być poprawne lub nie w Twoim konkretnym przypadku użycia.