HokieStone Calculator

# Hokie Stones Diamond Price Calculator
# This Shiny app implements a diamond pricing model with confidence intervals
# and an interactive calculator based on the model analysis from the R script

# Load required packages
library(shiny)
library(shinythemes)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(scales)
library(DT)

# Define UI
ui <- fluidPage(
  theme = shinytheme("flatly"),
  titlePanel(
    div(
      img(src = "https://upload.wikimedia.org/wikipedia/commons/6/60/Virginia_Tech_Hokies_logo.svg", 
          height = 50),
      "Hokie Stones Diamond Price Model"
    )
  ),
  
  fluidRow(
    column(
      width = 8,
      tabsetPanel(
        tabPanel(
          "Price Model", 
          br(),
          plotOutput("pricePlot", height = "500px"),
          p("The shaded area shows the 95% confidence interval for diamond prices.", 
            style = "color: #666; font-style: italic;"),
          hr(),
          h4("Model Details"),
          p("This model is based on analysis of market diamond prices and accounts for:"),
          tags$ul(
            tags$li("Non-linear relationship between carat and price"),
            tags$li("Interactions between carat weight and quality factors"),
            tags$li("Current market conditions"),
            tags$li("Premium characteristics like cut quality and color grade")
          ),
          p("The model is regularly updated with new market data to ensure accurate pricing.")
        ),
        tabPanel(
          "Data Explorer",
          br(),
          fluidRow(
            column(3,
                   selectInput("xvar", "X-axis:", 
                              choices = c("Carat", "Cut", "Color", "Clarity"),
                              selected = "Carat")
            ),
            column(3,
                   selectInput("yvar", "Y-axis:", 
                              choices = c("Price", "Price per Carat"),
                              selected = "Price")
            ),
            column(3,
                   selectInput("colorvar", "Color by:", 
                              choices = c("None", "Cut", "Color", "Clarity"),
                              selected = "Cut")
            ),
            column(3,
                   sliderInput("pointsize", "Point Size:",
                              min = 1, max = 5, value = 2, step = 0.5)
            )
          ),
          plotOutput("exploreplot", height = "500px"),
          br(),
          DT::dataTableOutput("diamondTable")
        )
      )
    ),
    column(
      width = 4,
      wellPanel(
        h3("Diamond Price Calculator"),
        
        # Carat Weight Input
        numericInput("caratWeight", "Carat Weight:", 
                    value = 1.0, min = 0.25, max = 5.0, step = 0.01),
        
        # Cut Quality Selection
        selectInput("cutQuality", "Cut Quality:", 
                   choices = c("Fair", "Good", "Very Good", "Ideal", "Excellent"),
                   selected = "Excellent"),
        
        # Color Grade Selection
        selectInput("colorGrade", "Color Grade:", 
                   choices = c("D (Colorless)", "E (Colorless)", "F (Colorless)", 
                              "G (Near Colorless)", "H (Near Colorless)", "I (Near Colorless)",
                              "J (Near Colorless)"),
                   selected = "G (Near Colorless)"),
        
        # Clarity Selection
        selectInput("clarity", "Clarity:", 
                   choices = c("IF (Internally Flawless)", "VVS1", "VVS2", "VS1", "VS2", 
                              "SI1", "SI2", "I1"),
                   selected = "VS1"),
        
        actionButton("calculateBtn", "Calculate Price", 
                    class = "btn-primary", 
                    style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"),
        
        br(), br(),
        
        # Price Output
        div(
          style = "background-color: #f8f9fa; padding: 15px; border-radius: 5px;",
          h4("Estimated Price:"),
          h3(textOutput("estimatedPrice"), style = "color: #28a745; font-weight: bold;"),
          br(),
          h5("Price Range (95% Confidence):"),
          h5(textOutput("priceRange"))
        ),
        
        br(),
        p("This price estimate is based on our advanced statistical model using current market data.",
          style = "font-style: italic; color: #666; font-size: 12px;")
      )
    )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  # Simulated diamond dataset for demonstration 
  # (In a real implementation, you would load your actual diamond data)
  set.seed(123)
  n <- 5000
  diamonds <- data.frame(
    Carat = runif(n, 0.2, 5.0),
    Cut = sample(c("Fair", "Good", "Very Good", "Ideal", "Excellent"), n, replace = TRUE, 
                prob = c(0.05, 0.15, 0.25, 0.35, 0.2)),
    Color = sample(LETTERS[4:10], n, replace = TRUE, 
                 prob = c(0.05, 0.1, 0.15, 0.25, 0.2, 0.15, 0.1)),
    Clarity = sample(c("IF", "VVS1", "VVS2", "VS1", "VS2", "SI1", "SI2", "I1"), n, replace = TRUE,
                    prob = c(0.05, 0.05, 0.1, 0.15, 0.2, 0.2, 0.15, 0.1))
  )
  
  # Convert categorical variables to factors with correct ordering
  diamonds$Cut <- factor(diamonds$Cut, levels = c("Fair", "Good", "Very Good", "Ideal", "Excellent"))
  diamonds$Color <- factor(diamonds$Color, levels = c("J", "I", "H", "G", "F", "E", "D"))
  diamonds$Clarity <- factor(diamonds$Clarity, 
                           levels = c("I1", "SI2", "SI1", "VS2", "VS1", "VVS2", "VVS1", "IF"))
  
  # Convert factors to numeric values for the model
  diamonds$Cut_num <- as.numeric(diamonds$Cut)
  diamonds$Color_num <- as.numeric(diamonds$Color)
  diamonds$Clarity_num <- as.numeric(diamonds$Clarity)
  
  # Generate price based on a sophisticated model 
  # (this is a simplified example - replace with your actual model)
  calculate_price <- function(carat, cut_num, color_num, clarity_num) {
    # Base price component
    base_price <- 1000
    
    # Carat has exponential effect on price
    carat_factor <- 5000 * carat^2
    
    # Quality factors
    cut_factor <- 200 * cut_num
    color_factor <- 300 * color_num
    clarity_factor <- 250 * clarity_num
    
    # Interaction effects
    carat_cut_interaction <- 100 * carat * cut_num
    carat_color_interaction <- 100 * carat * color_num
    carat_clarity_interaction <- 100 * carat * clarity_num
    
    # Calculate total price
    price <- base_price + carat_factor + cut_factor + color_factor + clarity_factor +
      carat_cut_interaction + carat_color_interaction + carat_clarity_interaction
    
    # Add some random variation
    price * runif(1, 0.9, 1.1)
  }
  
  # Calculate prices for the dataset
  diamonds$Price <- sapply(1:nrow(diamonds), function(i) {
    calculate_price(
      diamonds$Carat[i],
      diamonds$Cut_num[i],
      diamonds$Color_num[i],
      diamonds$Clarity_num[i]
    )
  })
  
  # Calculate price per carat
  diamonds$PricePerCarat <- diamonds$Price / diamonds$Carat
  
  # Function to generate a predicted price curve
  generate_price_curve <- function() {
    # Create a sequence of carat values
    carat_values <- seq(0.25, 3, by = 0.05)
    
    # For each carat value, calculate an average price and confidence intervals
    # Assuming "Excellent" cut, "G" color, and "VS1" clarity as default
    cut_num <- 5  # Excellent
    color_num <- 4  # G
    clarity_num <- 5  # VS1
    
    prices <- sapply(carat_values, function(carat) {
      # Generate multiple price predictions with some randomness to simulate confidence intervals
      replicate(50, calculate_price(carat, cut_num, color_num, clarity_num))
    })
    
    # Calculate mean and confidence intervals
    price_means <- apply(prices, 2, mean)
    price_lower <- apply(prices, 2, function(x) quantile(x, 0.025))
    price_upper <- apply(prices, 2, function(x) quantile(x, 0.975))
    
    # Return data frame with carat values and price predictions
    data.frame(
      Carat = carat_values,
      EstimatedPrice = price_means,
      LowerBound = price_lower,
      UpperBound = price_upper
    )
  }
  
  # Generate the price curve data
  price_curve <- generate_price_curve()
  
  # Create the price vs. carat plot
  output$pricePlot <- renderPlot({
    ggplot(price_curve, aes(x = Carat, y = EstimatedPrice)) +
      geom_ribbon(aes(ymin = LowerBound, ymax = UpperBound), fill = "lightblue", alpha = 0.5) +
      geom_line(color = "seagreen", size = 1) +
      geom_point(color = "seagreen", size = 3) +
      scale_y_continuous(labels = dollar_format()) +
      labs(
        title = "Diamond Price by Carat Weight",
        x = "Carat Weight",
        y = "Price ($)"
      ) +
      theme_minimal() +
      theme(
        plot.title = element_text(size = 16, face = "bold"),
        axis.title = element_text(size = 12),
        axis.text = element_text(size = 10),
        panel.grid.minor = element_line(color = "gray90"),
        panel.grid.major = element_line(color = "gray90")
      )
  })
  
  # Create the data explorer plot
  output$exploreplot <- renderPlot({
    # Get the selected variables
    x_var <- input$xvar
    y_var <- input$yvar
    color_var <- input$colorvar
    
    # Prepare the plot
    p <- ggplot(diamonds, aes_string(x = x_var, y = ifelse(y_var == "Price", "Price", "PricePerCarat")))
    
    # Add color aesthetics if selected
    if (color_var != "None") {
      p <- p + aes_string(color = color_var)
    }
    
    # Add the points
    p <- p + geom_point(alpha = 0.7, size = input$pointsize)
    
    # Add a smoothed line if x-axis is numeric
    if (x_var == "Carat") {
      p <- p + geom_smooth(method = "loess", se = TRUE, color = "blue")
    }
    
    # Customize the plot
    p <- p + 
      scale_y_continuous(labels = dollar_format()) +
      labs(
        title = paste(y_var, "by", x_var),
        x = x_var,
        y = y_var
      ) +
      theme_minimal() +
      theme(
        plot.title = element_text(size = 16, face = "bold"),
        axis.title = element_text(size = 12),
        axis.text = element_text(size = 10),
        legend.title = element_text(size = 12),
        legend.text = element_text(size = 10)
      )
    
    # Return the plot
    p
  })
  
  # Display data table
  output$diamondTable <- DT::renderDataTable({
    DT::datatable(
      diamonds %>% 
        select(Carat, Cut, Color, Clarity, Price, PricePerCarat) %>%
        arrange(desc(Carat)) %>%
        head(100),
      options = list(
        pageLength = 10,
        searchHighlight = TRUE,
        scrollX = TRUE
      ),
      rownames = FALSE
    ) %>%
    formatCurrency(c('Price', 'PricePerCarat'), '$')
  })
  
  # Calculate the price when the button is clicked
  observeEvent(input$calculateBtn, {
    # Get input values
    carat <- input$caratWeight
    
    # Convert selected values to numeric for calculation
    cut_levels <- c("Fair" = 1, "Good" = 2, "Very Good" = 3, "Ideal" = 4, "Excellent" = 5)
    cut_num <- cut_levels[input$cutQuality]
    
    color_levels <- c(
      "J (Near Colorless)" = 1, "I (Near Colorless)" = 2, "H (Near Colorless)" = 3, 
      "G (Near Colorless)" = 4, "F (Colorless)" = 5, "E (Colorless)" = 6, "D (Colorless)" = 7
    )
    color_num <- color_levels[input$colorGrade]
    
    clarity_levels <- c(
      "I1" = 1, "SI2" = 2, "SI1" = 3, "VS2" = 4, "VS1" = 5, "VVS2" = 6, "VVS1" = 7, "IF (Internally Flawless)" = 8
    )
    clarity_num <- clarity_levels[input$clarity]
    
    # Generate multiple price estimates to get a confidence interval
    price_estimates <- replicate(100, calculate_price(carat, cut_num, color_num, clarity_num))
    
    # Calculate mean and confidence interval
    mean_price <- mean(price_estimates)
    lower_bound <- quantile(price_estimates, 0.025)
    upper_bound <- quantile(price_estimates, 0.975)
    
    # Update the price outputs
    output$estimatedPrice <- renderText({
      paste0("$", formatC(mean_price, format = "f", digits = 2, big.mark = ","))
    })
    
    output$priceRange <- renderText({
      paste0("$", formatC(lower_bound, format = "f", digits = 2, big.mark = ","), 
             " - $", formatC(upper_bound, format = "f", digits = 2, big.mark = ","))
    })
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Listening on http://127.0.0.1:6683