r - Creating a glm formula that takes in reactive inputs in Shiny -


i'm creating new shiny app fits glm model. formula receives reactive inputs , keep getting error:

unused argument (x[1])

this how code looks in 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="+")))     })  

and fake example show i'm trying do:

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 = "+"))) 

edit: discover i'm receiving

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

instead of

   [1] 1 2 3 4 5 6 7 8 

i tried put

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

but still not returning values.

error: object 'omegaday()[1]' not found

any suggestions? help!

ok, couldn't find solve

  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]"  

thus, decided go non neat idea. did if interested

  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="+")))  }  }) 

it works now, i'm still curious if have done other way. please tell me if know so!


Comments