So I’m getting my daily fix of r-bloggers.com and I encounter this post. Hey, I figure, if polish can draw his country flag using R, why can’t lithuanian do it? 🙂 It should be easy, as cut and paste, right? It turned out not so easy in the end, but not that hard either. Here is the final result. The R code with the description of the process is below.

The hardest part was to get the map of the Lithuania. It turns out that the maps package used to obtain the map of Poland has out-dated maps, circa 1980. There was no Lithuania at that time, curse you Soviets 🙂

After searching a bit, I did not find the R package with the updated map, but I found out how to get more recent map into R. First you need to download the following file from this site. The simplified map from this site is in R package maptools, but it seems the full version is not available as an R package.
You have to unzip the file and then you import it in the following way:

library(maptools)
world<-readShapeSpatial("~/Downloads/TM_WORLD_BORDERS-0.3/TM_WORLD_BORDERS-0.3.shp")

lithuania<-world[world$ISO2=="LT",]
@

To get into more readable format the following lines are necessary. I found them on github ggplot2 page. Thanks to Haddley Wickham:

library(gpclib)
gpclibPermit()
library(ggplot2)
lt<-fortify(lithuania,region="ISO2")

> head(lt)
      long      lat order  hole piece group id
1 25.00000 56.29555     1 FALSE     1  LT.1 LT
2 25.07250 56.21915     2 FALSE     1  LT.1 LT
3 25.08111 56.21055     3 FALSE     1  LT.1 LT
4 25.09694 56.20110     4 FALSE     1  LT.1 LT
5 25.10611 56.19721     5 FALSE     1  LT.1 LT
6 25.13388 56.18888     6 FALSE     1  LT.1 LT

As you see in the end we get the data.frame with longitude and lattitudes and additional info. The relevant additional info in our case is in pieces column. Lithuania consists of 2 separate pieces: the mainland and Curonian spit. Since only part of Curonian spit belongs to Lithuania, it is not connected to Lithuanian mainland. So in the map it looks like an island, when in fact it is not.

The points in the data.frame are ordered, so you can plot them immediately:

plot(lt1,axes=FALSE,xlab="",ylab="",type="l")
polygon(lt2)

Now we have the shape, we need only to fill in the colors. To do that we need to divide the 2 polygons into 3 pieces with equal heights.

It is easy to cut the polygon into 2 pieces along the horizontal line. Here are the functions I used to do that:

x.mid <- function(x1, x2, y.mid) {
      c(x1[1] + ((x2[1] - x1[1]) / (x2[2] - x1[2])) * (y.mid - x1[2]),y.mid)
}

cut.poly.in.half <- function(xy,cut.y.point) {
    cond <- xy[,2]>cut.y.point
    if(!is.matrix(xy))xy <- as.matrix(xy)
    if(sum(cond)==0 | sum(!cond)==0) {
        warning("Whole polygon is either below orabove the cut-line, original polygon is returned")
        return(xy)
    }
    
    dcond <- diff(cond)
    if(sum(dcond)==0) {
        
        tmp<- sort(c(which.min(diff(cond)),which.max(diff(cond))))
        start.y <- tmp[1]
        end.y <- tmp[2]


        start <- x.mid(xy[start.y,],xy[start.y+1,],cut.y.point)    
        
        end <- x.mid(xy[end.y,],xy[end.y+1,],cut.y.point)
  
        top <- rbind(xy[1:start.y,],start,end,xy[(end.y+1):nrow(xy),])
        bottom <- rbind(start,xy[(start.y+1):end.y,],end)
        if(top[1,2]<cut.y.point) {
            tmp <- top
            top <- bottom
            bottom <- tmp
        }
        list(top=top,bottom=bottom)
    }
    
}

I borrowed some code from Bogumił Kamiński. The function just adds two points to the array of points. It checks whether the polygon is cuttable, i.e. the horizontal line goes through the middle. It also assumes, that the line cuts the the polygon into 3 pieces, if we imagine the polygon as the line with the start and an end, which basically what polygon is in R. It is easy to add the code for the case of 2 pieces, but this case is rare, and I was lazy, so there you go:).

Now let us start the cutting:

##We need to cut the polygon of all Lithuania into three equal parts
##First cut out the top part
aa <- cut.poly.in.half(as.matrix(lt1),cut.points[2])
##Now divide the remaining part into halves
bb <- cut.poly.in.half(aa$bottom,cut.points[1])
##Curonian spit part only needs to be cut into two parts
cc <- cut.poly.in.half(lt2,cut.points[2])
@

Now get the colors of Lithuanian flag, and do the final step:

##Colors of Lithuanian flag, from top to bottom.
##Gzr stands for geltona, zalia, raudona: yellow, green, red in lithuanian.
gzr <- c("#fdb913","#006a44","#c1272d")
##Colour the top 
polygon(aa$top,col=gzr[1])
polygon(cc$top,col=gzr[1])
##Colour the middle
polygon(bb$top,col=gzr[2])
polygon(cc$bottom,col=gzr[2])
##Colour the bottom
polygon(bb$bottom,col=gzr[3])

Using this code it is more or less easy to replicate this exercise for other countries which have flags with where colours are horizontal and there are no additional structures. Flags with vertical colours should be easy too. But flags with more structure as flag of Finland, or United Kingdom would be naturally harder.

Reklama

Ji vis dėlto bus! Jau galima registruotis. Visa informacija olimpiados puslapyje. Skleiskite šią džiaugsmingą žinią. Kas nori kuo nors padėti mielai kviečiam, kol kas organizavimas yra one man show.

Galutinius rezultatus rasite čia. Norintys aptarti ar peržiūrėti savo darbus rašykite man elektroniniu paštu. Rezultatai bus suvesti į duomenų bazę antradienį ryte.

Paskelbti galutiniai kursinio projekto rezultatai. Jeigu kas nors neaišku, rašykite elektroniniu paštu.

Bediskutuojant su pirmakursiais magistrantais kilo idėja padaryti konkursą. Užduotis yra tokia: reikia parašyti programą, kuri nuskaitytų iš duoto failo duomenis ir pateiktų tą patį, ką pateikia summary.lm. Magistrantai už tai gaus balus į egzaminą, na o visiems kitiems steigiu 100 Lt premiją laimėtojui. Praktinės vertės programa jokios neturės, nes pasaulyje yra pilna programų, kurios skaičiuoja tiesinę regresiją, bet užtat tai yra puiki proga pasitikrinti savo informatikos žinias.

Konkurso taisyklės:

1. Programa turi nuskaityti failą, kuriame yra lentelės tipo duomenys, eilutėse yra stebėjimai, stulpeliuose kintamieji. Pirmas stulpelis yra priklausomas kintamasis, visi kiti stulpeliai yra nepriklausomi kintamieji. Programa turi įvertinti tiesinės regresijos modelį ir išvesti atitinkamus rezultatus. Visą programos funkcionalumą nusako šis R kodas:

dt <- read.csv("data.csv")
colnames(dt)[1] <-"y"
print(summary(lm(y~.,data=dt)))

2. Programa turi būti programa, t.y. pasirinktos OS paleidžiamasis failas.
3. OS gali būti: Windows 7, Mac OS X 10.6, Ubuntu 10.10. Šiose OS bus tikrinama ar programa pasileidžia.
4. Programa gali turėti priklausomybių, t.y. kitų programų, kurių jai reikia sėkmingai veikti. Priklausomybės turi būti nemokamos, t.y. aš nesiruošiu pirkti papildomos programinės įrangos, tam kad galėčiau patikrinti programos veikimą.
5. Programa turės būti pateikta su išeities kodu.

Laimės originaliausia programa. Pirmenybė bus teikiama paprastumui, elgantiškumui ir daugiaplatformiškumui. Testiniai failai su duomenimis bus pateikti ateinančią savaitę. Konkursas baigiasi lapkričio 13 d. 13 val. Siųsti veikiančias programas galima ir anksčiau, kad aš spėčiau pranešti, ar programa veikia teisingai. Neveikiančios programos nebus vertinamos. Dalyvauti gali visi norintys, bet konkursas yra skirtas visų pirma ekonometrijos specialybės studentams, kurių informatikos žinios nėra ypatingai geros 🙂 Visi siunčiantys turės nurodyti savo vardą, pavardę ir ką studijuoja/studijavo. Informatikai tikriausiai bus automatiškai diskvalifikuojami, arba jiems bus atskiras prizas.

Klausti galima komentaruose, programas siųsti pašto adresu, kurį rasite mano oficialiame puslapyje. Konkurso taisyklės dar gali būti tikslinamos, bet apie tai bus pranešta šiame bloge.

Atsiskaitymas vyks 2 dienas, ketvirtadienį 12-13.30 ir penktadienį 12-13.30. Ketvirtadienį atsiskaitinėja 1 grupė, penktadienį 2 grupė. Jeigu darbą kartu darė studentai iš skirtingų grupių, prašome išsiaiškinti kiek jūsų tokių yra, kad nebūtų taip, kad vieną dieną ateis atsiskaityti 5 komandos, o kitą 25. Kiek man žinoma iš viso bus 20 komandų po 2 žmones, taigi kiekvienai komandai teks po 9 minutes. Organizacinės problemos sprendžiamos nebus.

Teorijos pratybų patikrinimo ir namų darbų perlaikymai vyks rugsėjo 21 d., antradienį 9 val. 116 auditorijoje ir 15.30 400 auditorijoje. Ateikite jums patogiu laiku.

Gynimų datos:

  1. Rugsėjo 30 d., spalio 1d.
  2. Spalio 28 d., 29 d.
  3. Lapkričio 25 d., 26 d.
  4. Gruodžio 16 d. 17 d.

Ataskaitų pristatymo datos:

  1. Rugsėjo 27 d.
  2. Spalio 25 d.
  3. Lapkričio 22 d.
  4. Gruodžio 13 d.

Ataskaitos siunčiamos elektroniniu paštu iki nurodytos dienos 18 val. Ataskaitų atsiųstų po termino gintis nebus galima.

Šį ketvirtadienį, 09.16, paskaita bus.

Kursinių temas galite rasti čia. Komentaruose parašykite kas kokį dėstytoją pasirinko. Taip matysite, kas ką nori rinktis.

Naujausi komentarai

vzemlys apie Rožiniai akiniai
Audrius apie Rožiniai akiniai
Karl apie Time series data aggregation u…
Vytautas Astrauskas apie Matematinio teksto rinkimo tur…
Auksinis kardas apie Drawing national flags on maps…
2018 m. gruodžio mėn.
Pr A T K Pn Š S
« Lap    
 12
3456789
10111213141516
17181920212223
24252627282930
31  
Reklama