progress.qmd

---
title: "Learning R"
format: html
---

<!-- This file is not intended to be edited -->
<!-- Render this file to see automated progress updates on your exercises -->

## Setup

You'll want to install the following prior to starting this course:

* [R and RStudio](https://posit.co/download/rstudio-desktop/)

On a related note, if you are a student (i.e. if you must have a '.edu' email and a student ID card), you should check out the [GitHub Student Developer Pack](https://education.github.com/pack). It comes with all sorts of freebies and discounts for developer tools including things like training, GitHub Pro, JetBrains, Microsoft Azure, Codespaces, and GitKraken.

## Your progress

```{r}
#| include: false

library(dplyr)
library(purrr)

if(!require(LearnR))
    c("The LearnR package is required to run this file.",
      "First, install the `devtools` package from CRAN,",
      "Then run this command: devtools::install_github('johnsonra/LearnR')") %>%
    paste(collapse = '\n') %>%
    stop()

# check that we are running the most recent version of LearnR
if(sessionInfo()$otherPkgs$LearnR$Version != "1.0-2")
    warning('Check your version of LearnR. A newer version may be available')

library(SnowballC)
library(quarto)

library(knitr)


# sample solutions base (solutions branch)
# (use specific commit to keep things consistent with forks)
# add file path to this to get raw file content
solution_sha <- '72821f39ccf1a98aa0b0be839f697446eac0b993'
solution_base <- paste0('https://raw.githubusercontent.com/johnsonra/Learning-R/', solution_sha, '/')

# starter code base (main branch)
starter_sha <- '0774eeb802af31ec0b0925ea0361e5694daf98e6'
starter_base <- paste0('https://raw.githubusercontent.com/johnsonra/Learning-R/', starter_sha, '/')


# check submission against solution
checks <- tibble(modules = list.files('Modules')) %>%
    filter(!grepl("Writing Good Software", modules)) %>%
    mutate(# paths to files on GitHub
           starter_path = paste0(starter_base, 'Modules/', modules, '/exercises.qmd'),
           solution_path = paste0(solution_base, 'Modules/', modules, '/exercises.qmd'),
           submission_path = paste0('Modules/', modules, '/exercises.qmd'),
           
           # check to see if they have started on the exercise
           started = map2_lgl(starter_path, submission_path, ~ {
               starter_file <- readLines(.x)
               submission_file <- readLines(.y)
               
               if(length(starter_file) != length(submission_file)) # if we have added lines, work has begun
                   return(TRUE)
               if(any(starter_file != submission_file)) # if the number of lines in the same, but some lines have changed...
                   return(TRUE)
               
               return(FALSE) # files are identical - work has not started
               }),
           
           # only parse these if they have submitted an update to this file
           submissions = map(submission_path, ~ parse_qmd(.x)),
           
           # sample solutions from the solutions branch
           solutions = map(solution_path, ~ parse_qmd(.x)),
           
           # double check that the solution renders - if not, we'll count it as incomplete
           
           submission_renders = map2_lgl(modules, started, ~ {
               if(.y)
               {
                   val <- try(quarto_render(paste0('Modules/', .x, '/exercises.qmd')), silent = TRUE)
                   return(class(val) != 'try-error')
               }
               
               return(FALSE)}),
           
           # compare submission to solution
           code_sim = map2(submissions, solutions, ~ {
               val <- try(compare_source_code(.x$f_code, .y$f_code), silent = TRUE)
               if(class(val) == 'try-error')
                   return(0)
               return(val)}),
               
           text_sim = map2(submissions, solutions, ~ {
               val <- try(compare_text(.x$f_text, .y$f_text), silent = TRUE)
               if(class(val) == 'try-error')
                   return(0)
               return(val)}) %>%
               
               map(~ pgamma(.x, 1, 1, lower.tail = FALSE)), # convert distances to scores (figure out this distribution later - will probably be problem dependent)
           
           # Total score
           score = ifelse(started,
                          map2_dbl(code_sim, text_sim, ~ mean(.x * .y) %>% as.double),
                          0),
           
           # fields for the table below
           Lesson = as.character(NA),
           Score = as.character(NA))


#' @param score_i Numeric score in [0,1]
#' @param score_png Location of graphic to save
#' @param color Color to make the progress bar for each lesson
#' @param message Character value - message to print on top of the progress bar
plot_score <- function(score_i, score_png, color = 'green4', message = paste0(round(score_i*100), '%'))
{
    png(score_png, bg = 'transparent', height = 16, width = 100)
    par(mar = rep(0,4))                                                       # get rid of margins
    plot(c(0, 1), rep(1, 2), col = 'grey80', type = 'l', lwd = 17, bty = 'n', # background for score line
         xaxt = 'n', yaxt = 'n')
    lines(c(0, score_i), rep(1, 2), col = color, lwd = 17)                    # line from 0 to score
    text(0.5, 1, message)                                                     # percentage
    dev.off()
}

# Edit READMEs generated during checks to add feedback
for(l in 1:nrow(checks)) # for each lesson
{
  module_path <- paste0('Modules/', checks$modules[l], '/')

  # label if they haven't started the exercise
  if(!checks$started[l])
  {
    plot_score(1,
               paste0(module_path, 'score0.png'),
               color = rgb(.5,1,1),
               message = 'Not Started')
    next
  }
  
  # label if there is an issue rendering the file
  if(!checks$submission_renders[l])
  {
    plot_score(1,
               paste0(module_path, 'score0.png'),
               color = 'orange',
               message = 'Rendering Error')
  }else{
  
    # over-all score
    plot_score(checks$score[l],
               paste0(module_path, 'score0.png'))
  
    # read in rendered output
    f_md <- paste0(module_path, 'exercises.html')
    out_md <- readLines(f_md)
  
    # identify challenges
    challenges <- grepl('<section id="challenge-', out_md) %>%
      which()
  
    # double check that we have the correct number of challenges (hack module 2 for now)
    if(length(challenges) != length(checks$code_sim[[l]]) & l != 2)
    {
      warning("Number of challenges aren't equal to number of solutions")
      plot_score(1,
                 paste0(module_path, 'score0.png'),
                 color = 'orange',
                 message = 'Error') # this is likely because there is a hard return that was removed
                                    # (e.g. causing "<!-- Challenge..." to be included in the line before it should be)
    }else{
  
      for(i in 1:length(checks$code_sim[[l]])) # for each challenge in lesson `l`
      {
        # make graphic
        plot_score(with(checks, code_sim[[l]][i] * text_sim[[l]][i]),
                   paste0(module_path, 'score', i, '.png'))
          
        # another module 2 hack
        if(l == 2)
        {
            i_hack <- i + 1
        }else{
            i_hack <- i
        }
    
        # add graphic to readme
        out_md[challenges[i_hack] + 1] <- paste0(out_md[challenges[i_hack] + 1],
                                                 ' <img src="score', i, '.png">')
      }
    }

    # create table
    checks$Lesson[l] <- paste0('<a href="', module_path, 'exercises.html">', gsub('-', ' ', checks$modules[l]), "</a>")
    checks$Score[l] <- paste0('<a href="', module_path, '"><img src="', module_path, 'score0.png"></a>')
    # write changes
    cat(out_md, file = f_md, sep = '\n')
  }  
}
```

```{r}
#| echo: false

if(any(!is.na(checks$Lesson)))
  filter(checks, !is.na(Lesson)) %>%
  select(Lesson, Score) %>%
  kable(align = c('l', 'c'))
```