1. Worum geht es?
Naja, ums Schreiben von Funktionen in der Programmiersprache R.
1.1. Was sind Funktionen?
-
Funktionen sind Programmkonstrukte, mit denen Du Teile des von Dir geschriebenen Codes wiederverwenden kannst (siehe Wikipedia).
-
Funktionen sind in den Standardbibliotheken jeder Programmiersprache vorhanden, viele R-Funktionen kennst Du wahrscheinlich schon:
sum()
,mean()
odersummary()
.
1.2. Warum Funktionen?
-
Damit Du Teile des von Dir geschriebenen Codes wiederverwenden kannst.
-
Damit Du, wenn Du Fehler im Code entdeckst, diese auch nur an einer Stelle korrigieren musst.
1.3. Wann Funktionen?
Immer wenn Du merkst, dass Du (alten) Code mehrfach kopierst und an anderer Stelle einfügst ohne ihn stark zu verändern, solltest Du darüber nachdenken, eine (oder mehrere) Funktion(en) aus ihm zu machen.
2. Eine Funktion schreiben
2.1. Eine neue Summenfunktion
Eine Summenfunktion gibt es wahrscheinlich in jeder Programmiersprache, in R
heißt sie sum()
. Diese Funktion ist besser, stabiler und schneller, als
alles, das wir selbst programmieren können.
Nunja, irgendwelchen Code müssen wir ja nehmen. Ich habe die Summenberechnung ausführlich als Beispiel zur Schleifenprogrammierung in Programmieren in R benutzt, und eine Wiederholung schadet sicher nicht.
2.1.1. Vom Code …
a <- c(2, 3, 4, 10) # <1> value <- 0 # <2> for (a_i in a) { # <3> value <- value + a_i # <4> } print(value) # <5>
## [1] 19
Dabei siehst Du:
-
Definition des zu summierenden Vektors
-
Definition des zur Addition neutralen Elementes
-
Schleife über die Elemente des Vektors
-
Addition des aktuellen Vektorelementes zum Ergebnis
-
Ausgabe des Ergebnisses
2.1.2. … zur Funktion
Für meine Summenfunktion will ich die Definition des zu summierenden Vektors
der Anwenderin überlassen (alles andere wäre auch sehr seltsam, wer braucht eine Funktion,
die immer die Zahl 19 ausgibt?),
daher wird der Vektor zu einem Argument der Funktion.
Ich wähle als Namen für das Argument jetzt x
(das könnte aber
auch a
bleiben, das ist eine Frage der Konvention, und unter x
verstehen wir
meist eine Unbekannte). Und als Ausgabe verwende ich keine Druck- sondern eine
Rückgabefunktion (return()
statt print()
).
Das Ergebnis sieht dann so aus:
my_sum <- function(x) {
value <- 0
for (x_i in x) {
value <- value + x_i
}
return(value)
}
Dabei habe ich mehrere Dinge getan, beispielsweise einen ziemlich miesen Namen für meine Funktion gewählt. Im Wesentlichen aber habe ich:
-
entschieden, welchen Code die Funktion enthält,
-
welche Zuweisung zu einem Funktionsargument wird und
-
was die Funktion zurückgibt.
2.2. Scoping
Programmiersprachen kennen für Objekte unterschiedliche Gültigkeitsbereiche (englisch "scope"), wir sehen uns das am Beispiel an:
2.2.1. Schreibzugriffe
Im Augenblick hat das Objekte value
den Wert 19:
print(value)
## [1] 19
Jetzt wenden wir unsere Summenfunktion an und berechnen die Summe eines anderen Vektors:
print(my_sum(1:3))
## [1] 6
Das Objekt value
behält seinen Wert:
print(value)
## [1] 19
Und das, obwohl wir innerhalb der Funktion dem Objekt value
in der ersten
Zeile den Wert 0 zuweisen und diesen dann in der Schleife mit den Werten 1, 3
und 6 überschreiben:
R verwaltet automatisch die Gültigkeitsbereiche aller Objekte.
Es gibt daher ein Objekt names value
außerhalb der Funktion, das den Wert 19 enthält und unverändert bleibt.
Innerhalb der Funktion legt R ein neues lokales Objekt, ebenfalls mit dem Namen
value
, an.
Du kannst auch aus einer Funktion in einen anderen Gültigkeitsbereich schreiben, wenn Du das wirklich willst.
2.2.2. Lesezugriffe
Mit dem Namen eines Objektes wird dieses gelesen. Innerhalb einer Funktion sucht R zunächst nach einem lokalen Objekt des gesuchten Namens, dann in den der Funktion übergeordneten Gültigkeitsbereichen, also außerhalb der Funktion.
Das kann zu unerwünschten Nebeneffekten führen. Stell Dir vor, Du kommentierst beim Schreiben der Summenfunktion die Definition des zur Addition neutralen Elementes aus Versehen aus:
my_sum_broken <- function(x) { # FIXME: this is accidentally commented out: # value <- 0 for (x_i in x) { value <- value + x_i } return(value) }
Du führst die Funktion aus und erhältst:
print(my_sum_broken(1:3))
## [1] 25
Was ist passiert?
Im ersten Durchlauf der Schleife gibt es beim Lesen von
value
noch kein lokales Objekt dieses Namens. Daher sucht R außerhalb der
Funktion und findet ein Objekt mit dem Wert 19.
Zu diesem Objekt addieren
wir x_i
, das im ersten Schleifendurchlauf den Wert 1
enthält und erschaffen
damit in der Funktion ein lokales Objekt names value
, das dann im zweiten
Durchlauf der Schleife auch gelesen werden kann.
Wenn Du diese Funktion verwendest, ohne vorher das Objekt value
zu definieren,
oder das Objekt value
entfernst und dann die Funktion ausführst
rm(value) print(my_sum_broken(1:3))
## Error in my_sum_broken(1:3): object 'value' not found
erhälst Du einen Fehler, weil R auch außerhalb der Funktion kein Objekt
names value
finden kann. Und diesen Fehler erwarten wir ja eigentlich, wenn
wir nur die Funktion betrachten: sie ist fehlerhaft.
Wie wir eine Funktion dazu bringen können, außerhalb ihres Gültigkeitsbereiches zu schreiben (nein, das wie habe ich Dir noch nicht gezeigt), so können wir eine Funktion auch zwingen, beim Lesen nur nach lokalen Objekten zu suchen:
my_sum_safer <- function(x) { for (x_i in x) { value <- get("value", inherits = FALSE) + x_i } return(value) }
Selbst wenn wir ein Objekt namens value
anlegen, gibt die Funktion nun einen
Fehler aus:
value <- 42 my_sum_safer(1:10)
## Error in get("value", inherits = FALSE): object 'value' not found
Ich finde es aber praktikabler, beim Schreiben einer Funktion darauf zu achten,
welche Objekte ich lese.
Und wenn Du Funktionen testest, findest Du Fehler, die auf Scoping beruhen,
sehr schnell.
2.2.3. Arbeiten mit Gültigkeitsbereichen
Ein Befehl, mit dem Du alle Objekte Deines aktuellen Arbeitsbereiches löschen kannst (entsprechend dem RStudio-Knopf mit dem Besensymbol [1]), lautet:
rm(list = ls(all.names = TRUE))
Nun bin ich
vergesslich, weshalb ich mir die Syntax schlecht merken kann und lieber eine
Funktion (aber keinen Knopf) hätte.
Da "der aktuelle Arbeitsbereich" ein Gültigkeitsbereich
(in R heißen die Gültigkeitsbereiche "environments", in S hießen sie "frames") ist und die
Funktionen ls
und rm
nur in einem Gültigkeitsbereich arbeiten, funktioniert das naheliegende
wipe_clean <- function() { rm(list = ls(all.names = TRUE)) }
nicht:
wipe_clean(); ls()
## [1] "a" "a_i" "my_sum" "my_sum_broken"
## [5] "my_sum_safer" "value" "wipe_clean"
Wenn ich den Gültigkeitsbereich explizit
wipe_clean <- function() { rm(list = ls(name = parent.frame(), all.names = TRUE), envir = parent.frame()) }
angebe, tut die Funktion, was ich wollte:
wipe_clean(); ls()
## character(0)
2.3. Argumente
Funktionen kennen Argumente, am besten nicht zu viele (siehe zum Beispiel [cc]). Unsere Summenfunktion kennt beispielsweise eines, nämlich den Vektor, den sie summieren soll. Der ist also ein obligatorisches Element, er sollte keine Voreinstellung haben (und hat auch keine).
Eine Funktion, die, wie wipe_clean
, kein Argument kennt, ist Folgende:
memory_hogs <- function() { z <- sapply(ls(envir = parent.frame()), function(x) object.size(get(x, envir = parent.frame()))) return(z) }
Diese Funktion gibt mir für jedes Objekt des Gültigkeitsbereiches, in dem ich sie aufrufe, den Speicherverbrauch aus.
va <- rep(mtcars, 1) vb <- rep(mtcars, 1000) vc <- rep(mtcars, 2000) vd <- rep(mtcars, 100) memory_hogs()
## memory_hogs va vb vc vd
## 7896 4424 3520824 7040824 352824
Bei so wenigen Objekten erkenne ich leicht, dass vc
der größte Speicherfresser ist und ich, falls mir der Speicher platzt und ich vc
nicht mehr unbedingt brauche, vc
löschen sollte.
Aber wenn ich viele Objekte habe, wäre es doch schön, ein optionales Funktionsargument zu haben, das in seiner Voreinstellung die Ausgabe nach Größe des Speicherbedarfs sortiert:
memory_hogs <- function(order = TRUE) {
z <- sapply(ls(envir = parent.frame()),
function(x) object.size(get(x, envir = parent.frame())))
if (isTRUE(order)) z <- z[order(z)]
return(z)
}
memory_hogs()
## va memory_hogs vd vb vc
## 4424 10120 352824 3520824 7040824
Das ist ein klassisches (optionales) Steuerargument, das das Verhalten einer Funktion steuert. Steuerargumente sollten eine sinnvolle Voreinstellung haben.
Da die memory_hogs
intern nun die Funktion order
aufruft, könnten wir ja auf die Idee kommen, dieser Funktion Argumente weiterreichen zu wollen.
Das können wir entweder explizit tun, oder wir benutzen ein spezielles, Ellipsis genanntes Argument, das durch drei Punkte (...
) aufgerufen wird:
memory_hogs <- function(...) {
z <- sapply(ls(envir = parent.frame()),
function(x) object.size(get(x, envir = parent.frame())))
if (! missing(...)) {
z <- z[order(z, ...)]
}
return(z)
}
memory_hogs()
## memory_hogs va vb vc vd
## 13624 4424 3520824 7040824 352824
memory_hogs(decreasing = TRUE)
## vc vb vd memory_hogs va
## 7040824 3520824 352824 50624 4424
Jetzt können wir die Rückgabe unserer Funktion nutzen, um die beiden größten Speicherfresser zu löschen:
rm(list = names(memory_hogs(decreasing = TRUE)[1:2])) memory_hogs()
## memory_hogs va vd
## 50624 4424 352824
Wir können also, wenn wir wollen, drei Arten von Argumenten unterscheiden:
-
Obligatorische. Sie kennen keine Voreinstellungen und übergeben üblicherweise Objekte, die von der Funktion verarbeitet werden sollen. Der zu summierende Vektor
x
inmy_sum
ist ein klassisches Beispiel: ein Voreinstellung für die zu summiernden Zahlen (etwax = c(40, 2)
) ist unsinnig. -
Optionale. Sie haben Voreinstellungen und dienen üblicherweise der Steuerung der Funktion. Das Argument
order
inmemory_hogs
ist ein klassisches Beispiel: in der Voreinstellung wird die Ausgabe nach Speicherverbrauch sortiert. -
Die Ellipsis, um Argumente an andere Funktionen weiterzureichen.
2.4. Return Value und Side Effects
Jede Funktion in R gibt einen Wert zurück, falls sie nicht mit einem Fehler abbricht.
Wenn wir keinen Rückgabewert (return value) explizit angeben, ist er automatisch der Wert des letzten in der Funktion ausgewerteten Ausdrucks (siehe ?expression
), oder, falls die Funktion keinen Ausdruck hat, NULL
(siehe ?return
), compris?
Es ist daher sicher nicht schlecht, wenn Du versucht, den Rückgabewert jeder Funktion explizit anzugeben.
Wenn Du die auf die explizite Rückgabe verzichtest ist Deine Funktion zwar (um eine Zeile) kürzer und inhaltsgleich, aber weniger sprechend. Und damit weniger gut lesbar.
Und damit mehr schlechter als eine Zeile kürzer mehr besser ist, capisce?
Komplexere Funktionen haben oft Nebenwirkungen (side effects).
Bei vielen dieser Funktionen sind die Nebenwirkungen der eigentliche Zweck der Funktion,
manchmal ist der Rückgabewert sogar belanglos.
Die Funktion rm
gibt beispielsweise unsichtbar NULL
zurück (und das selbst dann, wenn es gar nichts zu löschen gibt).
Das erkennen wir, wenn wir ihren Rückgabewert explizit drucken:
a <- "This is a string"
print(rm(a))
## NULL
print(rm())
## NULL
Das heißt also, dass unsere Funktion wipe_clean
den Wert invisible(NULL)
, zurückgibt, denn das war der Wert des letzten in ihr ausgewerteten Ausdrucks (der Aufruf der Funktion rm
).
Das können wir ändern, indem wir einen expliziten Rückgabewert einbauen (bei der Gelegenheit wandeln wir gleich noch den Gültigkeitsbereich, indem die Funktion löscht, in ein Steuerargument mit Voreinstellung um):
wipe_clean <- function(environment = parent.frame()) { objects <- ls(name = environment, all.names = TRUE) rm(list = objects, envir = environment) return(invisible(objects)) }
print(wipe_clean())
## [1] "memory_hogs" "va" "vd" "wipe_clean"
ls()
## character(0)
Jetzt gibt die Funktion die Namen der von ihr gelöschten Objekte zurück. Wir wissen also, wie hieß, was wir gelöscht haben. Damit können wir zwar nichts mehr anfangen, aber die Funktion hat nun genau einen expliziten Endpunkt. Das ist immerhin schön übersichtlich.
2.5. Funktionen verwalten
2.5.1. Im jeweiligen Skript
Ich schreibe viele Funktionen während Datenauswertungen, sie landen dann erstmal im jeweiligen Auswertungsskript. Manchmal sammele ich sie an dessen Beginn, meist lege ich sie aber gleich lokal ab.
2.5.2. Lokal
Viele meiner wissenschaftlichen Projekte haben im R-Skript-Verzeichnis ein Unterverzeichnis mit dem Namen ./functions
.
Darin lege ich die Funktionen, die ich in den Skripten des Projektes schreibe, ab.
Wichtige Funktionen kommen in eigene Dateien, die nach ihnen benannt sind, andere sammele ich, beispielsweise in
./functions/utils.R
oder ./functions/misc.R
.
Jedes Auswertungsskript hat dann am Beginn die Zeilen
for (f in dir("./functions/", full.names = TRUE, pattern = ".*\\.[rR]$")) { source(f) }
2.5.3. Global
Funktionen, die Du nicht nur in einem Projekt nutzen willst, kannst Du zentral verwalten, in dem Du Dateien wie im Abschnitt lokal beschrieben ablegst, nur mit dem Unterschied, dass Du ein zentrales Verzeichnis benutzt. Dann fügst Du in eine Deiner R-Startup-Dateien die Anweisung
for (f in dir("/full/path/to/functions_directory/", full.names = TRUE, pattern = ".*\\.[rR]$")) { source(f) }
ein und den passt "/full/path/to/functions_directory/" an.
Geeignte R-Startup-Dateien verrät Dir die R-Hilfe ?Startup
oder der Code:
candidates <- c( Sys.getenv("R_PROFILE"), Sys.getenv("R_PROFILE_USER"), file.path(Sys.getenv("R_HOME"), "etc", "Rprofile.site"), file.path(Sys.getenv("HOME"), ".Rprofile"), file.path(getwd(), ".Rprofile") ) Filter(file.exists, candidates)
2.5.4. Als Paket
Wenn Du Dir die Mühe machst, Deine Funktionen zu dokumentieren, kannst Du sie eigentlich auch gleich in einem oder mehreren Paketen verwalten. Das ist am elegantesten.
3. Schöner Programmieren
3.1. Argumententests
Wir haben verschiedene Möglichkeiten, die Objekte, die wir den Argumenten einer Funktion übergeben, zu testen.
3.1.1. Typentests
Wir können Objekte darauf testen, ob sie einem bestimmten Typ (einer Klasse) angehören;
bei Objekten, die einer Funktion als Argument übergeben werden ist dies besonders ratsam.
Das geht in reinen base R
, ist aber eher umständlich,
die Vignette zu checkmate
bietet ein anschauliches Bespiel.
Ich kenne zwei Pakete, die Typentest vereinfachen: assertthat und checkmate
-
checkmate ist hauptsächlich in C geschrieben, sehr schnell, sehr flexibel mit unterschiedlichen Testarten ("checks", "asserts" und "tests"), hat aber viele Abhängigkeiten und ist etwas sperrig: sein Manual ist über 100 Seiten lang.
-
assertthat ist reines R ohne irgendwelche Abhängigkeiten und recht übersichtlich.
assertthat ist sehr einfach:
x <- 6 assertthat::assert_that(is.numeric(x))
## [1] TRUE
x <- "This is a string."
assertthat::assert_that(is.numeric(x))
## Error: x is not a numeric or integer vector
Wenn wir unserer Summenfunktion
my_sum <- function(x) {
value <- 0
for (x_i in x) {
value <- value + x_i
}
return(value)
}
ein nicht-numerisches Argument übergeben, erhalten wir eine recht kryptische Fehlermeldung:
my_sum(c("a", "b"))
## Error in value + x_i: non-numeric argument to binary operator
Durch den Einbau eines Typentests
my_sum <- function(x) {
assertthat::assert_that(is.numeric(x))
value <- 0
for (x_i in x) {
value <- value + x_i
}
return(value)
}
wird die Meldung deutlich verständlicher:
my_sum(c("a", "b"))
## Error: x is not a numeric or integer vector
Mit checkmate können wir sogar erzwingen, dass x nicht nur numerisch sein muss, sondern auch mindestens zwei Elemente haben soll. Eine Summe einer Zahl ist ja etwas albern:
my_sum <- function(x) { checkmate::qassert(x, "n>=2") value <- 0 for (x_i in x) { value <- value + x_i } return(value) }
my_sum(42)
## Error in my_sum(42): Assertion on 'x' failed. Must be of length >= 2, but has length 1.
Ich nutze Typentests oft in Funktionen. Da checkmate deutlich mehr Funktionalität bietet, nutzte ich assertthat eher selten.
3.1.2. Auswahllisten
Mit Auswahllisten können wir Objekte darauf testen, ob sie eine von mehreren Möglichkeiten
enthalten. Das ist vor allem für Steuerargumente hilfreich.
base R
kennt match.arg
, das mit alphanumerischen Vektoren arbeitet und einfach das Objekt zurückgibt, wenn
es in der Auswahlliste enthalten ist:
noten <- c("sehr gut", "gut", "nicht soo gut", "das kann auf jeden Fall noch besser werden") note <- "gut" match.arg(arg = note, choices = noten)
## [1] "gut"
Dabei bedient es sich dem "partial matching", das heißt, dass ein eindeutig einer Auswahlmöglichkeit zuzuordnender Anfang einer Zeichenkette ausreicht:
note <- "das"
match.arg(arg = note, choices = noten)
## [1] "das kann auf jeden Fall noch besser werden"
Wird kein Treffer in der Auswahlliste gefunden, erhalten wir einen Fehler:
note <- "ausreichend"
match.arg(arg = note, choices = noten)
## Error in match.arg(arg = note, choices = noten): 'arg' should be one of "sehr gut", "gut", "nicht soo gut", "das kann auf jeden Fall noch besser werden"
match.arg
ist genau, was hinter Steuerargumenten vieler Funktionen (z.b. mgcv::gam(optimizer = …)
) steckt, hier ein Beispiel aus der Hilfe zu match.arg
:
center <- function(x, type = c("mean", "median", "trimmed")) { type <- match.arg(type) switch(type, mean = mean(x), median = median(x), trimmed = mean(x, trim = .1)) } center(rnorm(100), "med")
## [1] 0.08940291
center(rnorm(100), "m")
## Error in match.arg(type): 'arg' should be one of "mean", "median", "trimmed"
checkmate kennt auch Auswahllisten, macht aber kein partial matching
(was ich ganz gut finde):
note <- "das"
checkmate::assertChoice(x = note, choices = noten)
## Error in eval(expr, envir, enclos): Assertion on 'note' failed: Must be element of set {'sehr gut','gut','nicht soo gut','das kann auf jeden Fall noch besser werden'}, but is 'das'.
Außerdem gibt checkmate die gefundene Rückgabe unsichtbar zurück, weshalb ich hier ein explizites print
benötige:
note <- "gut"
checkmate::assertChoice(x = note, choices = noten)
print(checkmate::assertChoice(x = note, choices = noten))
## [1] "gut"
checkmate kann nicht nur mit alphanumerischen Vektoren umgehen:
x <- 3 choices <- 1:7 print(checkmate::assertChoice(x = x, choices = choices))
## [1] 3
Ich nutze Auswahllisten eher selten, da ich selten Steuerargumente mit mehreren Auswahlmöglichenkeiten in meinen Funktionen habe.
3.2. Funktionen testen
3.2.1. Unit Testing
Beim Unit Testing wollen wir nicht die einer Funktion übergebenen Argumente, sondern die Funktion selbst testen. Also im Zweifel ihren Rückgabewert.
Ich kenne zwei Pakete, die Unit Testing in R formalisieren (im Prinzip geht es auch ohne spezielle Pakete, aber seit ich die beiden Pakete kenne, habe ich nie mehr wie früher "von Hand" getestet):
Erwartungen
Die kleinste Testeinheit ist immer ein Vergleich.
Wenn wir die Funktionen
my_sum <- function(x) {
value <- 0
for (x_i in x) {
value <- value + x_i
}
return(value)
}
und
not_my_sum <- function(x) {
value <- 0
for (x_i in x) {
value <- value - x_i
}
return(value)
}
haben, können wir zum Beispiel mit base R
prüfen, ob sie tun, was wir erwarten:
my_sum(c(2, 7)) == 9
## [1] TRUE
# better use identical(), see ?Comparison
identical(not_my_sum(c(2, 7)), 9)
## [1] FALSE
Beide Pakete formalisieren dies zu Erwartungsfunktionen die hauptsächlich dazu dienen, Fehler zu beschreiben:
RUnit::checkIdentical(not_my_sum(c(2, 7)), 9)
## Error in RUnit::checkIdentical(not_my_sum(c(2, 7)), 9): FALSE ##
testthat::expect_identical(not_my_sum(c(2, 7)), 9)
## Error in cat(unlist(cond)): argument 1 (type 'list') cannot be handled by 'cat'
Tests
Um Erwartungen bei der Paketentwicklung oder in Bezug auf ihre Coverage auszuwerten, werden in beiden Paketen Erwartungen zu Tests zusammenfasst (eigentlich sollten Tests immer nur Erwartungen zu einer Funktion enthalten, aber wir wollen ja auch Fehler sehen):
Du kannst einen Test entweder einzeln laufen lassen
testthat::context("My first test.") testthat::test_that("Simple test on summation.", { testthat::expect_identical(not_my_sum(c(2, 7)), 9, info = "Not my sum.") testthat::expect_identical(my_sum(c(2, 7)), 9, info = "My sum.") })
## ── Failure (<text>:3:25): Simple test on summation. ────────────────────────────
## not_my_sum(c(2, 7)) not identical to 9.
## 1/1 mismatches
## [1] -9 - 9 == -18
## Not my sum.
## Error: Test failed
oder den Test in einer Testdatei
testthat::context("My first test.") testthat::test_that("Simple test on summation.", { testthat::expect_identical(not_my_sum(c(2, 7)), 9, info = "Not my sum.") testthat::expect_identical(my_sum(c(2, 7)), 9, info = "My sum.") })
mit einer Funktion auswerten, bei testthat ändert sich relativ wenig:
testthat::test_file(file.path("src", "test_my_sum.R"))
##
## ══ Testing test_my_sum.R ══════════════════════════════════════════════════════════════════════════════════════════════════════════
##
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 0 ]
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 0 ]
[ FAIL 1 | WARN 0 | SKIP 0 | PASS 0 ]
[ FAIL 1 | WARN 0 | SKIP 0 | PASS 1 ]
##
## ── Failure (test_my_sum.R:3:25): Simple test on summation. ─────────────────────
## not_my_sum(c(2, 7)) not identical to 9.
## 1/1 mismatches
## [1] -9 - 9 == -18
## Not my sum.
##
##
[ FAIL 1 | WARN 0 | SKIP 0 | PASS 1 ]
Du erhälst aber die Information, dass der Fehler im ersten Test in Zeile 3 auftrat.
Größer sind die Unterschiede bei RUnit, das primär für das Testen von Paketen entwickelt wurde: Es ist beim einfachen
test_sum <- function() { RUnit::checkIdentical(not_my_sum(c(2, 7)), 9) RUnit::checkIdentical(my_sum(c(2, 7)), 9) } test_sum()
## Error in RUnit::checkIdentical(not_my_sum(c(2, 7)), 9): FALSE ##
recht spröde, mit einer Testdatei
test_sum <- function() { RUnit::checkIdentical(not_my_sum(c(2, 7)), 9) RUnit::checkIdentical(my_sum(c(2, 7)), 9) }
allerdings gesprächiger:
test_file <- normalizePath(file.path("src", "runit_my_sum.R")) runit <- RUnit::runTestFile(test_file)
## Warning in RNGkind(kind = testSuite$rngKind, normal.kind = ## testSuite$rngNormalKind): RNGkind: Marsaglia-Multicarry has poor statistical ## properties
## Warning in RNGkind(kind = testSuite$rngKind, normal.kind = ## testSuite$rngNormalKind): RNGkind: severe deviations from normality for ## Kinderman-Ramage + Marsaglia-Multicarry
##
##
## Executing test function test_sum ...
## Timing stopped at: 0 0 0.001
## Error in RUnit::checkIdentical(not_my_sum(c(2, 7)), 9) : FALSE
##
## done successfully.
RUnit::printTextProtocol(runit)
## RUNIT TEST PROTOCOL -- Tue Nov 30 12:33:25 2021
## ***********************************************
## Number of test functions: 1
## Number of errors: 0
## Number of failures: 1
##
##
## 1 Test Suite :
## runit_my_sum - 1 test function, 0 errors, 1 failure
## FAILURE in test_sum: Error in RUnit::checkIdentical(not_my_sum(c(2, 7)), 9) : FALSE
##
##
##
##
## Details
## ***************************
## Test Suite: runit_my_sum
## Test function regexp: ^test.+
## Test file regexp: ^runit_my_sum.R$
## Involved directory:
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src
## ---------------------------
## Test file: /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/runit_my_sum.R
## test_sum: FAILURE !! (check number 1)
## Error in RUnit::checkIdentical(not_my_sum(c(2, 7)), 9) : FALSE
##
3.2.2. Code Coverage
Um zu sehen, ob Deine Unit Tests die Funktion gut testen, kannst Du ihre Überdeckung berechnen. covr ist eines der Pakete, die Code Coverage implentieren und das einzige, das ich nutze. Ich weiß es nicht, glaube aber, dass covr die branch coverage berechnet.
Du kannst auch mit einer hohen Überdeckung unzureichend testen, wie wir später sehen werden. Versuche daher nicht, sie unbedingt zu maximieren und lasse Dich von einer hohen Überdeckung einlullen. Aber prinzipiell ist eine hohe Überdeckung gut.
Wenn Du eine Datei mit einer Funktionsdefinition
my_sum <- function(x) {
assertthat::assert_that(is.numeric(x))
value <- 0
for (x_i in x) {
value <- value + x_i
}
return(value)
}
und eine mit dem Test
testthat::context("Tests for summation with argument assertion.") testthat::test_that("Testing summation", { testthat::expect_identical(my_sum(c(2, 7)), 9) testthat::expect_error(my_sum(c("2" + "7"))) })
hast, kannst Du die Überdeckung berechnen.
cov <- covr::file_coverage(file.path("src", "my_sum_assertion.R"), file.path("src", "test_my_sum_assertion.R"))
## Test passed 🌈
print(cov)
## Coverage: 100.00%
## src/my_sum_assertion.R: 100.00%
Wenn Du eine Funktion schreibst, in der eine Zeile eingebaut ist, die der Test nicht erreicht, weist Dich covr darauf hin:
my_sum <- function(x) { assertthat::assert_that(is.numeric(x)) if (! is.numeric(x)) message("You'll never get here!") value <- 0 for (x_i in x) { value <- value + x_i } return(value) }
cov <- covr::file_coverage(file.path("src", "my_sum_coverage.R"), file.path("src", "test_my_sum_assertion.R"))
## Test passed 😸
print(cov)
## Coverage: 83.33%
## src/my_sum_coverage.R: 83.33%
covr sagt Dir sogar, dass es die dritte Zeile ist:
covr::zero_coverage(cov)
## filename functions line value
## 2 src/my_sum_coverage.R my_sum 3 0
3.2.3. Nebenwirkungen testen
Funktionen sind relativ einfach zu testen, wenn ihr Rückgabewert ihr Zweck ist. Wenn sie aber Nebenwirkungen bezwecken, finde ich Tests schwieriger zu schreiben.
Stell Dir vor, Du hättest die fehlerhafte Löschfunktion aus Arbeiten mit Gültigkeitsbereichen in eine Datei geschrieben:
wipe_clean <- function(environment = parent.frame()) { objects <- ls(name = environment, all.names = TRUE) # FIXME: rm() by default removes objects from # the current frame, which is this function, not the parent frame! rm(list = objects) return(invisible(objects)) }
Nun schreibst Du eine Testdatei:
testthat::test_that("Test return value.", { a <- 3 testthat::expect_identical(wipe_clean(), c("a"))} )
Und erhälst vollständige Überdeckung:
cov <- covr::file_coverage(file.path("src", "wipe_clean_broken.R"), file.path("src", "test_wipe_clean_broken.R"))
## ── Warning (test_wipe_clean_broken.R:3:21): Test return value. ─────────────────
## object 'a' not found
## Backtrace:
## 1. testthat::expect_identical(wipe_clean(), c("a")) src/test_wipe_clean_broken.R:3:20
## 4. wipe_clean()
## 5. base::rm(list = objects)
print(cov)
## Coverage: 100.00%
## src/wipe_clean_broken.R: 100.00%
Alles gut? Nein, die Funktion ist kaputt und die Testdatei, die dies zeigt müsste auf die Nebenwirkung testen:
testthat::test_that("Test return value and side effects.", { a <- 3 testthat::expect_identical(wipe_clean(), c("a")) testthat::expect_identical(ls(), character(0))} )
covr::file_coverage(file.path("src", "wipe_clean_broken.R"), file.path("src", "test_wipe_clean.R"))
## ── Warning (test_wipe_clean.R:3:21): Test return value and side effects. ───────
## object 'a' not found
## Backtrace:
## 1. testthat::expect_identical(wipe_clean(), c("a")) src/test_wipe_clean.R:3:20
## 4. wipe_clean()
## 5. base::rm(list = objects)
##
## ── Failure (test_wipe_clean.R:4:21): Test return value and side effects. ───────
## ls() not identical to character(0).
## Lengths differ: 1 is not 0
## Error: Test failed
3.2.4. Was soll die ganze Testerei?
Stell Dir vor, Du erstelltest öfter Abbildungen. Jetzt bist Du ein Mensch mit einem Gefühl für Harmonien, daher willst Du gerne, wenn möglich, den Goldenen Schnitt bei der Wahl der Zuschnitte berücksichtigen.
Da Du Dir den Goldenen Schnitt nicht gut merken kannst, schreibst Du folgende Funktion:
golden_ratio <- function() { phi <- (1 + sqrt(5)) / 2 return(phi) }
Das ginge auch als Einzeiler:
golden_ratio <- function() return((1 + sqrt(5)) / 2)
aber den findest Du auch nicht viel eleganter, dafür aber schlechter lesbar.
Du schreibst auch einen Test, obwohl der ziemlich trivial ist:
testthat::test_that("Test on Golden Ratio", {
expectation <- (1 + sqrt(5)) / 2
result <- golden_ratio()
testthat::expect_identical(result, expectation)
})
covr::file_coverage(file.path("src", "golden_ratio.R"), file.path("src", "test_golden_ratio.R"))
## Test passed 🥇
## Coverage: 100.00%
## src/golden_ratio.R: 100.00%
Wenn Du Graphiken nach dem Goldenen Schnitt proportionieren willst, musst Du bei gegebener Länge der kurzen Seite diese mit dem Goldenen Schnitt multipizieren um die Länge der langen Seite zu erhalten.
Das ist eigentlich nicht allzu kompliziert, dennoch kommst Du manchmal durcheinander, also schreibst Du die folgende Funktion:
golden_rectangle <- function(b) { a <- b * golden_ratio() return(c("a" = a, "b" = b)) }
Auch für diese Funktion schreibst Du einen Test:
testthat::test_that("Test on golden rectangle", {
b <- 2
expectation <- c(a = b * golden_ratio(), b = b)
result <- golden_rectangle(b)
testthat::expect_identical(result, expectation)
})
covr::file_coverage(file.path("src", c("golden_ratio.R", "golden_rectangle.R")), file.path("src", "test_golden_rectangle.R"))
## Test passed 🎊
## Coverage: 100.00%
## src/golden_ratio.R: 100.00%
## src/golden_rectangle.R: 100.00%
Du benutzt die Funtktion …
source(file.path("src", "golden_ratio.R")) width <- 2 png("p1.png", units = "cm", res = 400, width = width, height = golden_rectangle(width)[["a"]]) par(mar=c(1,1,1,1)) plot(cars) dev.off()
## pdf
## 2
und bist begeistert:
Du benutzt die Funktion eine Weile weiter, merkst dann aber, dass Du ja auch querformatige Abbildungen erstellen willst und daher bei gegebener Länge der langen Seite diese durch den Goldenen Schnitt dividieren musst, um die Länge der kurzen Seite zu erhalten.
Jetzt kannst Du entweder eine neue Funktion schreiben oder die alte erweitern.
Da die Funktionalitäten zum selben Thema passen und golden_rectangle
bislang
recht simpel ist, schreibst Du Deine Funktion also um:
golden_rectangle <- function(value, landscape = TRUE) { phi <- golden_ratio() if (isTRUE(landscape)) { a <- value b <- a / phi } else { b <- value a <- b * phi } return(c("a" = a, "b" = b)) }
width <- 4 png("p2.png", units = "cm", res = 400, width = width, height = golden_rectangle(width)[["b"]]) par(mar=c(1,1,1,1)) plot(cars) dev.off()
## pdf
## 2
Herzlichen Glückwunsch, Du hast gerade die Schnittstelle Deiner Funktion zerschossen, indem Du ihr voreingestelltes Verhalten geändert hast. Glücklicherweise hast Du einen Test, der Dir jetzt um die Ohren fliegt:
covr::file_coverage(file.path("src", "golden_rectangle.R"), file.path("src", "test_golden_rectangle.R"))
## ── Failure (test_golden_rectangle.R:5:25): Test on golden rectangle ────────────
## `result` not identical to `expectation`.
## 2/2 mismatches (average diff: 1)
## [1] 2.00 - 3.24 == -1.236
## [2] 1.24 - 2.00 == -0.764
## Error: Test failed
Was bedeutet das? Du musst entweder
-
alle Aufrufe der Funktion, die Du vor der Veränderung ihrer Schnittstelle progammiert hast, anpassen (indem Du
, landscape = FALSE
einfügst) oder -
die Funktion so ändern, dass die Schnittstelle stabil bleibt (und der Test weiterhin funktioniert).
Du entscheidest Dich, die Funktion zu ändern:
golden_rectangle <- function(value, landscape = FALSE) { phi <- golden_ratio() if (isTRUE(landscape)) { a <- value b <- a / phi } else { b <- value a <- b * phi } return(c("a" = a, "b" = b)) }
Um Querformatige Proportionen zu erhalten musst Du nun aktiv Querformat einstellen:
golden_rectangle(width, landscape = TRUE)
Der Test funktioniert wieder, da Du aber die Funktion geändert hast, überdeckt er sie nicht mehr vollständig:
cov <- covr::file_coverage(file.path("src", "golden_rectangle.R"), file.path("src", "test_golden_rectangle.R"))
## Test passed 🥇
print(cov)
## Coverage: 71.43%
## src/golden_rectangle.R: 71.43%
print(covr::zero_coverage(cov))
## filename functions line value
## 3 src/golden_rectangle.R golden_rectangle 4 0
## 4 src/golden_rectangle.R golden_rectangle 5 0
Du erweiterst also Deine Testdatei an:
testthat::test_that("Test on golden rectangle", {
value <- 2
expectation <- c(a = value * golden_ratio(), b = value)
result <- golden_rectangle(value)
testthat::expect_identical(result, expectation)
result <- golden_rectangle(value * golden_ratio(), landscape = TRUE)
testthat::expect_identical(result, expectation)
})
covr::file_coverage(file.path("src", "golden_rectangle.R"), file.path("src", "test_golden_rectangle.R"))
## Test passed 🥳
## Coverage: 100.00%
## src/golden_rectangle.R: 100.00%
golden_rectangle
habe ich mir nur ausgedacht, um Dir mein Vorgehen zu verdeutlichen. Aber:
Ich teste fast alle meine Funktion nach genau dem Ablauf in diesem Abschnitt spätestens, wenn ich sie in ein Paket verpacke.
Du testest Deinen Code so oder so (zur Not auf die harte Tour, also bei der produktiven Anwendung), das Unit Testing ist nur eine hilfreiche Formalisierung, nutze sie! Und mit der Code Coverage hast Du sogar eine Möglichkeit, die Güte Deines Testens abzuschätzen.
3.3. Weniger schlecht programmieren
Ich möchte Dir gerne noch vier Funktionen aus vier verschiedenen Paketen vorstellen, die ich alle vier standardmäßig bei der Entwicklung von Paketen nutze.
Die erste findet echte Fehler in Deinem Code, die anderen drei können Dir helfen, besser lesbare, übersichtlichere und weniger komplizierte Funktionen zu schreiben.
Stell Dir vor, Du hättest in der Datei "src/code.R" folgende unschöne und kaputte Funktion geschrieben:
foo <- function(this, func, has, way, too, many,args, hell = TRUE) { if (isTRUE(this)) { if (isTRUE(func)) { if (isTRUE(has)) { if (!isTRUE(way)) { if (isTRUE(too)) print(sum(many, args)) else stop("What the hell?") } else stop("Haha, gotcha!") } else stop("Foobar!") } else stop("Foo!") } else stop("Bar!") return(invisible(you_will_never_get_here)) }
3.3.1. Fehler finden mit codetools
codetools gehört zur Gruppe der "recommended Packages" von R und kann Programmfehler finden:
source(file.path("src", "code.R")) codetools::checkUsage(foo, all = TRUE)
## <anonymous>: no visible binding for global variable 'you_will_never_get_here'
## <anonymous>: parameter 'hell' may not be used
in Deiner Funktion findet codetools
nicht benutzte Funktionsargumente und das nicht definierte Objekte this_is_not_defined
(und findet damit auch unsere Scopingfehler beim Lesen).
3.3.2. Entflusen mit lintr
Das Paket lintr prüft Code auf Fussel, das sind Abweichungen des Codes von Richtlinien zur übersichtlichen Formatierung. Die Richtlinien (gegen die lintr prüft, und die sind gut, halte Dich an sie; mehr über Progammierrichtlinien findest Du im Programmierleitfaden an der Forstlichen Versuchs- und Forschungsanstalt Baden-Württemberg) sehen unter anderem vor, dass auf Kommas immer ein Leerzeichen und auf öffnende geschweifte Klammern immer ein Zeilenumbruch folgen sollte:
lintr::lint(file.path("src", "code.R"))
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/code.R:1:49: style: Commas should always have a space after.
## foo <- function(this, func, has, way, too, many,args, hell = TRUE) {
## ^
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/code.R:2:23: style: Opening curly braces should never go on their own line and should always be followed by a new line.
## if (isTRUE(this)) { if (isTRUE(func)) {
## ^
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/code.R:5:1: style: Lines should not be more than 80 characters.
## if (isTRUE(too)) print(sum(many, args)) else stop("What the hell?")
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/code.R:10:22: warning: no visible binding for global variable 'you_will_never_get_here'
## return(invisible(you_will_never_get_here))
## ^~~~~~~~~~~~~~~~~~~~~~~
lintr gibt Dir klare Anweisungen, wie Du Deinen Code umschreiben solltest.
Das Paket kennt viele Optionen, lies Dir die Hilfe durch!
Hartes Entflusen
formatR macht in etwa, was
lintr empfiehlt,
styler geht etwas weiter
(indem es beispielsweise {}
-Blöcke sinnvoll ergäntzt)
und bringt damit in meinen Augen deutlich bessere Ergebnisse.
Ich nutze styler sehr selten und nur, wenn ich richtig schlechten Code lesen muss.
Da beide Pakete Quelldateien umschreiben, solltest Du Deine Quelldateien vorsichtshalber kopieren und dann erst entflusen:
tempfile <- paste0(tempfile(), ".R") file.copy(file.path("src", "code.R"), tempfile, overwrite = TRUE)
## [1] TRUE
formatR::tidy_file(tempfile)
## tidying /tmp/RtmpjoEzmQ/file69ad252829c2.R
formatR bereinigt schon mal das schlimmste:
cat(readLines(file.path(tempfile)), sep = "\n")
foo <- function(this, func, has, way, too, many, args, hell = TRUE) {
if (isTRUE(this)) {
if (isTRUE(func)) {
if (isTRUE(has)) {
if (!isTRUE(way)) {
if (isTRUE(too))
print(sum(many, args)) else stop("What the hell?")
} else stop("Haha, gotcha!")
} else stop("Foobar!")
} else stop("Foo!")
} else stop("Bar!")
return(invisible(you_will_never_get_here))
}
styler::style_file(file.path("src", "code.R"))
## Styling 1 files:
## src/code.R ℹ
## ────────────────────────────────────────
## Status Count Legend
## ✔ 0 File unchanged.
## ℹ 1 File changed.
## ✖ 0 Styling threw an error.
## ────────────────────────────────────────
## Please review the changes carefully!
Ich finde aber das Ergebnis von styler überzeugender:
cat(readLines(file.path("src", "code.R")), sep = "\n")
foo <- function(this, func, has, way, too, many, args, hell = TRUE) {
if (isTRUE(this)) {
if (isTRUE(func)) {
if (isTRUE(has)) {
if (!isTRUE(way)) {
if (isTRUE(too)) print(sum(many, args)) else stop("What the hell?")
} else {
stop("Haha, gotcha!")
}
} else {
stop("Foobar!")
}
} else {
stop("Foo!")
}
} else {
stop("Bar!")
}
return(invisible(you_will_never_get_here))
}
Nun ja, jetzt hast Du leider doch Deine Quelldatei überschrieben. Falls Du den Empfehlungen des Programmierleitfadens an der Forstlichen Versuchs- und Forschungsanstalt Baden-Württemberg folgst, benutzt Du sicher Versionskontrollsystem. Falls das git ist, kannst Du die Quelldatei wiederherstellen:
repo <- git2r::repository(".")
## Error in dyn.load(file, DLLpath = DLLpath, ...): unable to load shared object '/home/qwer/svn/R/r-devel/build/library/git2r/libs/git2r.so': ## libgit2.so.27: cannot open shared object file: No such file or directory
git2r::checkout(object = repo, path = file.path("src", "code.R"))
## Error in dyn.load(file, DLLpath = DLLpath, ...): unable to load shared object '/home/qwer/svn/R/r-devel/build/library/git2r/libs/git2r.so': ## libgit2.so.27: cannot open shared object file: No such file or directory
cat(readLines(file.path("src", "code.R")), sep = "\n")
foo <- function(this, func, has, way, too, many, args, hell = TRUE) {
if (isTRUE(this)) {
if (isTRUE(func)) {
if (isTRUE(has)) {
if (!isTRUE(way)) {
if (isTRUE(too)) print(sum(many, args)) else stop("What the hell?")
} else {
stop("Haha, gotcha!")
}
} else {
stop("Foobar!")
}
} else {
stop("Foo!")
}
} else {
stop("Bar!")
}
return(invisible(you_will_never_get_here))
}
3.3.3. Code säubern mit cleanr
Das Paket cleanr greift einige Richtlinien aus [cc] auf und prüft die Länge und (Zeilen-) Breite von Funktionen und Codedateien und die Verschachtelungstiefe von Funktionen, ihre Argumentenanzahl und ob sie einen expliziten Rückgabewert haben.
print(suppressWarnings(cleanr::check_file(file.path("src", "code.R"))))
## Error in cleanr::check_file(file.path("src", "code.R")): src/code.R foo found 8 arguments, max_num_arguments was 5 ## foo found nesting depth 4, max_nesting_depth was 3
Auch dieses Paket kennt viele Optionen, lies Dir die Hilfe durch!
3.3.4. Cyclomatic Complexity prüfen mit cyclocomp
McCabes "cyclomatic complexity" ([cyc]) mißt die Komplexität von Programmcode. Mit ihr kannst Du prüfen, ob Deine Funktionen einfach genug sind.
Insbesondere gibt Dir die "cyclomatic complexity" eine Idee davon, wie viele Testfälle Du für eine Funktion schreiben solltest (genau genommen ist sie eine obere Grenze für die Anzahl der für vollständige branch coverage benötigten Testfälle). Für Deine hässliche Funktion bräuchtest Du also 6 Testfälle:
cyclocomp::cyclocomp(parse(text = readLines(file.path("src", "code.R"))))
## [1] 6
Allgemein gilt: je höher die "cyclomatic complexity", desto unverständlicher der Code. McCabe empfiehlt eine "cyclomatic complexity" von nicht mehr als 10 für eine Funktion. Und der war professioneller Programmierer des Departement of Defense der National Security Agency. Bei einer "cyclomatic complexity" von 20 dürfte es selbst für professionelle Programmiererinnen langsam schwierig werden, die Absicht hinter Deinem Code zu verstehen. Wenn Du eine "cyclomatic complexity" von mehr als 40 schaffst, hast Du vielleicht eine Funktion geschrieben, die tut, was sie soll, aber ziemlich sicher eine, die kaum ein Mensch mehr versteht.
Und was machst Du dann? Dann solltest du versuchen, Teilfunktionen aus der Funktion auszugliedern. Das ist schwierig, aber wahrscheinlich weniger schwierig als Deine Funktion in Zukunft nochmal zu lesen oder gar zu ändern.
Natürlich gibt es immer Ausnahmen von der 10er-Regel. Die Funktion devtools::release
beispielsweise
hat eine ganze Reihe von interaktiven Abfragen des Typs
if (yesno("Were devtool's checks successful?")) return(invisible())
Diese treiben die "cyclomatic complexity" in die Höhe (weil die return
-Anweisungen
viele verschiedene mögliche Endpunkte der Funktion definieren. Eine wohlstrukturierte Funktion hat genau einen "exit node"):
source(file.path("src", "release.R")) cyclocomp::cyclocomp(release)
## [1] 35
Dabei ist die Funktion lediglich schwer verdaulich und nicht völlig unlesbar. Dennoch sollte Hadley Wickham die Funktion dringend entrümpeln:
linters <- lintr::default_linters[names(lintr::default_linters )!= "object_usage_linter"] lintr::lint(file.path("src", "release.R"), linters = linters)
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/release.R:41:1: style: functions should have cyclomatic complexity of less than 15, this has 35.
## release <- function(pkg = ".", check = FALSE, args = NULL) {
## ^
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/release.R:132:1: style: Lines should not be more than 80 characters.
## if (file.exists("codemeta.json")) "Have you updated codemeta.json with codemetar::write_codemeta()?",
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/release.R:193:1: style: Lines should not be more than 80 characters.
## yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely")
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/release.R:371:1: style: Variable and function name style should be snake_case.
## as.object_size <- function(x) structure(x, class = "object_size")
## ^~~~~~~~~~~~~~
## /home/qwer/git/cyclops/fvafrcu/funktionen_in_r/src/release.R:387:1: style: Lines should not be more than 80 characters.
## "Once it is accepted, delete this file and tag the release (commit ", sha, ")."
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
suppressWarnings(cleanr::check_file(file.path("src", "release.R")))
## Error in cleanr::check_file(file.path("src", "release.R")): src/release.R: line 132 counts 105 characters. ## src/release.R: line 193 counts 85 characters. ## src/release.R: line 387 counts 83 characters. ## src/release.R: 401 lines in file. ## src/release.R as.object_size found no return() statement at all. ## src/release.R build_cran found no return() statement at all. ## src/release.R cran_comments found no return() statement at all. ## src/release.R cran_mirror found no return() statement at all. ## src/release.R email found no return() statement at all. ## src/release.R email_browser found no return() statement at all. ## src/release.R find_release_questions found no return() statement at all. ## src/release.R flag_release line 14: found width 83 max_line_width was 80 ## flag_release found no return() statement at all. ## src/release.R has_cran_results found no return() statement at all. ## src/release.R maintainer found no return() statement at all. ## src/release.R release line 91: found width 105 max_line_width was 80 ## release found 107 lines, max_lines was 65 ## release found 106 lines of code, max_lines_of_code was 50 ## release found no return() statement at all. ## src/release.R release_email found no return() statement at all. ## src/release.R submit_cran found no return() statement at all. ## src/release.R upload_cran found no return() statement at all. ## src/release.R yesno line 1: found width 85 max_line_width was 80 ## yesno found no return() statement at all.
3.4. Funktionen dokumentieren
Wenn Du Hilfe zu einer Funktion in R suchst, kannst Du unter anderem die
R-Hilfe mit help(topic)
oder der Kurzform ?topic
aufrufen, bei Paketen findest Du
die selbe Information auch immer als pdf beigelegt.
Solche Hilfeformate kannst Du für Deine Funktionen auch schreiben.
3.4.1. Warum solltest Du Deine Funktionen dokumentieren?
Wenn Du Funktionen dokumentierst, erklärst Du einer anderen Person, was die Funktion tun sollte. Wenn Du das schaffst, kannst Du Dir einigermaßen sicher sein, dass Du weißt, was die Funktion tut und dass es richtig war, sie (und nicht eine etwas andere) zu schreiben.
Außerdem ist es von dokumentierten Funktionen zu Paketen nicht mehr weit, was ihre Verwaltung deutlich erleichtert.
Nehmen wir unser Beispiel zum Goldenen Schnitt:
Du merkst, dass Du die Funktion golden_ratio
eigentlich nur innerhalb
von golden_rectangle
benutzt und letzteres kein glücklicher Name ist, weil
Du die Funktion zwar zum Errechnen von Seitenlängen von Graphiken nutzt, sie
ja aber ganz allgemein den Goldenen Schnitt ausrechnet.
Du entschließt Dich daher, die interne Funktion in
.golden_ratio
(der führende Punkt ist eine Konvention, die aus der UNIX-Welt stammt,
dort werden (vorwiegend Konfigurations-) Dateien mit einem führenden Punkt
aus dem directory listing ausgeschlossen (unter Windows heißen diese Dateien "versteckt")
— in R kennzeichnet die Konvention interne Funktionen, die gewöhnlich
nicht direkt aufgerufen werden (sollten))
und golden_rectangle
in golden_ratio
umzubenennen.
Dazu musst Du
-
die Funktionsdateien und die zugehörigen Testdateien umbenennen,
-
die Namen in den Funktionsdefinitionen ändern und
-
die Namen in den Funktionsaufrufen ändern.
Das kannst Du von Hand machen, oder Du schreibst folgende Funktionen:
substitute_function <- function(from, to, file_name) { patterns <- c(definition_pattern = paste0(from, "( *<-)"), call_pattern = paste0(from, "(\\()")) x <- readLines(file_name) for (pattern in patterns) x <- sub(pattern, paste0(to, "\\1"), x) writeLines(x, con = file_name) } rename_function <- function(from, to, directory = ".") { file_names <- list.files(directory, full.names = TRUE, pattern = paste0("^(test_|)", from, "\\.[rR]$") ) new_file_names <- NULL for (file_name in file_names) { substitute_function(from = from, to = to, file_name = file_name) new_file_name <- file.path(dirname(file_name), sub(from, to, basename(file_name))) file.rename(file_name, new_file_name) new_file_names <- c(new_file_names, new_file_name) } return(new_file_names) }
Diese Funktionen leben ja von Nebenwirkungen, sie sind schwer zu testen und wir hoffen also, dass Du keine Fehler gemachst hast.
Funktionieren tut das so:
rename_function(from = "golden_ratio", to = ".golden_ratio", directory = "src")
## [1] "src/.golden_ratio.R" "src/test_.golden_ratio.R"
# replace calls to golden_ratio()! substitute_function(from = "golden_ratio", to = ".golden_ratio", file_name = file.path("src", "test_golden_rectangle.R")) substitute_function(from = "golden_ratio", to = ".golden_ratio", file_name = file.path("src", "golden_rectangle.R")) rename_function(from = "golden_rectangle", to = "golden_ratio", directory = "src")
## [1] "src/golden_ratio.R" "src/test_golden_ratio.R"
Du testest natürlich Deine neuen Dateien:
covr::file_coverage(file.path("src", ".golden_ratio.R"), file.path("src", "test_.golden_ratio.R"))
## Test passed 🥇
covr::file_coverage(file.path("src", c("golden_ratio.R", ".golden_ratio.R")), file.path("src", "test_golden_ratio.R"))
## Test passed 😸
## Coverage: 100.00%
## src/golden_ratio.R: 100.00%
Scheint geklappt zu haben.
Du siehst also, dass Du Deine Funktionen verändert hast, weil Du sie dokumentieren willst.
3.4.2. Wie kannst Du Funktionen dokumentieren?
Das R-Hilfeformat wird hier beschrieben, ich rate Dir aber, roxygen2 zu benutzen (hier gibt Hadley Wickham eine druckreife Einführung).
Du veränderst also Deine Funktionsdatei, in dem Du Dokumentationskommentare einfügst:
#' Compute the Other Quantity in Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' Specify \code{value = 1} to obtain the Golden Ratio itself in element "a" of #' the return value. #' @param value A Quantity. #' @param landscape Is the quantity given by \code{value} the larger one ("a")? #' @return A vector giving the quantities "a" and "b". #' @export #' @examples #' print(golden_ratio(value = 1)[["a"]]) golden_ratio <- function(value, landscape = FALSE) { phi <- .golden_ratio() if (isTRUE(landscape)) { a <- value b <- a / phi } else { b <- value a <- b * phi } return(c("a" = a, "b" = b)) }
und weil dokumentieren Dir so viel Spaß bereit, dokumentierst Du gleich auch die interne Funktion (interne Funktionen zu dokumentieren ist ein wenig umstritten, ich finde es gut).
#' Compute the Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' @return The Golden Ratio #' @keywords internal .golden_ratio <- function() { phi <- (1 + sqrt(5)) / 2 return(phi) }
Was hast Du davon, außer Arbeit?
Wenn Du Deine beiden Funktionen in eine Datei schreibst
#' Compute the Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' @return The Golden Ratio #' @keywords internal .golden_ratio <- function() { phi <- (1 + sqrt(5)) / 2 return(phi) } #' Compute the Other Quantity in Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' Specify \code{value = 1} to obtain the Golden Ratio itself in element "a" of #' the return value. #' @param value A Quantity. #' @param landscape Is the quantity given by \code{value} the larger one ("a")? #' @return A vector giving the quantities "a" and "b". #' @export #' @examples #' print(golden_ratio(value = 1)[["a"]]) golden_ratio <- function(value, landscape = FALSE) { phi <- .golden_ratio() if (isTRUE(landscape)) { a <- value b <- a / phi } else { b <- value a <- b * phi } return(c("a" = a, "b" = b)) }
kannst Du mit dem Paket document Hilfe-Dateien erstellen, wie Du sie aus R kennst:
document::document(file.path("src", "golden_ratios.R"), output_directory = ".")
list.files(pattern = "^golden.*", full.names = TRUE)
## [1] "./golden_ratios.html" "./golden_ratios.pdf" "./golden_ratios.txt"
Außerdem kannst Du mit document nach der Erstellung der Hilfe-Dateien in einer laufenden R-Sitzung die Hilfe zu Deiner Funktion ansehen:
document::man("golden_ratio")
Compute the Other Quantity in Golden Ratio
Description:
See <URL: https://en.wikipedia.org/wiki/Golden_ratio> for an
introduction to the Golden Ratio.
Usage:
golden_ratio(value, landscape = FALSE)
Arguments:
value: A Quantity.
landscape: Is the quantity given by ‘value’ the larger one ("a")?
Details:
Specify ‘value = 1’ to obtain the Golden Ratio itself in element
"a" of the return value.
Value:
A vector giving the quantities "a" and "b".
Examples:
print(golden_ratio(value = 1)[["a"]])
Und zum Dritten und Wichtigsten: Du hast Deine Funktionen dokumentiert und ihre Schnittstellen beschrieben. Sie sind jetzt paketierungsreif.
3.5. Paketieren
Zum Paketieren nimmst Du wieder die getrennten Funktionsdateien,
src/golden_ratio.R
und src/.golden_ratio.R
und ihre zugehörigen Testdateien.
Damit sie den Paketanforderungen genügen, musst Du noch zwei kleine
Änderungen vornehmen: golden_ratio.R
braucht noch einen
Verweis darauf, dass interne Funktionen in golden_ratio_internals.R
stehen
code <- c("#' @include golden_ratio_internals.R", "NULL", "", readLines(file.path("src", "golden_ratio.R"))) writeLines(code, file.path("src", "golden_ratio.R"))
#' @include golden_ratio_internals.R NULL #' Compute the Other Quantity in Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' Specify \code{value = 1} to obtain the Golden Ratio itself in element "a" of #' the return value. #' @param value A Quantity. #' @param landscape Is the quantity given by \code{value} the larger one ("a")? #' @return A vector giving the quantities "a" and "b". #' @export #' @examples #' print(golden_ratio(value = 1)[["a"]]) golden_ratio <- function(value, landscape = FALSE) { phi <- .golden_ratio() if (isTRUE(landscape)) { a <- value b <- a / phi } else { b <- value a <- b * phi } return(c("a" = a, "b" = b)) }
und die Dokumentation für .golden_ratio
sollte in eine Datei geschrieben
werden, deren Name nicht mit einem Punkt beginnt
(der Name der Hilfedatei wird, wenn Du ihn nicht explizit angibst, aus dem der
dokumentierten Funktion abgeleitet)
code <- readLines(file.path("src", ".golden_ratio.R")) return_line <- grep("@return", code) code_upper <- code[1:return_line] code_lower <- code[(return_line + 1):length(code)] code <- c(code_upper, "#' @rdname internals", code_lower) writeLines(code, file.path("src", ".golden_ratio.R"))
#' Compute the Golden Ratio #' #' See \url{https://en.wikipedia.org/wiki/Golden_ratio} for an introduction to #' the Golden Ratio. #' #' @return The Golden Ratio #' @rdname internals #' @keywords internal .golden_ratio <- function() { phi <- (1 + sqrt(5)) / 2 return(phi) }
Du erstellst eine Paketvorlage und kopierst die Dateien hinein:
# Create package skeleton package_name <- "mytools" package_dir <- file.path(dirname(tempdir()), package_name) unlink(package_dir, recursive = TRUE) # make sure it's not there usethis::create_package(package_dir, open = FALSE) # add source files file.copy(from = file.path("src", c("golden_ratio.R", ".golden_ratio.R")), to = file.path(package_dir, "R")) # rename the hidden file, package will not build otherwise: file.rename(file.path(package_dir, "R", ".golden_ratio.R"), file.path(package_dir, "R", "golden_ratio_internals.R")) # create package's testing skeleton withr::with_dir(package_dir, usethis::use_testthat()) # add test files file.copy(from = file.path("src", c("test_golden_ratio.R", "test_.golden_ratio.R")), file.path(package_dir, "tests", "testthat")) # build the docs roxygen2::roxygenize(package_dir)
## Warning: ## ── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────── mytools conflicts ── ## ✖ golden_ratio() masks mytools::golden_ratio() ## ## Did you accidentally source a file rather than using `load_all()`? ## Run `rm(list = c("golden_ratio"))` to remove the conflicts.
# Set package Metadata desc::desc_set_authors(person(given = "Your", family = "Name", role = c("aut", "cre"), email = "your.name@somewhe.re"), file = package_dir, normalize = TRUE) desc::desc_bump_version("minor", package_dir) ## Fix some more metadata d <- desc::desc(package_dir) ### Use title case d$set(Title = tools::toTitleCase(d$get("Title"))) ### Set package License d$set(License = "GPL") d$write()
Nun kannst Du das Paket prüfen:
check <- rcmdcheck::rcmdcheck(package_dir, args = "--as-cran")
print(check)
## ── R CMD check results ───────────────────────────────────────────────────────────────────────────────────────── mytools 0.1.0 ────
## Duration: 27.7s
##
## ❯ checking CRAN incoming feasibility ... NOTE
## Maintainer: ‘Your Name <your.name@somewhe.re>’
##
## New submission
##
## DESCRIPTION fields with placeholder content:
## Title: what the package does (one line, title case)
## Description: what the package does (one paragraph).
##
## 0 errors ✔ | 0 warnings ✔ | 1 note ✖
Nun ja, Du hast die Metadaten noch nicht angepasst. Solltest Du noch tun.
Du kannst Dein Paket auch testen:
covr::package_coverage(package_dir)
## mytools Coverage: 100.00%
## R/golden_ratio_internals.R: 100.00%
## R/golden_ratio.R: 100.00%
Und Du solltest immer auch die Deine drei Freunde lintr, cleanr und cyclocomp
fragen (wobei lintr hier die vorhandene Funktion
.golden_ratio()
nicht erkennt
[2] und cyclocomp
ebenfalls nicht
[3]
und daher keine cyclomatic complexity
für sie berechnet):
print(lintr::lint_package(package_dir))
## R/golden_ratio.R:9:80: style: Trailing whitespace is superfluous.
## #' Specify \code{value = 1} to obtain the Golden Ratio itself in element "a" of
## ^
## tests/testthat/test_golden_ratio.R:6:1: style: Lines should not be more than 80 characters.
## result <- golden_ratio(value * .golden_ratio(), landscape = TRUE)
## ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
print(suppressWarnings(cleanr::check_directory(package_dir)))
## [1] TRUE
print(cyclocomp::cyclocomp_package_dir(package_dir))
##
checking for file ‘/tmp/RtmpjoEzmQ/remotes69ad195f15b1/mytools/DESCRIPTION’ ...
✔ checking for file ‘/tmp/RtmpjoEzmQ/remotes69ad195f15b1/mytools/DESCRIPTION’
## ─ preparing ‘mytools’:
## ✔ checking DESCRIPTION meta-information
##
─ checking for LF line-endings in source and make files and shell scripts
## ─ checking for empty or unneeded directories
## ─ building ‘mytools_0.1.0.tar.gz’
##
##
name cyclocomp
## 1 golden_ratio 2
Gut! Das wird jetzt verpackt:
withr::with_dir(dirname(package_dir),
callr::rcmd_safe("build", basename(package_dir)))
## $status
## [1] 0
##
## $stdout
## [1] "* checking for file ‘mytools/DESCRIPTION’ ... OK\n* preparing ‘mytools’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘mytools_0.1.0.tar.gz’\n"
##
## $stderr
## [1] "\n"
##
## $timeout
## [1] FALSE
##
## $command
## [1] "/home/qwer/svn/R/r-devel/build/bin/R"
## [2] "CMD"
## [3] "build"
## [4] "mytools"
package_path <- paste0(package_dir, "_0.1.0.tar.gz") if (file.exists(package_path)) print(package_path)
## [1] "/tmp/mytools_0.1.0.tar.gz"
Paket fertig. Die Metadaten sind natürlich gelogen (Du solltest die Datei DESCRIPTION
anpassen, Du solltest eine Datei NEWS.md
pflegen, Du solltest ein version control system benutzten), aber funktional ist es korrekt.