# inst/doc/using-weighted-data.R In pricesensitivitymeter: Van Westendorp Price Sensitivity Meter Analysis

```## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk\$set(
collapse = TRUE,
comment = "#>"
)

## ---- echo=TRUE---------------------------------------------------------------
set.seed(1976)
library(survey)

# Creating dataset with price acceptance and biased gender variable
input_data <- data.frame(tch = round(rnorm(n = 250, mean = 8, sd = 0.5), digits = 2),
ch = round(rnorm(n = 250, mean = 12, sd = 0.5), digits = 2),
ex = round(rnorm(n = 250, mean = 13, sd = 0.5), digits = 2),
tex = round(rnorm(n = 250, mean = 15, sd = 0.5), digits = 2),
gender = sample(x = c("male", "female"),
size = 250,
replace = TRUE,
prob = c(2/3, 1/3)))

# for women: increasing the price acceptance by +50%
input_data\$tch[input_data\$gender == "female"] <- input_data\$tch[input_data\$gender == "female"] * 1.5
input_data\$ch[input_data\$gender == "female"] <- input_data\$ch[input_data\$gender == "female"] * 1.5
input_data\$ex[input_data\$gender == "female"] <- input_data\$ex[input_data\$gender == "female"] * 1.5
input_data\$tex[input_data\$gender == "female"] <- input_data\$tex[input_data\$gender == "female"] * 1.5

# for survey design object: occurence of each gender in the target population
# it's only one figure in this example because we assume that gender should be perfectly balanced.
# if this is not balanced in the population, we would need a vector with the number of occurences in the population.
# the sum of the strata size across all strata gives the total population size
# (here: two strata with 5k each = 10k total population)
input_data\$gender_pop <- 5000

# creating the survey design object for post-stratification based on gender
# we assume that the selection of respondents within each gender is biased and...
# only the gender balance in the sample is problematic
input_design <- survey::svydesign(ids = ~ 1, # no clusters
probs = NULL, # hence no cluster samling probabilities,
strata = input_data\$gender, # stratified by gender
fpc = input_data\$gender_pop, # strata size in the population
data = input_data) # data object used as input

## ---- echo=TRUE---------------------------------------------------------------
library(pricesensitivitymeter)
output_weighted_psm <- psm_analysis_weighted(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
design = input_design)
summary(output_weighted_psm)

## ---- echo=TRUE---------------------------------------------------------------
set.seed(20)
library(survey)

# Creating dataset with price acceptance and unbiased gender variable
input_data_2 <- data.frame(tch = round(rnorm(n = 250, mean = 4, sd = 0.5), digits = 2),
ch = round(rnorm(n = 250, mean = 8, sd = 0.5), digits = 2),
ex = round(rnorm(n = 250, mean = 12, sd = 0.5), digits = 2),
tex = round(rnorm(n = 250, mean = 16, sd = 0.5), digits = 2),
gender = sample(x = c("male", "female"),
size = 250,
replace = TRUE,
prob = c(0.5, 0.5)))

# for women: increasing the price acceptance by +50%
input_data_2\$tch[input_data_2\$gender == "female"] <- input_data_2\$tch[input_data_2\$gender == "female"] * 1.5
input_data_2\$ch[input_data_2\$gender == "female"] <- input_data_2\$ch[input_data_2\$gender == "female"] * 1.5
input_data_2\$ex[input_data_2\$gender == "female"] <- input_data_2\$ex[input_data_2\$gender == "female"] * 1.5
input_data_2\$tex[input_data_2\$gender == "female"] <- input_data_2\$tex[input_data_2\$gender == "female"] * 1.5

# now let's create a sample design object (using the survey package)
# ... assuming that gender is balanced equally in the population of 10000

# for survey design object: occurence of each gender in the target population
# would usually be information from sampling frame, differs here only for demonstration purposes
# here: scaling up based on actual sample information (hypothetical population of 250 * 4 = 10k)
input_data_2\$gender_pop <- NA
input_data_2\$gender_pop[input_data_2\$gender == "female"] <- sum(input_data_2\$gender == "female") * 40
input_data_2\$gender_pop[input_data_2\$gender == "male"] <- sum(input_data_2\$gender == "male") * 40

# creating the survey design object for post-stratification based on gender
input_design_2 <- survey::svydesign(ids = ~ 1, # no clusters
probs = NULL, # hence no cluster sampling probabilities,
strata = input_data_2\$gender, # stratified by gender
fpc = input_data_2\$gender_pop, # strata size in the population
data = input_data_2) # data object used as input

# quick check: there is only one weight for all our strata
# if we would have different weights per gender, we would see two unique values here
unique(weights(input_design_2, type = "analysis"))

# Loading pricesensitivitymeter package and running both weighted and unweighted analysis on the same data
library(pricesensitivitymeter)

check_weighted_1 <- psm_analysis_weighted(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
design = input_design_2)

check_unweighted_1 <- psm_analysis(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
data = input_data_2)

# results should be identical
summary(check_weighted_1)
summary(check_unweighted_1)

## -----------------------------------------------------------------------------
input_data_3 <- input_data_2

manipulated_men <- sample(which(input_data_2\$gender == "male"), 10)
input_data_3\$ch[manipulated_men] <- input_data_3\$tex[manipulated_men]

## -----------------------------------------------------------------------------
# creating the survey design object for post-stratification based on gender
input_design_3 <- survey::svydesign(ids = ~ 1, # no clusters
probs = NULL, # hence no cluster sampling probabilities,
strata = input_data_3\$gender, # stratified by gender
fpc = input_data_3\$gender_pop, # strata size in the population
data = input_data_3) # data object used as input

# Loading pricesensitivitymeter package and running both weighted and unweighted analysis on the same data
library(pricesensitivitymeter)

check_weighted_2 <- psm_analysis_weighted(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
design = input_design_3)

check_unweighted_2 <- psm_analysis(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
data = input_data_3)

# results should be different now
summary(check_weighted_2)
summary(check_unweighted_2)

## -----------------------------------------------------------------------------
# setting up data with NAs in "too cheap" variable
input_data_2 <- input_data
input_data_2\$tch <- NA

# create new sample design
input_design_2 <- survey::svydesign(ids = ~ 1, # no clusters
probs = NULL, # hence no cluster samling probabilities,
strata = input_data_2\$gender, # stratified by gender
fpc = input_data_2\$gender_pop, # strata size in the population
data = input_data_2) # data object used as input

library(pricesensitivitymeter)

test_2 <- psm_analysis_weighted(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
design = input_design_2)
summary(test_2)

## -----------------------------------------------------------------------------
# setting up dataset with purchase intent information
input_data_3 <- input_data

input_data_3\$pi_ch <- sample(x = c(1:5), size = nrow(input_data_3),
replace = TRUE, prob = c(0.1, 0.1, 0.2, 0.3, 0.3))

input_data_3\$pi_ex <- sample(x = c(1:5), size = nrow(input_data_3),
replace = TRUE, prob = c(0.3, 0.3, 0.2, 0.1, 0.1))

# re-creating the survey design object
input_design_3 <- survey::svydesign(ids = ~ 1,
probs = NULL,
strata = input_data_3\$gender,
fpc = input_data_3\$gender_pop,
data = input_data_3)

# running the weighted Price Sensitivity Meter analysis
test_3 <- psm_analysis_weighted(toocheap = "tch",
cheap = "ch",
expensive = "ex",
tooexpensive = "tex",
design = input_design_3,
pi_cheap = "pi_ch",
pi_expensive = "pi_ex",
pi_scale = 5:1,
pi_calibrated = c(0.7, 0.5, 0.3, 0.1, 0))

summary(test_3)
```

## Try the pricesensitivitymeter package in your browser

Any scripts or data that you put into this service are public.

pricesensitivitymeter documentation built on Oct. 20, 2021, 1:07 a.m.