在 Shiny 中创建一个接收响应式输入的 glm 公式

Question

我正在创建一个适合 glm 模型的新 Shiny 应用程序。但是公式接收到一些反应性输入，我不断收到错误：

未使用的参数 (x[1])

这就是代码在 Server.R 中的样子

 form <- reactive({ 
  as.formula(paste0('cbind(n,count) ~ ',paste0(apply(data.frame(V1=input$checkGroup,sapply(c('linear','quadratic','sine'), grepl, paste0('input$trans',gsub("\\.","",input$checkGroup)), ignore.case=TRUE)),
                                                   1,function(x) 
                                                     ifelse(x[2]==F,
                                                     ifelse(x[3]==F,
                                                     ifelse(x[4]==F,paste0('I((',paste0('omega',gsub("\\.","",x[1]),'()[1]'),'*sin(',paste0('omega',gsub("\\.","",x[1]),'()[2]'),'*as.numeric(',gsub("\\.","",x[1]),')+',paste0('omega',gsub("\\.","",x[1]),'()[3]'),')+',paste0('omega',gsub("\\.","",x[1]),'()[4]'),'))'),
                                                                    paste0('as.numeric(',x[1],')+I(as.numeric(',x[1],'))^2'),
                                                                    x[1])))),collapse="+")))  

 }) 

这是一个假的例子来展示我正在尝试做的事情：

x <- data.frame(V1=c('day','hour','source','relevancy','tollfree','dist.mean','simi.mean'),sapply(c('linear','quadratic','sine'), grepl, c(rep('linear',5),rep('quadratic',1),rep('sine',1)), ignore.case=TRUE))
as.formula(paste0('cbind(n,count) ~ ',paste0(apply(x,1,
  function(x)
    ifelse(x[2]==F,
    ifelse(x[3]==F,
    ifelse(x[4]==F,x[1],paste0('I((',paste0('omega',gsub("\\.","",x[1]),'()[1]'),'*sin(',paste0('omega',gsub("\\.","",x[1]),'()[2]'),'*as.numeric(',x[1],')+',paste0('omega',gsub("\\.","",x[1]),'()[3]'),')+',paste0('omega',gsub("\\.","",x[1]),'()[4]'),'))')
  ),
    paste0('as.numeric(',x[1],')+I(as.numeric(',x[1],'))^2')),
    x[1])),collapse = "+")))

编辑：我发现我收到了

   [1] "omegaday()[1]"       "omegahour()[1]"      "omegasource()[1]"    "omegaservice()[1]"   "omegarelevancy()[1]" "omegatollfree()[1]" [7] "omegadistmean()[1]"  "omegasimimean()[1]" 

代替

   [1] 1 2 3 4 5 6 7 8

我试着放了一个

   get(paste0('omega',gsub("\\.","",x[1]),'()[1]'))

但它仍然没有返回值。

错误：找不到对象“omegaday()[1]”

有什么建议吗？感谢您的帮助！

Answer 1

好的，所以我找不到任何可以解决的问题

  get(paste0('omega',gsub("\\.","",x[1]),'()[1]'))
  > [1] "omegaday()[1]"       "omegahour()[1]"      "omegasource()[1]"    "omegaservice()[1]"   "omegarelevancy()[1]" "omegatollfree()[1]" [7] "omegadistmean()[1]"  "omegasimimean()[1]" 

因此，我决定采用非简洁的想法。如果有人感兴趣，我会这样做

  name <- reactive({ 
  x <- data.frame(V1=ifelse(input$checkGroup=='distance','dist.mean',ifelse(input$checkGroup=='similarity','simi.mean',input$checkGroup))
          ,sapply(c('linear','quadratic','sine','exponential'), grepl, 
                                    apply(as.data.frame(paste0('trans',gsub("\\.","",ifelse(input$checkGroup=='distance','dist.mean',ifelse(input$checkGroup=='similarity','simi.mean',input$checkGroup))))),
                                          1,function(x) input[[x]]), 
                                    ignore.case=TRUE))

 if (sum((x[,3]))==0 & sum((x[,4]))==0 & sum((x[,5]))==0){ #just linear
   as.formula(paste('cbind(n,count) ~ ',paste(x[,1][which(x[,2])],collapse = "+")))
 } else if(sum((x[,4]))==0  & sum((x[,5]))==0){ # linear & quadratic
   as.formula(paste('cbind(n,count) ~ ',paste(x[,1][which(x[,2])],collapse = "+"),"+",paste0("as.numeric(",x[,1][which(x[,3])],')+I(as.numeric(',x[,1][which(x[,3])],')^2)',collapse = "+")))
 } else if(sum((x[,3]))==0 & sum((x[,5]))==0){ #linear & sine
   xp <- paste(
     x[,1][which(x[,2])],
      if(x[,1][which(x[,4])]=="day"){
       paste0('I((',omegaday()[1],'*sin(',omegaday()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegaday()[3],')+',omegaday()[4],'))')
     } else if(x[,1][which(x[,4])]=='hour'){
       paste0('I((',omegahour()[1],'*sin(',omegahour()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegahour()[3],')+',omegahour()[4],'))')
     }  else if(x[,1][which(x[,4])]=='source'){
       paste0('I((',omegasource()[1],'*sin(',omegasource()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegasource()[3],')+',omegasource()[4],'))')
     } else if(x[,1][which(x[,4])]=='service'){
       paste0('I((',omegaservice()[1],'*sin(',omegaservice()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegaservice()[3],')+',omegaservice()[4],'))')
     } else if(x[,1][which(x[,4])]=='relevancy'){
       paste0('I((',omegarelevancy()[1],'*sin(',omegarelevancy()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegarelevancy()[3],')+',omegarelevancy()[4],'))')
     } else if(x[,1][which(x[,4])]=='tollfree'){
       paste0('I((',omegatollfree()[1],'*sin(',omegatollfree()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegatollfree()[3],')+',omegatollfree()[4],'))')
     } else if(x[,1][which(x[,4])]=='dist.mean'){
       paste0('I((',omegadistmean()[1],'*sin(',omegadistmean()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegadistmean()[3],')+',omegadistmean()[4],'))')
     } else if(x[,1][which(x[,4])]=='simi.mean'){
       paste0('I((',omegasimimean()[1],'*sin(',omegasimimean()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegasimimean()[3],')+',omegasimimean()[4],'))')
     } else if(x[,1][which(x[,4])]=='simi.names'){
       paste0('I((',omegasiminames()[1],'*sin(',omegasiminames()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegasiminames()[3],')+',omegasiminames()[4],'))')
     } else if(x[,1][which(x[,4])]=='dist.names'){
       paste0('I((',omegadistnames()[1],'*sin(',omegadistnames()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegadistnames()[3],')+',omegadistnames()[4],'))')
     } else if(x[,1][which(x[,4])]=='week'){
       paste0('I((',omegaweek()[1],'*sin(',omegaweek()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegaweek()[3],')+',omegaweek()[4],'))')
     } else if(x[,1][which(x[,4])]=='rel'){
       paste0('I((',omegarel()[1],'*sin(',omegarel()[2],'*as.numeric(',x[,1][which(x[,4])],')+',omegarel()[3],')+',omegarel()[4],'))')
     } 
   )
   xp <- unlist(strsplit(xp,split=" "))

   as.formula(paste('cbind(n,count) ~ ',paste(unique(xp),collapse="+")))
 }
 })

现在可以了，但我仍然很好奇我是否可以采用其他方式。如果你知道，请告诉我！