Ränder-Problematik

Einstellungen für Ränder in Grafiken für: mar, mai, mgp, omi, oma.
mar=c(5,4,4,2)+0.1 gleich mar=c(u,li,o,re)+0.1,

mai=c(u,li,o,re) Angabe in inch,

mgp=c(3,1,0) gleich c(Titel, Label, Achse) in mex-Einheiten,

omi=c(0,0,0,0) gleich omi=c(u,li,o,re),

oma=c(0,0,0,0) gleich oma=c(u,li,o,re) in Textzeileneinheiten.

Quelle: http://www.geo.fu-berlin.de/geol/fachrichtungen/pal/mitarbeiter/plank/formeln_in_R.pdf

Gauss-Test

Beispiel
Das Gewicht von Briefumschlägen für Luftpost kann als normalverteilt angesehen werden, wobei das mittlere Gewicht weniger als 2 g betragen soll. Die Standardabweichung ist erfahrungsgemäss s=0.02 g. Ein Hersteller entnimmt der Produktion 100 Umschläge und stellt den Mittelwert mw_sp=1.98 g fest.

# Gausstest
n <- 100 # Anzahl Umschläge
MW <- 2 # Mittelwert der Grundgesamtheit
SD <- 0.02 # Standardabweichung der Grundgesamtheit
mw <- 1.98 # Mittelwert der Stichprobe
se <- SD/sqrt(n) # Standardfehler des Mittelwerts
alpha <- 0.05 # Signifikanzniveau

# Quantile der normalverteilung
qnorm(alpha/2, mean=MW, sd=se)
# p-Wert des zweiseitigen Gauss-Testes
2*min(pnorm(mw, mean=MW, sd=se), 1-pnorm(mw, mean=MW, sd=se))

Binomialtest

Beispiel
Jack Player wurde in einem Saloon in Texas erschossen, nachdem er beim Würfelspiel mit seinem Würfel in 60 Würfen 21mal die Sechs gewürfelt hatte und deshalb des Falschspiels bezichtigt wurde. War der Vorwurf seines (jähzornigen) Mitspielers berechtigt?
Man prüfe die Sachlage mit einem Binomialtest!

# Definition der Parameter
p <- 1/6
n <- 60
k <- 21
alpha <- 0.05

# Berechnung BinomialTest
binom.test(k, n, p, "greater")

dens <- dbinom(0:n, n, p)   # Berechnung der binomialen Dichte-Funktion
cols <- c(rep("lightgreen", green <- sum(cumsum(dens) < (1-alpha))), rep("red", n-green+1))

# Zeichnen des Säulen-Diagramms
plot(x=0:n, y=dens, col=cols, main="Tod eines Spielers",
     xlab="k", ylab="B(k,n,p)", las=1,
     cex.axis=0.8, type="h", lwd=3)

# ... und noch eine Textbemerkung
text(20, 0.08, "Binomialverteilung mit p=1/6, n=60", pos=4)

Kombiniertes Säulen-Linien-Diagramm

Ein etwas aufwendigeres Verfahren anhand eines Klimadiagramms:

# get some data
d.temp <- data.frame(
  month=c("Jan","Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
  ,nieder_96=c(9, 50, 41, 49, 141, 99, 161, 119, 52, 115, 123, 70)
  ,nieder_mittel=c(67, 65, 67, 85, 103, 135, 136, 130, 101, 81, 74, 76)
  ,temp_96=c(-1.9, -2.1, 3.8, 9.3, 11.8, 17.1, 17.3, 16.8, 10.2, 9.8, 5.4, 0.5)
  ,temp_mittel=c(-1, 0, 4.5, 7.3, 11.9, 15, 16.5, 15.5, 13.9, 8.1, 3.7, 0.2)
)

# define a few colors
hellblau <- rgb(red=204,green=255,blue=255, max=255)
dunkelblau <- rgb(red=51,green=204,blue=204, max=255)
dunkelgrau <- rgb(red=128,green=128,blue=128, max=255)
mittelgrau <- rgb(red=192,green=192,blue=192, max=255)
hellgrau <- rgb(red=227,green=227,blue=227, max=255)

# set the parameters
windows(width=7.2, height=5.5)
par(mar=c(5.1,4.1,7.1,16.1)) # set margins, default: c( 5.1, 4.1, 4.1, 2.1 )
par(bg=mittelgrau) # background color

# start plotting, we use barplot as basis
b <- barplot( t(d.temp[,c("nieder_mittel","nieder_96")])
  , col=c(dunkelgrau, hellblau)
  , beside=TRUE , xlab="Monate", cex.lab=0.8, mgp=c(2.2,0.7,0)
  , space=rep( c(0.3,-0.5), 12) # bars should overlap 50%
  , ylim=c(0,500), yaxt="n"
  , panel.first = {
      par(xpd=FALSE) # barplot paints over the whole figure region by default
      usr <- par("usr") # set background color lightgrey
      rect(xleft=usr[1], ybottom=usr[3], xright=usr[2], ytop=usr[4], col=hellgrau)
     grid(nx=NA, ny=10, col="white", lty="solid") # horiz grid only
     box()
     }
)

# find the centers of the bars and the gaps
barx <- apply(b, 2, FUN=mean)
run.mean <- filter( barx, filter=c(0.5,0.5))[-length(barx)]
gapx <- c(run.mean[1]-diff(barx)[1], run.mean, run.mean+diff(barx) )


# draw the vertikal gridlines
abline(v=gapx, col="white" )
box()

# design x-axis
axis(side=1, at=apply(b,2,FUN=mean), labels=d.temp$month, cex.axis=0.7
  , las=2, tck=-0.025  # no tickmarks for the x-axis
  , mgp=c(2.2,0.7,0) ) # decrease distance label to axis

# left y-axis
axis(side=2, at=seq(0,500,50), las=2, cex.axis=0.7)
rug( seq(0,500,10), side=2, ticksize=-0.01)
rug( seq(0,500,50), side=2, ticksize= 0.01)

# plot lines
par(new=TRUE)
matplot( x=barx, y=d.temp[,c("temp_96","temp_mittel")], col=c(dunkelblau,"grey60")
  , lwd=2, lty="solid", type="l", xaxt="n", yaxt="n", xlab="", ylab=""
  , xlim=par("usr")[1:2] # use the current xlim
  , ylim=c(-25, 25), xaxs="i", yaxs="i")

# design right axis
axis(side=4, labels=seq(-25,25,5), at=seq(-25,25,5), las=2, cex.axis=0.7)
rug( seq(-25,25,1), side=4, ticksize=-0.01)
rug( seq(-25,25,5), side=4, ticksize=0.01)

# write titles
mtext(text=c("Lufttemperatur [°C]","Niederschlag [mm]"), side=3, at=c(25,-3.2), adj=c(1,0)
  , las=1, line=1, cex=0.8 )
mtext(text="Klimadiagramm Zürich-SMA\n556 m. ü. M.", cex=1.2, font=2, side=3, line=3)

# plot legend
legend( x=30, y=27, xpd=TRUE
  , legend=c("Niederschlag 1996", "Niederschlag:\nlangjähriges Mittel", "Temperatur 1996", "Temperatur:\nlangjähriges Mittel" )
  , cex=0.7, bty="n", col=c(hellblau, dunkelgrau, dunkelblau, "black")
  , y.intersp=2.5, pt.cex=1.2, pch=c(15,15,45,45))

mtext("© Statistisches Amt des Kantons Zürich", side=1, line=3.5, at=-4, cex=0.7, las=1, adj=0)
mtext("Quelle: Schweizerische Meteorologische Anstalt (SMA)", side=1, line=3.5, at=41, cex=0.7, las=1, adj=1)

Plot-Zeichen

Was war das schon wieder für ein Zeichen?

parold <- par( mex=0.001, xaxt="n", yaxt="n", ann=F) # save graph sets
plot( x=1:25, y=rep(1,25), pch=1:25, cex=3, xlab="", ylab="", frame.plot=FALSE)
text( x=1:25, y=rep(0.8,25), labels=1:25 )
par(parold) # reset graph sets

Farben

Wie hiess doch schon wieder diese Farbe?

farben <- c( colors(), rep(NA,3) ) # 657 Farben um 3 NULL-Werte erweitern
zeilen <- 44; spalten <- 15 # 660 Farben
farben.zahlen <- matrix( 1:spalten ,nrow=zeilen, ncol=spalten, byrow=T ) # Matrix für Punkte

paralt <- par( mex=0.001, xaxt="n", yaxt="n", ann=F) # Grafikeinstellungen speichern
x_offset <- 0.5
x <- farben.zahlen[,1:spalten] # x-Werte (Zahlen)
y <- -rep(1:zeilen, spalten) # y-Werte (Zahlen)

plot( x, y
, pch=22 # Punkttyp Rechteck
, cex=3 # Vergrösserung Punkte
, bg=farben # Hintergrundfarben
, bty="n" # keine Box
, xlim=c(1,spalten+x_offset) # x-Wertebereich
)
text( x+0.1, y, farben, adj=0, cex=0.8 ) # Text Farben dazu

par(paralt) # Grafikeinstellungen zurücksetzen

Säulendiagramm mit gestapelten und überlappenden Säulen

# Prepare and organize some data
d.blue <- data.frame( grp1=c(5,4,3,5), grp2=c(3,3,2,1) )
rownames(d.blue) <- c( "t1","t2","t3","t4" )
set.seed(181)
d.red <- d.blue * runif(n=5)

# Barplot expects matrix instead of data.frame
m.blue <- t( as.matrix( d.blue ) )
m.red <- t( as.matrix( d.red ) )

# We need a function to prepare background of the barplot
mygrid <- function(){
  par(xpd=FALSE)     # barplot paints over the whole figure region by default  
  rect(xleft=-1, xright=199  # set background white, when bg has another col
  , ybottom=-99, ytop=99, col="white")
  grid(nx=NA, ny=NULL)       # horiz grid only
  par(xpd=TRUE)
  box()
}

# Set parameters
osp <- 0.5 # overlapping part in %
sp <- 1 # spacing between the bars
par( bg="grey90")            # set outer background

nbars <- dim(m.blue)[2]   # how many bars do we have?

# Create first barplot
b <- barplot( m.blue, col=c("lightblue","blue")
  , beside=FALSE, ylim=c(0,10)
  , axisnames=FALSE
  , main="My main title"
  , xlim=c(0, nbars*2-osp )      # enlarge x-Axis
  , space=c(0, rep(sp,nbars-1) ) # set spacing=1, starting with 0
  , panel.first=mygrid())

# Draw the red series
barplot( m.red, col=c("salmon","red"), beside=FALSE
  , space=c(1-osp, rep(1, nbars-1)) # shift to right by 1-osp
  , axisnames=FALSE, add=TRUE)

# Create axis separately, such that labels can be shifted to the left
axis(1, at=b+(1-osp)/2, labels=FALSE, tick=FALSE, las=1)

# Now draw the rotated textual axis labels
text( b+(1-osp)/2, par("usr")[3] - 0.2
  , labels = rownames(d.blue), srt = 45, pos = 1, xpd = TRUE)


# Add some other rotated text
text( x=b, y=1, labels="some text", srt=45 )

# Add legend
legend("topright", inset=0.05, bg="ivory1", cex=0.8
  , legend=c("A-grp 1","A-grp 2","B-gpr 1", "B-grp 2")
  , col=c("lightblue","blue","salmon","red"), pch=15, pt.cex=1.5
  , y.intersp=1.2, x.intersp=1 , ncol=2 )