R/teste.R

In lucisouzarj/lasa: DLab Package

forModelData= function(grp.loja.usuario,grp.sku.usuario,final.horizonte)
{
  load("/RProjetos/Dados/betaspricing.Rda")
  if(!is.na(betas.pricing[grp.sku.usuario,'beta'])){
    existe.beta=1
    beta.preco <- betas.pricing[grp.sku.usuario,'beta']
    beta.pvalue <- betas.pricing[grp.sku.usuario,'p.value']
  }else{
    existe.beta=0
    beta.preco <- NA
    beta.pvalue <- NA
  }
  
  #infos lojas:
  lojas <- dataGetDetailStore()
  lojas$cidade_limpa <- stri_trans_general(lojas$CGEO_TX_CIDADE, "Latin-ASCII")
  cols.interesse.loja=c('GEO_CD_LOJA','ADMG_CD_GR','EGEO_UF_ESTADO','cidade_limpa')
  info_loja=cbind(lojas[,cols.interesse.loja],str_sub(lojas[,c("GEO_TX_CENTRO_DISTRIBUICAO")],-2,-1))
  g.pri=priRCTComposition() #grupos pricing
  info_loja_completa <- merge(info_loja, g.pri, by.x= 'GEO_CD_LOJA', by.y= 'Loja', sort = FALSE) # 1 min
  colnames(info_loja_completa)=c("Loja","G.LASA","UF","CIDADE","CD","G.PRI")
  
  #cria tabela usuario:
  
  grp=grp.sku.usuario[1]
  info.grp.sku=paste0(c("VDA_BRT_G","VDA_QTD_G","EST_QTD_G","EST_TRAN_G","p_99_G"),rep(grp,5))
  cols.interesse.base=c(c("Data","Loja","opened"),info.grp.sku)
  if (grp.loja.usuario[1]=="BRASIL"){
    lojas.interesse=as.vector(t(subset(info_loja_completa, select = "Loja")))
  } else {
    lojas.interesse=as.vector(t(subset(info_loja_completa, eval(parse(text=grp.loja.usuario[1])) == grp.loja.usuario[2], select = "Loja")))
  }
  n.lojas=length(lojas.interesse)
  base.interesse <- base[which(base[,"Loja"] %in% lojas.interesse),cols.interesse.base]
  colnames(base.interesse)=c("Data","Loja","opened","v","q","s","str","p99")
  
  #Trata base de interesse (selecionada pelo usuário):
  serie.interesse=aggregate(. ~ Data, data = base.interesse, FUN = 'sum', na.rm = TRUE, na.action=NULL) #NA->0 Ideal?
  libera.analise=1
  if (length(serie.interesse[(serie.interesse[,5])!=0,5])/365.25<1.5) {libera.analise=0}
  aux=rowSums(serie.interesse[,-c(1:3)])
  for(i in length(aux):1){
    if(aux[i]!=0){break}
  }
  serie.interesse=serie.interesse[1:i,]
  
  #or: serie.interesse=aggregate(base.interesse[,-c(1,2)], by=list(base.interesse$Data), FUN=sum, na.rm=TRUE) #Não nomeia a coluna de Data como Data, mas como Group1
  
  DDSem=DSem(serie.interesse[,'Data']) #Dias da semana
  DFer=DFeriados(serie.interesse[,'Data']) #Feriados nacionais
  
  #Promocoes:
  load("/RProjetos/Dados/prom.atu.Rda")
  prom=prom.atu[[1]]
  MDataProm=max(prom[,'data'])
  mDataProm=min(prom[,'data'])
  MDataSerie=max(as.Date(serie.interesse[,'Data']))
  mDataSerie=min(as.Date(serie.interesse[,'Data']))
  min_data_obs=max(mDataProm,mDataSerie)
  max_data_obs=min(MDataProm,MDataSerie)
  
  if (min_data_obs==as.Date(timeFirstDayInMonth(min_data_obs)) ){
    fdcm_obs=min_data_obs
  } else {
    fdcm_obs=as.Date(timeFirstDayInMonth(min_data_obs)) #primeiro dia dos meses completos observados
  }
  if (max_data_obs==as.Date(timeLastDayInMonth(max_data_obs)) ){
    ldcm_obs=max_data_obs
  } else {
    ldcm_obs=as.Date(timeLastDayInMonth(max_data_obs-30)) #último dia dos meses completos observados
  }
  #Período base completa
  # cat(paste("\n Dados para ajuste de modelos com período", fdcm_obs, "a", ldcm_obs,". Último dia da tabela de
  #           \n promoções", MDataProm, "e último dia da base", MDataSerie,"."))
  
  #preço:
  p=serie.interesse[,"p99"]/length(unique(base.interesse$Loja))#p=serie.interesse[,'v']/serie.interesse[,'q']
  
  #Estoque loja:
  # slj=serie.interesse[,'s']/serie.interesse[,'str']
  # slj[is.na(slj)]=0
  # slj[is.nan(slj)]=0
  # slj[is.infinite(slj)]=0
  
  #Dados para previsão às cegas:
  #linhas para previsão às cegas, no mínimo, até final do mês da data final.horizonte:
  if ( (as.Date( final.horizonte)- as.Date( ldcm_obs) ) <=( as.Date( timeLastDayInMonth( ldcm_obs+ 1) )- as.Date( ldcm_obs) )) 
  {final.horizonte= as.Date(timeLastDayInMonth(ldcm_obs+1))}
  
  #periodo 1 mês a frente:
  #per.blind=seq(as.Date(ldcm_obs+1), as.Date(timeLastDayInMonth(ldcm_obs+25)), by="days")
  per.blind=seq(as.Date(MDataSerie+1), as.Date(final.horizonte), by="days")
  #Dados:
  #q=NA; Dias da semana; Dias de promoção; Feriados Nacionais; preço médio; estoque merc. entregue; número de lojas abertas.
  q.blind=rep(NA,length(per.blind))
  #Dias da semana
  DDSem.blind=DSem(per.blind) 
  #promoções:merge per.blind x prom
  prom.obs=subset(prom, data %in% per.blind)
  falta=per.blind[!(per.blind %in% prom[,'data'])]
  prom.falta=data.frame(matrix(0,nrow=length(falta),ncol=ncol(prom)))
  colnames(prom.falta)=colnames(prom)
  prom.falta[,'data']=falta
  prom.blind=rbind(prom.obs, prom.falta)
  MaxObs.prom=NULL
  if (length(falta)!=0) MaxObs.prom=min(falta)-1
  #Feriados nacionais
  DFer.blind=DFeriados(per.blind) 
  #preço médio:
  p.blind= rep(p[which(as.Date(serie.interesse[,'Data'])==MDataSerie)], length(per.blind))
  #estoque
  
  
  #Número de lojas abertas:
  num.lojas.blind=MediaNlojasAb(per.blind, DFer, serie.interesse[,"opened"], MDataSerie,
                                DDSem, DFer.blind, DDSem.blind)
  
  #num.lojas.blind=rep(0,nrow(DDSem.blind))## Luciene arrumar MediaNLojasAb
  
  #Todos os dados:
  dias=as.Date(serie.interesse[,'Data'])
  selec=dias>=fdcm_obs & dias<=MDataSerie #ldcm_obs
  dias=dias[selec]
  dados=data.frame(y=c(serie.interesse[selec,'q'], q.blind), 
                   rbind(DDSem[selec,], DDSem.blind), 
                   rbind(prom[prom[,'data'] %in% dias,-1], prom.blind[,-1]), 
                   rbind(DFer[selec,], DFer.blind), 
                   p=c(p[selec], p.blind),
                   #slj=slj[selec],
                   qlj=c(serie.interesse[selec,"opened"],num.lojas.blind))
  rownames(dados)=c(as.Date(serie.interesse[selec,"Data"]),as.Date(per.blind))
  
  
  #quebrar em in e out of sample
  dados.in=dados[1:which(rownames(dados)==MDataSerie),]
  dados.out.aux=dados[(which(rownames(dados)==MDataSerie)+1):nrow(dados),]
  
  if(final.horizonte>tail(rownames(dados.out.aux),1)){
    datas.aux=seq(as.Date(head(rownames(dados.out.aux),1)),as.Date(final.horizonte),by="day")
    aux=matrix(0,length(datas.aux)-nrow(dados.out.aux),ncol(dados.out.aux))
    colnames(aux)=colnames(dados.out.aux)
    dados.out=rbind(dados.out.aux,aux)
    rownames(dados.out)=datas.aux
    dados.out[,"p"]=round(dados.out[1,"p"],2)
    dados.out[,c("seg", "ter", "qua", "qui", "sex", "sab")]=DSem(datas.aux)
    aux=data.frame(DFeriados(datas.aux))
    dados.out[,colnames(aux)]=aux
    
    num.lojas.blind=MediaNlojasAb(datas.aux, dados.in[,colnames(aux)], serie.interesse[,"opened"], MDataSerie,
                                  DDSem, DFeriados(datas.aux), DSem(datas.aux))
    dados.out$qlj=num.lojas.blind
    
  }
  if(final.horizonte==tail(rownames(dados.out.aux),1)){
    dados.out=dados.out.aux
  }
  if(final.horizonte<tail(rownames(dados.out.aux),1)){
    dados.out=dados.out.aux[1:which(rownames(dados.out.aux)==final.horizonte),]
  }
  
  
  dados.out$y <- NULL
  dados.out$data <- rownames(dados.out)
  dados.out$dados.na.base <- ifelse(dados.out$data <= MDataProm, 'Sim', 'Nao')
  dados.out$data <- NULL
  dados.out <- cbind.data.frame('dados.na.base' = dados.out$dados.na.base, 'p' = dados.out$p, 'qlj' = dados.out$qlj, 
                                dados.out[,!(colnames(dados.out) %in% c('dados.na.base','p','qlj'))])
  
  dados.in <- cbind.data.frame('y' = dados.in$y, 'p' = dados.in$p, 'qlj' = dados.in$qlj, 
                               dados.in[,!(colnames(dados.in) %in% c('y', 'p','qlj'))])
  
  #trata período anterior ao período de atividade do SKU como NA
  test.y=cumsum(dados.in$y)
  dados.in=dados.in[test.y!=0,]
  
  if(libera.analise==0)
  {
    shinyjs::show('div.txt.analise.nao.liberada')
  } else{
    shinyjs::hide('div.txt.analise.nao.liberada')
  }
  
  
  return(list(dados.in=dados.in,dados.out=dados.out,fdcm_obs=fdcm_obs,ldcm_obs=ldcm_obs,MDataProm=MDataProm,MDataSerie=MDataSerie, per.blind=per.blind,
              MaxObs.prom=MaxObs.prom,n.lojas=n.lojas, existe.beta=existe.beta, beta.preco=beta.preco,beta.pvalue=beta.pvalue,
              libera.analise=libera.analise,grp.sku.usuario=grp.sku.usuario))
}