---
title: "AY 22/23 Assignment 1 Solution Template"
format: html
---

```{r}
akima_data <- readRDS("../data/assignment01.rds")
compute_slopes <- function(x, y){
  m <- (y[-1]-y[-5])/(x[-1]-x[-5])
  r_diff <- abs(m[4]-m[3])
  l_diff <- abs(m[2]-m[1])
  
  #if(m[1] == m[2] && m[4] == m[3]){
  if(m[1] != m[2] || m[4] != m[3]){
    mid_slope <- (r_diff*m[2] + l_diff*m[3])/(l_diff + r_diff)
  } else {
    mid_slope <- (1/2)*(m[2] + m[3])
  }
  mid_slope
}
est_poly <- function(x, y, slopes, n=50) {
  x_vals <- seq(x[1], x[2], length.out=n)
  p <- c(y[1], slopes[1], 
         (3*(y[2]-y[1])/(x[2]-x[1]) - 2*slopes[1] - slopes[2])/(x[2]-x[1]),
         (slopes[1] + slopes[2] -2*(y[2]-y[1])/(x[2]-x[1]))/(x[2]-x[1])^2)
  out <- cbind(x_vals, p[1] + p[2]*(x_vals-x[1]) + p[3]*(x_vals-x[1])^2 + p[4]*(x_vals-x[1])^3)
  unname(out)
}
```


```{r test_simple}
#| autoharp.scalars: ['for_loop', 'lambda_fn', 'apply_count']
f1 <- rmd_to_forestharp(.myfilename, TRUE)
if(is(f1, "logical")){
  for_loop <- lambda_fn <- apply_count <- NA_integer_
} else {
  for_loop <- fapply(f1, count_fn_call, pattern = "^for$")
  lambda_fn <- fapply(f1, count_lam_fn)
  apply_count <- fapply(f1, count_fn_call, pattern = "apply")
}
```

```{r test_nested_for}
#| autoharp.scalars: ['nested_for_used']
if(!is(f1, "logical")){
  nested_for_used <-  fapply(f1, detect_nested_for, combine=TRUE, 
                             combiner_fn = function(x) any(unlist(x)))
} else {
  nested_for_used <- NA
}
```


```{r test_data}
#| autoharp.scalars: ['any_missing']
if(exists("akima_data")){
  any_missing <- any(is.na(akima_data[,1]))
} else {
  any_missing <- NA
}
```


```{r test_compute_slopes}
#| autoharp.scalars: ['slopes_ok']
x_eg <- -2:2
y_eg <- x_eg^2
if(exists("compute_slopes")){
  slopes_ok <- identical(compute_slopes(x_eg,y_eg), 0)
} else {
  slopes_ok <- NA
}
```

```{r test_est_poly}
#| autoharp.scalars: ['est_poly_ok']
#| autoharp.objs: ['est_poly', 'compute_slopes']
x_eg2 <- c(0, 1)
y_eg2 <- c(0, 1)
slopes_eg <- c(0, 2)
if(exists("est_poly")){
  est_poly_ok <- identical(est_poly(x_eg2, y_eg2, slopes_eg, n=5),
                           .est_poly(x_eg2, y_eg2, slopes_eg, n=5))
} else {
  est_poly <- NA
}
```


