Question

我有一组discrete choice tasks中的一组数据，其中包含两个具有三个属性（品牌，价格，性能）的替代品。根据这些数据，我从后验分布中抽取了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＆amp; p2参考产品定义，u1＆amp; 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）表示形式视为（加权）其他样本产品的向量总和，并且您可以使用通过贡献加权的获胜概率再次运行竞赛组件属性向量的权重。

这样做的好处是模拟竞赛是有效的，全球排名结合将新产品表示为现有数据的稀疏矢量和，可以对结果进行大量思考和解释，这在您考虑策略时很有用。击败了比赛的产品属性。</ p>

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

如果您有此（或稀疏表示的加权平均值），您可以根据现有偏好绘制设置的模型，对新产品的性能进行有用的推理。

稀疏性作为一种表示的优势在于它允许您有用地推理，此外，您拥有的功能或产品越多越好，因为产品越可能被它们稀疏地表示。因此，您可以使用快速算法扩展到大矩阵并获得非常有用的结果。

插值产品属性

1 个答案: