1 How to use this file

This RMD is a change-review companion for the updated Lab A RMD. It is designed to knit to HTML and show the professor-code fold-in with green backgrounds behind only the changed or added material.

Use this file to quickly see what changed. Use the clean updated Lab A RMD for the actual final knit/submission.

Structure note: Section numbers are generated automatically by the HTML output. Manual section numbers were removed from headings so the table of contents does not show duplicate numbering.

Legend: Every green block below is either a new section, a changed line, or a changed interpretation that was added to align the working Lab A RMD with the professor’s Part 2 conjoint analysis workflow.

2 Change Map

Area Type Purpose
Prepare data Changed code Uses explicit factor levels for Deductible instead of sorting unique values
Regression model Changed code Adds professor-style conjoint_model object while preserving m01
Part-worth utilities New section Converts regression coefficients into centered utilities
Attribute importance New section Calculates range-based importance percentages
Ideal profile New section Identifies highest-utility policy configuration
Observed sanity check New section Compares model result against raw observed profile averages
Professor visuals New section Adds three visuals matching the Part 2 guidance
Discussion Q1 Changed interpretation Replaces visual guesswork with range-based importance
Takeaways Changed interpretation Updates final lab takeaways around utilities, importance, and sanity checks

3 Prepare Data: Professor-Aligned Factor Handling

CHANGED / ADDED

Added comments explaining why the attribute columns are treated as categorical factors. Also changed the Deductible level order to use the professor’s explicit level sequence.

# Professor-aligned preparation step:
# Treat the design attributes as categorical factors.
# Deductible looks numeric, but in conjoint analysis we want a separate
# part-worth utility for each level rather than assuming a straight-line slope.
df <- df_raw %>%
  mutate(
    Deductible = as.numeric(as.character(Deductible)),
    rating = as.numeric(rating)
  )

df$Deductible <- factor(
  df$Deductible,
  levels = c(500, 1000, 2000)
)

4 Regression Model: Add Professor Naming While Preserving Existing Code

CHANGED / ADDED

The professor’s guide names the model conjoint_model. The original report used m01. This update creates conjoint_model and then aliases it back to m01 so the rest of the existing report still works.

# Professor naming convention: this is the part-worth main-effects model.
conjoint_model <- lm(rating ~ Deductible + Brand + Pay_as_you_drive, data = df)

# Keep m01 as an alias so the rest of the existing report still knits.
m01 <- conjoint_model

summary(conjoint_model)

5 New Section: Professor Part-Worth Utilities and Best Profile

ADDED

This section introduces the professor’s continuation workflow after the main regression model.

# Professor Part-Worth Utilities and Best Profile

The professor's continuation adds four important outputs after the main regression model:

1. centered part-worth utilities;
2. range-based attribute importance;
3. the highest-utility predicted profile;
4. a sanity check against the actually observed profile averages.

6 New Section: Extract Centered Part-Worth Utilities

ADDED

This code turns baseline-relative regression coefficients into centered part-worth utilities. Centering makes each attribute’s utilities average to zero, which is the professor-style conjoint reporting layer.

coefs <- coef(conjoint_model)

get_utilities <- function(attr, levels_vec, coefs) {
  u <- setNames(numeric(length(levels_vec)), levels_vec)
  
  for (lv in levels_vec[-1]) {
    term_candidates <- c(
      paste0(attr, lv),
      paste0(attr, make.names(lv))
    )
    matched_term <- term_candidates[term_candidates %in% names(coefs)]
    
    if (length(matched_term) > 0) {
      u[lv] <- coefs[matched_term[1]]
    }
  }
  
  # Center so each attribute's levels average to zero.
  u - mean(u)
}

util_deductible <- get_utilities("Deductible", levels(df$Deductible), coefs)
util_brand <- get_utilities("Brand", levels(df$Brand), coefs)
util_payd <- get_utilities("Pay_as_you_drive", levels(df$Pay_as_you_drive), coefs)

cat("Deductible:\n")
print(round(util_deductible, 3))

cat("Brand:\n")
print(round(util_brand, 3))

cat("Pay_as_you_drive:\n")
print(round(util_payd, 3))

utility_table <- data.frame(
  Attribute = c(
    rep("Deductible", length(util_deductible)),
    rep("Brand", length(util_brand)),
    rep("Pay_as_you_drive", length(util_payd))
  ),
  Level = c(
    names(util_deductible),
    names(util_brand),
    names(util_payd)
  ),
  Utility = round(c(util_deductible, util_brand, util_payd), 3)
)

kable(
  utility_table,
  caption = "Part-worth utilities by attribute and level"
)

7 New Section: Attribute Importance from Utility Ranges

ADDED

This code calculates attribute importance using the professor’s range-based method: utility spread by attribute, normalized to 100%.

importance <- c(
  Deductible = diff(range(util_deductible)),
  Brand = diff(range(util_brand)),
  Pay_as_you_drive = diff(range(util_payd))
)

importance_pct <- round(100 * importance / sum(importance), 1)

importance_table <- data.frame(
  Attribute = names(importance_pct),
  Importance_Pct = importance_pct
)

kable(
  importance_table,
  caption = "Relative importance of each attribute (%)"
)

ADDED

This supporting object powers the written interpretation by finding the most important attribute dynamically from the model output.

top_importance <- importance_table %>%
  arrange(desc(Importance_Pct)) %>%
  slice(1)

8 New Section: Highest-Utility Profile

ADDED

This code builds the model-predicted ideal policy by selecting the best level from each attribute’s part-worth utilities.

best_deductible <- names(which.max(util_deductible))
best_brand <- names(which.max(util_brand))
best_payd <- names(which.max(util_payd))

best_profile_partworth <- data.frame(
  Deductible = factor(best_deductible, levels = levels(df$Deductible)),
  Brand = factor(best_brand, levels = levels(df$Brand)),
  Pay_as_you_drive = factor(best_payd, levels = levels(df$Pay_as_you_drive))
)

predicted_rating_partworth <- predict(conjoint_model, newdata = best_profile_partworth)

kable(
  best_profile_partworth,
  caption = "Highest-utility predicted profile from part-worth utilities"
)

cat("Predicted rating:", round(predicted_rating_partworth, 2), "\n")

9 New Section: Observed-Profile Sanity Check

ADDED

This code checks the model-based best profile against the raw observed mean ratings for the profiles respondents actually saw.

observed_avg <- aggregate(
  rating ~ Deductible + Brand + Pay_as_you_drive,
  data = df,
  FUN = mean
)

observed_avg <- observed_avg[order(-observed_avg$rating), ]

kable(
  observed_avg,
  digits = 2,
  caption = "Observed mean rating by profile"
)

ADDED

This object makes the highest observed profile available for interpretation text.

top_observed <- observed_avg[1, ]

10 New Visual: Part-Worth Utilities

ADDED

This visual translates the part-worth utility table into a readable chart.

utility_plot_df <- utility_table %>%
  mutate(
    Level = factor(Level, levels = Level[order(Attribute, -Utility)])
  )

ggplot(utility_plot_df, aes(x = reorder(Level, Utility), y = Utility, fill = Attribute)) +
  geom_col(show.legend = FALSE) +
  geom_hline(yintercept = 0, color = "#f87171", linetype = "dashed") +
  geom_text(
    aes(label = round(Utility, 2)),
    hjust = ifelse(utility_plot_df$Utility >= 0, -0.15, 1.15),
    color = "#f9fafb",
    size = 3.5
  ) +
  coord_flip() +
  facet_wrap(~Attribute, scales = "free_y") +
  labs(
    title = "Part-Worth Utilities by Attribute Level",
    subtitle = "Centered utilities: positive levels add preference within their attribute; negative levels subtract preference",
    x = NULL,
    y = "Centered Part-Worth Utility"
  ) +
  theme_conjoint_dark(base_size = 13)

11 New Visual: Relative Attribute Importance

ADDED

This is the professor-aligned chart for comparing attributes directly on a common 0% to 100% scale.

importance_plot_df <- importance_table %>%
  mutate(Attribute = reorder(Attribute, Importance_Pct))

ggplot(importance_plot_df, aes(x = Attribute, y = Importance_Pct)) +
  geom_col(fill = "#a78bfa") +
  geom_text(
    aes(label = paste0(Importance_Pct, "%")),
    hjust = -0.15,
    color = "#f9fafb",
    size = 4
  ) +
  coord_flip() +
  labs(
    title = "Relative Importance of Each Attribute",
    subtitle = "Calculated from each attribute's part-worth utility range",
    x = NULL,
    y = "Relative Importance (%)"
  ) +
  ylim(0, max(importance_plot_df$Importance_Pct) * 1.25) +
  theme_conjoint_dark(base_size = 13)

12 New Visual: Observed Mean Rating by Profile

ADDED

This chart is the raw-data sanity check. It highlights the top observed profile.

observed_plot_df <- observed_avg %>%
  mutate(
    profile_label = paste(Deductible, Brand, Pay_as_you_drive, sep = " | "),
    is_top = rating == max(rating)
  )

ggplot(observed_plot_df, aes(x = reorder(profile_label, rating), y = rating, fill = is_top)) +
  geom_col(show.legend = FALSE) +
  geom_text(
    aes(label = round(rating, 2)),
    hjust = -0.15,
    color = "#f9fafb",
    size = 3.5
  ) +
  coord_flip() +
  labs(
    title = "Mean Rating by Observed Profile",
    subtitle = "Raw average ratings for the exact policy profiles shown to respondents",
    x = "Profile: Deductible | Brand | Pay-as-you-drive",
    y = "Mean Rating"
  ) +
  ylim(0, max(observed_plot_df$rating) * 1.15) +
  theme_conjoint_dark(base_size = 13)

13 Updated Discussion Question 1 Interpretation

CHANGED

This replacement removes the earlier visual-estimate language and uses the professor’s range-based importance result instead.

The professor's range-based importance calculation makes this more defensible than relying on visual guesswork alone. In the current output, **[top_importance$Attribute]** is the largest overall driver, accounting for about **[top_importance$Importance_Pct%]** of the total modeled utility swing. I would use this as the primary prioritization signal while still checking the part-worth table and observed profile averages for context.

14 Updated Lab Takeaways

CHANGED

The takeaway list was expanded to reflect the professor’s Part 2 analysis workflow.

This lab shows how conjoint analysis turns ratings of bundled product profiles into estimates of attribute-level preference. The most important steps are:

1. define clear attributes and levels;
2. use a manageable profile design;
3. collect ratings in long format;
4. set factor levels intentionally;
5. fit the main-effects part-worth regression model;
6. convert baseline-relative coefficients into centered part-worth utilities;
7. calculate range-based attribute importance;
8. identify the highest-utility predicted profile;
9. sanity-check the result against observed profile averages;
10. translate the output into practical product or marketing decisions.

15 Quick Notes for Live Class

  • The professor code does not replace the regression model; it extends the interpretation.
  • The coefficient table still matters, but the part-worth table is cleaner for conjoint reporting.
  • The importance chart answers “which attribute matters most overall?”
  • The highest-utility profile answers “what product configuration should we recommend?”
  • The observed profile average answers “does the model result line up with raw respondent behavior?”