shiny cows

app.R

library(shiny)
library(bslib)
library(dplyr)
library(ggplot2)

# Sample cow data
cow_data <- data.frame(
  name = c("Bessie", "Daisy", "Buttercup", "Molly", "Clover", "Rosie", "Bella", "Penny", "Lulu", "Mabel"),
  breed = c("Holstein", "Jersey", "Angus", "Hereford", "Guernsey", "Simmental", "Holstein", "Jersey", "Angus", "Guernsey"),
  milk_per_day = c(28, 25, 0, 0, 27, 0, 30, 24, 0, 26),
  weight_kg = c(680, 450, 750, 720, 470, 780, 650, 430, 730, 460),
  age_years = c(5, 4, 6, 7, 3, 8, 4, 5, 6, 3),
  is_dairy = c(TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE)
)

ui <- page_navbar(
  title = "Fun with Cows! 🐄",
  theme = 
    # Pick a dark green color for the navbar background (see below for grass image)
    bs_theme(
      navbar_bg = "#314000",
      primary = "#6E4D1D",  # Brown like a Jersey cow
      secondary = "#D6C5AB", # Light tan like a Guernsey cow
      success = "#27422B",   # Rich green like a pasture
      "enable-shadows" = TRUE,
      "body-bg" = "#F8F7F3" # Creamy background like milk
    ),
  
  # First tab - Cow Facts
  nav_panel(
    title = "Cow Facts",
    # Use a grass image for the navbar background
    tags$style(HTML(
      ".navbar { 
        background-image: url('grass.jpg');
        background-size: cover;
        background-position: center;
      }"
    )),
    layout_columns(
      fill = FALSE,
      value_box(
        title = "Number of Cows",
        value = nrow(cow_data),
        showcase = bsicons::bs_icon("clipboard-data"),
        theme = "primary"
      ),
      value_box(
        title = "Average Milk (dairy cows)",
        value = paste(round(mean(cow_data$milk_per_day[cow_data$is_dairy]), 1), "liters/day"),
        showcase = bsicons::bs_icon("cup-hot"),
        theme = "info"
      ),
      value_box(
        title = "Average Weight",
        value = paste(round(mean(cow_data$weight_kg), 1), "kg"),
        showcase = bsicons::bs_icon("rulers"),
        theme = "success"
      )
    ),
    card(
      card_header("Did you know?"),
      "Cows have nearly 360° panoramic vision, but they have poor depth perception.",
      "A cow can climb up stairs, but not down because their knees can't bend properly.",
      "Cows have best friends and can become stressed when separated."
    ),
    card(
      card_header("Cow Table"),
      DT::DTOutput("cow_table")
    )
  ),
  
  # Second tab - Cow Charts
  nav_panel(
    title = "Cow Charts",
    layout_sidebar(
      sidebar = sidebar(
        title = "Filter Options",
        checkboxGroupInput("breed_filter", "Select Breeds:",
                         choices = unique(cow_data$breed),
                         selected = unique(cow_data$breed)),
        sliderInput("age_filter", "Age Range:",
                   min = min(cow_data$age_years),
                   max = max(cow_data$age_years),
                   value = c(min(cow_data$age_years), max(cow_data$age_years))),
        checkboxInput("dairy_only", "Dairy Cows Only", FALSE)
      ),
      card(
        card_header("Milk Production by Breed"),
        plotOutput("milk_plot")
      ),
      card(
        card_header("Cow Weight Distribution"),
        plotOutput("weight_plot")
      )
    )
  ),
  
  # Third tab - Cow Quiz
  nav_panel(
    title = "Cow Quiz",
    card(
      card_header("Test Your Cow Knowledge!"),
      radioButtons("q1", "1. How many stomachs does a cow have?",
                  choices = c("1", "2", "4", "6"),
                  selected = character(0)),
      radioButtons("q2", "2. What is a female cow that has not had a calf called?",
                  choices = c("Calf", "Heifer", "Steer", "Bull"),
                  selected = character(0)),
      radioButtons("q3", "3. How much water does a cow drink per day on average?",
                  choices = c("5-10 liters", "25-50 liters", "100-150 liters", "More than 200 liters"),
                  selected = character(0)),
      actionButton("check_answers", "Check Answers", class = "btn-primary"),
      textOutput("quiz_result")
    )
  )
)

server <- function(input, output, session) {
  # Cow table
  output$cow_table <- DT::renderDT({
    DT::datatable(cow_data, options = list(pageLength = 5))
  })
  
  # Filtered data reactive
  filtered_data <- reactive({
    result <- cow_data %>%
      filter(breed %in% input$breed_filter,
             age_years >= input$age_filter[1],
             age_years <= input$age_filter[2])
    
    if (input$dairy_only) {
      result <- result %>% filter(is_dairy == TRUE)
    }
    
    return(result)
  })
  
  # Milk production plot
  output$milk_plot <- renderPlot({
    data <- filtered_data()
    
    # Filter to only dairy cows for milk production
    dairy_cows <- data %>% filter(is_dairy == TRUE)
    
    ggplot(dairy_cows, aes(x = breed, y = milk_per_day, fill = breed)) +
      geom_bar(stat = "summary", fun = "mean") +
      labs(x = "Breed", y = "Average Milk Production (liters/day)") +
      theme_minimal() +
      theme(legend.position = "none") +
      coord_flip()
  })
  
  # Weight distribution plot
  output$weight_plot <- renderPlot({
    data <- filtered_data()
    
    ggplot(data, aes(x = breed, y = weight_kg, fill = breed)) +
      geom_boxplot() +
      labs(x = "Breed", y = "Weight (kg)") +
      theme_minimal() +
      theme(legend.position = "none")
  })
  
  # Quiz logic
  observeEvent(input$check_answers, {
    answers <- c("4", "Heifer", "25-50 liters")
    user_answers <- c(input$q1, input$q2, input$q3)
    
    correct <- sum(user_answers == answers, na.rm = TRUE)
    output$quiz_result <- renderText({
      paste("You got", correct, "out of 3 correct!")
    })
  })
}

shinyApp(ui, server)