library("grid")

## Streifen !

streifen <- function(sc) {

scale_factor <- sc

d <- seq(from=3, to=105, by=6)
color <- c("green3", "green4")

# 1. Farbe

colornumber <- 1

# Schleifendurchlauf:
# jeder Durchlauf ein Streifen, 
# Feld genau definiert in der Grösse, 
# d Intervall der Streifen 
# color[colornumber] ändert sich in jedem durchlauf von 1 in 2 und zurück.

for (i in d){
pushViewport(viewport(x=unit(i*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(70*scale_factor,"mm"),width=unit(6*scale_factor,"mm")))
grid.rect(gp=gpar(col=color[colornumber],fill=color[colornumber]))
popViewport()

# altanieren der Farbe

ifelse(colornumber==1, colornumber <- 2, colornumber <- 1) }
}

## Fussballfeld !
feld <- function(sc) {

# Zum skalieren der Grösse scale_factor,
# wird in jeder Funktion mitgegeben, 
# eine Eingabe beim Aufruf, 
# gibt sich selbst in die anderen Funktionen weiter

scale_factor <- sc

# Äusserer Rand
# Viewport wird initialisiert,
# gp=gpar(fill="green3") Argument heisst dass alles was gezeichnet wird mit green3 gefüllt wird
# grid.rect zeichnet Rechteck über ganzen Viewport, wird automatisch grün
# Nach initialisieren durch pushViewport mit popViewport wieder aus dem Zeichenbereich gehen

pushViewport(viewport(width=unit(118*scale_factor,"mm"),height=unit(80*scale_factor,"mm"),gp=gpar(fill="green3")))
grid.rect(gp=gpar(col="green3"))
popViewport()

# Inneres Feld
# Neues Aufrufen eines Zeichenbereichs

pushViewport(viewport(width=unit(108*scale_factor,"mm"),height=unit(70*scale_factor,"mm"),name="feld"))

# Erst: Streifen
# Aufrufen der Funktion Streifen,
# wie oben geschrieben werden auf vorgegebener Grösse Streifen
# in 2 Grüntönen eingezeichnet

streifen(sc)

# Feld Umrandung
# Grid Rect zeichnet grosses Rechteck um den gesammten Viewport
# da keine x/y width/height angegeben wurden

grid.rect(gp=gpar(col="white",lwd=2))


# Tore
# Genaue angabe von x und y Koordinaten,
# Grösse gegeben daher genaue Koordinaten
# da kein just( ) benutzt immer die Mitte angegeben und darum herum wird
# das Rechteck eingezeichnet
# keine Farbe für Line angegeben -> automatisch schwarz
# fill color beeinflusst nicht die äusseren Linien, nur das innere
# immer für beide Seiten aufgerufen, für bessere Übersicht 2 Aufrufe von grid.rect()

grid.rect(x=unit(-1*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(8*scale_factor,"mm"),width=unit(2*scale_factor,"mm"),gp=gpar(fill="grey"))
grid.rect(x=unit(109*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(8*scale_factor,"mm"),width=unit(2*scale_factor,"mm"),gp=gpar(fill="grey"))

# Strafräume
# Inneres Feld mit Streifen wird übermalt mit weissen Linien
# zur bestimmung des Feldes

grid.rect(x=unit(9*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
grid.rect(x=unit(99*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))

# 16 Meter Kreise
# wegen den Streifen im Feld können die abgeschnittenen Kreise 
# nicht dadurch erzeugt werden dass man einfach gefüllte Rechtecke 
# über die hälfte der Kreise Zeichnet.
# Stattdessen werden Viewports aufgerufen mit clip="on", 
# was bedeutet dass alles was gezeichnet wird nur innerhalb des Viewports
# angezeigt wird, als Mittelpunkt des Kreises wird nun ein Punkt ausserhalb des
# Viewports gewählt und der entstehende Kreis wird nur im Viewport angezeigt
# -> Halbkreis wird im Viewport angezeigt.
# Viewport wird wieder geschlossen, man befindet sich wieder im inneren Feld
# da dieser Viewport noch nicht mit popViewport geschlossen wurde.

pushViewport(viewport(x=unit(27*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(-5*scale_factor,"mm"),y=unit(22*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(81*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(23*scale_factor,"mm"),y=unit(22*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

# 5 Meter Raum
# Gleiches Prinzip wie 16 Meter Raum

grid.rect(x=unit(3*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(25*scale_factor,"mm"),width=unit(6*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
grid.rect(x=unit(105*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(25*scale_factor,"mm"),width=unit(6*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))

# Mittellinie, Mittelkreis
# Linie zum teilen des Feldes,
# Kreis in der Mitte des Felds.

grid.lines(x=unit(c(54*scale_factor,54*scale_factor),"mm"),y=unit(c(0,70*scale_factor),"mm"),gp=gpar(lwd=2,col="white"))
grid.circle(x=unit(54*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))

# Elfer,Mittelpunkt
# Punkte mit Grössen eingezeichnet

grid.points(x=unit(12*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(2*scale_factor,"mm"))
grid.points(x=unit(54*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(3*scale_factor,"mm"))
grid.points(x=unit(96*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(2*scale_factor,"mm"))

# Eckkreise
# Gleiches Prinzip wie 16 Meter Kreise mit clip="on"

pushViewport(viewport(x=unit(2.5*scale_factor,"mm"),y=unit(2.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(0*scale_factor,"mm"),y=unit(0*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(2.5*scale_factor,"mm"),y=unit(67.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(0*scale_factor,"mm"),y=unit(5*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(105.5*scale_factor,"mm"),y=unit(2.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(5*scale_factor,"mm"),y=unit(0*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(105.5*scale_factor,"mm"),y=unit(67.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(5*scale_factor,"mm"),y=unit(5*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

}

### Feld ohne Streifen
# wird genause erzeugt wie feld()
# nur ohne Streifen für andere Funktionen im Folgenden
# da in feld() übereinander gezeichnet wird muss alles neu erzeugt werden,
# die Streifen lassen sich nicht einfach entfernen.

feldohnestreifen <- function(sc) {

scale_factor <- sc

pushViewport(viewport(width=unit(118*scale_factor,"mm"),height=unit(80*scale_factor,"mm"),gp=gpar(fill="green3")))
grid.rect(gp=gpar(col="green3"))
popViewport()

pushViewport(viewport(width=unit(108*scale_factor,"mm"),height=unit(70*scale_factor,"mm"),name="feld"))

grid.rect(gp=gpar(col="white",lwd=2))

grid.rect(x=unit(-1*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(8*scale_factor,"mm"),width=unit(2*scale_factor,"mm"),gp=gpar(fill="grey"))
grid.rect(x=unit(109*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(8*scale_factor,"mm"),width=unit(2*scale_factor,"mm"),gp=gpar(fill="grey"))

grid.rect(x=unit(9*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
grid.rect(x=unit(99*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))


pushViewport(viewport(x=unit(27*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(-5*scale_factor,"mm"),y=unit(22*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(81*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(44*scale_factor,"mm"),width=unit(18*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(23*scale_factor,"mm"),y=unit(22*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

grid.rect(x=unit(3*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(25*scale_factor,"mm"),width=unit(6*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
grid.rect(x=unit(105*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),height=unit(25*scale_factor,"mm"),width=unit(6*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))


grid.lines(x=unit(c(54*scale_factor,54*scale_factor),"mm"),y=unit(c(0,70*scale_factor),"mm"),gp=gpar(lwd=2,col="white"))
grid.circle(x=unit(54*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),r=unit(10*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))

grid.points(x=unit(12*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(2*scale_factor,"mm"))
grid.points(x=unit(54*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(3*scale_factor,"mm"))
grid.points(x=unit(96*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),pch=20,gp=gpar(col="white"),size=unit(2*scale_factor,"mm"))

pushViewport(viewport(x=unit(2.5*scale_factor,"mm"),y=unit(2.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(0*scale_factor,"mm"),y=unit(0*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(2.5*scale_factor,"mm"),y=unit(67.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(0*scale_factor,"mm"),y=unit(5*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(105.5*scale_factor,"mm"),y=unit(2.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(5*scale_factor,"mm"),y=unit(0*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

pushViewport(viewport(x=unit(105.5*scale_factor,"mm"),y=unit(67.5*scale_factor,"mm"),height=unit(5*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),clip="on"))
grid.circle(x=unit(5*scale_factor,"mm"),y=unit(5*scale_factor,"mm"),r=unit(2*scale_factor,"mm"),gp=gpar(lwd=2,col="white"))
popViewport()

}

### Feldmasse
# Scalefaktor hier auf 1.5 gestellt, keine eigene Funktion für die Masse
# Alle masse in einem Vektor c(), für jeden eigene x/y koordinaten angegeben,
# manche gedreht mit rot=90, wieder Vektor angegeben da auch die die nicht
# gedreht werden eine rot Angabe brauchen, rot=0.

scale_factor <- 1.5

grid.text(c("99m","7,32m","70m","16,50m","40,32m","5,5m","18,32m","9,15m"),x=unit(c(54*scale_factor,-4*scale_factor,51*scale_factor,9*scale_factor,14*scale_factor,3*scale_factor,8*scale_factor,54*scale_factor),"mm")
                                                            ,y=unit(c(-2*scale_factor,35*scale_factor,35*scale_factor,11*scale_factor,35*scale_factor,20.5*scale_factor,35*scale_factor,23*scale_factor),"mm")
                                                            ,rot=c(0,90,90,0,90,0,90,0)
                                                            ,name="Masse", gp=gpar(cex=1.2))
                                                            
# Da das Grob Namen bekommen hat kann er einfach mit grid.remove() wieder
# entfernt werden.

grid.remove("Masse")


#############################
### Bayern gegen Nürnberg ###
#############################

### Mannschaftsaufstellungen:

Aufstellungen <- function(sc) {

# Scalefaktor wird mitgegeben wie oben beschrieben, in alle anderen Funktionen
# dann übergegeben.

scale_factor <- sc

# 1x2 Layout
# Grosser Viewport mit 2 gleichgrossen Fenstern
# Grösse wieder definiert für das Feld

pushViewport(viewport(layout=grid.layout(1, 2,widths=unit(c(110*scale_factor,110*scale_factor),c("mm","mm"))
                                              ,heights=unit(c(80*scale_factor,80*scale_factor),c("mm","mm"))
                                              )))
                                              
# Äusserer Rand
# Rechteck mit genauer Grösse um beide layout Felder
# um zu zeigen dass es ein Bild ist im Vortrag

grid.rect(width=unit(200*scale_factor,"mm")
         ,height=unit(140*scale_factor,"mm"))


# Hilfsvariablen Mannschaft Bayern

# Spielernummern mit Namen in 2 Vektoren, 
# in Richtiger Reihenfolge von hinten nach vorne und unten nach oben

bayern <- c(1,21,5,6,23,16,44,39,31,8,33)
bayernnamen <- c("Butt","Lahm","Demichelis","van Buyten","Pranjic","Ottl","Tymoshchuk","Kroos","Schweinsteiger","Altintop","Gomez")

# x und y Koordinaten wo die Spieler stehen

x1 <- c(5,27,27,27,27,43,43,65,65,65,80)
y1 <- c(35,10,26.6,43.2,60,26.6,43.2,34.9,60,10,34.9)

# Dummy wird erstellt, nötig für die Spielernamen
# Torhüter Name soll daneben angegeben werden
# erste Koordinate wird gelöscht -> soll langen Vektor ersparen

dummy1 <- y1*scale_factor
d1 <- dummy1[-1]
dummy2 <- x1*scale_factor
d2 <- dummy2[-1]

# Links Feld:
# Erst aufrufen des Vektors, dann drehen
# wird beides gleichzeitig gemacht drehen sich beide Layouts um sich selbst

pushViewport(viewport(layout.pos.col=1))
pushViewport(viewport(angle=90))

# scale_factor wird wieder weitergegeben

feld(sc)

# Überschrift über das Feld, zweimal mit leicht verschiedenen Positionen für tollen
# Schatten Effekt.

grid.text("FC Bayern München",x=unit(119.8*scale_factor,"mm"),y=unit(34.8*scale_factor,"mm"),gp=gpar(cex=2,col="black"),rot=270)
grid.text("FC Bayern München",x=unit(120*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),gp=gpar(cex=2,col="red"),rot=270)

# Spieler werden als Kreise eingezeichnet,
# leicht transparent mit alpha=0.7

grid.circle(x=unit(x1*scale_factor,"mm"),y=unit(y1*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=0.7),name="bcircl")

# Spielernummern werden in die Kreise geschrieben

grid.text(bayern,x=unit(x1*scale_factor+0.1*scale_factor,"mm")
                                    ,y=unit(y1*scale_factor+0.2*scale_factor,"mm")
                                    ,gp=gpar(cex=1.2),rot=270,name="bnmr")
                                    
# Spielernamen unter die Kreise, Torhüter daneben daher angabe
# mit Vektor, in d1/d2 Torhüter Koordinate gelöscht.

grid.text(bayernnamen,x=unit(c(x1[1]*scale_factor+1*scale_factor,d2-5*scale_factor),"mm")
                     ,y=unit(c(y1[1]*scale_factor-7*scale_factor,d1),"mm")
                     ,gp=gpar(cex=1.2),rot=270,name="bnm")
                     
# 3 Viewports wurden aufgerufen, 3 Viewports müssen geschlossen werden !

popViewport(3)

# Hilfsvariablen Mannschaft Nürnberg

# Spielernummern mit Namen in 2 Vektoren, 
# in Richtiger Reihenfolge von hinten nach vorne und unten nach oben

nuernberg <- c(1,25,5,3,16,2,8,13,22,37,23)
nuernbergnamen <- c("Schäfer","Judt","Nilsson","Wolf","Pinola","Simons","Ekici","Gündogan","Hegeler","Eigler","Schieber")

# x und y Koordinaten wo die Spieler stehen

x2 <- c(103,90,90,90,90,75,50,50,50,50,35)
y2 <- c(35,10,26.6,43.2,59.8,35,10,26.6,43.2,59.9,35)

# Rechtes Feld:

# Layout aufrufen, dannach drehen

pushViewport(viewport(layout.pos.col=2))
pushViewport(viewport(angle=90))

# Feld einzeichnen

feld(sc)

# Überschrift

grid.text("1. FC Nürnberg",x=unit(119.8*scale_factor,"mm"),y=unit(34.8*scale_factor,"mm"),gp=gpar(cex=2,col="black"),rot=270)
grid.text("1. FC Nürnberg",x=unit(120*scale_factor,"mm"),y=unit(35*scale_factor,"mm"),gp=gpar(cex=2,col="grey"),rot=270)

# Spieler

grid.circle(x=unit(x2*scale_factor,"mm")
           ,y=unit(y2*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="blue",fill="white",alpha=0.85),name="ncircl")

# Nummern

grid.text(nuernberg,x=unit(x2*scale_factor+0.1*scale_factor,"mm")
                   ,y=unit(y2*scale_factor+0.2*scale_factor,"mm")
                   ,gp=gpar(cex=1.2,col="black"),rot=270,name="nnmr")

# Namen, diesemal alle unter den Kreisen, auch Torhüter

grid.text(nuernbergnamen,x=unit(x2*scale_factor-5*scale_factor,"mm")
                        ,y=unit(y2*scale_factor,"mm")
                        ,gp=gpar(cex=1.2),rot=270,name="nnm")
                        
# 3 Viewports wurden aufgerufen, 3 Viewports müssen geschlossen werden !

popViewport(3)

}


Aufstellungen(1.5)

###############
### Abseits ###
###############

### Rotes Kreuz ###
# Hilfsfunktion für rotes Kreuz

kreuz <- function() {

# Viewport wird aufgerufen, da keine x/y koordinaten wird in der Mitte gezeichnet
# zwei Rects die unterschiedlich gedreht sind bilden das Kreuz
# ist auch in einem Viewport möglich.

pushViewport(viewport(angle=45))
grid.rect(width=unit(1,"mm"),height=unit(8,"mm"),gp=gpar(col="red",fill="red",alpha=0.9))
popViewport()

pushViewport(viewport(angle=135))
grid.rect(width=unit(1,"mm"),height=unit(8,"mm"),gp=gpar(col="red",fill="red",alpha=0.9))
popViewport()
}

### Grüner Hacken ##

hacken <- function() {

# Mitte mit npc angegeben, 0.5/0.5 ist die mitte
# zwei Rects die unterschiedlich gedreht sind bilden einen Hacken

pushViewport(viewport(angle=28))
grid.rect(x=0.5,y=0.495,width=unit(1,"mm"),height=unit(3.5,"mm")
         ,gp=gpar(col="green",fill="green",alpha=0.9))
popViewport()

pushViewport(viewport(angle=140))
grid.rect(x=0.485,y=0.48,width=unit(1,"mm"),height=unit(6,"mm")
         ,gp=gpar(col="blue",fill="green",alpha=0.9),name="test")
popViewport()
}

###################

abseits <- function(sc) {

# Hilfsvariablen:

scale_factor <- sc

# Bayernnummern, da sie vorher IN der Funktion waren müssen sie wieder neu
# angegeben werden.

bayern <- c(1,21,5,6,23,16,44,39,31,8,33)

x1 <- c(5,27,27,27,27,43,43,65,65,65,80)
y1 <- c(35,10,26.6,43.2,60,26.6,43.2,34.9,60,10,34.9)

# 3 Andere Spieler zum veranschaulichen des Abseits

x3 <- c(21,30,40)
y3 <- c(35,50,31)

feld(sc)

# Überschrift
# Wieder zwei Überschriften leicht nebeneinander für Schatten.

grid.text("Abseitsregel",x=unit(54.5*scale_factor,"mm")
                        ,y=unit(79*scale_factor,"mm")
                        ,gp=gpar(cex=3,col="grey"))

grid.text("Abseitsregel",x=unit(54*scale_factor,"mm")
                        ,y=unit(79.5*scale_factor,"mm")
                        ,gp=gpar(cex=3))
                        
# Unterschrift  
# Legende unter dem Feld, angabe mit y=-15*sc                      

grid.rect(x=unit(0,"mm"),y=unit(-15*scale_factor,"mm"),width=unit(5*scale_factor,"mm"),height=unit(5*scale_factor,"mm")
         ,gp=gpar(col="orange",fill="orange",alpha=0.5))

grid.text("Abseitsbereich",x=unit(15*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

grid.lines(x=unit(c(40*scale_factor,50*scale_factor),"mm"),y=unit(c(-15*scale_factor,-15*scale_factor),"mm")
          ,gp=gpar(lwd=3,col="black",lty="dashed"))

grid.text("Laufweg",x=unit(60*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

grid.arrows(x=unit(c(85*scale_factor,95*scale_factor),"mm"),y=unit(c(-15*scale_factor,-15*scale_factor),"mm")
           ,gp=gpar(lwd=3,col="black")
           ,length=unit(4,"mm"))

grid.text("Passweg",x=unit(105*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

# Einzeichnen der Spieler und Pfeile

# Spielerkreise, nur Torhüter + 4er Kette
# durch Vektor in x koordinate Spieler leicht versetzt

grid.circle(x=unit(c(x1[1]*scale_factor,x1[2]*scale_factor-3*scale_factor,x1[3:5]*scale_factor),"mm"),y=unit(y1[1:5]*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=0.7))
           
# Nummern

grid.text(bayern,x=unit(c(x1[1]*scale_factor,x1[2]*scale_factor-3.1*scale_factor,x1[3:5]*scale_factor+0.1*scale_factor),"mm")
                                    ,y=unit(y1[1:5]*scale_factor+0.2*scale_factor,"mm")
                                    ,gp=gpar(cex=1.2))
                                    
# Spielerkreise der 3 anderen Spielern der Angreifer

grid.circle(x=unit(x3*scale_factor,"mm"),y=unit(y3*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="white",fill="white",alpha=0.85))
           
# Kreuz auf dem im Abseits stehenden Spieler          

pushViewport(viewport(x=unit(x3[1]*scale_factor,"mm"),y=unit(y3[1]*scale_factor,"mm")))
kreuz()
popViewport()

# Nummern in die Angreifer

grid.text(c("23","37","22"),x=unit(x3*scale_factor+0.1*scale_factor,"mm")
                                    ,y=unit(y3*scale_factor+0.2*scale_factor,"mm")
                                    ,gp=gpar(cex=1.2))
                                    
# Abseitsbereich in Orange mit transparenz

grid.rect(x=unit((x1[2]*scale_factor-5.9*scale_factor)/2,"mm")
          ,y=unit(35*scale_factor,"mm"),height=unit(70*scale_factor,"mm")
          ,width=unit(x1[2]*scale_factor-5.9*scale_factor,"mm")
          ,gp=gpar(col="orange",fill="orange",alpha=0.5))
          
# Pfeile für Passweg

grid.arrows(x=unit(c(x3[3]*scale_factor-2.9*scale_factor,16*scale_factor),"mm")
           ,y=unit(c(y3[3]*scale_factor+1*scale_factor,43*scale_factor),"mm"),gp=gpar(lwd=3,col="black")
           ,length=unit(4,"mm"))
           
# Laufweg mit gestrichelter Linie

grid.lines(x=unit(c(x3[2]*scale_factor-3*scale_factor,15*scale_factor),"mm")
          ,y=unit(c(y3[2]*scale_factor,47*scale_factor),"mm")
          ,gp=gpar(lwd=3,lty="dashed"))
          
# Hacken auf dem Spieler der nicht im Abseits steht

pushViewport(viewport(x=unit(15*scale_factor,"mm"),y=unit(49.5*scale_factor,"mm")))
hacken()
popViewport()

}

abseits(1.5)


###########################
### Ballkontakte Bayern ###
###########################

### Auswechselpfeil

auswechsel <- function() {

# Pfeil in native, skaliert nicht mit scale_facor,
# eher schlecht..

pushViewport(viewport(angle=90))
grid.arrows(x=unit(c(0.52,0.48),"native")
           ,y=unit(c(0.5,0.5),"native")
           ,gp=gpar(col="red",lwd=3)
           ,length=unit(0.02,"native")
          )
popViewport()

}

### Einwechselpfeil

einwechsel <- function() {

# Pfeil in native, skaliert nicht mit scale_facor,
# eher schlecht..

pushViewport(viewport(angle=270))
grid.arrows(x=unit(c(0.52,0.48),"native")
           ,y=unit(c(0.5,0.5),"native")
           ,gp=gpar(col="green",lwd=3)
           ,length=unit(0.02,"native")
          )
popViewport()

}

###########################

ballkontakte <- function(sc) {

scale_factor <- sc

feld(sc)

## Überschrift, 2x wie oben..

grid.text("Ballkontakte Bayern",x=unit(54.5*scale_factor,"mm")
                        ,y=unit(79*scale_factor,"mm")
                        ,gp=gpar(cex=3,col="black"))

grid.text("Ballkontakte Bayern",x=unit(54*scale_factor,"mm")
                        ,y=unit(79.5*scale_factor,"mm")
                        ,gp=gpar(cex=3,col="red"))

## Unterschrift
# Legende der Auswechslungen

# Minute

grid.text(c("46.","56.","70.")
          ,x=unit(c(0*scale_factor,28*scale_factor,56*scale_factor),"mm")
          ,y=unit(-10*scale_factor,"mm")
          ,gp=gpar(cex=1.2))
          
# Spieler die ein/ausgeweschelt werden

# Kreise

grid.circle(x=unit(c(6*scale_factor,14*scale_factor,34*scale_factor,42*scale_factor,62*scale_factor,70*scale_factor),"mm")
           ,y=unit(-10*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="black",fill="red",alpha=0.7,alpha=0.5))
           
# Nummern

grid.text(c(6,2,39,7,8,25),x=unit(c(6*scale_factor,14*scale_factor,34*scale_factor,42*scale_factor,62*scale_factor,70*scale_factor),"mm")
                          ,y=unit(-10*scale_factor,"mm")
                          ,gp=gpar(cex=1.2))
                          
# Position der Ein/auswechsel Pfeile muss mit eigenen Viewports gepopt werden
# da sie jeweils in die Mitte gezeichnet werden

pushViewport(viewport(x=unit(10*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
auswechsel()
popViewport()

pushViewport(viewport(x=unit(18*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
einwechsel()
popViewport()

pushViewport(viewport(x=unit(38*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
auswechsel()
popViewport()

pushViewport(viewport(x=unit(46*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
einwechsel()
popViewport()

pushViewport(viewport(x=unit(66*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
auswechsel()
popViewport()

pushViewport(viewport(x=unit(74*scale_factor,"mm"),y=unit(-10*scale_factor,"mm")))
einwechsel()
popViewport()


###########################

# Hilfsvariablen

# Positionen

x1 <- c(5,27,27,27,27,43,43,65,65,65,80)
y1 <- c(35,10,26.6,43.2,60,26.6,43.2,34.9,60,10,34.9)

# Nummern

bayern <- c(1,21,5,6,23,16,44,39,31,8,33) ##  25 für  8 ( 17 ) &   7 für 39 ( 18 ) &   2 für 6 ( 26 )

# Ballkontakte der Spieler, ein/auswechslungen aufaddiert

b1 <- c(60,61,90,43+26,68,38,70,42,47+17,32+18,27)

# Definieren der Grobs:
# Grob Befehl, erzeugt die Objekte erst nur off screen

# Ballkontakte, Eingewechselte Positionen in Schwarz
# cex der Zahlen wird grösser je nach Anzahl der Ballkontakte

tb1 <- textGrob(b1,x=unit(x1*scale_factor-0.2*scale_factor,"mm")
                  ,y=unit(y1*scale_factor-0.5*scale_factor,"mm")
                  ,name="tg1"
                  ,gp=gpar(cex=(b1*scale_factor)/(40*scale_factor),col=c("white","white","white","black","white"
                                                                          ,"white","white","white","black","black","white")))

# Spieler Kreise, 2 Kreise, der erste grössere lwd angabe
# -> schönerer Rand der Kreise
# Radius skaliert wieder mit der Anzahl der Ballkontakte

cb1 <- circleGrob(x=unit(x1*scale_factor-0.2*scale_factor,"mm")
                 ,y=unit(y1*scale_factor-0.5*scale_factor,"mm")
                 ,r=unit((b1*scale_factor)/(10*scale_factor),"mm")
                 ,gp=gpar(col="black",lwd=3,fill="red",alpha=0.7))

cb2 <- circleGrob(x=unit(x1*scale_factor-0.2*scale_factor,"mm")
                 ,y=unit(y1*scale_factor-0.5*scale_factor,"mm")
                 ,r=unit((b1*scale_factor)/(10*scale_factor),"mm")
                 ,gp=gpar(col="white"))
                 
# Zeichnen der Grobs
# durch grid.draw() Grobs nun on screen eingezeichnet

grid.draw(cb1)
grid.draw(cb2)
grid.draw(tb1)


}

ballkontakte(1.5)

######################
### Tor-Entstehung ###
######################

# Funktionen für die einzelnen Aktionen:

# Spieler an punkt x,y mit nummer n im scale_factor sc
spieler <- function(sc,x,y,n) {

scale_factor <- sc

# Spielerkreis

grid.circle(x=unit(x*scale_factor,"mm"),y=unit(y*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=0.9))
           
# Spielernummer im Kreis

grid.text(n,x=unit(x*scale_factor,"mm")
           ,y=unit(y*scale_factor,"mm")
           ,gp=gpar(col="black",cex=1.2))

}

# Spieler läuft mit Ball von Punkt x1/y1 nach Punkt x2/y2 mit Nummer n

laufen <- function(sc,x1,y1,x2,y2,n) {

scale_factor <- sc

# Distanz wird euklidisch berechnet
# durch 3 geteilt für abstand der Kreise -> alle 3 einheiten ein "Schrittkreis" 

schritte <- round(sqrt((x1-x2)^2 + (y1-y2)^2) / 3)

# x und y Koordinaten werden durch die Schritte geteilt
# da von rechts nach links und unten nach oben gelaufen werden kann
# wird der Betrag der Koordinaten angegeben

schrittex <- abs(x1-x2) / schritte
schrittey <- abs(y1-y2) / schritte

# Hilfsvariable zum feststellen ob von rechts nach links oder oben nach unten gelaufen wird

k <- 1
l <- 1

# wenn x1 > x2 ist wird von rechts nach links gelaufen
# die Kreise müssen auch dementsprechend gezeichnet werden

if ( x1 > x2 ) {
k <- -1
}

# wenn y1 > y2 ist wird von oben nach unten gelaufen

if ( y1 > y2) {
l <- -1
}

# Schleife fürs einzeichnen der Schritte
# alle 3 abstands einheiten ein Schritt

for (i in 1:schritte) {

# Koordinaten der Schritte vorher definiert wieviel jeweils
# aufaddiert werden muss, Hilfsvariablen für Richtung

grid.circle(x=unit(x1*scale_factor+k*i*schrittex*scale_factor,"mm")
           ,y=unit(y1*scale_factor+l*i*schrittey*scale_factor,"mm")
           ,r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=c(0.3)))
}


# Endpunkt des Laufens mit Ball

grid.circle(x=unit(c(x1*scale_factor,x2*scale_factor),"mm")
           ,y=unit(c(y1*scale_factor,y2*scale_factor),"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=c(0.3,0.9)))

# Spielernummer im Endkreis

grid.text(n,x=unit(c(x2*scale_factor),"mm")
           ,y=unit(c(y2*scale_factor),"mm")
           ,gp=gpar(col="black",cex=1.2))


}

# Laufen ohne Ball von x1/y1 nach x2/y2

laufenohneball <- function(sc,x1,y1,x2,y2) {

scale_factor <- sc

# Laufline

grid.lines(x=unit(c(x1*scale_factor,x2*scale_factor),"mm")
          ,y=unit(c(y1*scale_factor,y2*scale_factor),"mm")
          ,gp=gpar(lwd=3,lty="dashed"))

}

# Passen/Schiessen von x1/y1 nach x2/y2 

passen <- function(sc,x1,y1,x2,y2) {

scale_factor <- sc

# Passpfeil

grid.arrows(x=unit(c(x1*scale_factor,x2*scale_factor),"mm")
           ,y=unit(c(y1*scale_factor,y2*scale_factor),"mm")
           ,gp=gpar(lwd=3,col="black")
           ,length=unit(4,"mm"))

}

# Torschütze x/y nummer n

torschütze <- function(sc,x,y,n) {

scale_factor <- sc

# Kreis mit Gelber umrandung

grid.circle(x=unit(x*scale_factor,"mm"),y=unit(y*scale_factor,"mm"),r=unit(3.5*scale_factor,"mm")
           ,gp=gpar(col="yellow",fill="yellow",alpha=0.9))

grid.circle(x=unit(x*scale_factor,"mm"),y=unit(y*scale_factor,"mm"),r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="yellow",fill="red",alpha=0.9))

grid.text(n,x=unit(x*scale_factor,"mm")
            ,y=unit(y*scale_factor,"mm")
            ,gp=gpar(col="black",cex=1.2))

}

# Überschrift "text"

überschrift <- function(text,sc) {

scale_factor <- sc

grid.text(               text
                        ,x=unit(54*scale_factor,"mm")
                        ,y=unit(79*scale_factor,"mm")
                        ,gp=gpar(cex=3,col="black"))

}

######

tor <- function(sc) {

scale_factor <- sc

### Überschrift

feld(sc)
überschrift("10. Minute, 1:0 Gomez",sc)

### Unterschrift ###

grid.circle(x=unit(0,"mm"),y=unit(-15*scale_factor,"mm"),r=unit(3.5,"mm")
         ,gp=gpar(col="yellow",fill="yellow",alpha=0.9))

grid.circle(x=unit(0,"mm"),y=unit(-15*scale_factor,"mm"),r=unit(2.9,"mm")
         ,gp=gpar(col="yellow",fill="red",alpha=0.9))

grid.text("Torschütze",x=unit(10*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

grid.lines(x=unit(c(25*scale_factor,35*scale_factor),"mm"),y=unit(c(-15*scale_factor,-15*scale_factor),"mm")
          ,gp=gpar(lwd=3,col="black",lty="dashed"))

grid.text("Laufweg",x=unit(43*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

grid.circle(x=unit(c(56*scale_factor,57.5*scale_factor,59*scale_factor,60.5*scale_factor,62*scale_factor),"mm")
           ,y=unit(-15*scale_factor,"mm")
           ,r=unit(2.9*scale_factor,"mm")
           ,gp=gpar(col="red",fill="red",alpha=c(0.1,0.1,0.1,0.1,0.9)))

grid.text("Laufweg mit Ball",x=unit(77*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

grid.arrows(x=unit(c(90*scale_factor,97*scale_factor),"mm"),y=unit(c(-15*scale_factor,-15*scale_factor),"mm")
           ,gp=gpar(lwd=3,col="black")
           ,length=unit(4,"mm"))

grid.text("Passweg",x=unit(105*scale_factor,"mm"),y=unit(-15*scale_factor,"mm"))

####################

## Pranjic

laufen(sc,80,65,70,60,23)
laufen(sc,93,53,102,48,23)
laufenohneball(sc,70,60,93,53)
passen(sc,70,60,78,47)
passen(sc,102,48,102,38)

## Kroos

spieler(sc,80,45,39)
passen(sc,80,45,100,48)

## Gomez

torschütze(sc,102,34,33)
passen(sc,102,34,108,35)

}

tor(1.5)


### Zum selbst probieren:
#sc <- 1.5
#
#feld(sc)
#laufen(sc,x1,y1,x2,y2,n)
#....
#...
#..


###################
### Random Walk ###
###################


randwalk2d <- function(p, n,x,y,z1){
  # Überprüfen, ob p ein Wahrscheinlichkeitsvektor ist und, ob n größer 0.
  if(sum(p) != 1 ||
     as.logical(max(p < 0)) ||
     as.logical(max(p > 1)) ||
     length(p) != 8 ||
     n < 1 ||
     n%%1 != 0){
    return(cat("Bitte Eingabe ?berpr?fen!\n"))
  }

  # Erzeugen der Matrix 'walk' für die Koordinaten des Walks.
  walk <- matrix(nrow=n+1, ncol=2, data=0)
  walk[1,1] <- x
  walk[1,2] <- y

  # Erzeugen der zufälligen Schritte des Walks
  steps <- sample(c("N","NE","E","SE","S","SW","W","NW"),
                    n,
                    replace=TRUE,
                    prob=p)
  z <- sample(1:z1,n,replace=TRUE)

  # Aktualisieren der Walk-Matrix anhand der Schritte.
  for(i in 2:(n+1)){
    if(steps[i-1] == "N" && walk[i-1,2]<=70-z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, 1*z[i-1])
    }
    if(steps[i-1] == "S" && walk[i-1,2]>0+z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, -1*z[i-1])
    }
    if(steps[i-1] == "E" && walk[i-1,1]<=108-z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(1*z[i-1], 0)
    }
    if(steps[i-1] == "W" && walk[i-1,1]>0+z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(-1*z[i-1], 0)
    }

    if(steps[i-1] == "NE" && ( walk[i-1,2]<=70-z[i-1] || walk[i-1,1]<=108-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0.5*z[i-1], 0.5*z[i-1])
    }
    if(steps[i-1] == "SE" && ( walk[i-1,2]>0+z[i-1] || walk[i-1,1]<=108-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0.5*z[i-1], -0.5*z[i-1])
    }
    if(steps[i-1] == "SW" && ( walk[i-1,1]>0+z[i-1] || walk[i-1,1]>0+z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(-0.5*z[i-1], -0.5*z[i-1])
    }
    if(steps[i-1] == "NW" && ( walk[i-1,1]>0+z[i-1] || walk[i-1,2]<=70-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(-0.5*z[i-1], 0.5*z[i-1])
    }

    if(steps[i-1] == "N" && walk[i-1,2]>=70-z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "S" && walk[i-1,2]<=0+z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "E" && walk[i-1,1]>=108-z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "W" && walk[i-1,1]<=0+z[i-1]){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }

    if(steps[i-1] == "NE" && ( walk[i-1,2]>=70-z[i-1] || walk[i-1,1]>=108-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "SE" && ( walk[i-1,2]<=0+z[i-1] || walk[i-1,1]>=108-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "SW" && ( walk[i-1,1]>=108-z[i-1] || walk[i-1,2]<=0+z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }
    if(steps[i-1] == "NW" && ( walk[i-1,1]<=0+z[i-1] || walk[i-1,2]>=70-z[i-1] ) ){
      walk[i, ] <- walk[i-1, ] + c(0, 0)
    }

  }

  # Zurückgeben der Koordinaten des Walks.

  return(walk)
}


plot.randwalk2d <- function(x,sc){

scale_factor <- sc

  # Erzeugen eines Grafikfensters.
  pushViewport(viewport(width=unit(108*scale_factor,"mm"),height=unit(70*scale_factor,"mm"),name="feld"))


  # Plotten der Anfangskoordinate.
  grid.points(x=unit(x[1,1]*scale_factor,"mm"),
         y=unit(x[1,2]*scale_factor,"mm"),
         gp=gpar(pch=16,
         col="red"))

  # Zeichnen der Schritte.
  i <- 1
  #Sys.sleep(2)
  while(i <= (dim(x)[1]-1)){
    grid.lines(x=unit(c(x[i, 1]*scale_factor, x[i+1, 1]*scale_factor),"mm"), y=unit(c(x[i, 2]*scale_factor, x[i+1, 2]*scale_factor),"mm"))
    i <- i+1
    #Sys.sleep(10/dim(x)[1])
  }

  # Plotten der Endkoordinate. Der Anfangspunkt wird nochmal gezeichnet f?r den
  # Fall, dass er im Laufe des Walks ?bermalt wurde.
  grid.points(x=unit(c(x[dim(x)[1], 1]*scale_factor, x[1,1]*scale_factor),"mm"),
        y=unit(c(x[dim(x)[1], 2]*scale_factor, x[1,2]*scale_factor),"mm"),
         gp=gpar(pch=16,
         col=c("green", "red")))
  popViewport()
}

################
### heat map ###
################

heat <- function(test1,sc) {

scale_factor <- sc

pushViewport(viewport(width=unit(108*scale_factor,"mm"),height=unit(70*scale_factor,"mm"),name="feld"))

# Aufteilen des Felds in Quadrate

b1 <- seq(from=3, to=105, by=6)
h1 <- seq(from=2.5,to=67.5, by=5)

# Durchlaufen der Quadrate

for (i in b1){
  for(j in h1){
  
  # Erzeugen eines Viewports auf dem Quadrat

  pushViewport(viewport(x=unit(i*scale_factor,"mm")
                       ,y=unit(j*scale_factor,"mm")
                       ,height=unit(5*scale_factor,"mm")
                       ,width=unit(6*scale_factor,"mm")))

      # Testen wieviele Punkte im Quadrat liegen
      
     y <- 1
     while(y <= dim(test1)[1]) {
      if ( ( i-3 <= test1[y,1]  &&  i+3 >= test1[y,1] )  && ( j-2.5 <= test1[y,2] && j+2.5 >= test1[y,2] ) )
      {
        # Zeichnen eines rects für jeden Punkt im Quadrat
        # überlagen der Punkte verringert die Transparenz
        
       grid.rect(gp=gpar(fill="red",alpha=0.1))

       }

      y <- y+1

     }
     popViewport()

}


}

 # Anfangs/End Punkt des Random Walks nochmal einzeichnen da überschrieben
 
 grid.points(x=unit(c(test1[dim(test1)[1], 1]*scale_factor, test1[1,1]*scale_factor),"mm"),
        y=unit(c(test1[dim(test1)[1], 2]*scale_factor, test1[1,2]*scale_factor),"mm"),
         gp=gpar(pch=16,
         col=c("green", "red")))
        
}

################################################
### Dichte der trunkietren Normalverteilung  ###
################################################

dnormTrunc <- function(x, mean, sd, lower, upper, ...){

     # Man integriert die Normalverteilung mit den Grenzen
     p <- integrate(dnorm, lower, upper, mean, sd, ...)
     # 0 wenn ausserhalb der Grenzen, sonst die Normalverteilung
     # geteilt durch die Grösse des Integrationswerts
     trunc <- function(x, mean, sd, p, lower, upper){
         ifelse((x < lower | x > upper), 0, dnorm(x, mean, sd)/p$value)
     }
     # neuer Dichteschätzer hinzugefügen
     sapply(x, FUN=trunc, mean, sd, p, lower, upper) }

### Kerndichteschätzer trunkiert
densityTrunc <- function(x, data, lower, upper, ...){
     # Dichte der Daten wird berechnet
     d <- density(x=data, ...)
     # Dichte wird zu Funktion gemacht
     f <- approxfun(d$x, d$y, ...)
     # Integrieren in den Grenzen
     p <- integrate(f, lower, upper, ...)
     # teilt wieder in den Grenzen durch das Integrierte 
     # ( kleiner 0 -> wird grösser )
     trunc <- function(x, p){
         ifelse((x < lower | x > upper), 0, f(x)/p$value)
     }
     # neuer Dichteschätzer
     sapply(x, trunc, p)
}


######################
### Komplexes Feld ###
######################

analyse <- function(p, n,x,y,z1,sc) {

scale_factor <- sc

# Erzeugen der benötigten Daten 

# randomwalk wird durchgeführt und gespeichert
test1 <- randwalk2d(p, n,x,y,z1)

# histogram wird erstellt und gespeichert
h1 <- hist(test1[,1],freq=FALSE,plot=F )
h2 <- hist(test1[,2],freq=FALSE,plot=F)

# Trunkierte Dichten werden erstellt und gespeichert
# erste spalte aus randomwalk sind die x koordinaten, 2. spalte die y
# Grenzen als minimum angegeben mit den start/end punkten für korrekten wert

d1 <- curve(densityTrunc(x, data=test1[,1], lower=min(0,h1$breaks[1]), upper=min(108,h1$breaks[length(h1$breaks)])), from=-20, to=150) 
n1 <- curve(dnormTrunc(x, mean=mean(h1$breaks), sd=sd(h1$breaks), lower=0, upper=108), add=TRUE, col="red", lty="dashed")

d2 <- curve(densityTrunc(x, data=test1[,2], lower=min(0,h2$breaks[2]), upper=min(70,h2$breaks[length(h2$breaks)])), from=-10, to=80) 
n2 <- curve(dnormTrunc(x, mean=mean(h2$breaks), sd=sd(h2$breaks), lower=0, upper=70), add=TRUE, col="red", lty="dashed")

# Festlegen des Layouts

# grid.newpage für neues fenster, curve befehl spinnt und zeichnet immer neues 
# Fenster ( plot=F geht nicht.. )

grid.newpage()

# 2x2 Layout mit genauen grössen

pushViewport(viewport(layout=grid.layout(2, 2,widths=unit(c(60*scale_factor,120*scale_factor),c("mm","mm"))
                                              ,heights=unit(c(60*scale_factor,90*scale_factor),c("mm","mm"))
                                              )))
                                              
# Feld unten links

pushViewport(viewport(layout.pos.col=1,layout.pos.row=2))
pushViewport(viewport(width=unit(70*scale_factor,"mm"),height=unit(45*scale_factor,"mm"),name="feld"))

# dataViewport für y Achse, grösse von Histogramm density

pushViewport(dataViewport(h2$breaks,h2$density,angle=90))
grid.yaxis()

# Abtragen der y Punkte des Random Walks
# schleife die die Punkte mit y = 0 und x wert überträgt,
# x koordinate bleibt unten obwohl gedreht

i <- 1
while(i <= (dim(test1)[1]-1)){
grid.points(x=unit(test1[i,2]*scale_factor,"mm"),y=unit(0,"native"))
i <- i+1
}

# Abtragen des Histogramms der y Punkt
# rechtecke werden einzeln gezeichnet,
# koordinaten aus dem vorher gespeichertem Histogramm herausgelesen

i <- 1

while(i <= (length(h2$counts)) ) {
grid.rect(x=unit(h2$mids[i]*scale_factor,"mm")
         ,y=unit((h2$intensities[i])/2,"native")
         ,width=unit(h2$breaks[i+1]*scale_factor-h2$breaks[i]*scale_factor,"mm")
         ,height=unit(h2$intensities[i],"native"))

i <- i+1
}

# Trunkierte Density der y-Punkte
# Punkte der gespeicherten Dichte werden mit Schleife verbunden

i <- 1

while(i <= (length(d2$x)-1) ) {
if ( d2$y[i] > 0 ) {
grid.lines(x=unit(c(d2$x[i]*scale_factor,d2$x[i+1]*scale_factor),"mm")
          ,y=unit(c(d2$y[i],d2$y[i+1]),"native"))
        }

i <- i+1
}

i <- 1

# Trunkierte Normalverteilung auf mean/sd der y-Punkte
# Punkte der gespeicherten Dichte werden mit Schleife verbunden

while(i <= (length(n2$x)-1) && n2$x != 0  ) {
if ( n2$y[i] > 0 ) {
grid.lines(x=unit(c(n2$x[i]*scale_factor,n2$x[i+1]*scale_factor),"mm")
          ,y=unit(c(n2$y[i],n2$y[i+1]),"native")
          ,gp=gpar(col="red"))
          }

i <- i+1
}

# 3 viewports gepusht, 3 viewports popen
popViewport(3)

# Oben rechts:

pushViewport(viewport(layout.pos.col=2,layout.pos.row=1))
pushViewport(viewport(width=unit(108*scale_factor,"mm"),height=unit(55*scale_factor,"mm"),name="feld"))
# data des histogramms aus den x punkten
pushViewport(dataViewport(h1$breaks,h1$density))
grid.yaxis()

# x-Punkte

i <- 1

while(i <= (dim(test1)[1]-1)){
grid.points(x=unit(test1[i,1]*scale_factor,"mm"),y=unit(0,"native"))
i <- i+1
}

# Histogramm 

i <- 1

while(i <= (length(h1$counts)) ) {
grid.rect(x=unit(h1$mids[i]*scale_factor,"mm")
         ,y=unit((h1$intensities[i])/2,"native")
         ,width=unit(h1$breaks[i+1]*scale_factor-h1$breaks[i]*scale_factor,"mm")
         ,height=unit(h1$intensities[i],"native"))

i <- i+1
}

# Density Histogramm

i <- 1

while(i <= (length(d1$x)-1)) {
if ( d1$y[i] > 0 ) {
grid.lines(x=unit(c(d1$x[i]*scale_factor,d1$x[i+1]*scale_factor),"mm")
          ,y=unit(c(d1$y[i],d1$y[i+1]),"native"))
          }

i <- i+1
}

# Normalverteilung Histogramm

i <- 1

while(i <= (length(n1$x)-1)) {
if ( n1$y[i] > 0 ) {
grid.lines(x=unit(c(n1$x[i]*scale_factor,n1$x[i+1]*scale_factor),"mm")
          ,y=unit(c(n1$y[i],n1$y[i+1]),"native")
          ,gp=gpar(col="red"))
          }

i <- i+1
}


popViewport(3)

# Unten rechts:

pushViewport(viewport(layout.pos.col=2,layout.pos.row=2))
feldohnestreifen(sc)
plot.randwalk2d(test1,sc)
heat(test1,sc)

popViewport(3)

}

### Analyse: function(p, n,x,y,z1,sc)
### p -> wahrscheinlichkeit des randomwalks
### n -> anzahl der punkte des randomwalks
### x,y -> startkoordinaten
### z1 -> gr?sse der schritte ( zuf?llig 1:z1 )
### sc -> scale_factor

analyse(c(1/8,1/8,1/8,1/8,1/8,1/8,1/8,1/8),360,50,40,10,1.5)


############################
### Plot: Tabelle/Punkte ###
############################

## FCB 09/10

tabelle <- function() {

# Hilfsvariablen Tabelle

punkte <- c(1,2,2,5,8,11,11,12,15,18,19,20,21,24,27,30,33,36,39,42,45,48,49,52,53,56,56,56,59,60,63,64,67,70)
platz <- c(10,11,14,8,5,3,7,8,6,5,6,8,7,4,4,3,3,3,2,2,2,2,2,1,1,1,1,2,1,1,1,1,1,1)
spieltag <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34)
yaxis <- seq(0,70,by=70/18)
yaxis <- yaxis[-1]

# Festlegen der Grösse
pushViewport(plotViewport(c(6,6,6,6)))
# Festlegen der Datengrösse
pushViewport(dataViewport(spieltag,1:70,name="tabelle"))

# Achsenbeschriftung

grid.xaxis(at=1:34,name="xachse")

grid.text("Spieltage",y=-0.15,gp=gpar(cex=1.2))
grid.text("FC Bayern 09/10",y=1,gp=gpar(cex=1.7))

grid.yaxis(name="links",at=round(yaxis),label=18:1,main=T)
grid.edit(gPath("links","ticks"),gp=gpar(col="red"))
grid.edit(gPath("links","labels"),gp=gpar(col="red",cex=1))
grid.text("Tabellenplatz",x=-0.09,rot=90,gp=gpar(cex=1.2,col="red"))

grid.yaxis(name="rechts",at=round(seq(1,70,by=3)),main=F)
grid.edit(gPath("rechts","ticks"),gp=gpar(col="blue"))
grid.edit(gPath("rechts","labels"),gp=gpar(col="blue",cex=1))
grid.text("Punkte",x=1.09,rot=270,gp=gpar(cex=1.2,col="blue"))

# Hilfsvariablen zum skalieren des Platzes auf Grösse der Tabelle
# Datenbereich ist 1:70, dh die 2. y achse muss eigens erstellt werden

platz <- c(10,11,14,8,5,3,7,8,6,5,6,8,7,4,4,3,3,3,2,2,2,2,2,1,1,1,1,2,1,1,1,1,1,1)
t1 <- seq(70,1,by=-(70/18))
platz2 <- seq(1:34)

# Plätze werden einzeln umgeschrieben auf vorher festgelegte grösse ( t1 )
# und in platz2 gespeichert

for ( i in 1:34 ) {
  j <- 1
    while(j<=18) {
    if(platz[i] == j )
      {
      platz2[i] <- t1[j]
      }
    j <- j+1
    }
  }
  
# Einzeichnen der Punkte und Linien

# points für Platzierung

grid.points(spieltag,platz2,name="platz",pch=20,size=unit(1,"native"),gp=gpar(col="red"))

# Punkte werden verbunden mit Schleifendurchlauf

i <- 1
while(i <= length(spieltag)-1) {
grid.lines(x=unit(c(spieltag[i],spieltag[i+1]),"native"),y=unit(c(platz2[i],platz2[i+1]),"native"),gp=gpar(lwd=1,col="black"))
i <- i +1
}

# points für Punkte

grid.points(x=spieltag,y=punkte,name="punkte",gp=gpar(col="blue"),size=unit(1,"native"),pch=20)

}

tabelle()


##################
### Ballbesitz ###
##################


ballbesitz <- function() {

# Hilfsvariablen
# ballbesitz in Prozent
ballbesitz <- c(0.672,0.722,0.59,0.77,0.787,0.704,0.655,0.542,0.502,0.61,0.721,0.566,0.597,0.735)
ergebnis <- c("2:1", "0:2", "0:0", "0:0", "2:1", "1:2","0:2","3:0","0:0","4:2","3:3","3:0","1:1","4:1")
## sieg = 1, ue = 2, niederlage = 3
ergebnis2 <- c(1,3,2,2,1,3,3,1,2,1,2,1,2,1)
farbe <- c("green","blue","red")

be <- seq(1,28,by=2)

# Festlegen der Grösse/Datenbereich

pushViewport(plotViewport(c(4,6,2,2)))
pushViewport(dataViewport(1:28,0:1,name="ballbesitz"))

# Achsen

grid.xaxis(at=seq(1,28,by=2),label=1:14)
grid.yaxis()

# Einzeichnen der Rects inc. Text
# Grösse je nach Ballbesitz
# ergebnis oben, ballbesitz gerundet in den rects

for(i in 1:14) {

grid.rect(x=unit(be[i],"native"),y=unit( ballbesitz[i] / 2,"native")
          ,height=unit(ballbesitz[i],"native"),width=unit(2,"native"),gp=gpar(fill="red"))
grid.rect(x=unit(be[i],"native"),y=unit( (1-ballbesitz[i])/2 + ballbesitz[i],"native")
          ,height=unit(1-ballbesitz[i],"native"),width=unit(2,"native"))
grid.text(round(ballbesitz[i],digits=2),x=unit(be[i],"native"),y=unit( ballbesitz[i] - 0.05,"native"))

grid.text(ergebnis[i],x=unit(be[i],"native"),y=unit( 1-0.05,"native"),gp=gpar(col=farbe[ergebnis2[i]],cex=1.2))

}

# Achsenbeschriftungen
# linie bei 50% zur besseren veranschaulichung

grid.lines(x=unit(c(0,28),"native"),y=unit(0.5,"native"))

# Achsenbeschriftungen
grid.text("FC Bayern 10/11 1. bis 14. Spieltag",y=1,gp=gpar(cex=1.7))
grid.text("Spieltage",y=-0.1,gp=gpar(cex=1.2))
grid.text("Ballbesitz",x=-0.12,rot=90,gp=gpar(cex=1.2))

}


ballbesitz()