Mai demult, avansasem într-o doară ideea de a crea un pachet $\mathbf{R}$ procedurilor de realizare a unui orar școlar dezvoltate în [1] și [2] (și puse la punct treptat, în mai multe articole postate ulterior pe acest site). De fapt, pe principiul "do one thing and do it well", am avea de constituit nu un pachet, ci trei pachete (independente): unul destinat repartizării pe zile a lecțiilor prof|cls, unul care să vizeze lecțiile existente într-o zi și să asigure alocarea acestora pe orele 1:7 și unul care să se ocupe de reducerea ferestrelor existente pe un orar de zi.

Între timp (obligatoriu…), am lecturat R packages (2e) — H. Wickham & J. Bryan.

Precizăm că nu vom deroga de la obiceiul nostru (deloc rău) de a nu folosi RStudio (și nici vreun alt "IDE"); în plus, fiind aici o primă tentativă de împachetare, nu vom folosi deocamdată, nici Git (… alt "obicei", dar unul chiar prost!).

Contextul de lucru; numele pachetului

Preferăm să începem cu al doilea dintre cele trei pachete sugerate mai sus; asumăm existența unui set de date (data.frame) reprezentând pe câte o linie lecțiile prof|cls ale unei zile de lucru, cu următoarele proprietăți principale (caracteristice unui orar școlar): fiecare profesor apare de cel mult 7 ori (și la o aceeași clasă, de cel mult două ori); fiecare clasă apare de cel puțin 4 ori și cel mult 7 ori.
În coloana prof avem coduri (și nu "numele profesorilor") de lungime 3 sau 6, semnificând disciplina principală a profesorului (abreviată pe două litere) și un număr de ordine între cei încadrați pe o aceeași disciplină principală; un cod de lungime 6, dacă există, reprezintă un cuplaj (sau "profesor fictiv"), alipind două coduri de lungime 3: cei doi profesori au de făcut lecția respectivă cu câte o grupă de elevi ai clasei cls.

Admitem și existența unor tuplaje, într-un set suplimentar de date: profesorii din acest set au de intrat în câte o aceeași oră a zilei, la câte o grupă constituită din elevi de la două, trei sau chiar patru clase (sau eventual, la câte una dintre clasele respective, într-o aceeași oră); formal, un tuplaj este reprezentat inițial înscriind în prof vectorul profesorilor și în cls vectorul claselor "tuplate" acestora.
Putem avea și un caz particular de "tuplaj": în loc de un cuplaj ca Ds1Mz1 pe clasa 9A și deasemenea, pe clasa 9B (când cei doi profesori intră la o aceeași clasă pe câte o grupă a ei) — se consideră tuplajul (Ds1, Mz1) / (9A, 9B), când se intră nu pe grupe, ci, cu alternare săptămânală a celor două clase, Ds1 intră la 9A și în același timp, Mz1 la 9B.

Vom exemplifica mai jos asemenea seturi de date, având în vedere obligația de a include în pachet și exemple de folosire a funcțiilor din pachet (nu ne vom gândi deocamdată și la teste de inclus în pachet); dar desigur că seturile descrise mai sus vor trebui constituite de cel care va instala și va folosi pachetul.

Pe CRAN există mii de pachete și dacă ne gândim să adăugăm și noi unul — verificând în prealabil că nu există deja, un pachet similar — în primul rând numele acestuia trebuie să difere de cele existente (și să respecte anumite convenții); numim pachetul pe care urmează să-l creem hours2lessons ("set hours for lessons").
Prin pak::pkg_name_check("hours2lessons") constatăm că numele ales este valabil.

Vom folosi devtools, pachet care standardizează și prin funcțiile oferite, simplifică procesul de dezvoltare a unui pachet propriu.

Scheletul pachetului

Lansăm R din directorul de lucru STMP/ și instituim pachetul nostru:

vb@Home:~/STMP$ R -q
> library(devtools)
Loading required package: usethis
> create_package("hours2lessons")
✔ Creating 'hours2lessons/'
✔ Setting active project to '/home/vb/STMP/hours2lessons'
✔ Creating 'R/'
✔ Writing 'DESCRIPTION'
# ...
✔ Writing 'NAMESPACE'

Edităm în gedit, fișierul DESCRIPTION, înscriind:

Title: Alocă Pe Ore Lecțiile Zilei
Authors@R: 
    person("Vlad", "Bazon", , "vlad.bazon@gmail.com", role = c("aut", "cre"))
Description: Lecțiile prof/cls trebuie completate cu un câmp "ora", astfel încât
    oricare două lecții prof/cls/ora să nu se suprapună într-o aceeași oră.

Este obligatoriu să înscriem corect câmpul "License:":

> use_mit_license()  # adaugă o copie a unui fișier de licențiere "open source"
✔ Writing 'LICENSE'
✔ Writing 'LICENSE.md'
✔ Adding '^LICENSE\\.md$' to '.Rbuildignore'

În subdirectorul R/ avem de definit funcțiile pachetului, remodelând funcții din programele "between.R" și "mount_h2.R" din [1] și [2]; în funcțiile respective implicam "dialectul" tidyverse (pentru funcții ca dplyr::filter(), sau purrr::map()), precum și pachetul igraph (pentru a determina caracteristici — importante pentru procesul repartizării pe ore a lecțiilor — ale unor grafuri asociate profesorilor și claselor).
Dar în funcțiile pe care urmează să le înscriem în R/, nu mai putem folosi "library(tidyverse)" (ca în programele obișnuite); pentru a folosi funcțiile necesare fără a prefixa cu numele pachetului din care face parte fiecare (la fel cum facem în programele obișnuite, după ce încărcăm "tidyverse"), putem proceda astfel: declarăm în fișierul DESCRIPTION pachetele care conțin funcțiile respective și menționăm în fișierul NAMESPACE ce funcții folosim din fiecare dintre aceste pachete.
devtools ne facilitează operațiile menționate:

> use_package("dplyr")
✔ Adding 'dplyr' to Imports field in DESCRIPTION
• Refer to functions with `dplyr::fun()`
> use_import_from("dplyr", c("%>%", "mutate", "pull", "distinct", "select", "all_of", "filter"))
`use_import_from()` requires package-level documentation.
Would you like to add it now?
✔ Writing 'R/hours2lessons-package.R'
• Modify 'R/hours2lessons-package.R'
✔ Adding '@importFrom dplyr %>%', '@importFrom dplyr mutate', '@importFrom dplyr pull', '@importFrom dplyr distinct', '@importFrom dplyr select', '@importFrom dplyr all_of', '@importFrom dplyr filter' to 'R/hours2lessons-package.R'
✔ Writing 'NAMESPACE'
✔ Loading hours2lessons
> use_package("purrr")
> use_import_from("purrr", "map")
✔ Adding '@importFrom purrr map' to 'R/hours2lessons-package.R'
✔ Writing 'NAMESPACE'
✔ Loading hours2lessons
> use_package("igraph")
> use_import_from("igraph", c("graph_from_adjacency_matrix", "betweenness"))
> use_package("rlang")
> use_import_from("rlang", ".data")
> use_package("stats")
> use_import_from("stats", "setNames")

Prin devtools::check() ne putem convinge că deocamdată, lucrurile sunt în regulă (rezultă: "0 errors | 0 warnings | 0 notes") și dacă vrem, putem "instala" pachetul (ceea ce încă amânăm, fiindcă nu am definit nici o funcție proprie); dar pentru aceasta a trebuit totuși, să introducem fișierul ~/.Renviron, conținând "_R_CHECK_SYSTEM_CLOCK_=0" — pentru a evita producerea notei "unable to verify current time" (din câte am putut înțelege, "checking for future file timestamps" implică o coordonare cu un anumit server extern de "clock" devenit însă, indisponibil — rezultând "nota" menționată).

Funcția prin care obținem coeficienții "betweenness"

Alocarea lecțiilor prof|cls pe orele 1:7 decurge (v. [1], [2]) pe fiecare clasă în parte, într-o anumită ordine a claselor (cu reluare în cazul unei "blocări" la alocarea orelor pe lecțiile clasei curente) — anume, într-o ordine aleatorie ponderată însă (crescător) de numărul de profesori comuni la câte două clase.
Vom remodela funcțiile din programul "between.R" (v. [1], [2]) prin funcția R/scale_prof_cls(), în care constituim graful profesorilor (și graful claselor) cu adiacența dată de numărul de clase comune (respectiv, de numărul de profesori comuni) și returnăm într-o listă, vectorii de coeficienți "betweenness" ai acestor grafuri:

#' Scalează profesorii (clasele) după numărul de clase (profesori) în comun
#' @param LSS data.frame cu lecțiile prof|cls
#' @return lista de coeficienți betweenness pentru profesori și clase
#' @export
#'
scale_prof_cls <- function(LSS) {
    BTW <- list(prof=0, cls=0)
    if(is.factor(LSS$prof))
        LSS <- LSS %>% mutate(prof = as.character(.data$prof))
    cols <- colnames(LSS)
    for(q1 in cols) {
        q2 <- setdiff(cols, q1)
        FxS <- LSS %>% distinct(.data[[q1]]) %>% pull()
        SxF <- map(FxS, function(X) 
                   LSS %>% filter(.data[[q1]] == X) %>%
                   select(all_of(q2)) %>% distinct() %>% pull()) %>%
               setNames(FxS)
        Qn <- names(SxF)
        len <- length(Qn)
        adjm <- matrix(rep(0, len), nrow=len, ncol=len, byrow=TRUE, 
                       dimnames = list(Qn, Qn))
        for(K1 in Qn)
            for(K2 in Qn)
                if(K1 != K2)
                    adjm[K1, K2] <- length(intersect(SxF[[K1]], SxF[[K2]])) 
        G <- graph_from_adjacency_matrix(adjm, mode="undirected")
        BTW[[q1]] <- 0.0001 + 
                     sort(betweenness(G, directed=FALSE, normalized=TRUE))
    }
    BTW
}

În loc de a edita direct, puteam folosi use_r("scale_prof_cls") — obținând și documentația specifică funcțiilor de sub R/ (conform pachetului roxygen2), care prefixează mai sus definiția funcției noastre (descriind ce face funcția, ce parametri folosește, ce returnează și important — declarând prin @export că funcția respectivă este "publică", putând fi invocată imediat după instalarea pachetului).

Ar fi de evidențiat unele "amănunte"; de exemplu, de ce n-am folosi (ca într-un program obișnuit) mutate(prof = as.character(prof)) (în loc de "(.data$prof)")? În acest caz check() ne-ar fi produs "NOTE: scale_prof_cls: no visible binding for global variable ‘prof’"…

check() ne asigură că lucrurile sunt încă în regulă; putem instala pachetul:

> load_all()
> install()

N-ar fi fost momentul de a instala pachetul, fiindcă mai avem de adăugat niște funcții; dar l-am instalat totuși, pentru a-l verifica dintr-un program obișnuit: putem abandona sesiunea curentă de lucru (tastând q() la prompt-ul consolei); apoi, lansăm R -q dintr-un director în care avem un fișier lessons.RDS de lecții prof|cls ale unei zile și tastăm comenzile:

> library(hours2lessons)
> LS <- readRDS("lessons.RDS")
> str(LS)  # ne asigurăm minimal că avem lecții prof|cls
    'data.frame':	235 obs. of  2 variables:
     $ prof: Ord.factor w/ 72 levels "BC1"<"BC2"<"BC3"<..: 8 48 57 72 27 36 19 ...
     $ cls : chr  "10A" "10A" "10A" "10A" ...
> BW <- scale_prof_cls(LS)
> #   extragem niște eșantioane aleatorii din vectorii rezultați:
> sample(BW$prof, 5)
       CP1        BC2        EA1        Ro3        Fi2 
0.01363766 0.01941706 0.02998656 0.01840056 0.01887833 
> sample(BW$cls, 5)
       10I        10F        10G        11I        12G 
0.01660521 0.01040006 0.01843804 0.02377603 0.01313335 

Mai departe, pentru a completa pachetul cu alte funcții (și a evita ca prin aceasta, să avem în final un pachet "corupt"), dezinstalăm întâi pachetul: adăugăm în sesiunea de lucru redată mai sus, comanda remove.packages("hours2lessons"); apoi, închidem sesiunea respectivă prin q() și lansăm R -q chiar din subdirectorul hours2lessons/ (și nu din STMP/, în care lucrasem inițial) care păstrează fișierele-sursă ale pachetului (în acest fel vom putea folosi comenzile devtools ca și mai înainte, când am creat prima dată pachetul, fără a indica mereu și numele pachetului):

> load_all("./")  # încarcă (și verifică) pachetul-sursă din directorul curent
> check()  # 0 errors ✔ | 0 warnings ✔ | 0 notes ✔

Acum putem continua dezvoltarea pachetului respectiv.

Montarea orelor 1:7 pe setul lecțiilor (… cu simplificare)

Avem de remodelat funcția din programul mount_h2.R (v. [1], [2]); în acest scop, instituim întâi aceste două variabile interne (neexportate către utilizatorul pachetului):

> PERM <- readRDS("~/25apr/lstPerm47.RDS")  # matricele de permutări de 4..7 ore
> h2bin <- as.integer(c(1, 2, 4, 8, 16, 32, 64)) # măștile orelor 1:7 ale zilei
> use_data(PERM, h2bin, internal=TRUE)
✔ Setting active project to '/home/vb/STMP/hours2lessons'
✔ Adding 'R' to Depends field in DESCRIPTION
✔ Saving 'PERM', 'h2bin' to 'R/sysdata.rda'
> check()  # OK

Amânăm (nefiind neapărat necesară) documentarea modului în care am constituit lista "lstPerm47.RDS" (listă cu 4 membri, fiecare fiind matricea permutărilor-coloană de 4, respectiv 5, 6 și 7 elemente).

Prin use_r("mount_hours") înființăm acum funcția:

#' Adaugă 'ora' încât oricare două lecții prof|cls|ora să nu se suprapună
#' @param LSS data.frame cu lecțiile prof|cls
#' @return Un orar prof|cls|ora pentru ziua respectivă
#' @export
#'
mount_hours <- function(LSS) {
    BTW <- scale_prof_cls(LSS)
    task <- LSS %>%
            mutate(prof = factor(.data$prof, 
                   levels = names(BTW$prof), ordered=TRUE)) %>%
            dplyr::arrange(.data$prof, .data$cls)  # după BTW$prof
    Z <- split(task, ~cls)  # desparte lecţiile după clasă
    lstCls <- names(Z)
    hBits <- rep(0L, nlevels(task$prof))  # șabloanele binare de alocare
    names(hBits) <- levels(task$prof)

    mountHtoCls <- function(Q) {  # alocă pe 1..7, lecţiile unei clase
        mpr <- PERM[[nrow(Q)-3]]  # matricea de permutări a orelor clasei
        bhp <- bith[Q$prof]  # biţii alocaţi anterior, profesorilor clasei
        for(i in sample(ncol(mpr))) {
            po <- mpr[, i]
            bis <- bitwShiftL(1L, po - 1L)
            if(any(bitwAnd(bhp, bis) > 0L)) 
                next  # caută o permutare care să evite biţi '1' alocaţi deja

            if(anyDuplicated(names(bhp)) > 0)  # profesor cu 2 ore la clasă
                for(jn in 1:(nrow(Q)-1))  # cumulează biţii asociaţi orelor
                    if(names(bhp)[jn] == names(bhp)[jn+1]) 
                        bis[jn] <- bis[jn+1] <- bis[jn] + bis[jn+1]
            blks <- bitwOr(bhp, bis)   # biţii vechilor şi noii alocări

            bith[Q$prof] <<- blks  # actualizează vectorul alocărilor (global)
            return(Q %>% mutate(ora = po))  # înscrie orarul clasei curente
        }
        return(NULL)  # pentru clasa curentă NU s-a reuşit un orar corect
    }

    odf <- vector("list", length(lstCls))
    names(odf) <- lstCls
    inr <- 0  # contorizează încercările nereușite
    while(TRUE) {
        succ <- TRUE
        bith <- hBits  # reiniţializează vectorul alocărilor (global)
        lstCls <- sample(lstCls, prob = BTW$cls)
        for(K in lstCls) {    cat("*")
            W <- mountHtoCls(Z[[K]])  # încearcă un orar pentru clasa curentă
            if(is.null(W)) {   cat(" / ")  # pentru ecou pe ecran 
                inr <- inr + 1 
                succ <- FALSE 
                break  # abandonează ('for') în caz de insucces
            }
            odf[[K]] <- W  # salvează orarul constituit clasei curente
        }
        if(succ)
            break
    }
    cat(inr, "attempts ")  # nu "încercări": în cod trebuie folosit numai ASCII
    dplyr::bind_rows(odf)  # returnează orarul lecţiilor zilei (prof|cls|ora)
}

Se poate observa că n-am făcut decât să preluăm din programul anterior "mount_h2.R" (renunțând însă la contorizarea ferestrelor) și să adaptăm puțin codul respectiv; a trebuit desigur, să iterăm de vreo trei ori check(), pentru a rezolva deficiențele apărute: de exemplu, fiindcă în NAMESPACE am omis să importăm din dplyr unele funcții întrebuințate mai sus (ca arrange, sau bind_rows()) am prefixat mai sus, cu numele pachetului (în loc de a mai adăuga în NAMESPACE "importFrom(dplyr,arrange)") etc.).

Desigur, putem reinstala pachetul astfel constituit și putem iarăși verifica funcționalitatea lui pe un fișier existent lessons.RDS; de fapt, o asemenea verificare este necesară: check() ne semnalase că nu putem folosi "Z <- task %>% split(.$cls)" cum aveam inițial, încât am folosit "Z <- task %>% split(.data$cls)" ceea ce a fost acceptat de check() — dar la "verificare" (după reinstalarea pachetului)… pentru linia respectivă am obținut eroarea "Can't subset '.data' outside of a data mask context.".
Revenind atunci la sursa pachetului, până la urmă am folosit (cu succes de data aceasta) formula simplă "Z <- split(task, ~cls)".

Funcția scrisă mai sus este într-adevăr lungă (știm… știm că se recomandă funcții "scurte", care fac — și bine — câte un singur lucru); totuși… nu suficient de lungă! Am neglijat (să zicem, pentru "simplitate") existența unor cuplaje și deasemenea, existența unor tuplaje (și e drept că în setul lessons.RDS folosit pentru "verificare" nu aveam cuplaje, că altfel… probabil am fi recuzat "la timp" simplificarea făcută mai sus).