Czysty R, nie potrzeba żadnych pakietów. Moja funkcja rysująca wykresy jest prosta w użyciu i całkiem elastyczna:
dostosuj_dane <- function(
y1,
y2 = NA,
y_prognoza = NA,
x1 = NA,
x2 = NA,
x3 = NA
) {
# ============================================================
# 1. Ustalenie osi X1 przed konwersją danych do numeric
# ============================================================
if (all(is.na(x1))) {
if (inherits(y1, "ts")) {
x1 <- as.numeric(time(y1))
} else {
x1 <- seq_along(y1)
}
}
# ============================================================
# 2. Konwersja serii Y do wartości numerycznych
# ============================================================
y1 <- as.numeric(y1)
if (!all(is.na(y2))) {
y2 <- as.numeric(y2)
}
if (!all(is.na(y_prognoza))) {
y_prognoza <- as.numeric(y_prognoza)
}
# ============================================================
# 3. Ustalenie osi X2 dla dopasowania
# ============================================================
if (!all(is.na(y2)) && all(is.na(x2))) {
x2 <- x1[seq_along(y2)]
}
# ============================================================
# 4. Ustalenie osi X3 dla prognozy
# ============================================================
if (!all(is.na(y_prognoza)) && all(is.na(x3))) {
liczba_punktow_historii <- length(x1)
krok <- if (liczba_punktow_historii > 1) {
diff(tail(x1, 2))
} else {
1
}
if (inherits(x1, "Date") || inherits(x1, "POSIXct")) {
jednostka_czasu <- if (inherits(x1, "Date")) {
"days"
} else {
"secs"
}
krok <- if (liczba_punktow_historii > 1) {
diff(tail(x1, 2))
} else {
as.difftime(1, units = jednostka_czasu)
}
x3 <- seq(
from = max(x1) + krok,
by = krok,
length.out = length(y_prognoza)
)
} else {
x3 <- seq(
from = max(x1) + krok,
by = krok,
length.out = length(y_prognoza)
)
}
}
# ============================================================
# 5. Utworzenie wspólnej osi czasu
# ============================================================
wspolna_os_czasu <- sort(unique(c(x1, x2, x3)))
wspolna_os_czasu <- wspolna_os_czasu[!is.na(wspolna_os_czasu)]
# ============================================================
# 6. Funkcja pomocnicza mapująca serię na wspólną oś
# ============================================================
mapuj_na_wspolna_os <- function(stara_os, stara_seria, nowa_os) {
if (all(is.na(stara_seria))) {
return(rep(NA, length(nowa_os)))
}
nowa_seria <- rep(NA, length(nowa_os))
pozycje <- match(stara_os, nowa_os)
nowa_seria[pozycje] <- stara_seria
nowa_seria
}
# ============================================================
# 7. Mapowanie serii historycznych
# ============================================================
y1_final <- mapuj_na_wspolna_os(
stara_os = x1,
stara_seria = y1,
nowa_os = wspolna_os_czasu
)
y2_final <- mapuj_na_wspolna_os(
stara_os = x2,
stara_seria = y2,
nowa_os = wspolna_os_czasu
)
# ============================================================
# 8. Przygotowanie serii prognozy
# ============================================================
if (!all(is.na(y_prognoza))) {
punkt_styku <- if (!all(is.na(y2))) {
tail(y2[!is.na(y2)], 1)
} else {
tail(y1[!is.na(y1)], 1)
}
y_prognoza_surowa <- mapuj_na_wspolna_os(
stara_os = x3,
stara_seria = y_prognoza,
nowa_os = wspolna_os_czasu
)
ostatni_punkt_historii <- max(x1, na.rm = TRUE)
pozycja_punktu_styku <- match(
ostatni_punkt_historii,
wspolna_os_czasu
)
y_prognoza_surowa[pozycja_punktu_styku] <- punkt_styku
y_prognoza_final <- y_prognoza_surowa
} else {
y_prognoza_final <- rep(NA, length(wspolna_os_czasu))
}
# Zachowana nazwa y_p dla zgodności z pierwotnym kodem
list(
x = wspolna_os_czasu,
y1 = y1_final,
y2 = y2_final,
y_p = y_prognoza_final
)
}
rysuj_wykres <- function(
y1,
y2 = NA,
y_prognoza = NA,
x1 = NA,
x2 = NA,
x3 = NA,
y1_nazwa = "y1",
y2_nazwa = "Dopasowanie",
y_prognoza_nazwa = "Prognoza",
x_nazwa = NA,
prawa_skala = FALSE,
poloz_legendy = "top",
wielk_czcionki_legendy = 1,
y1_kolor = "blue",
y2_kolor = "red",
y_prognoza_kolor = "green",
y1_typ = "solid",
y2_typ = "solid",
y_prognoza_typ = "dashed"
) {
dane_wykresu <- dostosuj_dane(
y1 = y1,
y2 = y2,
y_prognoza = y_prognoza,
x1 = x1,
x2 = x2,
x3 = x3
)
x_final <- dane_wykresu$x
y1_final <- dane_wykresu$y1
y2_final <- dane_wykresu$y2
y_prognoza_final <- dane_wykresu$y_p
if (length(y1_final) != length(x_final)) {
message("Błąd synchronizacji danych z osią czasu.")
return(invisible(NULL))
}
x_label <- if (!is.na(x_nazwa)) {
x_nazwa
} else {
"Czas"
}
# ============================================================
# 1. Rysowanie wykresu z prawą skalą
# ============================================================
if (prawa_skala && !all(is.na(y2_final))) {
zakres_y1 <- range(y1_final, na.rm = TRUE)
plot(
x_final,
y1_final,
type = "l",
col = y1_kolor,
lty = y1_typ,
lwd = 2,
ylim = zakres_y1,
xlab = x_label,
ylab = y1_nazwa,
axes = FALSE,
las = 1,
panel.first = {
abline(
v = x_final,
col = "gray",
lty = 3
)
abline(
h = pretty(zakres_y1),
col = "gray",
lty = 3
)
}
)
axis(
1,
at = x_final,
labels = x_final,
cex.axis = 0.8
)
axis(
2,
col.axis = y1_kolor,
cex.axis = 0.8,
las = 1
)
box()
par(new = TRUE)
plot(
x_final,
y2_final,
type = "l",
col = y2_kolor,
lty = y2_typ,
lwd = 2,
axes = FALSE,
xlab = "",
ylab = "",
ylim = range(y2_final, na.rm = TRUE)
)
axis(
4,
col.axis = y2_kolor,
cex.axis = 0.8,
las = 1
)
mtext(
y2_nazwa,
side = 4,
line = 2,
col = y2_kolor
)
if (!all(is.na(y_prognoza_final))) {
lines(
x_final,
y_prognoza_final,
col = y_prognoza_kolor,
lty = y_prognoza_typ,
lwd = 2
)
}
} else {
# ==========================================================
# 2. Rysowanie wykresu ze wspólną skalą
# ==========================================================
zakres_y <- range(
c(y1_final, y2_final, y_prognoza_final),
na.rm = TRUE
)
plot(
x_final,
y1_final,
type = "l",
col = y1_kolor,
lty = y1_typ,
lwd = 2,
ylim = zakres_y,
xlab = x_label,
ylab = y1_nazwa,
axes = FALSE,
las = 1,
panel.first = {
abline(
v = x_final,
col = "gray",
lty = 3
)
abline(
h = pretty(zakres_y),
col = "gray",
lty = 3
)
}
)
axis(
1,
at = x_final,
labels = x_final,
cex.axis = 0.8
)
axis(
2,
las = 1
)
box()
if (!all(is.na(y2_final))) {
lines(
x_final,
y2_final,
col = y2_kolor,
lty = y2_typ,
lwd = 2
)
}
if (!all(is.na(y_prognoza_final))) {
lines(
x_final,
y_prognoza_final,
col = y_prognoza_kolor,
lty = y_prognoza_typ,
lwd = 2
)
}
}
# ============================================================
# 3. Budowa legendy
# ============================================================
serie <- list(
y1 = y1_final,
y2 = y2_final,
y_prognoza = y_prognoza_final
)
nazwy_serii <- list(
y1 = y1_nazwa,
y2 = y2_nazwa,
y_prognoza = y_prognoza_nazwa
)
kolory_serii <- list(
y1 = y1_kolor,
y2 = y2_kolor,
y_prognoza = y_prognoza_kolor
)
typy_serii <- list(
y1 = y1_typ,
y2 = y2_typ,
y_prognoza = y_prognoza_typ
)
tekst_legendy <- character()
kolory_legendy <- character()
typy_legendy <- character()
for (nazwa_serii in names(serie)) {
if (!all(is.na(serie[[nazwa_serii]]))) {
tekst_legendy <- c(
tekst_legendy,
nazwy_serii[[nazwa_serii]]
)
kolory_legendy <- c(
kolory_legendy,
kolory_serii[[nazwa_serii]]
)
typy_legendy <- c(
typy_legendy,
typy_serii[[nazwa_serii]]
)
}
}
legend(
poloz_legendy,
legend = tekst_legendy,
col = kolory_legendy,
lty = typy_legendy,
lwd = 2,
bty = "n",
cex = wielk_czcionki_legendy
)
invisible(NULL)
}Przykłady użycia:
# Dane
y1_dane <- c(10, 12, 15, 14, 18, 20, 22)
y2_dane <- c(10.5, 11.8, 14.5, 14.5, 17, 20.6, 21.5)
y_prog <- c(23.5, 25.1, 26.8)
lata <- 2018:2024
lata_p <- 2025:2027Przykład 1: Wersja minimum, czyli najprostszy wykres
rysuj_wykres(y1 = y1_dane)
Przykład 2: Dodajemy własną nazwę serii
rysuj_wykres(
y1 = y1_dane,
y1_nazwa = "Sprzedaż"
)
Przykład 3: Dokładamy własną oś czasu
rysuj_wykres(
y1 = y1_dane,
y1_nazwa = "Sprzedaż",
x1 = lata,
x_nazwa = "Rok"
)
Przykład 5: Dodajemy drugą serię
rysuj_wykres(
y1 = y1_dane,
y2 = y2_dane
)
y2 i x
Przykład 7: Wszystkie serie i opisy razem
rysuj_wykres(
y1 = y1_dane,
y2 = y2_dane,
y_prognoza = y_prog,
x1 = lata,
x_nazwa = "Rok",
y1_nazwa = "Sprzedaż",
y2_nazwa = "Model",
y_prognoza_nazwa = "Prognoza"
)
Przykład 8: Prawa skala dla różnych jednostek (prawa_skala = TRUE)
par(mar = c(par("mar")[1:3], 5))
rysuj_wykres(
y1 = c(10, 12, 15, 14, 18),
y2 = c(500, 520, 580, 560, 610),
prawa_skala = TRUE,
y1_nazwa = "Cena [PLN]",
y2_nazwa = "Wolumen [szt.]"
)
Przykład 9: Estetyka – kolory, linie i pozycja legendy
rysuj_wykres(
y1 = y1_dane,
y2 = y2_dane,
y_prognoza = y_prog,
x1 = lata,
x2 = lata,
x3 = lata_p,
y1_nazwa = "Sprzedaż rzeczywista",
y2_nazwa = "Dopasowanie trendu",
y_prognoza_nazwa = "Prognoza na przyszłość",
x_nazwa = "Rok",
prawa_skala = FALSE,
poloz_legendy = "topleft",
wielk_czcionki_legendy = 0.85,
y1_kolor = "darkblue",
y2_kolor = "red",
y_prognoza_kolor = "darkgreen",
y1_typ = "solid",
y2_typ = "dashed",
y_prognoza_typ = "dotted"
)
P. S. Funkcja może być jeszcze aktualizowana.
Brak komentarzy:
Prześlij komentarz