## Erstellen eines ImageProfils mittels R ## Skript fuer R ## ## (c) Detlev Reymann 2008 ## detlev@reymann.eu ## Letzte Bearbeitung 07.09.2008 ############################################################### ## interaktive Ausgabe und Abfrage von Parametern: ## cat("\n"); cat("========================================================"); cat("\n"); cat("Anzeige eines Imageprofils\n"); cat("========================================================"); cat("\n"); cat("\n"); cat("Bitte geben Sie nachfolgend die Werte fuer die notwendigen Parameter ein.\n") cat("\n"); cat("\n"); cat("Bitte geben Sie nachfolgend den vollständigen Namen der Datei ein,\n"); cat("die die Daten enthält.\n"); cat("Bitte Gross- und Kleinschreibung beachten!\n"); cat("\n"); cat("Es wird eine Datei im csv-Format erwartet,\n"); cat("Feldtrenner: Semikolon, Dezimalzeichen: Komma.\n"); cat("\n"); DateiName <- readLines(stdin(), 1); ## Abfrage des kleinsten und des grössten Skalenbereiches: cat("Bitte den kleinsten Wert für die X-Achse eingeben: "); Minimum <- as.numeric(readLines(stdin(), 1)); cat("\n"); cat("Bitte den grössten Wert für die X-Achse eingeben: "); Maximum <- as.numeric(readLines(stdin(), 1)); cat("\n"); cat("Wenn Sie eine Linie z.B. für den eigenen Betrieb oder den\n"); cat("Mittelwert besonders hervorheben möchten, geben Sie bitte\n") cat("nachfolgend die Nummer in der Reihenfolge der Betriebe in der\n") cat("Datendatei ein; wenn keine Hervorhebung gewünscht ist, bitte\n"); cat("q eintippen"); cat("\n"); cat("Bitte Ihre Eingabe :"); Input <- readLines(stdin(), 1); Hervorhebung <- as.numeric(Input); if(Input == "q") { Hervorhebung <- -1 } ############################################################# ## Einige Hilfsrechnungen und Transformationen: Datenmatrix <- read.csv2(DateiName, header=TRUE, sep=";", na.strings="NA", dec=",", strip.white=FALSE, as.is=TRUE, check.names=FALSE); ## Datenmatrix enthält jetzt die gesamte Tabelle einschl der Betriebsnamen ## und der Variablennamen Datenmatrix2 <- read.csv2(DateiName, header=TRUE, sep=";", na.strings="NA", dec=",", strip.white=FALSE, as.is=TRUE, check.names=FALSE, skip=1); ## Datenmatrix enthält jetzt die gesamte Tabelle ab der Zeile 2 einschl der Betriebsnamen Daten <- read.csv2(DateiName, header=TRUE, sep=";", na.strings="NA", dec=",", strip.white=FALSE, as.is=TRUE, check.names=FALSE, skip=1); ## erste Spalte weglöschen Daten <- Daten[,-c(1)]; Namen <- read.csv2(DateiName, header=TRUE, sep=";", na.strings="NA", dec=",", strip.white=FALSE, as.is=TRUE, check.names=FALSE); ## wir benötigen nur die Namen der Betriebe aus der ersten Spalte i <- 2; while(NCOL(Namen) > 1) { Namen <- Namen[,-c(i)]; } Namen <- Namen[-c(1)]; ## Array mit den FragenLinks bzw den abgekuerzten FragenLinks aufbauen ## Der folgende Befehl liest die erste Zeile mit den Variablennamen ein ## Variable beginnen in Spalte 2: temp <- names(Datenmatrix); ## jetzt steht die erste Zeile in der Variablen temp FragenLinks <- temp[-c(1)]; ## jetzt ist der erste Eintrag weggelöscht. temp2 <- names(Datenmatrix2); ## jetzt steht die erste Zeile in der Variablen temp FragenRechts <- temp2[-c(1)]; ## jetzt ist der erste Eintrag weggelöscht. ############################################################# ## Jetzt abfragen, ob die Grafik am Bildschirm angezeigt werden soll oder ## als Grafik abgespeichert werden soll. ## Auswahl: png, eps, Bildschirm oder Ende Eingabe <- NA; while (TRUE) { cat("\n"); cat("Bitte geben Sie an, welche Ausgabe Sie für die Grafik möchten:\n"); cat("1 Grafik wird am Bildschirm angezeigt\n") cat("2 Grafik wird als png-Datei gespeichert\n") cat("3 Grafik wird als Postscript-Datei (ps) gespeichert\n") cat("4 Grafik wird als PDF-Datei (pdf) gespeichert\n") cat("=======================================================\n"); cat("q oder Q brechen die Ausgabe ab.\n") cat("Bitte Ihre Eingabe: "); Eingabe <- readLines(stdin(), 1); if (Eingabe == "2") png("ImageProfil.png") else if(Eingabe == "3") postscript("ImageProfil.ps") else if(Eingabe == "4") pdf("ImageProfil.pdf") else if(Eingabe == "q") break else if(Eingabe == "Q") break ############################################################### ## Jetzt die Grafik konfigurieren ## ## Äusserer Rand: par(oma=c(0, 0, 0, 0)); ## Schriftgrösse einstellen par(ps=14); ## Neues Fenster zur Anzeige der Grafik anlegen plot.new() ## Zuerst Breite des längsten Textes feststellen j <- 1; TextBreite <- 0; while(length(FragenLinks) > j) { if (strwidth(FragenLinks[j]) > TextBreite) { TextBreite <-strwidth(FragenLinks[j]) } j <- j+1; } j <- 1; while(length(FragenRechts) > j) { if (strwidth(FragenRechts[j]) > TextBreite) { TextBreite <-strwidth(FragenRechts[j]) } j <- j+1; } ## bei längeren oder deutlich kürzeren Texten ## den Multiplikationsfaktor ggf anpassen!! TextBreite <- 30*TextBreite; ## Bei Ausgabe in Postscript-Datei Schriftgrösse ändern if(Eingabe =="3") { TextBreite <- 2*TextBreite; } ## Bereich für das Zeichnen der Grafik festlegen ## Der Text gehört nicht zur Grafik! ## bottom, left, top, right par(mar=c(0.5, TextBreite, 0.5, TextBreite)) ## X-Achsengrösse entsprechnd der eigegebenen Parameter für Minimum und Maximum ## Y-Achsengrösse entsprechnd der Anzahl der FragenLinks und ## der Legendenhöhe ## ylim(c(0 ohne Legende ## Drei Betriebsnamen kommen jeweils in die Zeile der Legende ## auf ganzzahlig gerundet Zeilenhoehe <- 0.66 Legendenhoehe <- -((NROW(Namen)%%3)+1)*Zeilenhoehe; plot.window(xlim=c(Minimum, Maximum), ylim=c(Legendenhoehe, length(FragenLinks))) ## Markierungen der X-Achse setzen ## Erster Wert: Kleinster Wert, ## Zweiter Wert: Groesster Wert, ## Dritter Wert: Intervall für Markierungen auf der X-Achse ticks <- seq(Minimum, Maximum, 1); ## Y-Achse konfigurieren ## Zuerst die Höhe y <- 1:length(FragenLinks); ## gepunktete Linie für jede Frage zeichnen segments(Minimum, y, Maximum, y, lty="dotted") ## Für jede Frage die Werte eintragen Symbol <- 1; Farbe <- 2; ## Da schwarz zum Zeichnen der Grundlinien benutzt wird par(pch=Symbol, col=Farbe); ## Wertepunkte setzen ## Diese müssen einzeln gesetzt werden, da ansonsten X-Achsenorientiert! Reihe <- 1; ## Reihe entspricht Datensatz für einen Betrieb while(Reihe <= NROW(Daten)) { if (Hervorhebung == Reihe) par(lwd=3, lty="dashed") else par(lwd=1, lty=1); ## Symbole und Linien für einen Betrieb zeichnen Spalte <- 1; Wert <- 0; WertZuvor <- 0; while(Spalte <= NCOL(Daten)) { Wert <- Daten[Reihe,Spalte]; points(Wert, Spalte); if(Spalte > 1) { ## mit Linien verbinden lines(c(WertZuvor, Wert), c(Spalte-1, Spalte)); } Spalte <- Spalte+1; WertZuvor <- Wert; } Symbol <- Symbol+1; Farbe <- Farbe +1; par(pch=Symbol, col=Farbe); ## Ende jeweils ein Betrieb Reihe <- Reihe +1; } ## Farben zurücksetzen par(pch=1, col=1, lty=1, lwd=1); ## Linie für den Neutralwert zeichnen Neutralwert <- (Maximum + Minimum)/2; lines(c(Neutralwert, Neutralwert), c(1, NCOL(Daten))); ## Farben zurücksetzen par(pch=1, col=1, lty=1, lwd=1); ## Den Text der FragenLinks an der linken Seite ausgeben mtext(FragenLinks, at=y, adj=1, side=2, las=2) ## Den Text der FragenRechts an der rechten Seite ausgeben mtext(FragenRechts, at=y, adj=0, side=4, las=2) ## Die X-Achse zeichnen par(cex.axis=0.5, mex=0.5) axis(1, at=ticks, labels=abs(ticks), pos=0.5) ########################################### ## Legende ## Das ist wirklich nur ein schneller "Hack" ## Muss noch verbessert werden! ########################################### if (Eingabe == "2") par(ps=6) else par(ps=8); Betrieb <- 1; Spalte <- 1; ## Da wir ausserhalb des Grafikbereiches drucken, ## müssen wir negativ von unten zählen: if (NROW(Daten) < 7) Zeile <- -3 else Zeile <- -4; ## Reihe entspricht Datensatz für einen Betrieb Symbol <- 1; Farbe <- 2; par(col=Farbe); while(Betrieb <= NROW(Daten)) { mtext( Namen[Betrieb], side= 1, outer=TRUE, li= Zeile, adj= 0.025 + (Spalte-1)*0.4); Betrieb <- Betrieb + 1; Spalte <- Spalte +1; Symbol <- Symbol+1; Farbe <- Farbe +1; par(pch=Symbol, col=Farbe); if(Spalte == 4) { Spalte = 1; Zeile <- Zeile + 1; } } ## Improvisierte Trennlinie ## 3 = Postscript if(Eingabe == "3") Zeile = -6 ## 2 = PNG else if (Eingabe == "2") Zeile = -7 else Zeile = -6 if (NROW(Daten) < 7) Zeile <- Zeile +1 ## Farben zurücksetzen par(ps=24, pch=1, col=1, lty=1, lwd=1); mtext( "_____________________________________________________________________________", side= 1, outer=TRUE, li= Zeile, adj= 0.05); ## Gerät für die Grafikausgabe schliessen if(Eingabe == 2) dev.off(); if(Eingabe == 3) dev.off(); if(Eingabe == 4) dev.off(); } ## Ende der Schleife zur Abfrage der Ausgabeform