Oryginalny plik prognozy

Wycięty fragment

`Podglądówka' całej prognozy

Są na stronie http://www.meteo.pl/ udostępnione 120h prognozy falowania Bałtyku w postaci rysunków. Na tych rysunkach wysokość fal jest odwzorowana kolorem od czerwonego do jasno niebieskiego (najmniejsze). Kierunek fal jest odwzorowany strzałkami. Są też dostępne dane historyczne.

Wszystko jest łatwe do pobrania, bo nazwa pliku historycznego to na przykład wavehgt_0W_2015122200_015-00.png czyli wavehgt_0W_YYYYMMDD00_0HH-00.png (gdzie HH to 03/09/15/21). Pliki prognoz mają też nazwy wg schematu: wavehgt_0W_YYYYMMDD00_HHH-00.png, tyle że HHH się zmienia w zakresie 12--120 co trzy (godziny).

Pobieram wgetem 8 plików 12--120. Teraz trzeba ustalić jakie są kolory na obrazku i wysłać komunikat (analiza strzałek to beznadzieja sprawa, nawet się nie zabieram.)

Zaczynam od wycięcia interesującego mnie fragmentu Bałtyku:

## 8 plików 12--120
convert wavehgt_0W_YYYYMMDD00_HHH-00.png-00.png -crop 65x86+280+575 \
 wavehgt_0W_YYYYMMDD00_HHH-00.png-00D.png
## Wypisz kolory z rysunku:
convert wavehgt_0W_YYYYMMDD00_HHH-00.png-00D.png \
  -define histogram:unique-colors=true -format %c histogram:info:- | \
  getMaxFala.pl 
## Łączę w jeden:
montage PLIKI... -tile 2x4 -border 4 -geometry 480  S_YYYMMDD.png

Plik getMaxFala.pl zwraca kolor odpowiadający za najwyższą falę. Szczęśliwie tych kolorów za dużo nie jest, więc sprawdzanie jest enumeratywne

Mając najwyższe fale w horyzoncie 12--120 ustalamy max z tych 8 liczb i wypisujemy komunikat (Perl):

print "Max: $maxFF expected (in 120h time window)\n";
print "Details: ";
for $f (sort keys %faleMax) { print "$f = $faleMax{$f} /" }
print "\nAmber likelihood: ";
if ($maxFF < 3) { print "NONE\n" } 
elsif ($maxFF < 4) { print "VERY SMALL\n" }
elsif ($maxFF < 5) { print "SMALL\n" }
elsif ($maxFF < 5) { print "MEDIUM\n" }
elsif ($maxFF < 6) { print "LARGE\n" }
else  { print "Amber: HUGE"}
print "http://pinkaccordions.homelinux.org/fale/forecast/S_${yyyymmdd}.png\n";
print "Bye...\n";

Prawdę powiedziawszy polecenia convert/mogrify/wget też są `wbudowane' w skrypt Perla. Całe zadanie realizuje jeden skrypt, który w efekcie wypisuje na ekran powyższy komunikat:

  ## Fragment skryptu
  $GETMAXFALA='/home/pi/bin/getMaxFala.pl';
  ## ... ##
for $h (@Hours) {
    $hrNo = sprintf "%03.3i", $h;
    $url= "$URL/${yyyymmdd}00/wavehgt_0W_${yyyymmdd}00_${hrNo}-00.png";
    ###print STDERR "$url\n";
    system ("wget $url -O W_${yyyymmdd}00_${hrNo}-00.png");
    system ("convert W_${yyyymmdd}00_${hrNo}-00.png -crop 280x330+125+350 -fill red" .
        " -annotate +140+360 '$monthNo/${dayNo}+${hrNo}' -pointsize 24 -fill blue" .
        " W_${yyyymmdd}00_${hrNo}-00_C.png");
    #### Miniatura zatoki
    system ("convert W_${yyyymmdd}00_${hrNo}-00.png -crop 65x86+280+575 W_${yyyymmdd}00_${hrNo}-00_D.png");
    $maxFala = `convert "W_${yyyymmdd}00_${hrNo}-00_D.png" -define histogram:unique-colors=true
       -format %c histogram:info:- | $GETMAXFALA`;
    chomp($maxFala); 
    $files .= "W_${yyyymmdd}00_${hrNo}-00_C.png ";
    $files_S .= "W_${yyyymmdd}00_${hrNo}-00_D.png ";
    $faleMax{"+${hrNo}"}=$maxFala;
}

system ("montage $files -tile 2x4 -border 4 -geometry 480  W_${yyyymmdd}.png" );
system ("montage $files_S -tile 2x4 -border 4 -geometry 480  S_${yyyymmdd}.png" );
$maxFF = max(values(%faleMax)); chomp($maxFF);
  ## .. ##

Ten komunikat (w potoku) czyta inny skrypt i wysyła listy do zainteresowanych.

MZ to Ministerstwo Zdrowia. Specyfiką PL jest brak danych publicznych nt. Pandemii.. Na stronie GIS nie ma nic, a stacje wojewódzkie publikują jak chcą i co chcą. Ministerstwo zdrowia z kolei na swojej stronie podaje tylko dane na bieżący dzień, zaś na amerykańskim Twitterze publikuje komunikaty na temat. To co jest na stronie znika oczywiście następnego dnia zastępowane przez inne cyferki. Do tego są tam tylko dzienne dane zbiorcze o liczbie zarażonych i zmarłych, (w podziale na województwa). Nie ma na przykład wieku, płci itp... To co jest na Twitterze z kolei ma formę tekstowego komunikatu postaci: Mamy 502 nowe i potwierdzone przypadki zakażenia #koronawirus z województw: małopolskiego (79), śląskiego (77), mazowieckiego (75)... [...] Z przykrością informujemy o śmierci 6 osób zakażonych koronawirusem (wiek-płeć, miejsce zgonu): 73-K Kędzierzyn-Koźle, 75-M Łańcut, 92-K Lipie, 72-M, 87-M, 85-K Gdańsk.

Czyli podają zarażonych ogółem i w podziale na województwa oraz dane indywidualne zmarłych w postaci płci i wieku oraz miejsca zgonu (miasta żeby było inaczej niż w przypadku podawania zakażeń.)

No więc chcę wydłubać dane postaci 92-K z tweetów publikowanych przez Ministerstwo Zdrowia. W tym celu za pomocą tweepy pobieram cały streamline (+3200 tweetów zaczynających się jeszcze w 2019 roku), ale dalej to już działam w Perlu, bo w Pythonie jakby mniej komfortowo się czuję. Po pierwsze zamieniam format json na csv:

use JSON;
use Data::Dumper;
use Time::Piece;
use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";
binmode(STDOUT, ":utf8");

##  ID = tweeta ID; date = data; 
##  repid -- odpowiedź na tweeta o numerze ID
##  text -- tekst tweeta
print "id;date;repid;text\n";

while (<>) {
  chomp();
  $tweet =  $_;

  my $json = decode_json( $tweet );
  #print Dumper($json);
  $tid = $json->{"id"};
  $dat = $json->{"created_at"};
  ## Data jest w formacie rozwlekłym zamieniamy na YYYY-MM-DDTHH:MM:SS
  ## Fri Oct 04 14:48:25 +0000 2019
  $dat = Time::Piece->strptime($dat,
     "%a %b %d %H:%M:%S %z %Y")->strftime("%Y-%m-%dT%H:%M:%S");
  $rep = $json->{"in_reply_to_status_id"};
  $ttx = $json->{"full_text"}; $ttx =~ s/\n/ /g;
  ## Zamieniamy ; na , w tekście żeby użyć ; jako separatora
  $ttx =~ s/;/,/g; ####

  print "$tid;$dat;$rep;$ttx\n";

Komunikaty dłuższe niż limit Twittera są dzielone na kawałki, z których każdy jest odpowiedzią na poprzedni, np:

1298900644267544576;2020-08-27T08:30:20;1298900642522685440;53-M, 78-K i 84-K Kraków. Większość osób ...
1298900642522685440;2020-08-27T08:30:20;1298900640714948608;67-K Lublin (mieszkanka woj. podkarpackiego), 85-K Łańcut,...
1298900640714948608;2020-08-27T08:30:19;1298900639586680833;kujawsko-pomorskiego (24), świętokrzyskiego (18), opolskiego...
1298900639586680833;2020-08-27T08:30:19;;Mamy 887 nowych i potwierdzonych przypadków zakażenia #koronawirus z województw: ...

Czyli tweet 1298900639586680833 zaczyna, 1298900640714948608 jest odpowiedzią na 1298900639586680833, a 1298900642522685440 odpowiedzią na 1298900640714948608 itd. Tak to sobie wymyślili... W sumie chyba niepotrzebnie, ale w pierwszym kroku agreguję podzielone komunikaty w ten sposób, że wszystkie odpowiedzi są dołączane do pierwszego tweeta (tego z pustym polem in_reply_to_status_id):

## nextRef jest rekurencyjna zwraca numer-tweeta,
## który jest początkiem wątku
sub nextRef {
  my $i = shift;

  if ( $RR{"$i"} > 0 ) {  
    return ( nextRef( "$RR{$i}" ) );
  } else { return "$i" }
}

### ### ###
while (<>) { chomp();
   ($id, $d, $r, $t) = split /;/, $_;

   $TT{$id} = $t;
   $RR{$id} = $r;
   $DD{$id} = $d;
}

### ### ###
for $id ( sort keys %TT ) {  
   $lastId = nextRef("$id");
   $LL{"$id"} = $lastId;
   $LLIds{"$lastId"} = "$lastId"; 
}

### ### ###
for $id (sort keys %TT) {  
    ## print "### $DD{$id};$id;$LL{$id};$TT{$id}\n";  }
    $TTX{$LL{"$id"}} .= " " . $TT{"$id"};
    $DDX{$LL{"$id"}} .= ";" . $DD{"$id"};
}
### ### ###

for $i (sort keys %TTX) { 

    $dates = $DDX{"$i"};
    $dates =~ s/^;//; ## pierwszy ; jest nadmiarowy
    @tmpDat = split /;/, $dates;

    $dat_time_ = $tmpDat[0]; 
    ($dat_, $time_) = split /T/, $dat_time_;
    $ffN = $#tmpDat + 1;
    $collapsedTweet = $TTX{$i};
    print "$i;$dat_;$time_;$ffN;$collapsedTweet\n";
}

Zapuszczenie powyższego powoduje konsolidację wątków, tj. np. powyższe 4 tweety z 2020-08-27 połączyły się w jeden:

1298900639586680833;2020-08-27;08:30:19;4; Mamy 887 nowych i potwierdzonych przypadków
zakażenia #koronawirus z województw: małopolskiego (233), śląskiego (118), mazowieckiego (107),
[...] Liczba zakażonych koronawirusem: 64 689 /2 010 (wszystkie pozytywne przypadki/w tym osoby zmarłe).

Teraz wydłubujemy tylko tweety z frazą nowych i potwierdzonych albo nowe i potwierdzone:

## nowych i potwierdzonych albo nowe i potwierdzone
## (MZ_09.csv to CSV ze `skonsolidowanymi' wątkami)
cat MZ_09.csv | grep 'nowych i pot\|nowe i pot' > MZ_09_C19.csv
wc -l MZ_09_C19.csv
189 MZ_09_C19.csv

Wydłubanie fraz wiek-płeć ze skonsolidowanych wątków jest teraz proste:

  perl -e '
while (<>) {
 ($i, $d, $t, $c, $t) =  split /;/, $_;

  while ($t =~ m/([0-9]+-[MK])/g ) {
   ($w, $p) = split /\-/, $1;
   print "$d;$w;$p\n";
  }
}' MZ_09_C19.csv > C19D.csv
wc -l C19PL_down.csv
1738

Plik wykazał 1738 osób. Pierwsza komunikat jest z 16 kwietnia. Ostatni z 31. sierpnia. Pierwsze zarejestrowane zgony w PL odnotowano 12 marca (albo 13 nieważne). W okresie 12 marca --15 kwietnia zmarło 286 osób. Dodając 286 do 1738 wychodzi 2024. Wg MZ w okresie 12.03--31.08 zmarło 2039. Czyli manko wielkości 15 zgonów (około 0,5%). No trudno, nie chce mi się dociekać kto i kiedy pogubił tych 15...

Równie prostym skryptem zamieniam dane indywidualne na tygodniowe

#!/usr/bin/perl -w
use Date::Calc qw(Week_Number);

while (<>) {
  chomp();
  ##if ($_ =~ /age/) { next }  ##

  my ($d, $w, $p ) = split /;/, $_;
  my ($y_, $m_, $d_) = split /\-/, $d;
  my $week = Week_Number($y_, $m_, $d_);

  $DW{$week} += $w;
  $DN{$week}++;

  $DD{$d} = $week;
  $YY{$week} = 0;
  $YY_last_day{$week} = $d;

  ## wiek wg płci
  $PW{$p} += $w;
  $PN{$p}++;
}

for $d (keys %DD) {
    $YY{"$DD{$d}"}++; ## ile dni w tygodniu   
 }

print STDERR "Wg płci/wieku (ogółem)\n";

for $p (keys %PW) {
  $s = $PW{$p}/$PN{$p};
  printf STDERR "%s %.2f %i\n", $p, $s, $PN{$p};
  $total += $PN{$p};
}

print STDERR "Razem: $total\n";
print "week;deaths;age;days;date\n";

for $d (sort keys %DW) {
  if ($YY{$d} > 2 ) {## co najmniej 3 dni 
    $s = $DW{$d}/$DN{$d};
    printf "%s;%i;%.2f;%i;%s\n", $d, $DN{$d}, $s, $YY{$d}, $YY_last_day{$d};
  }
}

Co daje ostatecznie (week -- numer tygodnia w roku; meanage -- średni wiek zmarłych; deaths -- liczba zmarłych w tygodniu; days -- dni w tygodniu; date -- ostatni dzień tygodnia):

week;deaths;meanage;days;date
16;55;77.07;4;2020-04-19
17;172;75.09;7;2020-04-26
18;144;77.29;7;2020-05-03
19;123;76.46;7;2020-05-10
20;126;76.40;7;2020-05-17
21;71;76.37;7;2020-05-24
22;68;78.12;7;2020-05-31
23;93;75.73;7;2020-06-07
24;91;75.93;7;2020-06-14
25;109;77.24;7;2020-06-21
26;83;75.06;7;2020-06-28
27;77;74.09;7;2020-07-05
28;55;76.91;7;2020-07-12
29;54;77.33;7;2020-07-19
30;48;76.52;7;2020-07-26
31;60;74.88;7;2020-08-02
32;76;77.17;7;2020-08-09
33;71;73.11;7;2020-08-16
34;77;75.61;7;2020-08-23
35;79;74.33;7;2020-08-30

To już można na wykresie przedstawić:-)

library("dplyr")
library("ggplot2")
library("scales")
##
spanV <- 0.25
d <- read.csv("C19D_weekly.csv", sep = ';',  header=T, na.string="NA")

first <- first(d$date)
last <- last(d$date)
period <- sprintf ("%s--%s", first, last)
d$deaths.dailymean <- d$deaths/d$days

cases <- sum(d$deaths);
max.cases <- max(d$deaths)

note <- sprintf ("N: %i (source: twitter.com/MZ_GOV_PL)", cases)

pf <- ggplot(d, aes(x= as.Date(date), y=meanage)) +
 geom_bar(position="dodge", stat="identity", fill="steelblue") +
 scale_x_date( labels = date_format("%m/%d"), breaks = "2 weeks") +
 scale_y_continuous(breaks=c(0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80)) +
 xlab(label="week") +
 ylab(label="mean age") +
 ggtitle(sprintf ("Mean age of COVID19 fatalities/Poland/%s", period), subtitle=note ) 

note <- sprintf ("N: %i (source: twitter.com/MZ_GOV_PL)", cases)
pg <- ggplot(d, aes(x= as.Date(date), y=deaths.dailymean)) +
 geom_bar(position="dodge", stat="identity", fill="steelblue") +
 scale_x_date( labels = date_format("%m/%d"), breaks = "2 weeks") +
 scale_y_continuous(breaks=c(0,5,10,15,20,25,30,35,40,45,50)) +
 xlab(label="week") +
 ylab(label="daily mean") +
 ggtitle(sprintf("Daily mean number of COVID19 fatalities/Poland/%s", period), subtitle=note )

ggsave(plot=pf, file="c19dMA_w.png")
ggsave(plot=pg, file="c19dN_w.png")

Wynik tutaj:

Średnia Wg płci/wieku/ogółem. Ogółem -- 75,9 lat (1738 zgonów) w tym: mężczyźni (914 zgonów) -- 73.9 lat oraz kobiety (824) -- 78.4 lat. Stan pandemii na 31.08 przypominam. Apogeum 2 fali... Średnia wieku w PL (2019 rok) 74,1 lat (M) oraz 81,8 lat (K).

Google has launched a new website that uses anonymous location data collected from users of Google products and services to show the level of social distancing taking place in various locations. The COVID-19 Community Mobility Reports web site will show population data trends of six categories: Retail and recreation, grocery and pharmacy, parks, transit stations, workplaces, and residential. The data will track changes over the course of several weeks, and as recent as 48-to-72 hours prior, and will initially cover 131 countries as well as individual counties within certain states. (cf. www.google.com/covid19/mobility/.)

The raports contains charts and comments in the form: NN% compared to baseline (in six above mentioned categories) where NN is a number. It is assumed the number is a percent change at the last date depicted (which accidentaly is a part of a filename). So for example a filename 2020-03-29_PL_Mobility_Report_en.pdf contains a sentence `Retail & recreation -78% compared to baseline` which (probably) means that (somehow) registered traffic at R&R facilities was 22% of the baseline. Anyway those six numbers was extracted for OECD countries (and some other countries) and converted to CSV file.

The conversion was as follows: first PDF files was downloaded with simple Perl script:

#!/usr/bin/perl
# https://www.google.com/covid19/mobility/
use LWP::UserAgent;
use POSIX 'strftime';

my $sleepTime = 11;

%OECD = ('Australia' => 'AU', 'New Zealand' => 'NZ',
'Austria' => 'AT', 'Norway' => 'NO', 'Belgium' => 'BE',
'Poland' => 'PL', 'Canada' => 'CA', 'Portugal' => 'PT',
'Chile' => 'CL', 'Slovak Republic' => 'SK',
## etc ...
);

@oecd = values %OECD;

my $ua = LWP::UserAgent->new(agent => 'Mozilla/5.0', cookie_jar =>{});
my $date = "2020-03-29";

foreach $c (sort @oecd) {
   $PP="https://www.gstatic.com/covid19/mobility/${date}_${c}_Mobility_Report_en.pdf";

   my $req = HTTP::Request->new(GET => $PP);
   my $res = $ua->request($req, "${date}_${c}_Mobility_Report_en.pdf");

   if ($res->is_success) { print $res->as_string; }
   else { print "Failed: ", $res->status_line, "\n"; }
}

Next PDF files was converted to .txt with pdftotext. The relevant fragments of .txt files looks like:

  Retail & recreation
+80%

-78%
compared to baseline

So it looks easy to extract the relevant numbers: scan line-by-line looking for a line with appropriate content (Retail & recreation for example). If found start searching for 'compared to baseline'. If found retrieve previous line:

#!/usr/bin/perl
$file = $ARGV[0];

while (<>) {   chomp();
  if (/Retail \& recreation/ ) { $rr = scan2base(); }
  if (/Grocery \& pharmacy/ ) { $gp = scan2base(); }
  if (/Parks/ ) { $parks = scan2base(); }
  if (/Transit stations/ ) { $ts = scan2base(); }
  if (/Workplaces/ ) { $wps = scan2base(); }
  if (/Residential/ ) { $res = scan2base();
     print "$file;$rr;$gp;$parks;$ts;$wps;$res\n";
     last;  }
}

sub scan2base {
  while (<>) {
   chomp();
   if (/compared to baseline/) {  return ($prevline); }
   $prevline = $_;
  }
}

Extracted data can be found here.

Na okoliczność wielu zdjęć z jednego miejsca można dodać losowy szum (jitter). Czy to ma sens to już inna sprawa. Ja dodałem jitter (kołowy) do zdjęć zrobionych w fabryce jedwabiu w Margilan

#!/usr/bin/perl
### Add jitter to Geocoordinates 
use Math::Complex;
use Math::Trig;
use Getopt::Long;
use Image::ExifTool;
use Geo::Distance; 
##
my $sd =.002; ### max about 200m

print STDERR "USAGE $0 [-d] DIAMETER -c COORDINATES -f FILE (DIAMETER=0.002 is circa 200m!)\n";

GetOptions("d=i" =>  \$sd, "c=s" => \$coords, "f=s" => \$file );
my $factor = 0.00001;
my $init_shift = 0.00001;
my $pi = 4*atan2(1,1);

##$sd = sqrt($factor * $Skad{$skad});

my $r = $sd * sqrt(rand()); 
my $theta = rand() * 2 * $pi;

($lat, $lon) = split (/[:;,]/, $coords);

$rand_lat = $lat + $r * cos($theta);
$rand_lon = $lon + $r * sin($theta);

my $eT = new Image::ExifTool;

$eT->SetNewValue(GPSLatitudeRef => ($rand_lat > 0)?'N':'S', Group=>'GPS');
$eT->SetNewValue(GPSLongitudeRef => ($rand_lon > 0)?'E':"W", Group=>'GPS');
$eT->SetNewValue(GPSLatitude => abs($rand_lat), Group=>'GPS');
$eT->SetNewValue(GPSLongitude => abs($rand_lon), Group=>'GPS');

my $old_comment = $eT->GetValue('UserComment', 'ValueConv');

if ($old_comment) { $exif_comment = "$old_comment | GPS coordinates jigged"; } 
else { $exif_comment = "GPS coordinates jigged"; }

$eT->SetNewValue(UserComment => "$exif_comment");

if (-f $file) {
   $file_org = "${file}_orig";
   if ( system("cp", "$file", "$file_org") == 0 ) {
        $eT->WriteInfo("$file"); 
        print STDERR "$file updated\n";
  } else { print STDERR "*** $file update failed\n"; }
} else { print STDERR "*** ERROR with $file\n"; }

my $geo = new Geo::Distance;
$dist = $geo->distance( "meter", $lon, $lat => $rand_lon, $rand_lat );
print STDERR "Laat/Lon: $lat, $lon => $rand_lat, $rand_lon (Dist: $dist)\n";

Przykładowa mapa jest tutaj

Dystans wg dni tygodnia

Średni dystans wg dni tygodnia

Dystans wg tygodni w roku

Średnio rocznie wg tygodni

To był rekordowy rok w wielu kategoriach:-)

Zacznijmy od pogody, którą mierzę od 2010 roku przypominam. U mnie średnia wyszła 9,56 C, do tej pory rekord to było 9,44 C w 2015 r. Szczegółowo to tak wygląda:

rok     : 2010  2011  2012  2013  2014  2015  2016  2017  2018
--------------------------------------------------------------
średnia : 8.65  8.94  8.17  8.63  9.33  9.44  9.18  8.75  9.56

Rekordowo niska była też suma opadów: 447.9mm (148 dni opadowych); dla porównania w 2017 roku spadło 763,8mm deszczu (194 dni). Rekord do tej pory to 2014 rok: 450,6 (148 dni) czyli w zasadzie tyle samo (z dokładnością do błędu).

Na rowerze przejechałem 19,100 km (302 razy, co nie oznacza dni, bo czasami były dwa razy dziennie). Poprzedni rekord z 2017 r wynosił 17,855 km. Z tej okazji podsumowałem swoje życiowe wyczyny, a mam statystykę szczegółową od 1993 r. Kurcze 26 lat pykło, w których to latach przejechałem prawie 210 tys km. Do tego w latach 1990--1992 przejechałem ponad 20 tys km, ale nie zachowała się niestety dokładna rozpiska. Z okazji tych wszystkich wyczynów podsumowanie zrobiłem wg dni tygodnia i wg. tygodni w roku (wg. miesięcy to liczę na bieżąco). Konkretnie to podsumowanie jest zestawem 7 wykresów słupkowych rysowanych w R. Dane do skryptu i sam skrypt jest z kolei generowany przez prosty program w Perlu:

  #!/usr/bin/perl -w
use Date::Calc qw(Week_Number Day_of_Week);

##my $RRcmd = 'R CMD BATCH'; ## see below

my $color= 'pink';
my $current_yr = 2019;

my %Miesiac = (1 => 'styczeń', 2 => 'luty', 3 => 'marzec', 4 => 'kwiecień',
        5 => 'maj', 6 => 'czerwiec', 7 => 'lipiec', 8 => 'sierpień',
        9 => 'wrzesień', 10 => 'październik', 11 => 'listopad', 12 => 'grudzień',);
my %DoWName = ( 1 => 'pon', 2 => 'wto', 3=> 'sro', 4 => 'czw', 5 => 'pia', 6 => 'sob', 7 => 'nie' );


open(O, ">dow.R") || die "Cannot open!\n";
open(P, 'LANG=C grep "dist\|date" c*.xml|' ) || die "Cannot open!\n";

while (<P>) { 
  chomp();
  ##print ">>$_;";
  if (/date[^'"]+["']([0-9\/]+)["']/) {$date = "$1";}
  if (/dist[^'"]+["']([0-9\/]+)["']/) {$D{$date} += $1;}
}

close(P) || die "Cannot close!\n";

for $d (sort keys %D ) {    
  ($dyy, $dmm, $ddd) = split '/', $d;
  if ($dyy == $current_yr ) { next } ### skip as incomplete

  my $dow = Day_of_Week($dyy,$dmm,$ddd);
  $DoWs{$dow} += $D{$d}; $DoWNums{$dow}++;

  my $woy = Week_Number($dyy,$dmm,$ddd);
  $WoYs{$woy} += $D{$d}; $WoYNums{$woy}++;
  $RdT++;
  $Years{$dyy}=1;
}

@YNo = sort(keys (%Years));
$YNo = $#YNo +1;

print O "##Generated content == do not edit\n";
print O "##By Day of Week\n";
#
for $d (sort keys %DoWs) { 
  $mean = sprintf "%.1f", $DoWs{$d} / $DoWNums{$d}; 
  $t += $DoWs{$d}; 
  $days_totals .= "$DoWs{$d}, ";
  $days_means .= "$mean, ";
  $days_ns .= "$DoWNums{$d}, ";
  $days_labels .= "'" . $DoWName{$d} . "', ";
  ##printf "%-12.12s %7i %.1f (%i)\n", $DoWName{$d}, $DoWs{$d}, $mean, $DoWNums{$d};
  ;
}
$days_totals =~ s/, $//; $days_means =~ s/, $//;
##$days_ymeans =~ s/, $//;
$days_ns =~ s/, $//; $days_labels =~ s/, $//;

print O "days_totals <- c($days_totals);
  days_means <- c($days_means);
  days_ns <- c($days_ns);
  days_labels <- c($days_labels);\n";

print O "barplot(days_totals, 
 main='Distance (total $YNo[0]--$YNo[$#YNo]): $t kms', horiz=F,  
 names.arg=days_labels, col=c('$color'));
barplot(days_means, main='Day means ($YNo[0]--$YNo[$#YNo])', 
 horiz=F,  names.arg=days_labels, col=c('$color'));
barplot(days_ns, main='RideDays (total): $RdT', horiz=F,
 names.arg=days_labels, col=c('$color'));\n";

print STDERR "##Razem: $t\n";

##print "====\n";

print O "\n\n##By Week of Year\n";

for $w (sort {$a <=> $b } keys %WoYs) { 
  $mean = sprintf "%.1f", $WoYs{$w} / $WoYNums{$w}; 

  $vals_totals .= "$WoYs{$w}, ";
  $vals_ymeans .= sprintf "%.1f, ", $WoYs{$w}/$YNo;
  $vals_means .= "$mean, ";
  $vals_ns .= "$WoYNums{$w}, ";
  $vals_labels .= "$w, ";
}

$vals_totals =~ s/, $//; $vals_means =~ s/, $//;
$vals_ymeans =~ s/, $//;
$vals_ns =~ s/, $//; $vals_labels =~ s/, $//;

print O "vals_totals <- c($vals_totals);
  vals_ymeans <- c($vals_ymeans);
  vals_means <- c($vals_means);
  vals_ns <- c($vals_ns);
  vals_labels <- c($vals_labels);\n";

print O "barplot(vals_totals, main='Distance (total $YNo[0]--$YNo[$#YNo]): $t kms', 
  horiz=F,  names.arg=vals_labels, col=c('$color'));
barplot(vals_ymeans, main='Weak means ($YNo[0]--$YNo[$#YNo])', 
  horiz=F,  names.arg=vals_labels, col=c('$color'));
barplot(vals_means, main='Day means ($YNo[0]--$YNo[$#YNo])',
  horiz=F,  names.arg=vals_labels, col=c('$color'));
barplot(vals_ns, main='RideDays (total): $RdT', 
  horiz=F,  names.arg=vals_labels, col=c('$color'));\n";

print O "### ENDE!\n";

close(O);

print STDERR "##R dow.R\n";

system ("R", "CMD", "BATCH", "dow.R");
print STDERR "##xpdf Rplots.pdf\n";

print STDERR "##convert -density 300 Rplots.pdf opus_by_dow.jpg\n";
system ("convert", "-density", "300", "Rplots.pdf", "opus_by_dow.jpg");

Na koniec przyznam że mam mieszane uczucia co do zeszłorocznego wyczynu, w sensie że za dużo wyszło. Oprócz roweru też jest życie...

Tak więc w przyszłym roku raczej rekordu nie będzie.

Co wybory to inaczej oczywiście...

Wyniki wyborów 2010 są na stronie http://wybory2010.pkw.gov.pl/. Punktem wyjścia jest zaś strona z wynikami dla województwa postaci http://wybory2010.pkw.gov.pl/geo/pl/020000/020000-o-020000-RDA-2.html?wyniki=1, w której wiodące 02 z 020000 to kod teryt województwa a 2 przed .html to numer okręgu wyborczego. Zatem pobranie wszystkich stron `okręgowych' sprowadza się do:

#!/usr/bin/perl
#
use LWP::Simple;
#
my $uribase = 'http://wybory2010.pkw.gov.pl/geo/pl';
@Woj = ("02", "04", "06", "08", "10", "12", "14", "16",
  "18", "20", "22", "24", "26", "28", "30", "32");
@Okr = (1,2,3,4,5,6,7,8,9,10); ## nadmiarowo (max jest 8 chyba)

for $w (@Woj) {
  for $o (@Okr) {
    $url = "$uribase/${w}0000/${w}0000-o-${w}0000-RDA-${o}.html?wyniki=1";
    $file = "ws2010_woj_${w}_${o}";
    getstore($url, $file);
    print STDERR "$url stored\n";
  }
}

Teraz się okazuje że każdy taki plik zawiera odnośniki postaci /owk/pl/020000/2c9682212bcdb46c012bcea96efe0131.html. Każdy taki plik opisuje kandydata startującego w wyborach. Ich pobranie jest równie banalne:

#!/usr/bin/perl
#
use LWP::Simple;
use locale;
use utf8;
binmode(STDOUT, ":utf8");
use open IN => ":encoding(utf8)", OUT => ":utf8";

$baseURI="http://wybory2010.pkw.gov.pl";
$file = $ARGV[0];

while (<>) {
  chomp();
  if (/(owk\/[^<>"]*)/) {
     $url= "$baseURI/$1";
     if (/(owk\/[^<>"]*)[^<>]*>([^<>]*)/) {
       $who = "$2"; $who =~ s/ //g;
       $who =~ tr/ĄĆĘŁŃÓŚŻŹ/ACELNOSZZ/;
       $who =~ tr/ąćęłńóśżź/acelnoszz/;
     } else {$who = "XxYyZz"; }

     $outFile = "owk_${file}__${who}";
     getstore($url, $outFile);
     print STDERR "$url stored ($outFile)\n";
  }
}
## pobranie wszystkich owk-URLi to:
## for i in ws2010_woj* ; do perl pobierz-owk.pl $i ; done

W plikach `owk' są linki do protokołów z wynikami z poszczególnych komisji. Są to linki postaci: /obw/pl/3206/bacbedd03197794e2e1e8e438bff87e1.html. Należy je wszystkie pobrać (URLe nie pliki) i posortować usuwając duplikaty. Powinno być takich URLi około 25--27 tysięcy (tyle ile komisji):

#!/usr/bin/perl
#
$baseURI="http://wybory2010.pkw.gov.pl";
$file = $ARGV[0];

while (<>) {  chomp();
  if (/(obw\/[^<>"]*)/) {
     $url= "$baseURI/$1";
     if (/(obw\/[^<>"]*)[^<>]*>([^<>]*)/) {
         $obwNr = "$2"; }
     $outFile = "${file};${obwNr}";
     print "$url;$outFile\n";
} }
## for i in owk_2010* ; do perl pobierz-obw.pl $i ; done > proto0.csv
## awk -F';' '{print $1";"$3}' proto0.csv | sort -u > protokoly.csv
## wc -l protokoly.csv
## 25464 protokoly.csv

Każdy URL jest postaci /obw/pl/0201/051595429cc31a526f8b2455602ab929.html. Te 0201 to pewnie teryt powiatu, ale reszta wydaje się losowa więc nie da się ustalić jakiegoś schematu URLi protokołów, bo go nie ma po prostu. Teraz postaje pobrać te 25464 plików-protokołów z komisji obwodowych. Na wszelki wypadek będę zapisywał te protokoły wg schematu: proto_ws_2010_terytPowiatu_nrkomisji:

#!/usr/bin/perl
##
use LWP::Simple;
open (O, "protokoly.csv") || die "No protokoly.csv!";
while (<O>) { chomp();
  ($url, $nrk) =  split /;/, $_;
  $_ =~ m#http://wybory2010.pkw.gov.pl/obw/pl/([0-9][0-9][0-9][0-9])#;
  $teryt = $1;
  $outFile = "proto_ws_2010_${teryt}_$nrk";
  getstore($url, $outFile);
  print STDERR "*** $url stored ($outFile)\n";
}
close(O);
## time perl get-proto.pl

Mi się ściągało 62 minuty 30 sekund.

Z jakiś powodów obsługi przez Perla UTFa nie może być bezszmerowa. Zawsze coś nie działa i zawsze jest problem. I zawsze jest kombinowanie co by tu wstawić za zaklęcia żeby działało. Np. to zwykle działa:

#!/usb/bin/perl
use locale;
use utf8;
binmode(STDOUT, ":utf8");
##use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";

albo to poniżej też czasami działa (wtedy kiedy powyższe nie działa):

use utf8;
binmode(STDOUT, ":utf8");
use open ":encoding(utf8)";

Czasami nawet nie potrzeba ostatniego use open ":encoding(utf8)";. Czemu nie wiem. Nadmiarowe polecenia psują kodowanie BTW (jakby ktoś myślał, że jak wstawi wszystkie polecenia, które dotyczą kodowania UTF ,,na zapas'' to będzie zawsze dobrze.)

W zeszłym roku wziąłem udział w imprezie kolarsko-rekreacyjnej pn. Żuławy w Koło, a teraz zapisałem się na Kociewie Kołem, która ma się odbyć 9 września. Ta sama firma organizuje jak się łatwo domyśleć.

Żeby nie jechać w ciemno pobrałem stosowne dane ze strony organizatora, zamieniłem je na plik CSV i policzyłem różne statystyki. W 2016 średnia prędkość na najdłuższym dystancie (170 km) wyniosła na przykład 27,05 km/h. Rok później (dystans 155 km) było to 26,69 km/h. Czyli sporo, bo na płaskiej i krótszej trasie Żuławy w Koło było dla przykładu w 2016 roku 25,47 km/h, a w 2017 26,23 km/h. Więcej szczegółów na wykresach pudełkowych obok.

Ściągnąłem też w środę listę uczestników, których okazało się jest 719, w tym z Gdańska 332, z Gdyni 107, a tak w ogóle to ze 120 różnych miejscowości. Za pomocą Google Fusion Tables można pokazać listę na mapie. Żeby kropki z tej samej miejscowości się nie nakładały na siebie zastosowałem losowe `drganie' (jitter) wg. algorytmu:

### Jitter w kole o średnicy $r
$factorJ = 0.00001; ## ustalone heurystycznie

$sd = sqrt($factorJ * $N); # $N liczba kropek dla miejscowosci, tj dla GDA 332
$r = $sd * sqrt(rand()); $theta = rand() * 2 * $pi;
$rand_lat = $lat + $r * cos($theta);
$rand_lon = $lon + $r * sin($theta);

### Jitter w prostokącie o boku $r
$rand_lat = $lat + rand($sd);
$rand_lon = $lon + rand($sd);

Rezultat jak na obrazku poniżej, albo tutaj.

Lewy obrazek to mapa bez `jittera' a prawy z zastosowanym `jitterem'.

Kolega L. mi zadanie zlecił, w którym wykorzystywaną bazą musi być MS SQL. Podchodziłem do tego jak do jeża, ale wreszcie się przełamałem, usiadłem i działa (aż dziwne). W skład zadania wchodzi też baza danych pn. GraphiPlus, która zawiera m.in. tabele o nazwach dbo.FACTURES oraz dbo.SOCIETES:

#!/usr/bin/perl
use strict;
use utf8;
use DBI; 
require DBD::ODBC;
my $serverN = 'E5410-KOMPUTER\\SQLEXPRESS';
my $baseN = 'GraphiPlus';
my $dsN = "GraphiPlus";
## Obie formy działają (pierwsza przez DSN = Data Source Name/Źródło danych)
## Definiowanie DSN: Panel_Sterowania→Wszystkie_Elementy→
##    Narzędzia_Administracyjne→Źródła_danych_(ODBC)
# my $dbh = DBI->connect("dbi:$dsN", '<UID>', '<PASSWD>',
#   { RaiseError => 1 } ) or die DBI->errstr;
# Albo
my $dbh = DBI->connect("dbi:ODBC:driver={SQL Server};Server=$serverN;database=$baseN;uid=<UID>;pwd=<PASSWD;",
   {RaiseError => 1, } ) or die DBI->errstr;

print "*** Połączono z $baseN ***\n";

## małe litery do.TABELA są istotne!
my $sth = $dbh->prepare("SELECT * FROM dbo.FACTURES ") || die "ERROR" . $dbh->errstr ;  
$sth ->execute();

print "**** Tabela FACTURES:\n";
while ( my @invoiceRecord = $sth->fetchrow_array() ) {
   print (join(";", @invoiceRecord) . "\n");
}

## musi być (w mySQL niekoniecznie)
$sth->finish();

print "**** Tabela SOCIETESS:\n";
my $sth = $dbh->prepare("SELECT * FROM dbo.SOCIETES ") || die "ERROR" . $dbh->errstr ;  
$sth ->execute();

while ( my @invoiceRecord = $sth->fetchrow_array() ) {
   print (join(";", @invoiceRecord) . "\n");
}

$sth->finish();

$dbh->disconnect();

###

Gdybym nie znał nazw tabel to można je ustalić albo za pomocą SQL Server Management Studio, albo wykonując polecenie SELECT na systemowej tabeli pn. sys.tables:

my $sts = $dbh->prepare("SELECT name FROM sys.tables ") || die "ERROR" . $dbh->errstr ;

Contour+ ma GPSa i rejestruje współrzędne geograficzne, tyle że do niedawna nie bardzo wiedziałem jak (słusznie podejrzewałem że w postaci napisów aka subtitles). Wreszcie rozkminiłem jak to działa, a zmobilizowały mnie filmy zarejestrowane podczas imprezy Żuławy wKoło 2017.

Najpierw trzeba ustalić co jest w środku pliku .mov:

ffmpeg -i FILE0037.MOV
## ## ##  
Stream #0:2(eng): Subtitle: mov_text (text / 0x74786574), 1 kb/s (default)

Teraz można wyciągnąć napis znajdujący się w strumieniu (stream) 2:

ffmpeg -i FILE0037.MOV -vn -an -codec:s:0.2 srt file0037_2.srt

W pliku file0037_2.srt jest coś takiego:

692
00:11:31,000 --> 00:11:32,000
$GPRMC,061159.00,V,,,,,,,240917,,,N*7E
$GPGGA,061159.00,,,,,0,04,2.18,,,,,,*53

693
00:11:32,000 --> 00:11:33,000
$GPRMC,061200.00,A,5412.74161,N,01906.66188,E,18.465,202.51,240917,,,A*50
$GPGGA,061200.00,5412.74161,N,01906.66188,E,1,04,2.18,6.5,M,32.4,M,,*58

Czyli jest to zwykły plik napisów w formacie SRT, tj. sekwencja rekordów składających się z wierszy tekstu. Pierwszy wiersz zawiera numeru napisu (692 na przykład). Drugi wiersz określa czas wyświetlania napisu (początek --> koniec). Kolejne wiersze to tekst napisu. W przykładzie powyżej napis 692 jeszcze nie złapał fiksa, a napis 693 już tak. Współrzędne są zarejestrowane w postaci par zdań (sentences) GPRMC/GPGGA w standardzie NMEA. Do konwersji czegoś takiego na format GPX na przykład można zastosować gpsbabela

gpsbabel -i nmea -f file.srt -o GPX -F file.gpx

Ale wtedy gubi się informację z pierwszych dwóch wierszy rekordu, a jest ona niezbędna do synchronizacji obrazu ze współrzędnymi w programach nie potrafiących wykorzystać napisów wbudowanych. Chciał-nie-chciał musiałem rozpoznać NMEA i dokonać konwersji po swojemu:

$GPRMC,time,###,dd.mm,N/S,dd.mm,E/W,speed,###,date,###,###,###
$GPGGA,time,dd.mm,N/S,dd.mm,E/W,q,s,###,ele,M,###,M,###,### 

Gdzie: speed -- prędkość w węzłach czyli milach/godzinę; date -- data w formacie ddmmyy; time -- czas w formacie hhmmss.ss; dd.mm -- współrzędne geograficzne w formacie stopnieminuty.minuty tj 5412.74161 oznacza 54 stopnie 12.74161 minut a 01906.66188 oznacza 19 stopni 6.66188 minut (uwaga: szerokość/długość ma różną liczbę cyfr przed kropką dziesiętną); N/S/E/W -- kierunki geograficzne (north, south itp); q -- jakość sygnału (niezerowa wartość jest OK); s -- liczba satelitów; ele -- wysokość npm. (w metrach na szczęście w przypadku Contoura+). Zawartość pól oznaczona jako ### nas nie interesuje. Symbol M oznacza jednostkę miary (metry), z czego by wynikało, że różne odbiorniki GPS mogą zapisywać informacje o wysokości z wykorzystaniem innych jednostek miary.

Teraz banalny skrypt Perlowy zamienia SRT na format GPX dodając informacje o numerze napisu i czasie wyświetlania w postaci stosownego elementu cmt

  <trkpt lat="54.212360" lon="19.111031">
    <ele>6.500000</ele>
    <time>2017-09-24T06:12:00Z</time>
    <speed>9.499208</speed>
    <cmt>693 00:11:32,000 --> 00:11:33,000</cmt>
  </trkpt>

BTW nie ma elementu speed w specyfikacji schematu GPX, ale na przykład gpsbabel taki element wstawia i jakoś to działa. Sprawa wymaga zbadania.

Uwaga: Garmin Virb Edit nie czyta dokumentów GPX w wersji 1.0 -- musi być wersja 1.1. W praktyce oznacza to, że element gpx powinien posiadać atrybuty version oraz xmlns o następujących wartościach

<gpx version="1.1" xmlns="http://www.topografix.com/GPX/1/1">
 

Skrypt pn. cc2gpx.pl do konwersji SRT→GPX jest tutaj.

Absolutnie minimalistyczny przykład wykorzystania LaTeXa do publikowania zawartości bazy danych:

1. Dane są w bazie sqlite (można ją utworzyć/dodawać rekordy w prosty sposób wykorzystując coś co się nazywa sqlitebrowser)

W przykładzie (poniżej) plik kleinertest.db3 zawiera tabelę Kursanci, z której pobierane są pola ImieNazwisko, Plec i Ocena.

2. Do drukowania uruchamiamy skrypt w języku Perl. Skrypt jest tak prosty że do dopasowania go do konkretnej tabeli nie potrzeba znajomości Perla a wystarczy zdrowy rozsądek (co zmienić zaznaczono @@)

Perl dla Windows do pobrania z https://www.activestate.com/

3. Skrypt uruchamia pdflatexa i drukuje zawartość bazy do pliku pdf

4. Można skomplikować skrypt, np podając argument na wejściu. Dajmy na to nazwisko delikwenta do wydrukowania. Żeby nie drukować wszystkiego. Do tego potrzeba minimalnej znajomości Perla

#!/usr/bin/perl -w
# Potrzebne są moduły Perla DBI DBD-SQLite DBD-SQLite2
#
use strict;
use utf8;
use DBI;

binmode(STDOUT, ":utf8");

my $dbfileName= "kleinertest.db3"; ## @@ nazwa pliku z bazą
my $tmpfileName = "kleinertest.tex"; ## @@ nazwa pliku .tex
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfileName", "", "");

## @@ Pobranie danych z tabeli Kursanci (pola: ImieNazwisko, Plec Ocena)
my $sth = $dbh->prepare("SELECT
   ImieNazwisko,
   Plec,
   Ocena
   FROM Kursanci ");
$sth ->execute();

## PreAmBuła ### ### ### ### ###
open (TEX, ">$tmpfileName");

print TEX "\\documentclass{article}\\usepackage{mydbiprint}\\begin{document}\n";

## MidBuła: drukowanie rekordów z bazy ## ### ### ###
## ImieNazwisko = $r[0], Plec = $r[1], Ocena = $r[2] itd...
while ( my @r = $sth->fetchrow_array() ) {
     print TEX "\\Dyplom{ $r[0] }{$r[1]}{ $r[2] }\n"; ## @@ dopasować do konkretnej tabeli
   }

## PostAmBuła ## ### ### ### ###
print TEX "\\end{document}\n";

$dbh->disconnect || warn "Nie moge zamknac bazy $dbfileName\n";

## TeXowanie pliku: ## ## ### ### ### ### ###
close(TEX);
system("pdflatex", "$tmpfileName");

## koniec 

Przykładowy pakiet mydbiprint.sty:

%% Minimalistyczny szablon do drukowania z bazy
\RequirePackage[utf8]{inputenc}
\RequirePackage{polski}
\RequirePackage{ifthen}
\pagestyle{empty}
\newcommand{\Dyplom}[3]{%%
  \begin{center}\fontsize{30}{40}\selectfont DYPLOM\end{center}
    \ifthenelse{\equal{#2}{K}}
               {\DyplomDlaPani{#1}{#3}}
               {\DyplomDlaPana{#1}{#3}}
 }
\newcommand\DyplomDlaPani[2]{%
   \begin{center}Pani #1\end{center}
  Zdała egzamin z oceną #2\newpage}
\newcommand\DyplomDlaPana[2]{\begin{center}Pan #1\end{center}
    Zdał egzamin z oceną #2\newpage}
\endinput 

Poniższy skrypt Perlowy służy do pobierania najnowszych twitów (Tweets) użytkowników identyfikowanych poprzez ich screen_name. Twity są dopisywane do bazy, która jednocześnie pełni rolę pliku konfiguracyjnego. Przykładowo, aby twity użytkownika maly_wacek były dodane do bazy należy wpisać do niej wpis (w dowolnym miejscu, dla porządku najlepiej na początku):

INIT;maly_wacek;;INIT

Ściśle rzecz biorąc po pierwszym dodaniu do bazy, powyższy wpis jest już niepotrzebny, ale też nie przeszkadza. Baza jest zapisywana w taki sposób, że najnowszy tweet każdego użytkownika jest na końcu, zatem po przeczytaniu pliku, w wyniku przypisania $Users{$tmp[1]} = $tmp[0] (por. poniżej), hash %Users zawiera wszystkich użytkowników oraz id_str ich ostatnio pobranego twita. Zapewne niespecjalnie optymalny sposób archiwizacji, ale prosty i działa:

#!/usr/bin/perl
use Net::Twitter;

# Z UTF8 w Perlu jest zawsze problem:
use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";

my $timelineBase = "timelines.log";

if ( -f "$timelineBase" ) {

   open (BASE,  $timelineBase) ||
      die "Cannot open: $timelineBase";

   while (<BASE>) { chomp();
      @tmp = split /;/, $_;
      $Users{$tmp[1]} = $tmp[0]; # last id_str
   }
}

close (BASE) ;

## ###  ####

open (BASE,  ">>$timelineBase") ;

my $nt = Net::Twitter->new(legacy => 0);

my $nt = Net::Twitter->new(
   traits   => [qw/API::RESTv1_1/],
   consumer_key        => "######",
   consumer_secret     => "######",
   access_token        => "######",
   access_token_secret => "######", );

foreach $user ( keys %Users ) {
   my @message ; my $screen_name = $user ;
   my $result ;

   if ( $Users{$user} eq 'INIT' ) {
     ## max ile się da, wg dokumentacji 3200
     $result = $nt->user_timeline({
       screen_name => $screen_name, count=> '3200' })
   }
   else {
     $result = $nt->user_timeline({
       screen_name => $screen_name, 
         since_id => $Users{$user}, });
   }

   foreach my $tweet ( @{$result} ) {
      $text_ = $tweet->{text} ;
      $text_ =~ s/;/\,/g; $text_ =~  s/\n/ /g;
      $date_ = $tweet->{created_at} ;
      push ( @message, $tweet->{id_str} .  ";" \
         . "$screen_name;$date_;$text_" );
   }

   ## Drukuj posortowane:
   my $tweetsC;
   foreach my $tweet ( sort (@message) ) {
      $tweetsC++ ; print BASE $tweet . "\n"; }
   if ( $tweetsC > 0 ) {
       print STDERR "fetched $tweetsC for $screen_name\n"; }
}

close (BASE)

Uwaga: poprzez API można pobrać twity użytkowników, którzy zablokowali nam możliwość oglądania ich konta (inna sprawa po co oglądać takiego palanta).

Utworzenie aplikacji na apps.twitter.com

Należy się zalogować na stronie apps.twitter.com/. Kliknąć Create New App.

Wybrać Name (np. tprzechlewski.app), Description, Website i Callback URL.

Wybrać Keys and Access Tokens i pobrać wartości: Consumer Key oraz Consumer Secret.

Przewinąć zawartość strony i wybrać Create my access token. Zostaną wygenerowane Access Token oraz Access Token Secret, które także należy pobrać.

Na potrzeby wyżej opisanego skryptu to wystarczy. Pobrane wartości wstawiamy w miejsca oznaczone jako ######

Instalowanie Net::Twitter

Na jednym z moich komputerów ciągle działa dość archaiczna wersja Debiana Lenny:

$ cat /proc/version
Linux version 2.6.32-5-kirkwood (Debian 2.6.32-30)

$ cat /etc/issue
Debian GNU/Linux 5.0 \n \l

$ perl --version
This is perl, v5.10.0 built for arm-linux-gnueabi-thread-multi
Copyright 1987-2007, Larry Wall

Z poważnym obawami, że się uda spróbowałem:

cpan> install Net::Twitter
Strange distribution name

Pomaga (por. tutaj):

cpan> install IO::AIO 

Potem:

cpan> install YAML
cpan> install Net::Twitter

Ściąga się milion pakietów. Przy testowaniu Net-HTTP-6.09 system zawisł na etapie t/http-nb.t (pomogło Ctr-C), ale finał był pomyślny, tj. Net::Twitter został zaistalowany.

Mój inny system jest już nowszy a instalacja Net::Twitter bezproblemowa:

$ cat /etc/issue
Fedora release 21 (Twenty One)
  
$ perl --version
This is perl 5, version 18, subversion 4 (v5.18.4) built for x86_64-linux-thread-multi
(with 25 registered patches, see perl -V for more detail)
Copyright 1987-2013, Larry Wall

$ yum install perl-Net-Twitter

Automatyzacja

Teraz wystarczy umieścić w crontab na przykład taki wpis:

# 48 min po północy codziennie
48 0 * * * /home/tomek/bin/twitter.sh 

Co zawiera twitter.sh jest oczywiste

Scrapping various Web pages I managed to gather data on players participating in last 4 Rugby World Cups. Is there a trend in body mass of rugby players participating in RWC tournaments?

Using Plotly API via Perl script (described here Box-plot chart with plot.ly and Perl API) I can quickly plot series of boxplots:

# cpan install WebService::Plotly in case  WebService::Plotly is not installed
plotly_boxplot.pl -col=5 -by=0 -title='RWC players by weight' -sep=';' rwc1999-2015.csv

Resulting boxplots and data can be viewed here.

Jak to z Microsoftem bywa nie jest łatwo. Są dwa formaty Excela -- stary (.xls) oraz nowy (.xlsx). Pakiety Perlowe Spreadsheet::Excel oraz Spreadsheet::ParseXLSX radzą sobie nieźle, aczkolwiek oczywiście gwarancji nie ma i być nie może skoro sam Excel czasami siebie samego nie potrafi zinterpretować.

No ale jest jeszcze trzeci format: jak plik .xlsx jest zabezpieczone hasłem (password protected). I na taką okoliczność nie ma zbyt wielu narzędzi. Można wszakże problem rozwiązać w dwóch krokach korzystając Libreoffice, który potrafi interpretować pliki Excela i można go uruchomić w trybie batch:

#!/bin/bash
XLS="$1"
TMP="${XLS%.*}.xlsx"
libreoffice --headless --convert-to xlsx "$XLS" --outdir ./xlsx-temp/
perl xslx2csv.pl ./xlsx-temp/"$TMP" "$OUTFILE"

Powyższy skrypt obsłuży wszystkie rodzaje plików Excela, zamieniając je najpierw na plik w formacie XLSX (plik password protected zostanie zmieniony na prawdziwy format XLSX, interpretowalny przez np. Spreadsheet::ParseXLSX).

Można od razu konwertować do CSV (--convert-to csv), ale konwersji będzie podlegać tylko pierwszy arkusz. Jak interesuje nas na przykład drugi, to kicha... nie da się (a przynajmniej ja nie wiem jak to osiągnąć). Inny problem to zamiana XLSX→XLSX -- nie ma w LibreOffice możliwości określenia nazwy pliku wynikowego, a próba:

libreoffice --headless --convert-to xlsx plik.xlsx

Kończy się błędem. Na szczęście jest obejście w postaci opcji --outdir. Plik wyjściowy -- o tej samej nazwie co wejściowy -- jest zapisywany w innym katalogu i problem rozwiązany.

Po zamianie Excela na ,,kanoniczny'' XLSX do konwersji na CSV można wykorzystać następujący skrypt Perla:

#!/usr/bin/perl
# Wykorzystanie perl xslx2csv.pl plik.xslx [numer-arkusza]

use Spreadsheet::ParseXLSX;
use open ":encoding(utf8)";
use open IN => ":encoding(utf8)", OUT => ":utf8";

$xslxfile = $ARGV[0]; 
$ArkuszNo = $ARGV[1] || 1; ## domyślnie arkuszu 1

my $source_excel = new Spreadsheet::ParseXLSX;
my $source_book = $source_excel->parse("$xslxfile")
  or die "Could not open source Excel file $xslxfile: $!";

# Zapisuje zawartość wybranego arkusza do hasza %csv
my %csv = ();

foreach my $sheet_number (0 .. $source_book->{SheetCount}-1) {
  my $sheet = $source_book->{Worksheet}[$sheet_number];

  print STDERR "*** SHEET:", $sheet->{Name}, "/", $sheet_number, "\n";
  if ( $ArkuszNo ==  $sheet_number + 1 ) {

    next unless defined $sheet->{MaxRow};
    next unless $sheet->{MinRow} <= $sheet->{MaxRow};
    next unless defined $sheet->{MaxCol};
    next unless $sheet->{MinCol} <= $sheet->{MaxCol};

    foreach my $row_index ($sheet->{MinRow} .. $sheet->{MaxRow}) {
       foreach my $col_index ($sheet->{MinCol} .. $sheet->{MaxCol}) {
          my $source_cell = $sheet->{Cells}[$row_index][$col_index];
	  if ($source_cell) {
	    $csv{$row_index}{$col_index} = $source_cell->Value;
	  }
       }
    }
  }
}

Arkusz jest w haszu %csv. Jak go przekształcić/wydrukować itp. pozostawiam inwencji ewentualnego czytelnika.

GoogleCL przestało działać, bo Google przestało obsługiwać wersję OAuth 1.0. Ponadto, wygląda na to, że dostosowanie tego użytecznego narzędzia do wersji OAuth 2.0 bynajmniej nie jest trywialne na co wskazują liczne (ale do tej pory bezskuteczne) prośby i wołania o aktualizację GoogleCL, które można znaleźć w Internecie.

Ponieważ poszukiwania w miarę podobnego zamiennika zakończyły się niepowodzeniem, nie pozostało nic innego zmajstrować coś samodzielnie. Autoryzację OAuth 2.0 mam już opanową -- obsługuje ją Pythonowy skrypt oauth2picasa.py. (Skrypt jest (zapożyczonym) fragmentem z projektu picasawebsync). Wystarczyło dorobić następujący prosty skrypt Perlowy (por. także: Publishing a blog post):

#!/usr/bin/perl
# *** Wyslanie posta na blogger.com ***
use strict;
use LWP::UserAgent;
use XML::LibXML;
use Getopt::Long;

my $profileID="default";
my $blogID = '1928418645181504144'; # Identyfikator bloga
my $blog_entry ;

## Na wypadek gdy ktoś ma kilka blogów moża podać na któr
## ma być wysłany post używając opcji -blog
GetOptions( "blog=s" => \$blogID, "post=s" => \$blog_entry) ;

if ( $blog_entry eq '' ) {
print STDERR "*** USAGE: $0 -b blog -p message (-b is optional) ***\n" }

## sprawdź czy post jest well formed:
my $parser = XML::LibXML->new();
eval {my $res_  = $parser->parse_string($blog_entry) };
if ($@) { die "*** Error parsing post message! \n"; }

my $ACCESS_TOKEN=`oauth2blogger.py`; # pobierz ACCESS_TOKEN
print STDERR "*** AccessToken: $ACCESS_TOKEN ***\n";

my $req = HTTP::Request->new(
  POST => "https://www.blogger.com/feeds/$blogID/posts/default");

$req->header( 'Content-Type' => 'application/atom+xml' );
$req->header( 'Authorization' => "Bearer $ACCESS_TOKEN" );
$req->header( 'GData-Version' => '2' );

$req->content($blog_entry);

my $ua = LWP::UserAgent->new;
my $res = $ua->request($req);

# Jeżeli coś jest nie tak poniższe drukuje verbatim:
# http://www.perlmonks.org/bare/?node_id=464442
# $ua->prepare_request($req); print($req->as_string); exit ;

if ($res->is_success) {
   my $decoded_response = $res->decoded_content;
   print STDERR "*** OK *** $decoded_response\n"; }
else { die $res->status_line; }

Wykorzystanie:

perl blogger_upload.pl -p 'treść-posta'

Treść posta musi być oczywiście w formacie xHTML i zawierać się wewnątrz elementu content, który z kolei jest wewnątrz elementu entry. Element entry zawiera także title określający tytuł posta, oraz elementy category zawierające tagi. Przykładem może być coś takiego:

<entry xmlns='http://www.w3.org/2005/Atom'>
 <title type='text'>Marriage!</title>
 <content type='xhtml'>
    <div xmlns="http://www.w3.org/1999/xhtml">
      <p>Mr. Darcy has proposed marriage to me!</p>
      <p>He is the last man on earth I would ever desire to marry.</p>
      <p>Whatever shall I do?</p>
    </div>
  </content>
  <category scheme="http://www.blogger.com/atom/ns#" term="marriage" />
  <category scheme="http://www.blogger.com/atom/ns#" term="Mr. Darcy" />
</entry>

Opisany skrypt jest tutaj: blogger_upload.pl.

UWAGA: Ten tekst nie jest o polityce ale o [elementarnej] statystyce.

Media informowały, że posłowie PiS Adam Hofman, Mariusz A. Kamiński i Adam Rogacki wzięli na podróż do Madrytu na posiedzenie komisji Zgromadzenia Parlamentarnego Rady Europy po kilkanaście tysięcy złotych zaliczki, zgłaszając wyjazd samochodem; w rzeczywistości polecieli tanimi liniami lotniczymi. Ponieważ kontrola wydatków posłów jest iluzoryczna różnica pomiędzy kosztem podróży samochodem a samolotem [za dużo mniejsze pieniądze] miała stanowić dodatkowy przychód wyżej wymienionych. Według prokuratury, która wszczęła śledztwo, zachodzi podejrzenie popełnienia oszustwa.

Łapiąc wiatr w żagle [sprawa się upubliczniła tuż przed ostatnimi wyborami samorządowymi] koalicja rządząca w osobie Marszałka Sejmu RP Sikorskiego zarządziła audyt, którego efektem było udostępnienie m.in. dokumentu pn. Wyjazdy zagraniczne posłów VII kadencja (kopia jest tutaj).

Jak przystało na kraj, w którym od lat działa Ministerstwo cyfryzacji zestawienie jest w formacie PDF, zatem pierwszym ruchem była zamiana na coś przetwarzalnego. Wpisanie w google PDF+Excel+conversion skutkuje ogromną listą potencjalnych konwerterów. Bagatelizując skalę problemu spróbowałem dokonać konwersji narzędziami dostępnymi on-line, ale z marnym rezultatem (za duży dokument przykładowo; serwis za free jest tylko dla PDFów mniejszych niż 50 stron). W przypadku Convert PDF to EXCEL online & free coś tam skonwertował, nawet wyglądało toto na pierwszy rzut oka OK ale na drugi już nie: dokument niekompletny oraz nieprawidłowo zamienione niektóre liczby (przykładowo zamiast 837,50 zł w arkuszu jest 83750 -- 100 razy więcej!).

Ostatecznie skończyło się na ściągnięciu 30 dniowej wersji Adobe Acrobata Pro XI, który faktycznie sprawdził się w roli konwertera PDF→XLSX. Do konwersji wykorzystałem służbowego laptopa Elki wyposażonego w legalny Office 2010, na którym zainstalowałem ww. AA Pro XI. OOffice niby czyta XLSX, ale z koszmarnymi błędami, więc żeby dalej móc obrabiać arkusz w Linuksie wczytałem wynikowy XLSX do Excela 2010 po czym zapisałem go w (starszym) formacie XLS. Ten plik wyświetlił się w OO Calcu bez problemu.

Arkusz jest tak sformatowany, że 4 pierwsze komórki oraz są często wielowierszowe i scalone, zawierają bowiem liczbę porządkową, datę, miejsce i cel wyjazdu delegacji posłów. Po zamianie na plik CSV zawartość komórek scalonych pojawi się w pierwszym wierszu, a pozostałe będą puste. Prostym skryptem Perlowym mogę wypełnić puste komórki wg. algorytmu: jeżeli cztery pierwsze pola są puste, to skopiuj wartości ostatnich niepustych:

if ($tmp[0] eq '' && $tmp[1] eq '' && $tmp[2] eq '' && $tmp[3] eq '' ) { ... }

Pierwszy problem: wielowierszowe komórki z kolumn 1--4 nie zawsze są scalone. Czasem tekst jest podzielony na wiersze co psuje konwersję. Ręcznie scalam niescalone komórki (trochę to trwa). Przed scaleniem usuwam z kolumn 1--4 końce wiersza.

Drugi problem: część liczb nie jest liczbami z uwagi na użycie separatora tysięcy, który się zamienił w PDFie na odstęp (spację). Zatem zaznaczam kolumny zawierające różne pozycje kosztów po czym:

Edytuj→Znajdź i zamień

usuwam odstępy, tj. zamieniam spację na pusty napis

Format→Komórki

wybieram numer z dwoma miejscami po przecinku.

Po uporządkowaniu arkusza, zapisuję go w formacie CSV. Następnie prostym skryptem Perlowym zamieniam na taki plik CSV, w którym puste komórki są wypełniane zawartością z poprzednich wierszy. Kolumna Państwo - miasto jest kopiowana. Kopia jest zmieniana na jednoznaczne: Państwo, miasto (pierwszy-kraj, przecinek, pierwsze miasto z listy celów podróży -- żeby geokoderowi było łatwiej.)

Innym skryptem Perlowym dodaję do pliku CSV 3 kolumny, które zawierają:

1. współrzędne celu podróży (w tym celu zamieniam adres Państwo, miasto na współrzędne geograficzne korzystając z geokodera Google);

2. odległość w kilometrach pomiędzy punktem o współrzędnych 21.028075/52.225208 (W-wa, Wiejska 1) a celem podróży (obliczoną przy wykorzystaniu pakietu GIS::Distance);

3. linię zdefiniowana w formacie KML o końcach 21.028075/52.225208--współrzędne-celu-podróży (do ewentualnego wykorzystania z Google Fusion Tables).

#!/usr/bin/perl
#
use Storable;
use Google::GeoCoder::Smart;
use GIS::Distance;

$geo = Google::GeoCoder::Smart->new();

my $gis = GIS::Distance->new();

my $GeoCodeCacheName = 'geocode.cache';
my $NewCoordinatesFetched=0; # global flag
my $SLEEP_TIME = 2 ;
my $coords_okr = "21.028075,52.225208"; # Warszawa = środek świata

my %GeoCodeCache = %{ retrieve("$GeoCodeCacheName") } if ( -f "$GeoCodeCacheName" ) ;
my ($wwa_lng, $wwa_lat) = split (",", $coords_okr);
my $linesNo = 0 ;
my $GCtotaluse = 1; # laczna liczba wywolan geocodera

while (<>) {
  $linesNo++;
  chomp();  $_ =~ s/[ \t]+;[ \t]+/;/g; ## usuń ew. niepotrzebne spacje

  @line = split ";", $_;  print STDERR "**$linesNo = $line[3] ... ";

  # geokodowanie (uwaga na limit) 
  # Poprawki dla miejsc, których nie zna Google:
  $line[3] =~ s/Erewań/Erywań/; ## 
  $line[3] =~ s/Sowayma/Madaba/; ## najbliższe miasto
  $line[3] =~ s/Bołszowce/Iwano-Frankiwsk/; ## najbliższe miasto

  my $coords = addr2coords( $line[3] );

  ($tmp_lat, $tmp_lng, $gcuse) = split " ", $coords;
  if ($gcuse > 0) {$GCtotaluse++ ; }

  $distance = $gis->distance($tmp_lat,$tmp_lng => $wwa_lat,$wwa_lng );
  $distance_t = sprintf ("%.1f", $distance);

  my $kml_line = "<LineString><coordinates>$tmp_lng,$tmp_lat $coords_okr</coordinates></LineString>";
  print "$_;\"$coords\";$distance_t;\"$kml_line\"\n";
  print STDERR "\n";

  if ($GCtotaluse % 100 == 0 ) {# store every 100 geocoder calls
    store(\%GeoCodeCache, "$GeoCodeCacheName");
    print STDERR "\n... Cache stored. ***\n";    
  }
}

##
store(\%GeoCodeCache, "$GeoCodeCacheName");

## ## ## ####
sub addr2coords {
 my $a = shift ;
 my $r = shift || 'n';
 my ($lat, $lng) ;
 my $GCuse = 0;

 ##consult cache first
 if (exists $GeoCodeCache{"$a"} ) {
   print STDERR "Coordinates catched ... $a ";
   ($lat,$lng) = split (" ", $GeoCodeCache{"$a"} );
 }
 else {
   print STDERR "Geocoding ... $a ";
   my ($resultnum, $error, @results, $returncontent) = $geo->geocode("address" => "$a");
   $GCuse = 1;
   sleep $SLEEP_TIME; ## make short pause

   $resultnum--; 
   $resultNo=$resultnum ;

   if (resultNo > 0) { print STDERR "** Location $a occured more than once! **" }
   if ($error eq 'OK') {
     $NewCoordinatesFetched=1;
     for $num(0 .. $resultnum) {
       $lat = $results[$num]{geometry}{location}{lat};
       $lng = $results[$num]{geometry}{location}{lng};
       ##print "*** LAT/LNG:$lat $lng ERROR: $error RES: $resultNo ***\n";
     }

     $GeoCodeCache{"$a"} = "$lat $lng"; ## store in cache

   } else { print STDERR "** Location $a not found! due to $error **"  }
 }


 if ($r eq 'r' ) { return "$lng,$lat,$GCuse"; } # w formacie KML
 else { return "$lat $lng $GCuse"; }
}

Gotowy plik CSV zawierający zestawienie podróży jest dostępny tutaj.

Na podstawie zestawienia i z użyciem pakietu ggplot2 generują się takie oto śliczne wykresy.

Wszystkie podróże z zestawienie (N=1874; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Tylko podróże dla których koszt transportu był niezerowy (N=1423; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Poniższy skrypt R sumuje i drukuje wszystkie podróże każdego posła:

require(plyr)

d <- read.csv("W7RR_podroze_by_podroz1.csv", sep = ';', dec = ",",  header=T, na.string="NA");

# Dodaj kolumnę której wartości to konkatenacja: "Poseł|Klub"
d[,"PosKlub"] <- do.call(paste, c(d[c("Posel", "Klub")], sep = "|"));

# Usuń wszystko za wyjątkiem tego co potrzeba:
d <- d[ c("PosKlub", "Klacznie", "Ktransp", "Dist") ];

# Sumowanie po PosKlub 
PSums <- as.data.frame ( ddply(d, .(PosKlub), numcolwise(sum)) );

# Z powrotem rozdziel kolumnę "Poseł|Klub" na dwie
PSums <- as.data.frame ( within(PSums, PosKlub <-data.frame( do.call('rbind', 
   strsplit(as.character(PosKlub), '|', fixed=TRUE))))  )

# Drukuj 
PSums;

Z pliku .Rout kopiuję zestawienie łącznych wydatków posłów oraz łącznej pokonanej przez nich odległości:

       PosKlub.X1 PosKlub.X2 KlacznieT  KtranspT    DistT
1 Adam Abramowicz        PiS   4.02599   2.64595   1.3153
2     Adam Hofman        PiS 119.55271  59.53315  26.1716
3   Adam Kępiński        SLD  10.15754   7.93882   3.8069
4   Adam Kępiński         TR  12.63098   8.02327   2.2107
...

Uwaga: kilkanaście nazwisk się powtarza ponieważ posłowie zmienili przynależność klubową w czasie trwania kadencji [Aby uwzględnić takich posłów sumowanie odbywało się po wartościach zmiennej zawierającej połączone napisy Poseł|Klub.]

Na podstawie takiego z kolei zestawienia i znowu z użyciem ggplot2 generują inne śliczne wykresy.

Uwaga: sumowane tylko podróże, dla których koszt transportu był niezerowy (N=1423; odpowiednio: koszt łączny, koszt transportu, długość w tys km):

Link do tabeli zawierającej zestawienie podróży w formacie Google Fusion Tables jest tutaj.

Dane + skrypty dostępne są także w: github.com/hrpunio/Data.

Wycieczka do Swornychgaci spowodowała m.in. konieczność dopasowania moich starych skryptów Perla służących do obsługi Flickra.

Flickr zmienił bowiem niedawno API przechodząc na SSL. Zapewne nowa wersja modułu Flickr-API tą zmianę uwzględnia, ale można też rozwiązać sprawę dodając stosowny parametr do starych skryptów. Konkretnie poniższy wiersz:

my $api = new Flickr::API({'key' => $api_key, 'secret' => $shared_secret, });

należy uzupełnić o parametr rest_uri, tj:

my $api = new Flickr::API({'key' => $api_key, 'secret' => $shared_secret,
 'rest_uri' => 'https://api.flickr.com/services/rest/' });

Podobnie niewielkich modyfikacji wymaga skrypt służący do wysyłania zdjęć (moduł Flickr-Upload):

my $ua = Flickr::Upload->new( {'key' => $api_key, 'secret' => $shared_secret,
          'uri' => 'https://up.flickr.com/services/upload/' } );

W tzw. międzyczasie zmieniła się też nieco metoda flickr.photos.geo.setLocation:

 #if ( $response->{success} ) { ## przestało działać 
  unless ( $response->{error_code} > 0 ) {

W dokumentacji jest napisane: This method has no specific response -- It returns an empty success response if it completes without error.. No to faktycznie jak jest empty to if (EMPTY) { zwraca fałsz i warunek jest źle interpertowany. Poza tą jedną poprawką wszystko inne działa.

Ponieważ w przeciwieństwie do MSW w Linuksie długość wiersza poleceń jest absurdalnie duża zapomniałem, że jednak jest skończona:

system ("perl", "clickshop-delete.pl", "-items", join (',', @AllItems)) 

Program clickshop-delete.pl nie jest wykonywany. Żeby ustalić czemu dodaję:

system ("perl", "clickshop-delete.pl", "-items", join (',', @AllItems)) \
== 0 or warn "system failed: $? [$!]\n";

Teraz wiadomo czemu nie działa:

system failed: -1 [Lista argumentów za długa]

Poniższe ustala jak długi może być wiersz poleceń (Debian Lenny na Sheevaplug/ARM):

tomek@neptune:~$ getconf ARG_MAX
131072

Prosty sposób na zmodyfikowanie skryptu z wykorzystaniem splice:

my $max2process=6000; # każdy element @AllItems ma 12 znaków, więc 6000 jest OK
while ( my @items2process = splice @AllItems, 0, $max2process ) {
      system ("perl", "clickshop-delete.pl", "-items", join (',', @items2process)) == \
        0 or warn "system failed: $? [$!]\n";
   }

Powinno działać.

The following Perl script reads data from a CSV file and draws a series of Box-Plots. Usage:

perl plotly_boxplot.pl -col=number -by=number -title=TITLE

where: -col=number -- column number containig variable to plot, -by=number -- column number containig grouping variable.

#!/usr/bin/perl
use WebService::Plotly;
use Getopt::Long;

# login to plotly script
require "$ENV{'HOME'}/bin/login2plotly.pl";

my $plotly = WebService::Plotly->new( un => $plotly_user, key => $plotly_key );

my $sep_sequence = ';';
my $col_number = -1;
my $by_col_number = -1;
my $chart_title='??Chart title??';
my $header='Y';
#my $boxpoints='outliers'; ## or all' | 'outliers' | False
my $USAGE="*** USAGE: -col=i -by=i -title=s -header=s -sep=s FILE *** \n";


# plot values from column 'col' grouped by column 'by'. If header is Y skip first row in data.
# Add title 'title'. Columns in csv data are separated by 'sep' (default ';')
GetOptions("col=i" => \$col_number, "by=i" => \$by_col_number, "title=s" => \$chart_title,
        'header=s' => \$header, 'sep=s' => \$sep_sequence, );
        ##'boxpoints=s' => \$boxpoints ) ;  ## this option not work!

if (($col_number == -1 ) || ($by_col_number == -1) ) { print $USAGE } 

while (<>) { chomp ($_); $nr++;
    if (($nr < 2) << ( $header eq 'Y' ) ) { next }
    $_ =~ s/"//g;
    my @fields = split(/$sep_sequence/, $_);
    push @{$data{$fields[$by_col_number]}}, $fields[$col_number];
    # http://stackoverflow.com/questions/3779213/how-do-i-push-a-value-onto-a-perl-hash-of-arrays
}

my @variants = sort keys %data;

print STDERR "*** No of rows scanned: $nr ***\n";
print STDERR "*** Groups found: @variants ($boxpoints) \n";
for $k (keys %data ) { print "$k"; push (@boxes, { y =>$data{$k}, type => 'box', #'boxpoints' => 'none',
  name => "$k" } ) }

my $layout = { 'title' => $chart_title };

my $response = $plotly->plot(\@boxes, layout => $layout );

my $url = $response->{url};
my $filename = $response->{filename};

print STDERR "*** done: filename: '$filename' url: '$url' ***\n"

Example: Age of Nobel Prize winners by discipline (grouping wariable) plot.ly/~tomasz.przechlewski/28/

Zbiór to set a grupa to pool. Zbiór zawiera zdjęcia jednego użytkownika a grupa (pool) to zbiór zdjęć różnych użytkowników. To tak tytułem wyjaśnienia.

Flickr API zawiera funkcje flickr.groups.pools.getPhotos oraz flickr.photosets.getPhotos, które zwracają informacje o zdjęciach należących do określonego zbioru (albo grupy). Wynik wygląda jakoś tak:

<photoset id="4" primary="2483" page="1" perpage="500" pages="1" total="2">
  <photo id="2484" secret="123456" server="1" title="my photo" isprimary="0" />
  <photo id="2483" secret="123456" server="1" title="flickr rocks" isprimary="1" />
</photoset>

Poniższy skrypt wykorzystujący flickr.groups.pools.getPhotos/flickr.photosets.getPhotos ściąga informacje o zdjęciach dodanych do grupy/zbioru. Wynik zapisuje w Perlowej notacji:

@photos=( {'id'=>"2484", 'secret'=>"123456", 'server'=>"1", 'title'=>"my photo", 'isprimary'=>"0"},
  {'id' =>"2483", 'secret'=>"123456", 'server'=>"1", 'title'=>"flickr rocks", 'isprimary'=>"1", );

Jest to zatem gotowy do dołączenia do innego skryptu np. za pomocą require kod Perla (lista haszy). Ściągana jest informacja o grupie lub zbiorze określonej/określonym przez podanie stosownego id:

flickr_albums.getPhotos.pl -s set-id  
# albo
flickr_albums.getPhotos.pl -p group-id  

Uwaga: moduł login2flickr.rc deklaruje m.in stosowną wartość api_key co jest niezbędne do korzystania z API flickra.

#!/usr/bin/perl
#
use Flickr::API;
use Compress::Zlib;
use Getopt::Long;
use XML::DOM;

require 'login2flickr.rc'; # prywatny moduł do 

$set_id = $pool_id = $method = $Photos='';

GetOptions( "set=s" => \$set_id, "pool=s" => \$pool_id, ) ;

if ( $set_id ne "" ) {
  $root_ele = 'photoset';
  $method = 'flickr.photosets.getPhotos';
  $ofname = "set-${set_id}.ph";
}
elsif ( $pool_id ne "" ) {
  $root_ele='photos';
  $method = 'flickr.groups.pools.getPhotos';
  $ofname = "pool-${pool_id}.ph";
} else {
  die "*** Podaj id zbioru/pula (set-id/pool-id)\n";
}

## ### ### ### ### ###
my $extras = 'date_taken,views,url_o,url_m,geo,tags';

my $api = new Flickr::API({'key' => $api_key, secret => $sharedsecret});
my $parser = XML::DOM::Parser->new();

my $nbrPages = $photoIdx = 0;

do
{ 
  my $params = { per_page => 500, page => $nbrPages+1, extras => $extras };

  $params->{group_id} = $pool_id if $pool_id; 
  $params->{photoset_id} = $set_id if $set_id; 

  ##print STDERR "*** Method/params: $method, $params ***\n";
  my $response = $api->execute_method($method, $params ); 

  die "Problem: $response->{error_message}\n" if !$response->{success}; 

  ## sprawdz czy _content nie jest gzipniety, jezeli to rozpakuj:
  my $content_encoding = $response->{_headers}->{'content-encoding'} ;
  my $plain_content ;

  if ($content_encoding =~ /gzip/ ) {
    $plain_content = Compress::Zlib::memGunzip( $response->{_content});
  } else { $plain_content = $response->{_content};  }

  my $log = $parser->parse($plain_content);

  ## Dane są podzielone na strony o maksymalnej wielkości 500 zdjęć:
  for $ps ( $log->getElementsByTagName( $root_ele ) ) {
      if ($ps->getAttributeNode ("page")  ) { $page = $ps->getAttributeNode ("page")->getValue(); }
      if ($ps->getAttributeNode ("pages") ) { $pages = $ps->getAttributeNode ("pages")->getValue(); }
    }

  print "*** Page $page of $pages ***\n";

  ## dla każdego elementu:
  for $p_ ( $log->getElementsByTagName('photo') ) {
    $element_content='';

    ## zapisz wszystkie atrybuty
    if ($p_ ->getAttributes() !=null){
      $numberAttributes = $p_->getAttributes()->getLength();
    }

    for ($loopIndex =0; $loopIndex < $numberAttributes; $loopIndex++) {
      $attribute = ($p_ -> getAttributes())->item($loopIndex);
      $attrname = $attribute->getNodeName();
      $attrvalue = $attribute->getNodeValue();
      $element_content .= "'$attrname' => '$attrvalue', ";
    }

    $Photos .= "{ $element_content },\n";
    $photoIdx++;
  }

  ++$nbrPages;

} while ($page < $pages );

## ## ###
print STDERR "Writing to $ofname\n";
open (OFILE, ">$ofname"); 
print OFILE "## Created with $method\n\@photos = (\n $Photos \n);\n1;\n";
close OFILE; 

print STDERR "*** $photoIdx photos written to $ofname ***\n";

Skrypt jest do pobrania tutaj.

Kol. DM pisze sobie bloga używając WordPressa. Trochę go to kosztuje więc pojawiła się koncepcja żeby przeszedł na bezpłatnego Bloggera. Początkiem tej koncepcji jest oczywiście konwersja WP do formatu Bloggera.

Wpisy kol. DM zawierają tekst i dużo zdjęć oraz innych rysunków. Nie mam bladego pojęcia nt. WordPressa, ale dość szybko ustaliłem, że można wyeksportować treść posługując się stosowną funkcją dostępną z Kokpit→Narzędzia→Eksport (powstaje plik w formacie WordPress eXtended RSS -- WXR).

Plik WXR zapisujemy na dysku. Można go zamienić do formatu Bloggera korzystując z konwertera dostępnego tutaj. Jest wprawdzie napisane, że konwerter obsługuje pliki nie większe niż 1Mb, ale mój miał 4Mb i też poszło.

Plik kolegi DM zawiera tekst oraz prawidłowe linki do niektórych rysunków. Inne rysunki są wstawiane sprytnym czymś co nazywane jest shortcode (cf Shortcode API.) Nie wchodząc w szczegóły, zamiast rysunków w treści postu jest umieszczone np. coś takiego:

[nggallery id=506]

506 z kolei jest identyfikatorem zbioru rysunków, które fizycznie są przechowywane w katalogu:

wp-content/gallery

Każda galeria jest w oddzielnym katalogu, ale nazwami katalogów nie są identyfikatory typu 506 ale coś innego. Logując się do phpMyAdmin byłem w stanie ściągnąć całą bazę (w formacie SQL), w której siedzi WordPress. W jednej z tabel bazy znalazłem przypisanie id_galerii→nazwa-katalogu-z-plikami

INSERT INTO `wp_ngg_gallery` (`gid`, `name`, `slug`, 
`path`, `title`, `galdesc`, `pageid`, `previewpic`, `author`) VALUES
(17, 'gottardo_2', '', 'wp-content/gallery/gottardo_2', '', '', 0, 0, 1),
(16, 'gottardo_1', '', 'wp-content/gallery/gottardo_1', '', '', 0, 0, 1),
(15, 'nufenen', '', 'wp-content/gallery/nufenen', NULL, NULL, 0, 0, 1),
... itd ...

Czyli zawartość czegoś, co w treści wygląda jak:

[nggallery id=15]

Znajduje się w katalogu wp-content/gallery/nufenen.

Teraz ściągnąłem cały katalog wp-content na dysk lokalny wykorzystując ncftp

ncftp -u USER -p PASS HOST
get -R -T wp-content

Następnie zamieniłem nazwy plików w następujący sposób:

nr_galerii__nazwa_pliku

Pliki wysłałem na google za pomocą skryptu. Istotne jest to, że skrypt po załadowaniu, zwraca URL zdjęcia pod którym jest ono dostępne na koncie googla:

100__fra_07063.jpg http://lh5.ggpht.com/-26SgLqsS1vM/UhdwT-Q62CI/AAAAAAAAABQ/k_ipaT4SNsE/100__fra_07063.jpg
100__fra_07064.jpg http://lh4.ggpht.com/-1kWivWwiZW4/UhdwU4vZWPI/AAAAAAAAABY/XxuIGrIPj8Q/100__fra_07064.jpg
itd...

Czyli zdjęcie 100__fra_07063.jpg (oryginalnie należące go galerii o identyfikatorze równym '100') jest dostępne pod adresem:

http://lh5.ggpht.com/-26SgLqsS1vM/UhdwT-Q62CI/AAAAAAAAABQ/k_ipaT4SNsE/100__fra_07063.jpg

Uwaga: Album ze zdjęciami na koncie googla może zawierać maksymalnie 1000 zdjęć. Jeżeli zdjęć jest więcej trzeba utworzyć więcej albumów.

Skryptem Perla (wyrażenia regularne/regułowe) zamieniam każde [nggallery id=506] na stosowny ekwiwalent. Przykładowo:

<div id='gid_g509'>
<span>< a href="http://lh5.ggpht.com/-NZ_dEAq8qZI/Uhf_OPG9jiI/AAAAAAAADp8/BtBx9DwVgs4/509__1106_016.jpg" 
 imageanchor="1" style="margin-bottom: 1em; margin-right: .1em;">
<img border="0" src="http://lh5.ggpht.com/-NZ_dEAq8qZI/Uhf_OPG9jiI/AAAAAAAADp8/BtBx9DwVgs4/s128/509__1106_016.jpg" 
  height='85' /></a>
</span>
 ... itd ...

Pozostałe zdjęcia mają `prawdziwe URLe' (a nie jakieś shortcody), ale oczywiście URLe te są złe bo wskazują na starego hosta. Zdjęcia te (z `prawdziwymi URLami') są przechowywane w katalogu ./wp-content/uploads. Ze zdjeciami postępuję, tak jak w przypadku zdjęć z galerii: 1) wysyłam na konto google skryptem; 2) zmieniam oryginalne URLe na URLe z konta google (skryptem Perla).

Przed importem do Bloggera warto sprawdzić czy plik, który ma być zaimportowany jest well-formed:

xmllint plik-do-zaimportowania.xml