d.frm <- data.frame(name=c("Max","Max","Max","Max","Max","Moritz","Moritz","Moritz")
,typ=c("rot","blau","grün","blau","grün","rot","rot","blau")
,anz=c(5,4,5,8,3,2,9,1) )
d.frm <- d.frm[ order(d.frm$name, -d.frm$anz),]
d.frm
Zusammenfassung wie summaryBy:
> as.data.frame( do.call("rbind", tapply( d.frm$anz, d.frm$name, summary )))
Min. 1st Qu. Median Mean 3rd Qu. Max.
Max 3 4.0 5 5 5.0 8
Moritz 1 1.5 2 4 5.5 9
Dienstag, 15. Dezember 2009
Dienstag, 17. November 2009
Windows Schriftarten verwenden
Windows Schriftarten müssen definiert werden, bevor sie genutzt werden können:
# Type family examples - creating new mappings
plot(1:10,1:10,type="n")
windowsFonts(
A=windowsFont("Arial Black"),
B=windowsFont("Bookman Old Style"),
C=windowsFont("Comic Sans MS"),
D=windowsFont("Symbol")
)
text(3,3,"Hello World Default")
text(4,4,family="A","Hello World from Arial Black")
text(5,5,family="B","Hello World from Bookman Old Style")
text(6,6,family="C","Hello World from Comic Sans MS")
text(7,7,family="D", "Hello World from Symbol")
# Type family examples - creating new mappings
plot(1:10,1:10,type="n")
windowsFonts(
A=windowsFont("Arial Black"),
B=windowsFont("Bookman Old Style"),
C=windowsFont("Comic Sans MS"),
D=windowsFont("Symbol")
)
text(3,3,"Hello World Default")
text(4,4,family="A","Hello World from Arial Black")
text(5,5,family="B","Hello World from Bookman Old Style")
text(6,6,family="C","Hello World from Comic Sans MS")
text(7,7,family="D", "Hello World from Symbol")
Donnerstag, 5. November 2009
Add a time axis
Adding a time scaled x-axis to a plot can be tedious...
# add a time axis
axis(side = 1, at =as.numeric(seq(as.Date("2000-01-01"), by = "year", length = 10))
, labels = format( seq(as.Date("2000-01-01"), by = "year", length = 10) , "%Y")
, cex.axis = 0.8, las = 1)
# plot the timegrid
# vertical gridlines according to chosen time-values
abline(v = seq(as.Date("2000-01-01"), by = "year", length = 10), col = "grey", lty = "dotted")
# where to plot the horizontal gridlines? get the coords by means of axTicks()
abline(h = axTicks(2), col = "grey", lty = "dotted")
# add a time axis
axis(side = 1, at =as.numeric(seq(as.Date("2000-01-01"), by = "year", length = 10))
, labels = format( seq(as.Date("2000-01-01"), by = "year", length = 10) , "%Y")
, cex.axis = 0.8, las = 1)
# plot the timegrid
# vertical gridlines according to chosen time-values
abline(v = seq(as.Date("2000-01-01"), by = "year", length = 10), col = "grey", lty = "dotted")
# where to plot the horizontal gridlines? get the coords by means of axTicks()
abline(h = axTicks(2), col = "grey", lty = "dotted")
Montag, 5. Oktober 2009
Dummy-Kodierung
Gesucht ist die Dummy-Kodierung eines Faktors:
d.frm <- data.frame(
name=c("Max","Max","Max","Max","Max","Moritz","Moritz","Moritz")
, typ=c("rot","blau","grün","blau","grün","rot","rot","blau")
, anz=c(5,4,5,8,3,2,9,1)
)
d.frm
name typ anz
1 Max rot 5
2 Max blau 4
3 Max grün 5
4 Max blau 8
5 Max grün 3
6 Moritz rot 2
7 Moritz rot 9
8 Moritz blau 1
Gewünschtes liefert
model.matrix(~d.frm$typ)[,-1]
d.frm$typgrün d.frm$typrot
1 0 1
2 0 0
3 1 0
4 0 0
5 1 0
6 0 1
7 0 1
8 0 0
oder alternativ die Funktion class.ind aus der library(nnet):
library(nnet)
class.ind( df$typ )
blau grün rot
[1,] 0 0 1
[2,] 1 0 0
[3,] 0 1 0
[4,] 1 0 0
[5,] 0 1 0
[6,] 0 0 1
[7,] 0 0 1
[8,] 1 0 0
Still another brilliant Ripley solution:
ff <- factor(sample(letters[1:5], 25, replace=TRUE))
diag(nlevels(ff))[ff,]
d.frm <- data.frame(
name=c("Max","Max","Max","Max","Max","Moritz","Moritz","Moritz")
, typ=c("rot","blau","grün","blau","grün","rot","rot","blau")
, anz=c(5,4,5,8,3,2,9,1)
)
d.frm
name typ anz
1 Max rot 5
2 Max blau 4
3 Max grün 5
4 Max blau 8
5 Max grün 3
6 Moritz rot 2
7 Moritz rot 9
8 Moritz blau 1
Gewünschtes liefert
model.matrix(~d.frm$typ)[,-1]
d.frm$typgrün d.frm$typrot
1 0 1
2 0 0
3 1 0
4 0 0
5 1 0
6 0 1
7 0 1
8 0 0
oder alternativ die Funktion class.ind aus der library(nnet):
library(nnet)
class.ind( df$typ )
blau grün rot
[1,] 0 0 1
[2,] 1 0 0
[3,] 0 1 0
[4,] 1 0 0
[5,] 0 1 0
[6,] 0 0 1
[7,] 0 0 1
[8,] 1 0 0
Still another brilliant Ripley solution:
ff <- factor(sample(letters[1:5], 25, replace=TRUE))
diag(nlevels(ff))[ff,]
Freitag, 21. August 2009
Read from/Write to clipboard
Daten lesen aus dem, resp. schreiben in das Clipboard ganz einfach:
d.x <- data.frame( x=c(1,2,3,3), y=c("A","B","A","A") )
write.table(d.x, file="clipboard", sep="\t", row.names=FALSE)
a <- read.table("clipboard", header=TRUE)
d.x <- data.frame( x=c(1,2,3,3), y=c("A","B","A","A") )
write.table(d.x, file="clipboard", sep="\t", row.names=FALSE)
a <- read.table("clipboard", header=TRUE)
Montag, 8. Juni 2009
Modell-Formelnotation
---------------------------------------------------------------------------------------------
Operator Bedeutung
----------------------------------------------------------------------------------------------
+... Hinzunahme einer Variablen
-... Herausnahme einer Variablen (-1 für Achsenabschnitt)
:... Wechselwirkung/Interaktion von Variablen
*... Hinzunahme von Variablen und deren Wechselwirkungen
/... hierarchisch untergeordnet ("nested").
.... y/z bedeutet: z hat nur Wirkung innerhalb der Stufen von y, aber nicht global.
^... alle Interaktionen bis zum angegebenen Grad
.... alle Variablen aus dem Datensatz in das Modell aufnehmen
I(). innerhalb von I() behalten arithmetische Operatoren ihre ursprüngliche Bedeutung
.... ("Inhibit interpretation")
----------------------------------------------------------------------------------------------
Bsp:
y ~ x1 * x2 * x3 - x1:x2:x3 # ohne 3-fach Interaktion
y ~ (x1 + x2 + x3)^2 # alle Variablen inkl. Interaktion bis zum 2. Grad
Operator Bedeutung
----------------------------------------------------------------------------------------------
+... Hinzunahme einer Variablen
-... Herausnahme einer Variablen (-1 für Achsenabschnitt)
:... Wechselwirkung/Interaktion von Variablen
*... Hinzunahme von Variablen und deren Wechselwirkungen
/... hierarchisch untergeordnet ("nested").
.... y/z bedeutet: z hat nur Wirkung innerhalb der Stufen von y, aber nicht global.
^... alle Interaktionen bis zum angegebenen Grad
.... alle Variablen aus dem Datensatz in das Modell aufnehmen
I(). innerhalb von I() behalten arithmetische Operatoren ihre ursprüngliche Bedeutung
.... ("Inhibit interpretation")
----------------------------------------------------------------------------------------------
Bsp:
y ~ x1 * x2 * x3 - x1:x2:x3 # ohne 3-fach Interaktion
y ~ (x1 + x2 + x3)^2 # alle Variablen inkl. Interaktion bis zum 2. Grad
Freitag, 29. Mai 2009
Kombinationen tabellieren
Ausgangslage ist ein data.frame mit einer Zeile pro Element und n Indikatorvariablen. Es stellt sich die Frage nach den Häufigkeiten der Kombinationen der Indikatorvariablen.
d.frm <- data.frame(name=c("Franz", "Maria", "Claudine")
, A=c(1,0,1), B=c(1,1,1), C=c(0,0,1), D=c(0,1,0))
Solution 1 (clumsy):
# Berechne die Summe der mit einer 2er-Potenz multiplizierten Indikatoren
d.frm$sum <- as.matrix(d.frm[,2:5]) %*% (2^(0:3))
# Erzeuge levels für eine Komb-Faktor
d.lvl <- expand.grid( c(0,"A"),c(0,"B"),c(0,"C"),c(0,"D") )
# Bilde eine neue Variable mit der Textbezeichnung der 2^n-Summe
d.frm$sum_x <- factor(d.frm$sum
, levels=((d.lvl!=0)*1) %*% (2^(0:3))
, labels=gsub( "0","", do.call( "paste", c( d.lvl, list(sep="") ))))
d.frm
......name A B C D sum sum_x
1 ...Franz 1 1 0 0 ..3 ...AB
2 ...Maria 0 1 0 1 .10 ...BD
3 Claudine 1 1 1 0 ..7 ..ABC
Solution 2 (smart):
d.frm$sum_xx <- apply( d.frm[,2:5], 1,
function(x) paste(LETTERS[1:4][as.logical(x)], collapse="") )
Wenn einfach nur die Kombinationen gesucht sind, gibt's dafür die Bordmittel:
> combn( letters[1:4], 2 )
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "a" "a" "a" "b" "b" "c"
[2,] "b" "c" "d" "c" "d" "d"
Oder auch interessant mit den Funktionen outer und lower.tri (pairwise):
m <- outer(x, x, paste, sep="-" )
m[!lower.tri(m, diag=TRUE) ]
[1] "a-b" "a-c" "b-c" "a-d" "b-d" "c-d"
Get all binary combinations
The idea is to get a vector with n 0s and n 1s, chop it into n parts of c(0,1) (this is a list), and use expand.grid:
n <- 4="4">->
expand.grid(split(rep(c(0,1), each=n), 1:n))
d.frm <- data.frame(name=c("Franz", "Maria", "Claudine")
, A=c(1,0,1), B=c(1,1,1), C=c(0,0,1), D=c(0,1,0))
Solution 1 (clumsy):
# Berechne die Summe der mit einer 2er-Potenz multiplizierten Indikatoren
d.frm$sum <- as.matrix(d.frm[,2:5]) %*% (2^(0:3))
# Erzeuge levels für eine Komb-Faktor
d.lvl <- expand.grid( c(0,"A"),c(0,"B"),c(0,"C"),c(0,"D") )
# Bilde eine neue Variable mit der Textbezeichnung der 2^n-Summe
d.frm$sum_x <- factor(d.frm$sum
, levels=((d.lvl!=0)*1) %*% (2^(0:3))
, labels=gsub( "0","", do.call( "paste", c( d.lvl, list(sep="") ))))
d.frm
......name A B C D sum sum_x
1 ...Franz 1 1 0 0 ..3 ...AB
2 ...Maria 0 1 0 1 .10 ...BD
3 Claudine 1 1 1 0 ..7 ..ABC
Solution 2 (smart):
d.frm$sum_xx <- apply( d.frm[,2:5], 1,
function(x) paste(LETTERS[1:4][as.logical(x)], collapse="") )
Wenn einfach nur die Kombinationen gesucht sind, gibt's dafür die Bordmittel:
> combn( letters[1:4], 2 )
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] "a" "a" "a" "b" "b" "c"
[2,] "b" "c" "d" "c" "d" "d"
Oder auch interessant mit den Funktionen outer und lower.tri (pairwise):
m <- outer(x, x, paste, sep="-" )
m[!lower.tri(m, diag=TRUE) ]
[1] "a-b" "a-c" "b-c" "a-d" "b-d" "c-d"
Get all binary combinations
The idea is to get a vector with n 0s and n 1s, chop it into n parts of c(0,1) (this is a list), and use expand.grid:
n <- 4="4">->
expand.grid(split(rep(c(0,1), each=n), 1:n))
Montag, 25. Mai 2009
Gruppenweise Auswertung
Erstaunlich umständlich ist die gruppenweise Selektion von bestimmten Elementen eines dataframes. Zum Beispiel soll gruppenweise das erste Element nach einer vorgegebenen Sortierung zurückgegeben werden:
d.frm <- data.frame(
name=c("Max","Max","Max","Max","Max","Moritz","Moritz","Moritz")
,typ=c("rot","blau","grün","blau","grün","rot","rot","blau")
,anz=c(5,4,5,8,3,2,9,1) )
d.frm <- d.frm[ order(d.frm$name, -d.frm$anz),]
d.frm
....name .typ anz
4 ...Max blau ..8
1 ...Max .rot ..5
3 ...Max grün ..5
2 ...Max blau ..4
5 ...Max grün ..3
7 Moritz .rot ..9
6 Moritz .rot ..2
8 Moritz blau ..1
d.frm[ tapply( rownames(d.frm), d.frm$name, head, n=1), ]
. ..name. typ.anz
4....Max.blau...8
7 Moritz..rot...9
Noch einfacher ist allerdings:
d.frm <- d.frm[ order(d.frm$name, -d.frm$anz),]
d.frm[ !duplicated(d.frm$name),]
Wenn der zweite Wert gesucht wäre, ginge dies mit der Index-Funktion "[":
d.frm[ tapply( rownames(d.frm), d.frm$name, "[", 2), ]
d.frm <- data.frame(
name=c("Max","Max","Max","Max","Max","Moritz","Moritz","Moritz")
,typ=c("rot","blau","grün","blau","grün","rot","rot","blau")
,anz=c(5,4,5,8,3,2,9,1) )
d.frm <- d.frm[ order(d.frm$name, -d.frm$anz),]
d.frm
....name .typ anz
4 ...Max blau ..8
1 ...Max .rot ..5
3 ...Max grün ..5
2 ...Max blau ..4
5 ...Max grün ..3
7 Moritz .rot ..9
6 Moritz .rot ..2
8 Moritz blau ..1
d.frm[ tapply( rownames(d.frm), d.frm$name, head, n=1), ]
. ..name. typ.anz
4....Max.blau...8
7 Moritz..rot...9
Noch einfacher ist allerdings:
d.frm <- d.frm[ order(d.frm$name, -d.frm$anz),]
d.frm[ !duplicated(d.frm$name),]
Wenn der zweite Wert gesucht wäre, ginge dies mit der Index-Funktion "[":
d.frm[ tapply( rownames(d.frm), d.frm$name, "[", 2), ]
Montag, 6. April 2009
Umorganisation von Daten
Daten, die pivotisiert vorliegen, können mit reshape (siehe auch stack/unstack) wieder in die Faktor-Form gebracht werden.
# Ausgangslage: Breite Form
> d.wide <- data.frame( age=c(22,34,28,31), gender_c=c("m","w","w","m"), ZH=c(12,33,2,5), BE=c(5,6,3,1))
> d.wide
.age gender_c ZH BE
1 22 ....m 12 .5
2 34 ....w 33 .6
3 28 ....w .2 .3
4 31 ....m .5 .1
# ...und die lange Form:
> d.long <- reshape( d.wide, varying=3:4, times=names(d.tmp)[-c(1:2)], v.names="count", direction="long")
> d.long
age gender_c time count id
1.ZH 22 m ZH 12 1
2.ZH 34 w ZH 33 2
3.ZH 28 w ZH 2 3
4.ZH 31 m ZH 5 4
1.BE 22 m BE 5 1
2.BE 34 w BE 6 2
3.BE 28 w BE 3 3
4.BE 31 m BE 1 4
... und wieder zurück:
wide <- reshape( d.long, idvar=c("age","gender_c","id"), timevar="time", direction="wide" )
wide
# Ausgangslage: Breite Form
> d.wide <- data.frame( age=c(22,34,28,31), gender_c=c("m","w","w","m"), ZH=c(12,33,2,5), BE=c(5,6,3,1))
> d.wide
.age gender_c ZH BE
1 22 ....m 12 .5
2 34 ....w 33 .6
3 28 ....w .2 .3
4 31 ....m .5 .1
# ...und die lange Form:
> d.long <- reshape( d.wide, varying=3:4, times=names(d.tmp)[-c(1:2)], v.names="count", direction="long")
> d.long
age gender_c time count id
1.ZH 22 m ZH 12 1
2.ZH 34 w ZH 33 2
3.ZH 28 w ZH 2 3
4.ZH 31 m ZH 5 4
1.BE 22 m BE 5 1
2.BE 34 w BE 6 2
3.BE 28 w BE 3 3
4.BE 31 m BE 1 4
... und wieder zurück:
wide <- reshape( d.long, idvar=c("age","gender_c","id"), timevar="time", direction="wide" )
wide
Sonntag, 15. Februar 2009
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,
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.
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))
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)
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
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 )
Dienstag, 20. Januar 2009
Zeichenfunktionen
nchar
Count the number of characters, also auch Länge eines Strings:
> nchar( c("Lorem", "ipsum") )
[1] 5 5
tolower/toupper
Gross-/Kleinschreibung
> tolower( LETTERS[1:8] )
[1] "a" "b" "c" "d" "e" "f" "g" "h"
> toupper( letters[1:8] )
[1] "A" "B" "C" "D" "E" "F" "G" "H"
match
Positionen (Index) von Elementen in einer Liste finden sich mit match.
> match(c("d","p"),letters)
[1] 4 16
grep
suchen von Ausdrücken in einem Vektor, retourniert die Indizes der Elemente, in denen der Ausdruck vorkommt
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> grep(pattern="A",x=x)
[1] 2
regexpr
suchen von Ausdrücken in einem Vektor, retourniert pro Element die ERSTE Position des Vorkommens (-1 für nicht vorhanden) und die Länge der Übereinstimmung
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> regexpr(pattern="i",text=x)
[1] 3 2 -1
attr(,"match.length")
[1] 1 1 -1
gregexpr
suchen von Ausdrücken in einem Vektor,
retourniert pro Element ALLE Positionen und die Länge der Übereinstimmung
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> gregexpr(pattern="i",text=x)
[[1]]
[1] 3
attr(,"match.length")
[1] 1
[[2]]
[1] 2 11
attr(,"match.length")
[1] 1 1
[[3]]
[1] -1
attr(,"match.length")
[1] -1
sub
Ersetzt das ERSTE Vorkommen von pattern in einer Zeichenkette
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> sub(pattern="i", replacement="III", x=x)
[1] "ThIIIs" " IIIs a Andri 1,2" " and 3 * test sentence"
gsub
Ersetzt ALLE Vorkommen von pattern in einer Zeichenkette
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> gsub(pattern="i", replacement="III", x=x)
[1] "ThIIIs" " IIIs a AndrIII 1,2" " and 3 * test sentence"
substr
Teile eines Strings extrahieren (oder ersetzen, letzteres aber besser mit (g)sub):
> substr( x="Lorem ipsum dolor sit amet", start=7, stop=500 )
[1] "ipsum dolor sit amet"
substr( x<-"Lorem ipsum dolor sit amet", start=nchar(x)-3, stop=nchar(x) )
left, right und mid
Die guten alten BASIC-Zeichen-Funktionen mit regular expressions in Funktionen umgesetzt:
left <- function(x, n) {
# x...string, n...Anzahl Zeichen
sub( pattern=paste(".{",nchar(x)-n,"}$", sep=""), replacement="", x=x)
}
right <- function(x, n) {
sub( pattern=paste("^.{",nchar(x)-n,"}", sep=""), replacement="", x=x)
}
mid <- function(x, pos, n) {
x <- sub( pattern=paste("^.{",pos-1,"}", sep=""), replacement="", x=x)
x <- sub( pattern=paste(".{",nchar(x)-n,"}$", sep=""), replacement="", x=x)
return(x)
}
trim
Leerzeichen vor und hinter dem Text entfernen
sub(" *([^ ]+) *", "\\1", x) does not work.. where had I that from?
gsub( pattern="^ +| +$", replacement="", x=" trim links und rechts ")
oder wenn auch Tabulatoren gelöscht werden sollen:
gsub( pattern="^[ \t]+|[ \t]+$", replacement="", x=" trim links und rechts ")
Beispiel
Alle Vektorelemente, die eine Zahl enthalten:
> x[1] "This" " is a Andri 1,2" " and 3 * test sentence"
> x[ as.matrix( regexpr(pattern="[[:digit:]]",text=x) )>0 ]
[1] " is a Andri 1,2" " and 3 * test sentence"
paste
Spaltenweises Verbinden von Spalten eines data.frames:
do.call("paste", c(data.frame(letters, LETTERS), list(sep="/")))
[1] "a/A" "b/B" "c/C" "d/D" "e/E" "f/F" "g/G" "h/H" "i/I" "j/J" "k/K" "l/L" "m/M" "n/N" "o/O" "p/P" "q/Q" "r/R"[19] "s/S" "t/T" "u/U" "v/V" "w/W" "x/X" "y/Y" "z/Z"
und warum nicht direkt (?): :-o
apply( data.frame(letters, LETTERS), 1, paste, collapse="/" )
und warum nicht nocht direkter (???): :-o :-o :-o
data.frame(letters, LETTERS, paste(letters, LETTERS, sep="/"))
Count the number of characters, also auch Länge eines Strings:
> nchar( c("Lorem", "ipsum") )
[1] 5 5
tolower/toupper
Gross-/Kleinschreibung
> tolower( LETTERS[1:8] )
[1] "a" "b" "c" "d" "e" "f" "g" "h"
> toupper( letters[1:8] )
[1] "A" "B" "C" "D" "E" "F" "G" "H"
match
Positionen (Index) von Elementen in einer Liste finden sich mit match.
> match(c("d","p"),letters)
[1] 4 16
grep
suchen von Ausdrücken in einem Vektor, retourniert die Indizes der Elemente, in denen der Ausdruck vorkommt
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> grep(pattern="A",x=x)
[1] 2
regexpr
suchen von Ausdrücken in einem Vektor, retourniert pro Element die ERSTE Position des Vorkommens (-1 für nicht vorhanden) und die Länge der Übereinstimmung
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> regexpr(pattern="i",text=x)
[1] 3 2 -1
attr(,"match.length")
[1] 1 1 -1
gregexpr
suchen von Ausdrücken in einem Vektor,
retourniert pro Element ALLE Positionen und die Länge der Übereinstimmung
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> gregexpr(pattern="i",text=x)
[[1]]
[1] 3
attr(,"match.length")
[1] 1
[[2]]
[1] 2 11
attr(,"match.length")
[1] 1 1
[[3]]
[1] -1
attr(,"match.length")
[1] -1
sub
Ersetzt das ERSTE Vorkommen von pattern in einer Zeichenkette
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> sub(pattern="i", replacement="III", x=x)
[1] "ThIIIs" " IIIs a Andri 1,2" " and 3 * test sentence"
gsub
Ersetzt ALLE Vorkommen von pattern in einer Zeichenkette
> x <- c("This"," is a Andri 1,2"," and 3 * test sentence")
> gsub(pattern="i", replacement="III", x=x)
[1] "ThIIIs" " IIIs a AndrIII 1,2" " and 3 * test sentence"
substr
Teile eines Strings extrahieren (oder ersetzen, letzteres aber besser mit (g)sub):
> substr( x="Lorem ipsum dolor sit amet", start=7, stop=500 )
[1] "ipsum dolor sit amet"
substr( x<-"Lorem ipsum dolor sit amet", start=nchar(x)-3, stop=nchar(x) )
left, right und mid
Die guten alten BASIC-Zeichen-Funktionen mit regular expressions in Funktionen umgesetzt:
left <- function(x, n) {
# x...string, n...Anzahl Zeichen
sub( pattern=paste(".{",nchar(x)-n,"}$", sep=""), replacement="", x=x)
}
right <- function(x, n) {
sub( pattern=paste("^.{",nchar(x)-n,"}", sep=""), replacement="", x=x)
}
mid <- function(x, pos, n) {
x <- sub( pattern=paste("^.{",pos-1,"}", sep=""), replacement="", x=x)
x <- sub( pattern=paste(".{",nchar(x)-n,"}$", sep=""), replacement="", x=x)
return(x)
}
trim
Leerzeichen vor und hinter dem Text entfernen
sub(" *([^ ]+) *", "\\1", x) does not work.. where had I that from?
gsub( pattern="^ +| +$", replacement="", x=" trim links und rechts ")
oder wenn auch Tabulatoren gelöscht werden sollen:
gsub( pattern="^[ \t]+|[ \t]+$", replacement="", x=" trim links und rechts ")
Beispiel
Alle Vektorelemente, die eine Zahl enthalten:
> x[1] "This" " is a Andri 1,2" " and 3 * test sentence"
> x[ as.matrix( regexpr(pattern="[[:digit:]]",text=x) )>0 ]
[1] " is a Andri 1,2" " and 3 * test sentence"
paste
Spaltenweises Verbinden von Spalten eines data.frames:
do.call("paste", c(data.frame(letters, LETTERS), list(sep="/")))
[1] "a/A" "b/B" "c/C" "d/D" "e/E" "f/F" "g/G" "h/H" "i/I" "j/J" "k/K" "l/L" "m/M" "n/N" "o/O" "p/P" "q/Q" "r/R"[19] "s/S" "t/T" "u/U" "v/V" "w/W" "x/X" "y/Y" "z/Z"
und warum nicht direkt (?): :-o
apply( data.frame(letters, LETTERS), 1, paste, collapse="/" )
und warum nicht nocht direkter (???): :-o :-o :-o
data.frame(letters, LETTERS, paste(letters, LETTERS, sep="/"))
Abonnieren
Posts (Atom)