插值产品属性

Question

我有一组来自一系列离散选择任务的数据,其中包括两个具有三个属性(品牌,价格,性能)的备选方案.根据这些数据,我从后验分布中抽取了1000次,然后我将用它来计算每个人和每次抽签的效用和最终偏好份额.

价格和性能分别在离散水平(-.2,0,.2)和(-.25,0,.25)进行测试.我需要能够在测试的属性级别之间插入实用程序.我们现在假设线性插值在统计上是合理的.换句话说,如果我想测试价格低10%的场景,那么以最有效的方式为价格插入实用工具是什么？我无法想到一种灵活或有效的插值方法.我使用了plyr的mdply函数的mapply()方法

这是一些数据和我目前的方法:

library(plyr)
#draws from posterior, 2 respondents, 2 draws each
draw <- list(structure(c(-2.403, -2.295, 3.198, 1.378, 0.159, 1.531, 
1.567, -1.716, -4.244, 0.819, -1.121, -0.622, 1.519, 1.731, -1.779, 
2.84), .Dim = c(2L, 8L), .Dimnames = list(NULL, c("brand_1", 
"brand_2", "price_1", "price_2", "price_3", "perf_1", "perf_2", 
"perf_3"))), structure(c(-4.794, -2.147, -1.912, 0.241, 0.084, 
0.31, 0.093, -0.249, 0.054, -0.042, 0.248, -0.737, -1.775, 1.803, 
0.73, -0.505), .Dim = c(2L, 8L), .Dimnames = list(NULL, c("brand_1", 
"brand_2", "price_1", "price_2", "price_3", "perf_1", "perf_2", 
"perf_3")))) 

#define attributes for each brand: brand constant, price, performance
b1 <- c(1, .15, .25)
b2 <- c(2, .1, .2)

#Create data.frame out of attribute lists. Wil use mdply to go through each 
interpolateCombos <- data.frame(xout = c(b1,b2), 
                                atts = rep(c("Brand", "Price", "Performance"), 2),
                                i = rep(1:2, each = 3),
                                stringsAsFactors = FALSE)

#Find point along line. Tried approx(), but too slow

findInt <- function(x1,x2,y1,y2,reqx) {
  range <- x2 - x1
  diff <- reqx - x1
  out <- y1 + ((y2 - y1)/range) * diff
  return(out)
}


calcInterpolate <- function(xout, atts, i){
  if (atts == "Brand") {
    breaks <- 1:2
    cols <- 1:2
  } else if (atts == "Price"){
    breaks <- c(-.2, 0, .2)
    cols <- 3:5
  } else {
    breaks <- c(-.25, 0, .25)
    cols <- 6:8
  }

  utils <- draw[[i]][, cols]

  if (atts == "Brand" | xout %in% breaks){ #Brand can't be interpolated or if level matches a break
    out <- data.frame(out = utils[, match(xout, breaks)])
    } else{ #Must interpolate    
    mi <- min(which(breaks <= xout))
    ma <- max(which(breaks >= xout))
    out <- data.frame(out = findInt(breaks[mi], breaks[ma], utils[, mi], utils[,ma], xout))
    }
  out$draw <- 1:nrow(utils)
  return(out)
}
out <- mdply(interpolateCombos, calcInterpolate)

为了提供我正在尝试完成的内容而不插入属性级别,我就是这样做的.请注意,品牌现在根据列参考定义.p1和p2表示产品定义,u1和u2是实用程序,s1,s2是该抽取的首选份额.

任何推动正确的方向将不胜感激.我的真实案例有10个产品,每个产品有8个属性.在10k抽取时,我的8gb内存正在流淌,但是我无法摆脱这个我挖过的兔子洞.

p1 <- c(1,2,1)
p2 <- c(2,1,2)


FUN <- function(x, p1, p2) {
  bases <- c(0,2,5)

  u1 <- rowSums(x[, bases + p1])
  u2 <- rowSums(x[, bases + p2])
  sumExp <- exp(u1) + exp(u2)
  s1 <- exp(u1) / sumExp
  s2 <- exp(u2) / sumExp
  return(cbind(s1,s2))
}
lapply(draw, FUN, p1 = p1, p2 = p2)

[[1]]
                s1        s2
[1,] 0.00107646039 0.9989235
[2,] 0.00009391749 0.9999061

[[2]]
              s1        s2
[1,] 0.299432858 0.7005671
[2,] 0.004123175 0.9958768

Answer 1

获得您想要的东西的一种不太传统的方法是使用您的 10k 抽奖建立您所有产品的全球排名。

使用每次抽奖作为 10 个产品之间的二元竞赛的来源，并将所有抽奖的这些竞赛结果相加。

这将为您提供 10 种产品的最终“排行榜”。由此，您可以在所有消费者中获得相对效用，或者您可以根据每种产品的获胜次数（以及可选的每次竞赛中替代方案的“强度”）分配绝对值。

当您想要测试具有不同属性配置文件的新产品时，请找到其稀疏（st）表示作为其他样本产品（加权）的向量和，并且您可以使用按贡献权重加权的获胜概率再次运行竞赛分量属性向量。

这样做的优点是模拟比赛是有效的，并且全球排名与将新产品表示为现有数据的稀疏向量和相结合，允许对结果进行大量思考和解释，这在您考虑击败竞争对手的策略时非常有用产品属性。

要找到新产品 (y) 的稀疏（描述性）表示，请求解 Ax = y，其中 A 是现有产品的矩阵（行作为其属性向量），y 是现有产品贡献权重的向量。您希望最小化 y 中的非零条目。查看有关快速同伦方法（如幂迭代）的 Donoho DL 文章，可快速解决 l0-l1 最小化问题以找到稀疏表示。

当您有了这个（或稀疏表示的加权平均值）时，您可以根据现有偏好设置所建立的模型，有效地推断新产品的性能。

稀疏性作为表示的优点是它允许您进行有用的推理，此外，您拥有的特征或产品越多越好，因为产品越有可能由它们稀疏地表示。因此，您可以扩展到大型矩阵，并通过快速算法获得真正有用​​的结果。