CARE Partner App – Deployment

C:/Users/SamOkello/OneDrive - CARE International/Desktop/deploy/ ├─ app/ │ ├─ app.R │ └─ .rsconnectignore ├─ deployment.qmd └─ .rsconnectignore

1) Set shinyapps.io account (run once)

#| label: account-setup #| eval: false # flip to TRUE only when you want to set credentials install.packages(“rsconnect”) library(rsconnect)

rsconnect::setAccountInfo( name = “okellobwibo”, token = “77B22F5DFD02B29F82C0DFBB9AFC4AD3”, secret = “42Dy8rOzHddJLgSxi0YzexydkXjO1lLi5FT3kLVF” )

#| label: deploy-app #| eval: false # flip to TRUE to deploy from this doc library(rsconnect)

app_dir <- “C:/Users/SamOkello/OneDrive - CARE International/Desktop/deploy/app”

deployApp( appDir = app_dir, appPrimaryDoc = “app.R”, appFiles = c(“app.R”), # add “www”,“data” if you include them account = “okellobwibo”, appName = “care-uganda-fy25-dashboard”, launch.browser = TRUE, logLevel = “verbose” )

---

2) app/app.R (your Shiny dashboard)

Save as UTF-8. This is the revised app with currency/percent label helpers and robust date parsing. It ends with shinyApp(ui, server).

```r # app.R — CARE Uganda FY25 Partnerships Dashboard (Shiny)

options(shiny.maxRequestSize = 100 * 1024^2) # 100 MB uploads

library(shiny) library(shinydashboard) library(bslib) library(tidyverse) library(readxl) library(janitor) library(lubridate) library(scales) library(plotly) library(DT) library(treemapify) library(writexl)

———- Helpers ———-

parse_date_flexible <- function(x, year_anchor = “-01-01”) { n <- length(x) out <- as.Date(rep(NA), origin = “1970-01-01”) xc <- as.character(x) |> trimws()

is_year_str <- grepl(“^\d{4}$”, xc) out[is_year_str] <- as.Date(paste0(xc[is_year_str], year_anchor))

if (is.numeric(x)) { is_year_num <- !is.na(x) & is.finite(x) & (x %% 1 == 0) & x >= 1900 & x <= 2100 out[is_year_num] <- as.Date(paste0(as.integer(x[is_year_num]), year_anchor)) is_serial <- !is.na(x) & is.finite(x) & !is_year_num out[is_serial] <- as.Date(x[is_serial], origin = “1899-12-30”) }

need <- is.na(out); if (any(need)) { y <- suppressWarnings(ymd(xc[need], quiet = TRUE)); out[need & !is.na(y)] <- y[!is.na(y)] } need <- is.na(out); if (any(need)) { y <- suppressWarnings(mdy(xc[need], quiet = TRUE)); out[need & !is.na(y)] <- y[!is.na(y)] } need <- is.na(out); if (any(need)) { y <- suppressWarnings(dmy(xc[need], quiet = TRUE)); out[need & !is.na(y)] <- y[!is.na(y)] } out }

standardize_category <- function(x){ x0 <- tolower(trimws(x)) case_when( x0 %in% c(“national ngo”,“ngo (national)”,“local ngo”) ~ “National NGO”, x0 %in% c(“ingo”,“international ngo”) ~ “INGO”, x0 %in% c(“cbo”,“community based organization”,“community-based organization”) ~ “CBO”, x0 %in% c(“cso”,“civil society organization”,“civil-society organization”) ~ “CSO”, x0 %in% c(“cooperative”,“co-op”,“coop”) ~ “Cooperative”, x0 %in% c(“private sector”,“private”,“company”,“ltd”,“limited”,“private_sector”) ~ “Private Sector”, x0 %in% c(“government”,“government agency”,“ministry”,“district”,“government_agency”) ~ “Government Agency”, x0 %in% c(“un”,“un agency”,“un-agency”) ~ “UN Agency”, x0 %in% c(“academic”,“research”,“university”,“academic/research”,“academic_research”) ~ “Academic/Research”, x0 %in% c(“bank”,“financial institution”) ~ “Bank”, x0 %in% c(“wro_wlo_wro”,“wro/wlo/wro”,“wro”,“wlo”) ~ “WRO/WLO”, TRUE ~ str_to_title(x0) ) } standardize_district <- function(x){ x0 <- x %>% as.character() %>% stringr::str_squish() %>% str_to_title() gsub(” District$“,”“, x0) } safe_div <- function(num, den){ ifelse(is.na(den) | den == 0, NA_real_, num/den) }

Label helpers

dollar_lab <- label_dollar(accuracy = 1, prefix = “$”) pct_lab <- label_percent(accuracy = 1)

———- UI ———-

header <- dashboardHeader(title = “CARE Uganda • Partnerships FY25”)

sidebar <- dashboardSidebar( fileInput(“infile”, “Upload FY25 Excel”, accept = c(“.xlsx”,“.xls”)), helpText(“Columns: Partner ID, Partner_name, District_office location, Email address, Entity_start_date, Start_date_partnership, Phone, Category_partner, FY25_Budget, FY25_Expenses, No_contracts”), hr(), sliderInput(“abs_cap”, “Absorption cap (%) for visuals”, min = 50, max = 500, value = 200, step = 10), checkboxInput(“filter_valid”, “Only partners with valid budget > 0”, TRUE), selectInput(“cat_filter”, “Filter by category”, choices = c(“All”), selected = “All”, multiple = TRUE), selectInput(“dist_filter”, “Filter by district”, choices = c(“All”), selected = “All”, multiple = TRUE), hr(), downloadButton(“download_excel”, “Download Cleaned Outputs”) )

body <- dashboardBody( bslib::bs_theme_dependencies(bs_theme(version = 5)), fluidRow( valueBoxOutput(“vb_partners”, width = 2), valueBoxOutput(“vb_budget”, width = 2), valueBoxOutput(“vb_expenses”, width = 2), valueBoxOutput(“vb_abs”, width = 2), valueBoxOutput(“vb_top5”, width = 2), valueBoxOutput(“vb_hhi”, width = 2) ), fluidRow( box(title = “Absorption Distribution”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_abs_hist”, height = 320)), box(title = “Budget by Category”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_budget_cat”, height = 320)) ), fluidRow( box(title = “Top 15 Partners by Budget”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_top15”, height = 360)), box(title = “Budget vs Absorption (bubble)”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_bubble”, height = 360)) ), fluidRow( box(title = “Absorption Bands (share of partners)”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_bands_share”, height = 320)), box(title = “Localization Share (Donut)”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_local_donut”, height = 320)) ), fluidRow( box(title = “Heatmap: Budget by District x Category”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_heatmap”, height = 360)), box(title = “Treemap: Category → Partner (Budget)”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_treemap”, height = 360)) ), fluidRow( box(title = “Tenure vs Absorption (with smoother)”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_tenure_abs”, height = 360)), box(title = “Timeline: Entity Founded vs CARE Start”, width = 6, status = “primary”, solidHeader = TRUE, plotlyOutput(“plot_timeline”, height = 360)) ), fluidRow( box(title = “Variance Waterfall (Expenses - Budget)”, width = 12, status = “warning”, solidHeader = TRUE, plotlyOutput(“plot_waterfall”, height = 360)) ), fluidRow( box(title = “Partner Scorecard”, width = 12, status = “success”, solidHeader = TRUE, DTOutput(“tbl_scorecard”)) ), fluidRow( box(title = “Risk Flags”, width = 12, status = “danger”, solidHeader = TRUE, DTOutput(“tbl_risks”)) ) )

ui <- dashboardPage(header, sidebar, body, skin = “yellow”)

———- SERVER ———-

server <- function(input, output, session){

fy_end <- as.Date(“2025-06-30”)

raw_react <- reactive({ path <- req({ if (!is.null(input\(infile\)datapath)) input\(infile\)datapath else if (file.exists(“CARE_Uganda_Partnerships_FY25.xlsx”)) “CARE_Uganda_Partnerships_FY25.xlsx” else validate(“Upload your FY25 Excel (left sidebar).”) }) readxl::read_excel(path) |> janitor::clean_names() })

dat_base <- reactive({ raw <- raw_react() |> janitor::remove_empty(c(“rows”,“cols”))

req_cols <- c("partner_id","partner_name","district_office_location","email_address",
              "entity_start_date","start_date_partnership","phone","category_partner",
              "fy25_budget","fy25_expenses","no_contracts")
miss <- setdiff(req_cols, names(raw))
validate(need(length(miss)==0, paste("Missing columns:", paste(miss, collapse=", "))))

dat <- raw |>
  mutate(across(where(is.character), ~ stringr::str_squish(.x))) |>
  transmute(
    partner_id               = as.character(partner_id),
    partner_name             = as.character(partner_name),
    district_office_location = standardize_district(district_office_location),
    email_address            = tolower(as.character(email_address)),
    entity_start_date        = parse_date_flexible(entity_start_date),
    start_date_partnership   = parse_date_flexible(start_date_partnership),
    phone                    = as.character(phone),
    category_partner         = standardize_category(category_partner),
    fy25_budget              = readr::parse_number(as.character(fy25_budget)),
    fy25_expenses            = readr::parse_number(as.character(fy25_expenses)),
    no_contracts             = as.integer(readr::parse_number(as.character(no_contracts)))
  ) |>
  distinct()

dat |>
  mutate(
    absorption_rate   = if_else(fy25_budget > 0, fy25_expenses / fy25_budget, NA_real_),
    partner_tenure_yrs= if_else(!is.na(start_date_partnership),
                                time_length(interval(start_date_partnership, fy_end), "years"), NA_real_),
    entity_age_yrs    = if_else(!is.na(entity_start_date),
                                time_length(interval(entity_start_date, fy_end), "years"), NA_real_),
    avg_contract_size = if_else(!is.na(no_contracts) & no_contracts > 0, fy25_budget/no_contracts, NA_real_),
    underspend_flag   = !is.na(absorption_rate) & absorption_rate < 0.70,
    overspend_flag    = !is.na(absorption_rate) & absorption_rate > 1.10
  )

})

observe({ dat <- dat_base() updateSelectInput(session, “cat_filter”, choices = c(“All”, sort(unique(dat\(category_partner))), selected = "All") updateSelectInput(session, "dist_filter", choices = c("All", sort(unique(dat\)district_office_location))), selected = “All”) })

dat_filt <- reactive({ d <- dat_base() if (isTRUE(input\(filter_valid)) d <- d |> filter(!is.na(fy25_budget) & fy25_budget > 0) if (!is.null(input\)cat_filter) && !“All” %in% input\(cat_filter) d <- d |> filter(category_partner %in% input\)cat_filter) if (!is.null(input\(dist_filter) && !"All" %in% input\)dist_filter) d <- d |> filter(district_office_location %in% input\(dist_filter) cap <- input\)abs_cap/100 d |> mutate(absorption_rate_capped = pmin(pmax(absorption_rate, 0), cap)) })

kpi_vals <- reactive({ d <- dat_filt() tot_budget <- sum(d\(fy25_budget, na.rm = TRUE) tot_expenses <- sum(d\)fy25_expenses, na.rm = TRUE) overall_abs <- safe_div(tot_expenses, tot_budget) share <- if (tot_budget>0) d\(fy25_budget/tot_budget else rep(NA_real_, nrow(d)) hhi_100 <- sum((share*100)^2, na.rm = TRUE) top5_share <- d |> arrange(desc(fy25_budget)) |> slice_head(n=5) |> summarise(share = sum(fy25_budget, na.rm=TRUE)/tot_budget) |> pull(share) local_cats <- c("National NGO","CBO","CSO","Cooperative","WRO/WLO") local_budget_share <- safe_div(sum(d\)fy25_budget[d$category_partner %in% local_cats], na.rm = TRUE), tot_budget) list( partners = nrow(d), tot_budget = tot_budget, tot_expenses = tot_expenses, overall_abs = overall_abs, top5_share = top5_share, hhi_100 = hhi_100, local_share = local_budget_share ) })

output\(vb_partners <- renderValueBox({ valueBox(kpi_vals()\)partners, “Partners”, icon = icon(“users”), color = “yellow”) }) output\(vb_budget <- renderValueBox({ valueBox(dollar_lab(kpi_vals()\)tot_budget), “FY25 Budget”, icon = icon(“wallet”), color = “blue”) }) output\(vb_expenses <- renderValueBox({ valueBox(dollar_lab(kpi_vals()\)tot_expenses), “FY25 Expenses”, icon = icon(“money-bill-wave”), color = “blue”) }) output\(vb_abs <- renderValueBox({ valueBox(percent(kpi_vals()\)overall_abs, 1), “Overall Absorption”, icon = icon(“chart-line”), color = “green”) }) output\(vb_top5 <- renderValueBox({ valueBox(percent(kpi_vals()\)top5_share, 1), “Top-5 Budget Share”, icon = icon(“layer-group”), color = “purple”) }) output\(vb_hhi <- renderValueBox({ lvl <- cut(kpi_vals()\)hhi_100, breaks = c(-Inf,1500,2500,Inf), labels = c(“Low”,“Moderate”,“High”)) valueBox(sprintf(“%s (%.0f)”, as.character(lvl), kpi_vals()$hhi_100), “HHI (0–10,000)”, icon = icon(“balance-scale”), color = “red”) })

# —- Plots —- output$plot_abs_hist <- renderPlotly({ d <- dat_filt() |> filter(!is.na(absorption_rate_capped)) p <- ggplot(d, aes(x = absorption_rate_capped)) + geom_histogram(bins = 30) + geom_vline(xintercept = c(0.70, 1.10), linetype = “dashed”) + scale_x_continuous(labels = pct_lab) + labs(x=“Absorption Rate (capped)”, y=“Count”) ggplotly(p) })

output$plot_budget_cat <- renderPlotly({ d <- dat_filt() |> group_by(category_partner) |> summarise(budget = sum(fy25_budget, na.rm = TRUE), .groups = “drop”) |> arrange(budget) p <- ggplot(d, aes(x = reorder(category_partner, budget), y = budget)) + geom_col() + coord_flip() + scale_y_continuous(labels = dollar_lab) + labs(x=“Category”, y=“Budget (USD)”) ggplotly(p) })

output$plot_top15 <- renderPlotly({ d <- dat_filt() |> arrange(desc(fy25_budget)) |> slice_head(n=15) p <- ggplot(d, aes(x = reorder(partner_name, fy25_budget), y = fy25_budget)) + geom_col() + coord_flip() + scale_y_continuous(labels = dollar_lab) + labs(x=“Partner”, y=“Budget (USD)”) ggplotly(p) })

output$plot_bubble <- renderPlotly({ d <- dat_filt() |> filter(!is.na(absorption_rate_capped)) p <- ggplot(d, aes(x = fy25_budget, y = absorption_rate_capped, size = pmax(no_contracts,1), color = category_partner, text = paste0(“”, partner_name, “
”, “Budget:”, dollar_lab(fy25_budget), “
”, “Absorption:”, percent(absorption_rate,1), “
”, “#Contracts:”, no_contracts))) + geom_point(alpha = .8) + geom_hline(yintercept = c(0.70, 1.10), linetype=“dashed”) + scale_x_continuous(labels = dollar_lab) + scale_y_continuous(labels = pct_lab) + labs(x=“FY25 Budget (USD)”, y=“Absorption Rate (capped)”) ggplotly(p, tooltip=“text”) })

output$plot_bands_share <- renderPlotly({ d <- dat_filt() |> mutate(band = case_when( is.na(absorption_rate) ~ “No Data”, absorption_rate < 0.70 ~ “<70% (Underspend)”, absorption_rate <= 1.10 ~ “70–110% (On Track)”, TRUE ~ “>110% (Overspend)” )) |> count(category_partner, band, name = “n”) |> group_by(category_partner) |> mutate(share = n/sum(n)) p <- ggplot(d, aes(x = category_partner, y = share, fill = band)) + geom_col(position = “fill”) + coord_flip() + scale_y_continuous(labels = pct_lab) + labs(x=“Category”, y=“Share of partners”, fill=“Band”) ggplotly(p) })

output\(plot_local_donut <- renderPlotly({ d <- dat_filt() local_cats <- c("National NGO","CBO","CSO","Cooperative","WRO/WLO") donut <- tibble( group = c("Local","Non-Local"), value = c(sum(d\)fy25_budget[d\(category_partner %in% local_cats], na.rm = TRUE), sum(d\)fy25_budget[!d$category_partner %in% local_cats], na.rm = TRUE)) ) |> mutate(pct = value/sum(value)) p <- ggplot(donut, aes(x = 2, y = value, fill = group, text = paste0(group, “:”, percent(pct,1)))) + geom_col(width = 1, color=“white”) + coord_polar(theta = “y”) + xlim(0.5, 2.5) + theme_void() ggplotly(p, tooltip=“text”) })

output$plot_heatmap <- renderPlotly({ d <- dat_filt() |> group_by(district_office_location, category_partner) |> summarise(budget = sum(fy25_budget, na.rm = TRUE), .groups = “drop”) p <- ggplot(d, aes(x = category_partner, y = district_office_location, fill = budget, text = paste0(district_office_location,” × “,category_partner,”
Budget: “, dollar_lab(budget)))) + geom_tile() + labs(x=”Category”, y=“District”) + scale_fill_continuous(labels = dollar_lab) ggplotly(p, tooltip=“text”) })

output$plot_treemap <- renderPlotly({ d <- dat_filt() |> mutate(category_partner = fct_explicit_na(category_partner, na_level = “Unknown”)) p <- ggplot(d, aes(area = fy25_budget, fill = category_partner, label = paste0(partner_name,“”, dollar_lab(fy25_budget)))) + treemapify::geom_treemap() + treemapify::geom_treemap_text(colour = “white”, place = “centre”, reflow = TRUE) ggplotly(p) })

output$plot_tenure_abs <- renderPlotly({ d <- dat_filt() |> filter(!is.na(absorption_rate_capped), !is.na(partner_tenure_yrs)) p <- ggplot(d, aes(x = partner_tenure_yrs, y = absorption_rate_capped, color = category_partner)) + geom_point(alpha = .8) + geom_smooth(se = TRUE) + scale_y_continuous(labels = pct_lab) + labs(x=“Tenure with CARE (years)”, y=“Absorption Rate (capped)”) ggplotly(p) })

output$plot_timeline <- renderPlotly({ d <- dat_filt() |> transmute(partner_name, category_partner, fy25_budget, entity_year = year(entity_start_date), care_year = year(start_date_partnership)) |> pivot_longer(cols = c(entity_year, care_year), names_to = “type”, values_to = “year”) |> mutate(type = recode(type, entity_year = “Entity Founded”, care_year = “CARE Partnership Start”)) p <- ggplot(d, aes(x = year, y = reorder(partner_name, year))) + geom_line(aes(group = partner_name), color=“grey60”) + geom_point(aes(color = category_partner, shape = type, size = fy25_budget), alpha = .9) + labs(x=“Year”, y=“Partner”) ggplotly(p) })

output$plot_waterfall <- renderPlotly({ d <- dat_filt() |> mutate(variance = fy25_expenses - fy25_budget) |> filter(!is.na(variance)) |> arrange(desc(abs(variance))) |> slice_head(n = 20) |> mutate(pos = variance >= 0) p <- ggplot(d, aes(x = reorder(partner_name, variance), y = variance, fill = pos, text = paste0(partner_name,“
Variance:”, dollar_lab(variance)))) + geom_col() + coord_flip() + scale_y_continuous(labels = dollar_lab) + scale_fill_manual(values = c(“TRUE”=“#2E7D32”,“FALSE”=“#C62828”), labels = c(“Overspend”,“Underspend”)) + labs(x=“Partner”, y=“Variance (USD)”, fill=““) ggplotly(p, tooltip=”text”) })

# —- Tables —- output\(tbl_scorecard <- renderDT({ d <- dat_filt() |> transmute( PartnerID = partner_id, Partner = partner_name, Category = category_partner, District = district_office_location, EntityStart = as.character(entity_start_date), CAREStart = as.character(start_date_partnership), TenureYrs = round(partner_tenure_yrs, 1), Contracts = no_contracts, BudgetUSD = fy25_budget, ExpensesUSD = fy25_expenses, Absorption = absorption_rate ) datatable(d, filter = "top", options = list(pageLength = 20, scrollX = TRUE)) |> formatCurrency(c("BudgetUSD","ExpensesUSD"), currency = "\)“, digits = 0) |> formatPercentage(”Absorption”, 1) })

output\(tbl_risks <- renderDT({ d <- dat_filt() |> arrange(desc(fy25_budget)) |> mutate(top5 = row_number() <= 5) |> transmute( Partner = partner_name, Category = category_partner, District = district_office_location, BudgetUSD = fy25_budget, ExpensesUSD = fy25_expenses, Absorption = absorption_rate, Underspend = underspend_flag, Overspend = overspend_flag, Top5Budget = top5 ) datatable(d, options = list(pageLength = 15, scrollX = TRUE)) |> formatCurrency(c("BudgetUSD","ExpensesUSD"), "\)“, digits = 0) |> formatPercentage(”Absorption”, 1) })

# —- Download cleaned outputs (Excel) —- output\(download_excel <- downloadHandler( filename = function(){ "FY25_partnership_analysis.xlsx" }, content = function(file){ d <- dat_filt() by_category <- d |> group_by(category_partner) |> summarise( partners=n(), budget=sum(fy25_budget,na.rm=TRUE), expenses=sum(fy25_expenses,na.rm=TRUE), absorption_rate = safe_div(expenses,budget), .groups="drop") by_district <- d |> group_by(district_office_location) |> summarise( partners=n(), budget=sum(fy25_budget,na.rm=TRUE), expenses=sum(fy25_expenses,na.rm=TRUE), absorption_rate = safe_div(expenses,budget), .groups="drop") by_tenure <- d |> mutate(tenure_band = case_when( is.na(partner_tenure_yrs) ~ NA_character_, partner_tenure_yrs < 1 ~ "<1y", partner_tenure_yrs < 3 ~ "1–3y", partner_tenure_yrs < 5 ~ "3–5y", TRUE ~ "5y+" )) |> group_by(tenure_band) |> summarise( partners=n(), budget=sum(fy25_budget,na.rm=TRUE), expenses=sum(fy25_expenses,na.rm=TRUE), absorption_rate=safe_div(expenses,budget), .groups="drop") kpis <- tibble( metric = c("Total partners","Total FY25 Budget","Total FY25 Expenses","Overall Absorption", "Top-5 Budget Share","HHI (0-10,000)","Local Budget Share"), value = c(nrow(d), sum(d\)fy25_budget,na.rm=TRUE), sum(d\(fy25_expenses,na.rm=TRUE), safe_div(sum(d\)fy25_expenses,na.rm=TRUE), sum(d\(fy25_budget,na.rm=TRUE)), d |> arrange(desc(fy25_budget)) |> slice_head(n=5) |> summarise(sum(fy25_budget,na.rm=TRUE)/sum(d\)fy25_budget,na.rm=TRUE)) |> pull(1), sum(((d\(fy25_budget/sum(d\)fy25_budget,na.rm=TRUE))*100)^2, na.rm=TRUE), { local_cats <- c(“National NGO”,“CBO”,“CSO”,“Cooperative”,“WRO/WLO”) safe_div(sum(d\(fy25_budget[d\)category_partner %in% local_cats],na.rm=TRUE), sum(d$fy25_budget,na.rm=TRUE)) }) ) writexl::write_xlsx( list( “KPIs”=kpis, “Clean_Data”=d, “By_Category”=by_category, “By_District”=by_district, “By_Tenure”=by_tenure ), path = file ) } ) }

shinyApp(ui, server)

/* !.rsconnectignore !deployment.qmd !_quarto.yml

/* !.rsconnectignore !app.R !www/ !data/