Question

我正在处理多项逻辑回归问题（即，我想对名义结果变量的一些无序，独立水平进行分类）。我的问题是我知道结果变量的级别（在此示例中为y=c('a','b','c')），并且我知道预测变量，它们的级别及其类（在这里为数字/整数或名义值）。我知道每个预测变量和结果之间的近似分布应该是什么（例如，x的较高值y='a'在x出现的频率更高，否则y的较低值会随机分布在其他变量之间nnet::multinom(y~.,df)级别）。

基本上，我想做4件事：1）生成这些变量的数据集，这些数据集近似于我指定的分布； 2）对数据predict()进行多项式逻辑回归； 3）使用结果模型使用新数据来y个级别R； 4）检索概率以进行进一步处理。我对MLR模型的准确性或p值不感兴趣，因此不需要将数据拆分为训练/测试样本，也不需要进行k折交叉验证或其他任何操作。

我最初的想法是，这种基于某些用户指定分布的数据集反向工程不能太罕见，并且可能存在一个rm(list=ls()) set.seed(123) # specify vars and levels -- y=outcome var y <- c('a','b','c') x <- c(1:5) p <- c(1:4) r <- c(1:8) q <- c('foo','bar','hello','world') # nominal var # sample data based on user-specified distributions/probs df1 <- data.frame(x1=sample(x,100,T,prob=c(0.1,0.1,0.2,0.25,0.35)), y='b') df2 <- data.frame(x1=sample(x,200,T,prob=c(0.35,0.25,0.2,0.1,0.1)), y=sample(c('a','c'),200,T)) df <- rbind(df1,df2) # check distribution of x1 levels v. y levels table(df$x1,df$y) b a c 1 7 38 30 2 11 29 26 3 22 17 22 4 26 14 7 5 34 12 5包/函数做这个。到目前为止我还没有找到。到目前为止，我的方法如下：手动指定每个预测变量的每个级别相对于结果的每个级别的分布，就像这样：

# create random sample
df <- ldply(mget(ls()),
            function(x) sample(x,1000,T)) %>% 
  gather(k,v,-`.id`) %>%
  spread(`.id`,v) %>% select(-k)
str(df)
# change back vars to numeric
df[,c('p','r','x')] <- 
  apply(df[,c('p','r','x')],2,function(x) as.numeric(x))

glimpse(df)

Observations: 1,000
Variables: 5
$ p <dbl> 2, 2, 3, 1, 3, 2, 2, 4, 2, 4, 4, 3, 2, 4, 1, 4, 2, 1, 4, 3, 1, 3, 4, 3, 2, 2, 3...
$ q <chr> "bar", "bar", "foo", "bar", "world", "hello", "foo", "hello", "world", "hello",...
$ r <dbl> 2, 2, 1, 6, 6, 3, 4, 8, 6, 6, 2, 2, 8, 7, 7, 6, 3, 2, 4, 5, 2, 7, 1, 6, 3, 7, 8...
$ x <dbl> 2, 5, 1, 3, 3, 5, 2, 4, 1, 3, 5, 1, 5, 5, 2, 1, 1, 4, 4, 1, 5, 1, 5, 4, 4, 3, 2...
$ y <chr> "a", "c", "b", "a", "b", "a", "b", "c", "c", "b", "c", "c", "b", "a", "c", "b",...

# graph distribution of each predictor against each outcome -- not run here
# df %>% gather(k,v,-y) %>% group_by(y,k,v) %>%
#   summarise(n=n()) %>%
#   mutate(prop=n/sum(n)) %>%
#   ggplot(aes(y,prop,fill=v)) + geom_bar(stat='identity',position='dodge') +
#   facet_wrap(~k,scales='free') + theme(legend.position = 'none')

# run MLR model
m <- multinom(y~.,df)
summary(m)$coefficients
m$wts # coefficients from model

# adjust weight 16, which is x against y=b
m$wts[16] <- 1

问题在于，随着预测变量数量的增加和级别的提高，这很繁琐。我的下一个方法是生成随机数据样本，运行MLR模型，并调整模型权重。

function coStatus(RATE_OF_WHT, NAME) {
sString = "";
if (RATE_OF_WHT == "4" || RATE_OF_WHT == "7" || RATE_OF_WHT == "8" || RATE_OF_WHT == "14.5" || RATE_OF_WHT == "15" || RATE_OF_WHT == "2" && NAME.includes("LTD") || NAME.includes("LIMITED") || NAME.includes("Ltd") || NAME.includes("Limited")) {sString = "COMPANY"}
else if (RATE_OF_WHT == "155" || RATE_OF_WHT == "3" || RATE_OF_WHT == "6" && NAME.includes("LTD") || NAME.includes("LIMITED") || NAME.includes("Ltd") || NAME.includes("Limited")) {sString = "COMPANY"}
else {sString = "INDIVIDUAL"}
return sString;
}

同样，当预测变量和水平的数量很大时，这很繁琐。 Plus 在我继续更改模型权重并预测新数据时，我遇到了一些意外的概率（显然，我对MLR的了解不足，无法自信地使用此方法）。

因此，我在这个阶段或多或少陷入困境。我已经考虑过使用多种插补或自举方法来生成所需的数据，但是我认为这两种方法都不适用。 MI将为不完整案例估算数据，而我想指定有限数量的完整案例并从中推断。同样，假设样本分布近似于总体分布，则引导程序将对数据重新采样。再说一次，我看不到如何指定数量有限的情况才能有效地做到这一点（也许是自举加上置换/改组？）。

无论如何，这里非常感谢您的帮助/建议。还要感谢真正阅读这篇冗长文章的人！

Answer 1

因此，我的解决方案是修改随机生成的数据，然后使用修改后的数据（可以更好地近似所需的分布）来运行MLR模型。

我创建了两个函数，一个函数重估数字变量，另一个函数重估名义变量。数值重值功能允许用户指定将预测值重新分配的方向，以及是否应应用或排除指定级别的结果变量。下面的功能已根据问题中包含的示例数据进行了测试。

当我返回并运行MLR模型并预测新数据时，对于每种结果，我都会得到不同的概率，从而更符合我的期望。

# redistribute values for specific predictors -----------------------------
# at specific levels of outcome var
####
# define function for numeric var
revalue.nums <- function(data,yvar.name,yvar.level,xvar.name,
                         direction=1, yvar.level.opposite=FALSE){
  # evaluate dir==-1 & oppo==T first, then dir==-1 & oppo==F,
  # then dir==1 & oppo==T, finally dir==1 & oppo==F
  if (direction==-1 & yvar.level.opposite==TRUE) {
    data[[xvar.name]][data[[yvar.name]] != yvar.level] <- 
      sample(get(xvar.name), 
             length(data[[xvar.name]][data[[yvar.name]] != yvar.level]), T,
             prob = c(seq(from=max(get(xvar.name)), 
                          to=min(get(xvar.name))) / sum(get(xvar.name))))
    return(data)
  } else if (direction==-1 & yvar.level.opposite==FALSE) {
    data[[xvar.name]][data[[yvar.name]]==yvar.level] <- 
      sample(get(xvar.name), 
             length(data[[xvar.name]][data[[yvar.name]]==yvar.level]), T,
             prob = c(seq(from=max(get(xvar.name)), 
                          to=min(get(xvar.name))) / sum(get(xvar.name))))
    return(data)
  } else if (direction==1 & yvar.level.opposite==TRUE) {
    data[[xvar.name]][data[[yvar.name]] != yvar.level] <- 
      sample(get(xvar.name), 
             length(data[[xvar.name]][data[[yvar.name]] != yvar.level]), T,
             prob = c(seq(from=min(get(xvar.name)), 
                          to=max(get(xvar.name))) / sum(get(xvar.name))))
    return(data)
  } else {
    data[[xvar.name]][data[[yvar.name]]==yvar.level] <- 
      sample(get(xvar.name), 
             length(data[[xvar.name]][data[[yvar.name]]==yvar.level]), T,
             prob = c(seq(from=min(get(xvar.name)), 
                          to=max(get(xvar.name))) / sum(get(xvar.name))))
    return(data)
  }
}
####

# define function
revalue.chars <- function(data,yvar.name,yvar.level,xvar.name,xvar.level,probs=0.25){
  data[[xvar.name]][data[[yvar.name]] == yvar.level] <- 
    sample(sort(sub(xvar.level,'1',get(xvar.name))),
           length(data[[xvar.name]][data[[yvar.name]] == yvar.level]), T,
           prob = c(probs, rep(probs / (length(get(xvar.name))-1),
                               rep(length(get(xvar.name))-1))))
  data[[xvar.name]][data[[xvar.name]] == '1'] <- xvar.level
  return(data)
}
###

# test functions on toy data
table(df$y,df$p) # orig
df1 <- revalue.nums(df,'y','a','p')
table(df1$y,df1$p) # changes y=a only, skew p to have higher values
df1 <- revalue.nums(df1,'y','a','p',yvar.level.opposite = T,direction = -1)
table(df1$y,df1$p) # changes y!=a, skew p to have lower values

table(df$y,df$q)
df2 <- revalue.chars(df,'y','b','q','hello',probs=0.5)
table(df2$y,df2$q) # increase num of q=hello and y=b occurrences

逆向工程多项式逻辑回归数据

1 个答案: