# University Library System - Students & Teachers
# Needs only: install.packages("shiny") Run with: shiny::runApp("app.R")
# All the library logic is plain base R (The Book of R, Ch. 1-11). Shiny and
# date handling (Sys.Date, as.Date) are the only things beyond those chapters.
# Data is saved as CSV files in a "library_data" folder, so it survives restarts.
library(shiny)
# ---- Settings: named vectors (Ch. 2) ----
LOAN_DAYS <- c(Student = 14, Teacher = 30)
MAX_LOANS <- c(Student = 3, Teacher = 6)
FINE_PER_DAY <- 50
DATA_DIR <- "library_data"
TABLES <- c("users", "books", "copies", "loans", "holds", "requests")
naira <- function(x) paste0("\u20A6", format(x, big.mark = ",", trim = TRUE))
# ---- Files: read.csv / write.csv (Ch. 8) ----
save_table <- function(x, name) write.csv(x, file.path(DATA_DIR, paste0(name, ".csv")), row.names = FALSE)
load_table <- function(name) read.csv(file.path(DATA_DIR, paste0(name, ".csv")), stringsAsFactors = FALSE)
# ---- Starting data: data frames (Ch. 5), strings (Ch. 4), loops (Ch. 10) ----
make_seed <- function() {
today <- Sys.Date()
nm <- c("Adebayo Tunde", "Chioma Okafor", "Ibrahim Musa", "Ngozi Eze", "Folake Adeyemi",
"Dr. Bello Yusuf", "Mrs. Kemi Ogunleye", "Mr. Emeka Nwosu", "Dr. Amina Sani", "Prof. Segun Adewale")
users <- data.frame(
user_id = c(sprintf("STU%03d", 1:5), sprintf("TCH%03d", 1:5)), name = nm,
role = rep(c("Student", "Teacher"), each = 5),
email = paste0(tolower(gsub(" ", ".", sub("^(Dr|Mr|Mrs|Prof)\\. ", "", nm))), "@school.edu.ng"),
password = "pass123", stringsAsFactors = FALSE)
bk <- read.csv(quote = "", sep = "|", stringsAsFactors = FALSE, text = "title|author|category
The Book of R|Tilman M. Davies|Statistics
R for Data Science|Hadley Wickham & Garrett Grolemund|Statistics
Introduction to Probability|Joseph Blitzstein & Jessica Hwang|Statistics
Practical Statistics for Data Scientists|Peter Bruce & Andrew Bruce|Statistics
Discovering Statistics Using R|Andy Field et al.|Statistics
Linear Algebra Done Right|Sheldon Axler|Mathematics
Elementary Differential Equations|William Boyce & Richard DiPrima|Mathematics
Calculus|James Stewart|Mathematics
Introduction to Algorithms|Thomas Cormen et al.|Computer Science
Java: The Complete Reference|Herbert Schildt|Computer Science
Python Crash Course|Eric Matthes|Computer Science
Principles of Economics|N. Gregory Mankiw|Economics
Macroeconomics|Olivier Blanchard|Economics
Things Fall Apart|Chinua Achebe|Literature
Half of a Yellow Sun|Chimamanda Ngozi Adichie|Literature
University Physics|Hugh Young & Roger Freedman|Physics
A Brief History of Time|Stephen Hawking|Physics
A History of Nigeria|Toyin Falola & Matthew Heaton|History
Oxford Advanced Learner's Dictionary|A. S. Hornby|Reference
Statistics|David Freedman, Robert Pisani & Roger Purves|Statistics")
n <- nrow(bk)
bk$book_id <- sprintf("B%03d", 1:n); bk$isbn <- sprintf("SAMPLE-ISBN-%03d", 1:n)
bk$location <- sprintf("Shelf %s-%02d, Floor %d", toupper(substr(bk$category, 1, 2)), 1:n,
ifelse(bk$category %in% c("Literature", "History", "Reference", "Economics"), 1, 2))
bk <- bk[, c("book_id", "isbn", "title", "author", "category", "location")]
ncp <- c(3, 2, 2, 2, 2, 2, 2, 3, 2, 3, 3, 2, 2, 1, 2, 2, 2, 2, 1, 2)
cp <- data.frame(copy_id = sprintf("C%04d", seq_len(sum(ncp))), book_id = rep(bk$book_id, ncp),
status = "Available", stringsAsFactors = FALSE)
# book number, member, days ago borrowed, days kept before returning (NA = still out)
sp <- data.frame(
b = c(1, 2, 3, 14, 5, 7, 8, 9, 10, 11, 12, 1, 13, 3),
u = c("STU001","STU002","STU003","STU004","STU005","TCH001","TCH002","TCH003","TCH004","STU001","STU002","STU003","TCH005","STU005"),
ago = c(5, 20, 30, 16, 40, 10, 45, 60, 3, 25, 8, 50, 12, 2),
ret = c(NA, NA, 12, NA, 20, NA, NA, 25, NA, 10, NA, 14, NA, NA))
loans <- NULL
for (i in seq_len(nrow(sp))) {
bid <- bk$book_id[sp$b[i]]
role <- users$role[match(sp$u[i], users$user_id)]
cid <- cp$copy_id[cp$book_id == bid & cp$status == "Available"][1]
out <- today - sp$ago[i]; due <- out + LOAN_DAYS[[role]]
back <- if (is.na(sp$ret[i])) as.Date(NA) else out + sp$ret[i]
if (is.na(back)) cp$status[cp$copy_id == cid] <- "Borrowed"
loans <- rbind(loans, data.frame(
loan_id = sprintf("L%04d", i), copy_id = cid, book_id = bid, user_id = sp$u[i],
out = out, due = due, back = back,
fine = if (is.na(back)) 0 else max(0, as.numeric(back - due)) * FINE_PER_DAY,
renewals = 0L, stringsAsFactors = FALSE))
}
holds <- data.frame(res_id = "R0001", book_id = "B014", user_id = "STU005", status = "Waiting", stringsAsFactors = FALSE)
requests <- data.frame(req_id = character(), user_id = character(), title = character(), author = character(),
note = character(), date = character(), status = character(), stringsAsFactors = FALSE)
list(users = users, books = bk, copies = cp, loans = loans, holds = holds, requests = requests)
}
if (!dir.exists(DATA_DIR)) {
dir.create(DATA_DIR)
s <- make_seed()
for (t in TABLES) save_table(s[[t]], t)
}
init <- list()
for (t in TABLES) init[[t]] <- load_table(t)
for (col in c("out", "due", "back")) init$loans[[col]] <- as.Date(init$loans[[col]])
db <- reactiveValues(users = init$users, books = init$books, copies = init$copies,
loans = init$loans, holds = init$holds, requests = init$requests)
commit <- function() for (t in TABLES) save_table(db[[t]], t)
# ---- Library functions: writing functions (Ch. 11), if/else and loops (Ch. 10) ----
rs <- function(ok, msg) list(ok = ok, msg = msg)
title_of <- function(id) db$books$title[match(id, db$books$book_id)]
card <- function(label, value) div(class = "stat", div(class = "v", value), div(class = "l", label))
dmy <- function(d) format(d, "%d %b %Y")
free_copy <- function(cid) { # returned copy goes to next person waiting, else back on the shelf
cp <- db$copies; i <- which(cp$copy_id == cid); h <- db$holds
w <- which(h$book_id == cp$book_id[i] & h$status == "Waiting")
if (length(w) > 0) {
h$status[w[1]] <- "Ready"; db$holds <- h; cp$status[i] <- "On hold"
} else {
cp$status[i] <- "Available"
}
db$copies <- cp
}
borrow <- function(uid, bid, qty = 1) {
u <- db$users[db$users$user_id == uid, ]; n <- 0; why <- ""
for (k in seq_len(qty)) {
l <- db$loans; mine <- l[l$user_id == uid & is.na(l$back), ]
h <- db$holds; rdy <- which(h$user_id == uid & h$book_id == bid & h$status == "Ready")
cp <- db$copies; j <- which(cp$book_id == bid & cp$status == (if (length(rdy) > 0) "On hold" else "Available"))
if (nrow(mine) >= MAX_LOANS[[u$role]]) { why <- paste("Borrowing limit reached:", MAX_LOANS[[u$role]], "books."); break }
if (u$role == "Student" && bid %in% mine$book_id) { why <- "You already have this book."; break }
if (length(j) == 0) { why <- "No copy available. Use Reserve to join the waiting list."; break }
if (length(rdy) > 0) { h$status[rdy[1]] <- "Fulfilled"; db$holds <- h }
cp$status[j[1]] <- "Borrowed"; db$copies <- cp
db$loans <- rbind(l, data.frame(
loan_id = sprintf("L%04d", nrow(l) + 1), copy_id = cp$copy_id[j[1]], book_id = bid, user_id = uid,
out = Sys.Date(), due = Sys.Date() + LOAN_DAYS[[u$role]], back = as.Date(NA),
fine = 0, renewals = 0L, stringsAsFactors = FALSE))
n <- n + 1
}
if (n == 0) return(rs(FALSE, why))
commit()
rs(TRUE, paste0("Borrowed ", n, " cop", if (n == 1) "y" else "ies", " of '", title_of(bid), "'. Due ",
dmy(Sys.Date() + LOAN_DAYS[[u$role]]), if (nzchar(why)) paste0(" (stopped: ", why, ")") else ""))
}
reserve <- function(uid, bid) {
cp <- db$copies; h <- db$holds
if (any(cp$book_id == bid & cp$status == "Available")) return(rs(FALSE, "A copy is available now. Borrow it instead."))
if (any(h$user_id == uid & h$book_id == bid & h$status %in% c("Waiting", "Ready"))) return(rs(FALSE, "You already reserved this book."))
db$holds <- rbind(h, data.frame(res_id = sprintf("R%04d", nrow(h) + 1), book_id = bid,
user_id = uid, status = "Waiting", stringsAsFactors = FALSE))
commit()
rs(TRUE, paste0("Added to the waiting list for '", title_of(bid), "'. Position: ",
sum(h$book_id == bid & h$status == "Waiting") + 1))
}
giveback <- function(lid) {
l <- db$loans; i <- which(l$loan_id == lid)
late <- max(0, as.numeric(Sys.Date() - l$due[i])); fine <- late * FINE_PER_DAY
l$back[i] <- Sys.Date(); l$fine[i] <- fine; db$loans <- l
free_copy(l$copy_id[i]); commit()
rs(TRUE, paste0("Returned '", title_of(l$book_id[i]), "'.", if (fine > 0) paste(" Late fine:", naira(fine)) else " Thank you!"))
}
renew <- function(lid) {
l <- db$loans; i <- which(l$loan_id == lid)
role <- db$users$role[match(l$user_id[i], db$users$user_id)]
if (Sys.Date() > l$due[i]) return(rs(FALSE, "Overdue loans cannot be renewed. Please return the book."))
if (l$renewals[i] >= 2) return(rs(FALSE, "Maximum of 2 renewals reached."))
if (any(db$holds$book_id == l$book_id[i] & db$holds$status == "Waiting")) return(rs(FALSE, "Someone is waiting for this book."))
l$due[i] <- l$due[i] + LOAN_DAYS[[role]]; l$renewals[i] <- l$renewals[i] + 1L; db$loans <- l
commit(); rs(TRUE, paste("Renewed. New due date:", dmy(l$due[i])))
}
# ---- UI ----
css <- "body{background:#f6f8fb}.card{background:#fff;border-radius:10px;padding:20px;box-shadow:0 1px 4px rgba(0,0,0,.1)}
.topbar{display:flex;justify-content:space-between;align-items:center;padding:10px 0;border-bottom:1px solid #dde3ea;margin-bottom:10px}
.cards{display:flex;flex-wrap:wrap;gap:12px;margin-bottom:15px}.stat{background:#fff;border-radius:10px;padding:14px 18px;min-width:140px;box-shadow:0 1px 4px rgba(0,0,0,.1)}
.stat .v{font-size:26px;font-weight:700;color:#2c7be5}.stat .l{color:#6b7785;font-size:13px}
.notif{background:#fff;border-left:4px solid #2c7be5;padding:8px 12px;margin-bottom:8px;border-radius:4px}
.notif.bad{border-left-color:#d9534f}.notif.warn{border-left-color:#f0ad4e}.muted{color:#6b7785}"
login_ui <- div(class = "card", style = "max-width:540px;margin:30px auto;",
h3("University Library System"),
tabsetPanel(
tabPanel("Login", br(), textInput("lid", "Student/Staff ID or Email"), passwordInput("lpw", "Password"),
actionButton("login", "Log in", class = "btn-primary")),
tabPanel("Register", br(), textInput("rn", "Full name"), textInput("re", "Email"),
selectInput("rr", "I am a", c("Student", "Teacher")), passwordInput("rp", "Password (min 6 characters)"),
actionButton("reg", "Create account", class = "btn-primary"))),
hr(), strong("Demo accounts (password: pass123)"), tableOutput("demo"))
ui <- fluidPage(tags$head(tags$style(HTML(css))), uiOutput("page"))
# ---- Server ----
server <- function(input, output, session) {
me <- reactiveVal(NULL)
note <- function(x) showNotification(x$msg, type = if (x$ok) "message" else "error")
user <- reactive({ req(me()); db$users[db$users$user_id == me(), ] })
# Login, registration, logout
output$demo <- renderTable(db$users[, c("user_id", "name", "role")])
observeEvent(input$login, {
k <- tolower(trimws(input$lid))
i <- which(tolower(db$users$user_id) == k | tolower(db$users$email) == k)
if (length(i) == 0 || db$users$password[i[1]] != input$lpw) return(note(rs(FALSE, "Invalid ID/email or password.")))
me(db$users$user_id[i[1]])
})
observeEvent(input$reg, {
em <- trimws(input$re)
if (trimws(input$rn) == "" || em == "" || nchar(input$rp) < 6) return(note(rs(FALSE, "Fill every field; password needs 6+ characters.")))
if (tolower(em) %in% tolower(db$users$email)) return(note(rs(FALSE, "Email already registered.")))
id <- sprintf("%s%03d", c(Student = "STU", Teacher = "TCH")[[input$rr]], sum(db$users$role == input$rr) + 1)
db$users <- rbind(db$users, data.frame(user_id = id, name = trimws(input$rn), role = input$rr,
email = em, password = input$rp, stringsAsFactors = FALSE))
commit()
showModal(modalDialog(paste("Account created. Your ID is", id, "- log in with it or your email."), easyClose = TRUE))
})
observeEvent(input$logout, me(NULL))
# Layout: Teachers get one extra tab
output$page <- renderUI({
if (is.null(me())) return(login_ui)
u <- isolate(user())
tabs <- list(
tabPanel("Dashboard", br(), uiOutput("dash"), plotOutput("act", height = "280px")),
tabPanel("Search & Borrow", br(),
fluidRow(column(4, textInput("q", "Search title, author or ISBN"),
selectInput("catf", "Category", c("All", sort(unique(init$books$category)))),
checkboxInput("avail", "Available only")),
column(8, tableOutput("results"), uiOutput("bookui"), uiOutput("detail"), uiOutput("qtyui"),
actionButton("borrow", "Borrow", class = "btn-success"),
actionButton("reserve", "Reserve", class = "btn-warning")))),
tabPanel("My Loans", br(), h4("Current loans"), tableOutput("mine"), uiOutput("loanui"),
actionButton("renew", "Renew"), actionButton("ret", "Return"),
hr(), h4("My reservations"), tableOutput("myres"), uiOutput("holdui"), actionButton("cancel", "Cancel reservation"),
hr(), h4("Borrowing history"), tableOutput("hist")),
tabPanel("Alerts", br(), uiOutput("alerts")),
tabPanel("My Account", br(), uiOutput("acct"), hr(), h4("Change password"),
passwordInput("op", "Current password"), passwordInput("np", "New password (min 6 characters)"),
actionButton("chpw", "Update password")))
if (u$role == "Teacher") tabs <- c(tabs, list(
tabPanel("Request Book", br(), textInput("rt", "Book title"), textInput("ra", "Author"),
textInput("rnote", "Why is it needed? (e.g. course, class size)"),
actionButton("sendreq", "Send request", class = "btn-success"), hr(), h4("My requests"), tableOutput("myreq"))))
tagList(div(class = "topbar", strong("University Library System"),
span(paste0(u$name, " (", u$role, ") "), actionButton("logout", "Log out", class = "btn-sm"))),
do.call(tabsetPanel, c(list(id = "tabs"), tabs)))
})
# Loans with lateness and fines worked out (Ch. 6: NA, Ch. 10: ifelse)
lf <- reactive({
l <- db$loans; act <- is.na(l$back); end <- l$back; end[act] <- Sys.Date()
l$late <- pmax(0, as.numeric(end - l$due)); l$active <- act
l$owed <- ifelse(act, l$late * FINE_PER_DAY, l$fine)
b <- match(l$book_id, db$books$book_id); l$title <- db$books$title[b]; l$category <- db$books$category[b]
l
})
mine <- reactive({ req(me()); d <- lf(); d[d$user_id == me() & d$active, ] })
myh <- reactive({
req(me()); h <- db$holds; h <- h[h$user_id == me() & h$status %in% c("Waiting", "Ready"), ]
h$title <- title_of(h$book_id); h
})
# Dashboard + base R plot (Ch. 7)
output$dash <- renderUI({
u <- user(); m <- mine()
tagList(h3(paste("Welcome,", u$name)),
div(class = "cards", card("Books borrowed", paste(nrow(m), "of", MAX_LOANS[[u$role]])), card("Overdue", sum(m$late > 0)),
card("Fines accruing", naira(sum(m$owed))), card("Active reservations", nrow(myh()))))
})
output$act <- renderPlot({
d <- lf(); d <- d[d$user_id == me(), ]; req(nrow(d) > 0)
par(mar = c(4, 9, 3, 1))
barplot(sort(table(d$category)), horiz = TRUE, las = 1, col = "steelblue",
main = "My borrowing by category", xlab = "Number of loans")
})
# Search and borrow
cat_view <- reactive({
b <- db$books; cp <- db$copies
b$avail <- sapply(b$book_id, function(i) sum(cp$book_id == i & cp$status == "Available"), USE.NAMES = FALSE)
q <- tolower(trimws(if (is.null(input$q)) "" else input$q))
if (nzchar(q)) b <- b[grepl(q, tolower(paste(b$title, b$author, b$isbn)), fixed = TRUE), ]
if (!is.null(input$catf) && input$catf != "All") b <- b[b$category == input$catf, ]
if (isTRUE(input$avail)) b <- b[b$avail > 0, ]
b
})
output$results <- renderTable({
d <- cat_view()
data.frame(Title = d$title, Author = d$author, Category = d$category, Location = d$location, Available = d$avail)
})
output$bookui <- renderUI({
d <- cat_view()
selectInput("book", "Choose a book", setNames(d$book_id, paste0(d$title, " (", d$avail, " available)")), selected = isolate(input$book))
})
output$detail <- renderUI({
req(input$book); b <- cat_view(); b <- b[b$book_id == input$book, ]; req(nrow(b) == 1)
wellPanel(h4(b$title), p(b$author, " | ", b$category), p("ISBN: ", b$isbn, " | ", b$location))
})
output$qtyui <- renderUI(if (user()$role == "Teacher") numericInput("qty", "Number of copies", 1, min = 1, max = 5))
observeEvent(input$borrow, {
req(input$book); qty <- if (is.null(input$qty) || is.na(input$qty) || input$qty < 1) 1 else input$qty
note(borrow(me(), input$book, qty))
})
observeEvent(input$reserve, { req(input$book); note(reserve(me(), input$book)) })
# My loans, reservations, history
output$mine <- renderTable({
m <- mine()
data.frame(Title = m$title, Borrowed = dmy(m$out), Due = dmy(m$due), `Days late` = m$late,
Fine = m$owed, Renewals = m$renewals, check.names = FALSE)
})
output$loanui <- renderUI({
m <- mine(); selectInput("loan", "Select a loan", setNames(m$loan_id, paste0(m$title, " (due ", dmy(m$due), ")")), selected = isolate(input$loan))
})
observeEvent(input$renew, { req(input$loan); note(renew(input$loan)) })
observeEvent(input$ret, { req(input$loan); note(giveback(input$loan)) })
output$myres <- renderTable({ h <- myh(); data.frame(Book = h$title, Status = h$status) })
output$holdui <- renderUI({
h <- myh(); selectInput("hold", "Select a reservation", setNames(h$res_id, paste0(h$title, " - ", h$status)), selected = isolate(input$hold))
})
observeEvent(input$cancel, {
req(input$hold); h <- db$holds; i <- which(h$res_id == input$hold); was <- h$status[i]
h$status[i] <- "Cancelled"; db$holds <- h
if (was == "Ready") {
cp <- db$copies; j <- which(cp$book_id == h$book_id[i] & cp$status == "On hold")
if (length(j) > 0) free_copy(cp$copy_id[j[1]])
}
commit(); note(rs(TRUE, "Reservation cancelled."))
})
output$hist <- renderTable({
req(me()); d <- lf(); d <- d[d$user_id == me() & !d$active, ]
data.frame(Title = d$title, Borrowed = dmy(d$out), Returned = dmy(d$back), Fine = d$owed)
})
# Alerts
output$alerts <- renderUI({
m <- mine(); it <- list()
for (k in seq_len(nrow(m))) {
r <- m[k, ]
if (r$late > 0) {
it <- c(it, list(div(class = "notif bad", sprintf("Overdue: '%s' is %d day(s) late. Fine so far: %s", r$title, as.integer(r$late), naira(r$owed)))))
} else if (as.numeric(r$due - Sys.Date()) <= 2) {
it <- c(it, list(div(class = "notif warn", sprintf("Due soon: '%s' on %s", r$title, dmy(r$due)))))
}
}
h <- myh()
for (k in seq_len(nrow(h))) if (h$status[k] == "Ready")
it <- c(it, list(div(class = "notif", sprintf("'%s' is ready. Borrow it from Search & Borrow.", h$title[k]))))
if (length(it) > 0) tagList(it) else p("No alerts. You're all caught up.")
})
# Account and (teachers) book requests
output$acct <- renderUI({ u <- user(); tagList(p(strong("Name: "), u$name), p(strong("ID: "), u$user_id), p(strong("Role: "), u$role), p(strong("Email: "), u$email)) })
observeEvent(input$chpw, {
i <- which(db$users$user_id == me())
if (input$op != db$users$password[i]) return(note(rs(FALSE, "Current password is wrong.")))
if (nchar(input$np) < 6) return(note(rs(FALSE, "New password needs 6+ characters.")))
u <- db$users; u$password[i] <- input$np; db$users <- u; commit(); note(rs(TRUE, "Password updated."))
})
observeEvent(input$sendreq, {
if (trimws(input$rt) == "" || trimws(input$ra) == "") return(note(rs(FALSE, "Enter the title and author.")))
r <- db$requests
db$requests <- rbind(r, data.frame(req_id = sprintf("Q%04d", nrow(r) + 1), user_id = me(), title = trimws(input$rt),
author = trimws(input$ra), note = trimws(input$rnote), date = as.character(Sys.Date()), status = "Pending", stringsAsFactors = FALSE))
commit(); note(rs(TRUE, "Request sent to the library."))
})
output$myreq <- renderTable({ r <- db$requests; r <- r[r$user_id == me(), ]; data.frame(Title = r$title, Author = r$author, Date = r$date, Status = r$status) })
}
shinyApp(ui, server)
## PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents