Zum Inhalt springen

GNU R: Programmierbeispiele

Links hinzufügen
Aus Wikibooks


Diese Seite sammelt die Programmierbeispiele für das Kapitel Programmieren mit R.

Warnung!
Grundsätzlich sollten in R Skripte nicht ungeprüft verwendet werden, da R-Skripte u.U. zum Starten von Angriffen gegen den eigenen oder fremde Rechner verwendet werden können. Dies gilt für dieses Buch im Besonderen, da auf Wikibooks alle Artikel und somit auch die Skripte frei editierbar sind.

Beispiel 1: Abschlussnote

[Bearbeiten]

Eine (gedachte) Abschlussnote ergibt sich aus 3 Teilnoten. Hierbei fliessen die ersten 2 Noten zu 30% - und die dritte Note zu 40% in die Abschlussnote ein. Wir programmieren uns also eine nette kleine Funktion, die uns die Abschlussnote aus den Teilnoten errechnet. 

Abschlussnote <- function(x,y,z){     
   x.note <- (x/100)*30
   y.note <- (y/100)*30
   z.note <- (z/100)*40
   abschluss <- x.note + y.note + z.note
   cat ("Abschlussnote:", abschluss, "\n")
 }

Wir können die Funktion nun aufrufen per: Abschlussnote(x, y, z), wobei x, y, z durch die jeweiligen Teilnoten ersetzt werden, z.B. so: 

Abschlussnote(1.1, 1.7, 1.5)

Wir erhalten: 

Abschlussnote: 1.44

Beispiel 2: Cut-Off-Points

[Bearbeiten]

Bestimmung des Cut-Off-Points eines Assessmentinstruments anhand von Sensitivität und Spezifität.

Übergeben werden muss der Funktion:

  • ein Vektor x, welcher die einzelnen Summenwerte (des Assessmentinstruments) enthält
  • ein Vektor y, welcher für den entsprechenden Summenwert angibt, ob ein Risiko vorliegt (bzw. Ereignis eintraf) oder nicht (z.B. "0 und 1" oder "j und n").
  • der Parameter risk, welcher angibt, wodurch die positive Gruppe im Vektor y repräsentiert wird (s.o., z.B. "0 oder 1" bzw. "j oder n")
  • der Parameter dir, welcher anzeigt
    • ob ein höherer Summenwert (x) die Chance zur positiven Gruppenzugehörigkeit erhöht ( dir="GREATER" )
    • ob ein niedrigerer Summenwert (x) die Chance zur positiven Gruppenzugehörigkeit erhöht ( dir="LESS" )
  • der Parameter plot, welcher per TRUE / FALSE angibt, ob eine Graphik ausgegeben werden soll, oder nicht.


sens.spec <- function(x,y, risk=1, dir="LESS", plot=F) {
       
       frame <- data.frame(x,y)
       var.min <- min(na.omit(x))                                   # welches ist der niedrigste Wert?
       var.max <- max(na.omit(x))                                   # welches ist der höchste Wert?
       dummy <- var.min
       
       cat("\r")
       cat("Minimum of value: ", var.min, "\r")
       cat("Maximum of value: ", var.max, "\r", "\r")
       cat("Risk is coded with: ", risk, "\r")

       if (tolower(dir) %in% c("greater", "g")) {
               cat("greater value means higher risk", "\r", "\r")
               }

       if (tolower(dir) %in% c("less","l")) {
               cat("lesser value means higher risk", "\r", "\r")
               }

       sesp.table <- cbind(999, 999, 999, 999, 999, 999, 999)       # dient der Indizierung, wird später gelöscht (s.u.)
       while(dummy <= var.max) {
               ### true/false positive/negative
               if (tolower(dir) %in% c("less","l")) {
                       tp <- length(frame$x[frame$x<=dummy & frame$y==risk]) # true positive
                       fp <- length(frame$x[frame$x<=dummy & frame$y!=risk]) # false positive
                       tn <- length(frame$x[frame$x>dummy  & frame$y!=risk]) # true negative
                       fn <- length(frame$x[frame$x>dummy  & frame$y==risk]) # false negative
                       }
       
       
       
               if (tolower(dir) %in% c("greater", "g")) {
                       tp <- length(frame$x[frame$x>=dummy & frame$y==risk]) # true positive
                       fp <- length(frame$x[frame$x>=dummy & frame$y!=risk]) # false positive
                       tn <- length(frame$x[frame$x<dummy  & frame$y!=risk]) # true negative
                       fn <- length(frame$x[frame$x<dummy  & frame$y==risk]) # false negative
                       }
               
               sensi <- round((tp / (tp+fn)),digits=3)                       # Sensitivität
               speci <- round((tn / (tn+fp)),digits=3)                       # Spezifität
               sesp.table <- rbind(sesp.table, c(dummy, sensi, speci, tp,fp,tn,fn))
               dummy <- (dummy+1)
               }
       
       colnames(sesp.table) <- c("Value", "Sensitivy", "Specificy", "tp", "fp", "tn", "fn") 
       sesp.table <- sesp.table[-1,] # hier werden die "999" gelöscht
       
       if (plot==T) {
               plot.table <- cbind(sesp.table[,2], sesp.table[,3])
               plot(plot.table)
               }
       	
       if (plot==F) {
               print(sesp.table)
               cat("\r")
               cat("Cut-Off-Points include positive cases", "\r")
               cat("\r")
               }
       }
sens.spec(x, y)  # Aufruf der Funktion

Beispiel 3: Entfernen von Umlauten

[Bearbeiten]

Diese Funktion entfernt störende Umlaute 

noumlaute <- function(variable)
{
   ## ----------------------------------------------------------------------                                                                                            
   ## Funktion entfernt stoerende Umlaute, unten stehende Liste ggf. erweitern                                                                                          
   ## ----------------------------------------------------------------------                                                                                            
   variable <- gsub("ä","ae",variable)
   variable <- gsub("ü","ue",variable)
   variable <- gsub("ö","oe",variable)
   variable <- gsub("Ü","Ue",variable)
   variable <- gsub("Ä","Ae",variable)
   variable <- gsub("Ö","Oe",variable)
   variable <- gsub("ß","ss",variable)
   return(variable)
}

Beispiel 4: Zeit Sampler

[Bearbeiten]

Diese Funktion erzeugt eine randomisierte Liste von je einem aller Wochentagen im Monat September. 

randay<-function(name1, name2)#name1 und name2 sind nur labels fuer den Output 
{
 start.date <- strptime("2008/09/01","%Y/%m/%d")      # erzeugt das Startdaum, welches dem ersten Montag im Montag entspricht 
   end.date <- strptime("2008/09/30","%Y/%m/%d")      # erzeugt das Enddatum, welches hier immer gleich ist 
        MON <- seq(start.date, end.date, by="7 days") # erzeugt die Sequenz "vom Startdatum bis zum Enddatum, alle 7 Tage" 
 start.date <- strptime("2008/09/02","%Y/%m/%d")      # und legt das Ergebnis in einem Object ab.
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        TUE <- seq(start.date, end.date, by="7 days")
 start.date <- strptime("2008/09/03","%Y/%m/%d")
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        WED <- seq(start.date, end.date, by="7 days")
 start.date <- strptime("2008/09/04","%Y/%m/%d")
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        THU <- seq(start.date, end.date, by="7 days")
 start.date <- strptime("2008/09/05","%Y/%m/%d")
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        FRI <- seq(start.date, end.date, by="7 days")
 start.date <- strptime("2008/09/06","%Y/%m/%d")
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        SAT <- seq(start.date, end.date, by="7 days")
 start.date <- strptime("2008/09/07","%Y/%m/%d")
   end.date <- strptime("2008/09/30","%Y/%m/%d")
        SUN <- seq(start.date, end.date, by="7 days")
          a <- c(sample(MON,1),sample(TUE,1),sample(WED,1),sample(THU,1),sample(FRI,1),sample(SAT,1),sample(SUN,1)) # Sampling
          a <- sort(a)
  cat("Name 1:", name1, "Name 2:", name2, "\n", format(a, "%a %m/%d/%y"), "\n")}

siehe auch

[Bearbeiten]


Inhaltsverzeichnis

[Bearbeiten]

Abgerufen von „https://de.wikibooks.org/w/index.php?title=GNU_R:_Programmierbeispiele&oldid=956816“