update freeze

Author: ratnanil

_freeze/Week5/2_demo/execute-results/html.json

@@ -0,0 +1,15 @@
+{
+  "hash": "e00e81fc9d27a8c9cec95b81742d8ecd",
+  "result": {
+    "engine": "knitr",
+    "markdown": "---\ntitle: \"Demo: R Functions\"\n---\n\n\nUp to now, we have used a variety of different functions designed by other developers. Sometimes we need to execute an operation multiple times, and most often it is reasonable to write a function to do so. Whenever you have copied and pasted a block of code more than twice, you should consider writing a function [@wickham2023]. \n\nThe first step in writing a function, is picking a name and assigning `<- function(){}` to it.\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- function() {}\n```\n:::\n\nTo run the function, we have to call the assigned name with the brackets. The function `testfun` gives no output, which is why we get `NULL` back. \n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nNULL\n```\n\n\n:::\n\n```{.r .cell-code}\nclass(testfun)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n[1] \"function\"\n```\n\n\n:::\n:::\n\nTo make the function actually *do* something, we need to specify *what* should be done within the curly brackets `{}`. The following function always prints the same statement and accepts no input values:\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- function() {\n    print(\"this function does nothing\")\n}\n\ntestfun()\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n[1] \"this function does nothing\"\n```\n\n\n:::\n:::\n\nIf we want the function to accept some input values, we have to define them within the round brackets. For example, I specify a variable named `sometext` and can call this variable within the execution.\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- function(sometext) {\n    print(sometext)\n}\n\ntestfun(sometext = \"this function does slightly more, but still not much\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\n[1] \"this function does slightly more, but still not much\"\n```\n\n\n:::\n:::\n\n:::{.callout-note collapse=\"true\"}\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- function(sometext) {\n    print(sometext)\n}\n```\n:::\n\nNote that since R Version 4.1, the above syntax can also be written as follows:\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- \\(sometext){\n    print(sometext)\n}\n```\n:::\n\nor even more compact:\n\n::: {.cell}\n\n```{.r .cell-code}\ntestfun <- \\(sometext) print(sometext)\n```\n:::\n\n:::\n\nLet's take a more practical example. Say we want a function that calculates our age if provided with the date of our birthday. We can use `Sys.time()` to provide today's date and `difftime()` to calculate the time difference between today and our birthday.\n\n::: {.cell}\n\n```{.r .cell-code}\nmy_age <- function(birthday, output_unit) {\n    difftime(Sys.time(), birthday, units = output_unit)\n}\n\nmy_age(birthday = \"1997-04-23\", output_unit = \"days\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nTime difference of 10206.26 days\n```\n\n\n:::\n:::\n\nAs we already know from using other functions, if we declare our variables in the order that we initially listed them, we do not need to specify the parameters (no need of `birthday = ` and `output_unit =`).\n\n::: {.cell}\n\n```{.r .cell-code}\nmy_age(\"1997-04-23\", \"days\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nTime difference of 10206.26 days\n```\n\n\n:::\n:::\n\nIf we want any of our parameters to have default value, we can assign an initial value to the parameter when declaring the variables within the round brackets.\n\n::: {.cell}\n\n```{.r .cell-code}\nmy_age <- function(birthday, output_unit = \"days\") {\n    difftime(Sys.time(), birthday, units = output_unit)\n}\n\n# if not stated otherwise, our function uses the unit \"days\"\nmy_age(\"1997-04-23\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nTime difference of 10206.26 days\n```\n\n\n:::\n\n```{.r .cell-code}\n# We can still overwrite units\nmy_age(\"1997-04-23\", \"hours\")\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nTime difference of 244950.2 hours\n```\n\n\n:::\n:::\n\nAll you need to do now is run execute the function deceleration (`myage <- function...` etc.) at the beginning of your script, and you can use the function for your entire R session. \n\n:::{.callout-important}\nAlways try to make your function self sufficient: Only use objects within your function that are either passed as function arguments or created within the funtion. See more on this topic [here](https://raps-with-r.dev/fprog.html#referentially-transparent-and-pure-functions), in the online version of the book by @rodrigues2023.\n:::\n\n\n<!-- Todo: inlucd browser() (only for rscripts) --> \n\n\n",
+    "supporting": [],
+    "filters": [
+      "rmarkdown/pagebreak.lua"
+    ],
+    "includes": {},
+    "engineDependencies": {},
+    "preserve": {},
+    "postProcess": true
+  }
+}

_freeze/Week5/2_tasks_and_inputs/execute-results/html.json

@@ -0,0 +1,15 @@
+{
+  "hash": "85ee0864c8ed66a75cba415bdf7e2d86",
+  "result": {
+    "engine": "knitr",
+    "markdown": "## Solutions\n\n:::{.callout-tip}\nHover over the code and copy the content by clicking on the clipboard icon on the top right. You can now paste this into an R-Script.\n:::\n\n::: {.cell}\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\n\n\nbmi <- function(height_m, weight_kg){\n  weight_kg / height_m^2\n}\n\ncelcius2farenheit <- function(celcius){\n  farenheit  <- celcius * 9/5 + 32\n  \n  # this function has an expicit return\n  return(farenheit) \n}\n\n\neuclid <- function(x, y, n = 1) {\n  distance <- sqrt((x - lead(x, n))^2 + (y - lead(y, n))^2)\n  \n  # this is an implicit return\n  distance\n}\n\n# with R's new shorthand:\n\neuclid <- \\(x,y,n = 1) sqrt((x - lead(x, n))^2 + (y - lead(y, n))^2)\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\n\nlibrary(\"readr\")  # move this to the top of your script\nlibrary(\"dplyr\")  # move this to the top of your script\n\nwildschwein <- read_delim(\"datasets/wildschwein_BE_2056.csv\", \",\")\n\nwildschwein_filter <- wildschwein |>\n       filter(\n              DatetimeUTC >= as.POSIXct(\"2015-04-01 00:00:00\",tz = \"UTC\"),\n              DatetimeUTC <= as.POSIXct(\"2015-04-15 23:59:59\",tz = \"UTC\")\n       ) |>\n       filter(TierName %in% c(\"Rosa\", \"Sabi\"))\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\nwildschwein_filter <- wildschwein_filter |>\n  group_by(TierID) |>\n  mutate(\n    DatetimeRound = lubridate::round_date(DatetimeUTC, \"15 minutes\")\n  )\n\nhead(wildschwein_filter)\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\nlibrary(\"purrr\") # move this to the top of your script\n\nsabi <- wildschwein_filter |>\n  filter(TierName == \"Sabi\")\n\nrosa <- wildschwein_filter |>\n  filter(TierName == \"Rosa\")\n\nwildschwein_join <- full_join(sabi, rosa, by = c(\"DatetimeRound\"), suffix = c(\"_sabi\", \"_rosa\"))\n\nwildschwein_join <- wildschwein_join |>\n  mutate(\n    distance = sqrt((E_rosa - E_sabi)^2 + (N_rosa - N_sabi)^2),\n    meet = distance < 100\n  )\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\nlibrary(\"ggplot2\")  # move this to the top of your script\n\n\nwildschwein_meet <- wildschwein_join |>\n  filter(meet)\n\nggplot(wildschwein_meet) +\n  geom_point(data = sabi, aes(E, N, colour = \"sabi\"), shape = 16, alpha = 0.3) +\n  geom_point(data = rosa, aes(E, N, colour = \"rosa\"), shape = 16, alpha = 0.3) +\n  geom_point(aes(x = E_sabi, y = N_sabi, fill = \"sabi\"), shape = 21) +\n  geom_point(aes(E_rosa, N_rosa, fill = \"rosa\"), shape = 21) +\n  labs(color = \"Regular Locations\", fill = \"Meets\") +\n  coord_equal() +\n  theme_minimal()\n```\n\n\n:::\n\n::: {.cell-output .cell-output-stdout}\n\n```{.sourceCode .r}\nmeanmeetpoints <- wildschwein_join |>\n  filter(meet) |>\n  mutate(\n    E.mean = (E_rosa + E_sabi) / 2,\n    N.mean = (N_rosa + N_sabi) / 2\n  )\n\nlibrary(\"plotly\")  # move this to the top of your script\n\n\n# plot_ly(wildschwein_join, x = ~E_rosa, y = ~N_rosa, z = ~DatetimeRound, type = \"scatter3d\", mode = \"lines\") |>\n#   add_trace(wildschwein_join, x = ~E_sabi, y = ~N_sabi, z = ~DatetimeRound) |>\n#   add_markers(data = meanmeetpoints, x = ~E.mean, y = ~N.mean, z = ~DatetimeRound) |>\n#   layout(scene = list(\n#     xaxis = list(title = \"E\"),\n#     yaxis = list(title = \"N\"),\n#     zaxis = list(title = \"Time\")\n#   ))\n\n\nwildschwein_join |>\n  filter(DatetimeRound < \"2015-04-04\") |>\n  plot_ly(x = ~E_rosa, y = ~N_rosa, z = ~DatetimeRound, type = \"scatter3d\", mode = \"lines\") |>\n  add_trace(wildschwein_join, x = ~E_sabi, y = ~N_sabi, z = ~DatetimeRound) |>\n  add_markers(data = meanmeetpoints, x = ~E.mean, y = ~N.mean, z = ~DatetimeRound) |>\n  layout(scene = list(\n    xaxis = list(title = \"E\"),\n    yaxis = list(title = \"N\"),\n    zaxis = list(title = \"Time\")\n  ))\n```\n\n\n:::\n:::\n",
+    "supporting": [],
+    "filters": [
+      "rmarkdown/pagebreak.lua"
+    ],
+    "includes": {},
+    "engineDependencies": {},
+    "preserve": {},
+    "postProcess": true
+  }
+}