Я пишу некоторый код для создания сбалансированных экспериментальных проектов для исследования рынка, в частности для использования в совместном анализе и максимальном масштабировании разностей.
Первым шагом является создание конструкции с частичным балансированным незавершенным блоком (PBIB). Это прямолинейно, используя пакет R AlgDesign.
Для большинства типов исследований такой дизайн будет достаточным. Однако в маркетинговых исследованиях мы хотим контролировать эффекты порядка в каждом блоке. Здесь я был бы рад помочь.
Создать тестовые данные
# The following code is not essential in understanding the problem,
# but I provide it in case you are curious about the origin of the data itself.
#library(AlgDesign)
#set.seed(12345)
#choices <- 4
#nAttributes <- 7
#blocksize <- 7
#bsize <- rep(choices, blocksize)
#PBIB <- optBlock(~., withinData=factor(1:nAttributes), blocksizes=bsize)
#df <- data.frame(t(array(PBIB$rows, dim=c(choices, blocksize))))
#colnames(df) <- paste("Item", 1:choices, sep="")
#rownames(df) <- paste("Set", 1:nAttributes, sep="")
df <- structure(list(
Item1 = c(1, 2, 1, 3, 1, 1, 2),
Item2 = c(4, 4, 2, 5, 3, 2, 3),
Item3 = c(5, 6, 5, 6, 4, 3, 4),
Item4 = c(7, 7, 6, 7, 6, 7, 5)),
.Names = c("Item1", "Item2", "Item3", "Item4"),
row.names = c("Set1", "Set2", "Set3", "Set4", "Set5", "Set6", "Set7"),
class = "data.frame")
** Определить две вспомогательные функции
balanceMatrix вычисляет баланс матрицы:
balanceMatrix <- function(x){
t(sapply(unique(unlist(x)), function(i)colSums(x==i)))
}
balanceScore вычисляет метрику "fit" - более низкие оценки лучше, с нулевым совершенством:
balanceScore <- function(x){
sum((1-x)^2)
}
Определить функцию, которая произвольно изменяет строки
findBalance <- function(x, nrepeat=100){
df <- x
minw <- Inf
for (n in 1:nrepeat){
for (i in 1:nrow(x)){df[i,] <- sample(df[i, ])}
w <- balanceMatrix(df)
sumw <- balanceScore(w)
if(sumw < minw){
dfbest <- df
minw <- sumw
}
}
dfbest
}
Основной код
Информационная рамка df представляет собой сбалансированный дизайн из 7 наборов. Каждый набор будет отображать 4 элемента респонденту. Числовые значения в df относятся к 7 различным атрибутам. Например, в Set1 респонденту будет предложено выбрать его/ее предпочтительный вариант из атрибутов 1, 3, 4 и 7.
Порядок элементов в каждом наборе концептуально не важен. Таким образом, упорядочение (1,4,5,7) идентично (7,5,4,1).
Однако, чтобы получить полностью сбалансированный дизайн, каждый атрибут будет отображаться равным количеством раз в каждом столбце. Эта конструкция не сбалансирована, поскольку атрибут 1 появляется 4 раза в столбце 1:
df
Item1 Item2 Item3 Item4
Set1 1 4 5 7
Set2 2 4 6 7
Set3 1 2 5 6
Set4 3 5 6 7
Set5 1 3 4 6
Set6 1 2 3 7
Set7 2 3 4 5
Чтобы попытаться найти более сбалансированный дизайн, я написал функцию findBalance. Это ведет к случайному поиску лучших решений, путем случайной выборки по строкам df. С 100 повторами он находит следующее лучшее решение:
set.seed(12345)
dfbest <- findBalance(df, nrepeat=100)
dfbest
Item1 Item2 Item3 Item4
Set1 7 5 1 4
Set2 6 7 4 2
Set3 2 1 5 6
Set4 5 6 7 3
Set5 3 1 6 4
Set6 7 2 3 1
Set7 4 3 2 5
Это выглядит более сбалансированным, а вычисленная матрица баланса содержит множество единиц. Матрица баланса подсчитывает количество раз, когда каждый атрибут появляется в каждом столбце. Например, в следующей таблице указано (в верхней левой ячейке), что атрибут 1 дважды появляется в столбце 1 и дважды в столбце 2:
balanceMatrix(dfbest)
Item1 Item2 Item3 Item4
[1,] 0 2 1 1
[2,] 1 1 1 1
[3,] 1 1 1 1
[4,] 1 0 1 2
[5,] 1 1 1 1
[6,] 1 1 1 1
[7,] 2 1 1 0
Баланс для этого решения равен 6, что указывает на наличие по меньшей мере шести ячеек, не равных 1:
balanceScore(balanceMatrix(dfbest))
[1] 6
Мой вопрос
Благодарим вас за следующий подробный пример. Мой вопрос: как я могу переписать эту функцию поиска более систематично? Я хотел бы сказать R:
- Свернуть
balanceScore(df) - Изменяя порядок строк
df - Подлежит: уже полностью ограничено
