![[Photo gallery]](/staff/tp/icons/ico_gallery.png){kind=icon}
Podsumowanie wyników dla lat 2015--2017
![[Zdjęcie T. Przechlewskiego]](/personal/rysunki/home-icon.jpg){kind=icon}
z16 <- read.csv("wyniki_zulawy_2016_D.csv", sep = ';', header=T, na.string="NA", dec=",");
aggregate (z16$time, list(Numer = z16$dist), summary)
z16$year <- 2016;
z15 <- read.csv("wyniki_zulawy_2015_D.csv", sep = ';', header=T, na.string="NA", dec=",");
aggregate (z15$time, list(Numer = z15$dist), summary)
z15$year <- 2015;
z17 <- read.csv("wyniki_zulawy_2017_D.csv", sep = ';', header=T, na.string="NA", dec=".");
aggregate (z17$time, list(Numer = z17$dist), summary)
z17$year <- 2017;
zz15 <- z15[, c("dist", "kmH", "time", "year")];
zz16 <- z16[, c("dist", "kmH", "time", "year")];
zz17 <- z17[, c("dist", "kmH", "time", "year")];
zz <- rbind (zz15, zz16, zz17);
## tylko dystans 140
zz140 <- subset (zz, ( dist == 140 ));
sum140 <- aggregate (zz140$kmH, list(Numer = zz140$year), summary)
boxplot (kmH ~ year, zz140, ylab = "Śr.prędkość [kmh]", col = "yellow", main="140km" )
## tylko dystans 55
zz75 <- subset (zz, ( dist > 60 & dist < 90 ));
sum75 <- aggregate (zz75$kmH, list(Numer = zz75$year), summary)
sum75
boxplot (kmH ~ year, zz75, ylab = "Śr.prędkość [kmh]", col = "yellow", main="80/75km" )
## tylko dystans 55
zz55 <- subset (zz, ( dist < 60 ));
sum55 <- aggregate (zz55$kmH, list(Numer = zz55$year), summary)
sum55
xl <- paste ("średnie 2015=", sum55$x[1,4], "kmh 2016=",
sum55$x[2,4], "kmh 2017=", sum55$x[3,4], " kmh")
boxplot (kmH ~ year, zz55, xlab = xl,
ylab = "Śr.prędkość [kmh]", col = "yellow", main="55km" )
A ja (numer 418) byłem 70 w kategorii 140 km, z czasem 5:42:03 co dało 24,56 kmh przeciętną. Do pierwszego bufetu się spinałem, potem już nie...
Change in number of seats won by party (AfD is brown of course regardless official party colors :-):-)
library(ggplot2)
df <- read.csv("de.csv", sep = ';', header=T, na.string="NA");
ggplot(df, aes(x=party, y=diff, fill=party )) +
geom_bar(stat="identity") +
geom_text(aes(label=diff), vjust=-0.5) +
labs(x = "", y="change") +
ggtitle("German elections results (#MP change)") +
## AfD is brown regardless official party colors :-)
scale_fill_manual(values=c("#8B4513", "#56B4E9",
"yellow", "green", "red", "#ff6666") )
Jutro planuję przejechać 140km biorąc udział w imprezie pn. Żuławy wKoło 2017. Niby Żuławy a profil trasy sugeruje jakieś istotne wzniesienie w okolicach 25--40km:
Uważnie przyjrzenie się liczbom (zwłaszcza na osi OY) pozwala stwierdzić, że jest to złudzenie, wynikające z różnicy w jednostkach miary obu osi (kilometry vs metry). W rzeczywistości góra tam jest symboliczna o czym można się przekonać robiąc wykres nachyleń. Żeby pozbyć się przypadkowych błędów związanych z niedokładnością pomiaru oryginalne 673 punktowe dane zostały zmienione na 111 punktowe (uśrednienie minimum 1 km) lub 62 punktowe (uśrednienie minimum 2 km).
Przy czym uśrednienie minimum $x$ oznacza obliczenie nachylenia dla najkrótszego odcinka kolejnych $n$ punktów z oryginalnego śladu GPX, który będzie dłuższy niż $x$.
Skrypty R/dane są tutaj. Oryginale ślady GPX/TCX skopiowane ze strony ŻwK są tutaj.
Punktem wyjścia są dane ze strony ZKDP (w formacie Excel.) Ponieważ pobieram je od pewnego czasu mam tego więcej niż jest na ww. stronie bo od stycznia 2015 do lipca 2017, czyli 31 plików. Ręczna konwersja byłaby zatem ciut za bardzo czasochłonna.
for i in *.xls do
oocalc --headless --convert-to csv $i ;
# albo ssconvert -v $i `basename $i .xls`.csv ;
done
# Wyciągam dane dotyczące sprzedaży ogółem dla SE
grep 'Super Ex' *.csv | awk -F ',' '{print $7} ' > se_sales.csv
# Analogicznie dla innych tytułów
Uwaga: program ssconvert znajduje się
w pakiecie gnumeric,
oocalc to oczywiście składni Libre/OpenOffice.
Wielkości sprzedaży dla trzech najpoczytniejszych tytułów pokazują wykresy liniowe (pierwszy w tys egz. a drugi w procentach nakładu ze stycznia 2015 r.)
library(ggplot2)
library(reshape2)
df <- read.csv("newspaper_sales_2015-17.csv", sep = ';',
header=T, na.string="NA");
meltdf <- melt(df,id="month")
ggplot(meltdf,aes(x=month, y=value, colour=variable, group=variable)) +
geom_line() +
ylab(label="sales [ths]") +
theme(legend.title=element_blank()) +
scale_x_discrete (breaks=c("2015-01-01", "2015-06-01",
"2016-01-01", "2016-06-01", "2017-01-01", "2017-06-01"),
labels=c("2015-01", "2015-06", "2016-01", "2016-06",
"2017-01", "2017-06") )
# https://stackoverflow.com/questions/10085806/extracting-specific-columns-from-a-data-frame
obs <- df[,c("month")]
normalize <- function(x) { return (x /x[1] * 100 ) }
dfN <- as.data.frame(lapply(df[-1], normalize))
# https://stackoverflow.com/questions/10150579/adding-a-column-to-a-data-frame
dfN["month"] <- obs
str(dfN)
meltdf <- melt(dfN,id="month")
# https://www.r-bloggers.com/what-is-a-linear-trend-by-the-way/
pN <- ggplot(meltdf,
aes(x=month, y=value, colour=variable, group=variable)) + geom_line() +
ylab(label="sales [ths]") +
theme(legend.title=element_blank()) +
stat_smooth(method = "lm", se=F) +
scale_x_discrete (breaks=c("2015-01-01", "2015-06-01",
"2016-01-01", "2016-06-01", "2017-01-01", "2017-06-01"),
labels=c("2015-01", "2015-06", "2016-01",
"2016-06", "2017-01", "2017-06") )
pN
Spadek widoczny na wykresach można określić liczbowo na przykład szacując linię trendu:
# Trend liniowy # http://t-redactyl.io/blog/2016/05/creating-plots-in-r-using-ggplot2-part-11-linear-regression-plots.html # http://r-statistics.co/Time-Series-Analysis-With-R.html seq = c (1:nrow(dfN)) dfN["trend"] <- seq trendL.gw <- lm(data=dfN, gw ~ trend ) trendL.fakt <- lm(data=dfN, fakt ~ trend ) trendL.se <- lm(data=dfN, se ~ trend ) trendL.gw trendL.fakt trendL.se
Współczynniki trendu dla GW, Faktu i SE są odpowiednio równe -1.114 -0.6415 -0.4301, co należy interpretować następująco: przeciętnie z miesiąca na miesiąc nakład spada o 1,11%, 0,64% oraz 0,43% nakładu ze stycznia 2015 r., odpowiednio dla GW, Faktu i SuperExpresu.
Dane i wyniki są tutaj
Żuławy w koło to maraton rowerowy (czyli przejazd rowerem na dłuższym dystansie -- nie mylić z wyścigiem) organizowany od paru lat na Żuławach jak nazwa wskazuje. Sprawdziłem jak ta impreza wyglądała pod kątem prędkości w roku 2016. W tym celu ze strony Wyniki żUŁAWY wKOŁO 2016 ściągnąłem stosowny plik PDF z danymi, który następnie skonwertowałem do pliku w formacie XLS (Excel) wykorzystując konwerter on-line tajemniczej firmy convertio.pl. Tajemniczej w tym sensie, że nie znalazłem informacji kto i po co tą usługę świadczy.
Konwersja (do formatu CSV) -- jak to zwykle konwersja -- nie poszła na 100% poprawnie i wymagała jeszcze circa 30 minutowej ręcznej obróbki. Być może zresztą są lepsze konwertery, ale problem był z gatunku banalnych i wolałem stracić 30 minut na poprawianiu wyników konwersji niż 2 godziny na ustalaniu, który z konwerterów on-line konwertuje ten konkretny plik PDF (w miarę) bezbłędnie.
Po konwersji wypadało by sprawdzić (chociaż zgrubnie) czy wszystko jest OK.
## Czy każdy wiersz zawieraja 9 pól (powinien)
$ awk -F ';' 'NF != 9 {print NR, NF}' wyniki_zulawy_2016S.csv
## Ilu było uczestników na dystansie 140km?
$ awk -F ';' '$7 ==140 {print $0}' wyniki_zulawy_2016S.csv | wc -l
133
## Ilu było wszystkich (winno być 567 + 1 nagłówek)
$ cat wyniki_zulawy_2016S.csv | wc -l
568 # ok!
Do analizy statystycznej wykorzystano wykres pudełkowy (porównanie wyników na różnych dystansach) oraz histogram (rozkład średnich prędkości na dystansie 140km). BTW gdyby ktoś nie wiedział co to jest wykres pudełkowy to wyjaśnienie jest na rysunku obok. Objaśnienie: Me, $Q_1$, $Q_3$ to odpowiednio mediana i kwartyle. Dolna/górna krawędź prostokąta wyznacza zatem rozstęp kwartylny (IQR). Wąsy ($W_L$/$W_U$) są wyznaczane jako 150% wartości rozstępu kwartylnego. Wartości leżące poza ,,wąsami'' (nietypowe) są oznaczane kółkami.
Ww. wykresy wygenerowano następującym skryptem:
#
co <- "Żuławy wKoło 2016"
#
z <- read.csv("wyniki_zulawy_2016_C.csv", sep = ';',
header=T, na.string="NA", dec=",");
aggregate (z$meanv, list(Numer = z$dist), fivenum)
boxplot (meanv ~ dist, z, xlab = "Dystans [km]",
ylab = "Śr.prędkość [kmh]", col = "yellow", main=co )
## tylko dystans 140
z140 <- subset (z, ( dist == 140 ));
## statystyki zbiorcze
s140 <- summary(z140$meanv)
names(s140)
summary_label <- paste (sep='', "Średnia = ", s140[["Mean"]],
"\nMediana = ", s140[["Median"]],
"\nQ1 = ", s140[["1st Qu."]], "\nQ3 = ", s140[["3rd Qu."]],
"\n\nMax = ", s140[["Max."]] )
# drukuje wartości kolumny meanv
# z140$meanv
# drukuje wartości statystyk zbiorczych
s140
# wykres słupkowy
h <- hist(z140$meanv, breaks=c(14,18,22,26,30,34,38), freq=TRUE,
col="orange",
main=paste (co, "[140km]"), # tytuł
xlab="Prędkość [kmh]",ylab="L.kolarzy", labels=T, xaxt='n' )
# xaxt usuwa domyślną oś
# axis definiuje lepiej oś OX
axis(side=1, at=c(14,18,22,26,30,34,38))
text(38, 37, summary_label, cex = .8, adj=c(1,1) )
Dane i wyniki są tutaj