.packageName <- "IBGEPesq"
IBGEtabula <- function(desenho, colunas, dominios, elimina=NA, dominios.vazios=T,
                       digitos.cv = 1, total.geral=F, proporcao=F, desvio.padrao=F,
                       proporcao.totais="um")
{
  library(survey)
  # Verifica se os objetos de entrada esto corretos (Giu 2006.12.12)
  if (!inherits(desenho, "survey.design"))
    stop("Objeto 'desenho' fornecido no  um objeto 'survey.design'.")
  if (any(!make.unique(colnames(desenho$variables))==colnames(desenho$variables)))
    stop(paste("As seguintes variveis do objeto desenho so repetidas:",
    colnames(desenho$variables)[!make.unique(colnames(desenho$variables))==colnames(desenho$variables)]))
  if (!inherits(colunas,"character"))
    stop("Objeto 'colunas' deve se referir aos nomes das variveis.")
  if (!all(colunas %in% colnames(desenho$variables)))
    stop(paste("As seguintes variveis do objetos 'colunas' no esto presentes no desenho fornecido: ",
    paste(colunas[!(colunas %in% colnames(desenho$variables))],collapse="; "),collapse=""))
  if (any(duplicated(colunas)))
    stop(paste("As seguintes variveis esto repetidas no objeto 'colunas': ",
    paste(colunas[duplicated(colunas)],collapse="; "),collapse=""))
  if (!inherits(dominios,"character"))
    stop("Objeto 'dominios' deve se referir aos nomes das variveis.")
  if (!all(dominios %in% colnames(desenho$variables)))
    stop(paste("As seguintes variveis do objeto 'dominios' no esto presentes no desenho fornecido: ",paste(dominios[!(dominios %in% colnames(desenho$variables))],collapse="; "),collapse=""))
  if (!all(is.na(elimina)))
    if (!inherits(unlist(elimina[!is.na(elimina)]),"character"))
      stop("Objeto 'elimina' deve conter 'NA' ou os nomes dos nveis a serem eliminados.")
  if (length(elimina)!=1 & length(elimina)!=length(dominios))
    stop("Objeto 'elimina' deve ter tamanho 1 ou o mesmo tamanho que 'dominios'.")
  if (!inherits(dominios.vazios,"logical"))
    stop("Objeto 'dominios.vazios' deve ser lgico (boolean).")
  if (!inherits(total.geral,"logical"))
    stop("Objeto 'total.geral' deve ser lgico (boolean).")
  if (!inherits(proporcao,"logical"))
    stop("Objeto 'proporcao' deve ser lgico (boolean).")
  if (!any(proporcao.totais %in% c("proporcao","um","total")))
    stop("Objeto 'proporcao.totais' deve ser igual a \"proporcao\", \"um\" ou \"total\".") 

  if (proporcao)
    {
    tabelaprop <- data.frame()
    tabelapropse <- data.frame()
    }
  #estimativas:
  if (length(elimina)==1) elimina <- rep(elimina, length(dominios))
  cat("\n", paste("Estimando", paste(dominios[1], collapse=" x ")),":\n")
  resp <- list(svyby(as.formula(paste("~ ", paste(colunas, collapse= "+"))),
          as.formula(paste("~",dominios[1])), desenho, svytotal, na.rm=T, verbose=T, drop.empty.groups=F))
  #elimina itens indesejados, por exemplo, sem declarao:
  i.elimina <- resp[[1]][,dominios[1]] %in% elimina[[1]]
  if (any(i.elimina)) resp[[1]] <- resp[[1]][-which(i.elimina),]
  #calcula erro padro:
  respse <- list(SE(resp[[1]]))
  nomes <- as.matrix(resp[[1]][,1])
  #elimina colunas que apenas contm os nomes dos itens dos grupos:
  resp[[1]] <- resp[[1]][,-1]
  #elimina colunas com o erro padro e mantm somente colunas com estimativas:
  resp[[1]] <- resp[[1]][,1:(ncol(resp[[1]])/2)]
  #calcula CV:
#  respcv <- list(respse[[1]] / resp[[1]])
  if (proporcao & ((proporcao.totais=="proporcao") | length(dominios)==1))
    {
    respropaux <- matrix(0,ncol=1,nrow=length(nomes))
    respropseaux <- matrix(0,ncol=1,nrow=length(nomes))
    cat("\n", paste("Estimando proporo", paste(dominios[1], collapse=" x ")), ":\n")          
    for (coluna in colunas)
      {
      resprop <- list(svyby(as.formula(paste("~",dominios[1])),
        as.formula(paste("~", coluna,collapse="")), desenho, svymean, na.rm=T, drop.empty.groups=F))
      i.elimina <- resprop[[1]][,coluna] %in% 0
      if (any(i.elimina)) resprop[[1]] <- resprop[[1]][!i.elimina,]
      respropse <- SE(resprop[[1]])
      resprop[[1]] <- resprop[[1]][,-1]
      resprop[[1]] <- resprop[[1]][,1:(ncol(resprop[[1]])/2)]
#      respropcv <- list(respropse[[1]] / resprop[[1]])
      i.elimina <- grep(paste(c(dominios[1],elimina[length(dominios)]),collapse=""),colnames(resprop[[1]]))
      if (length(i.elimina)>0) resprop[[1]] <- resprop[[1]][,-i.elimina]
      i.elimina <- grep(paste(c(dominios[1],elimina[length(dominios)]),collapse=""),colnames(respropse[[1]]))
      if (length(i.elimina)>0) respropse[[1]] <- respropse[[1]][,-i.elimina]
      resprop <- as.vector(unlist(t(resprop[[1]])))
      respropse <- as.vector(unlist(t(respropse[[1]])))
      respropaux <- cbind(respropaux,resprop)
      respropseaux <- cbind(respropseaux,respropse)
      }
    resprop <- data.frame(nomes,respropaux)
    respropse <- data.frame(nomes,respropseaux)
    rownames(resprop) <- nomes
    rownames(respropse) <- nomes
    resprop <- resprop[,-(1:2)]
    respropse <- respropse[,-(1:2)]
    colnames(resprop) <- colunas
    colnames(respropse) <- colunas
    tabelaprop <- rbind(tabelaprop,resprop)
    tabelapropse <- rbind(tabelapropse,respropse)
    }
  possibilidades <- numeric(0)
  ngr <- length(dominios) #nmero de nveis de agrupamento
  if (ngr > 1)
    {
    for (k in 1:ngr)
      {
      #define os cruzamentos possveis entre k grupos:
      possib <- combn(ngr,k)
      #elimina as possibilidades que no contm o primeiro nvel de agrupamento:
      if (k==1)
        possib <- as.matrix(possib[,possib[1,]!=1]) else
        possib <- as.matrix(possib)
      # armazena as possibilidades de cruzamento para uso posterior, na arrumao
      #      da tabela:
      possibilidades <- c(possibilidades, list(possib))
      for (l in 1:ncol(possib))
        {
        grupos.esc <- dominios[possib[,l]] #define o cruzamento atual
        cat("\n", paste("Estimando", paste(grupos.esc, collapse=" x ")), ":\n")
        # rearranja de trs pra frente para melhor apresentao final:
        grupos.esc <- grupos.esc[length(grupos.esc):1]
        # realiza a estimao:
        resp <- c(resp, list(svyby(as.formula(paste("~", paste(colunas, collapse= "+"))),
                as.formula(paste("~",paste(grupos.esc, collapse= "+"))), desenho,
                svytotal, na.rm=T, verbose=T, drop.empty.groups=F)))
        nresp <- length(resp)
        # elimina itens indesejados, por exemplo, sem declarao:
        for (e in possib[,l])
        {
          i.elimina <- resp[[nresp]][,dominios[e]] %in% elimina[[e]]
          if (any(i.elimina)) resp[[nresp]] <- resp[[nresp]][-which(i.elimina),]
        }
        # calcula erro padro:
        respse <- c(respse, list(SE(resp[[nresp]])))
        # calcula o nmero de itens em cada nvel de agrupamento:
        if (k==ngr)
          {
          itens <- apply(resp[[nresp]][,1:length(grupos.esc)], 2, unique) # 2006.12.01 Giu
          if (inherits(itens,"matrix"))
            {
            itens.temp <- list()
            for (i in 1:ncol(itens))
              itens.temp <- c(itens.temp,list(itens[,i]))
            itens <- itens.temp
            }
          nitens <- sapply(itens, length)
          }
        # elimina colunas que apenas contm os nomes dos itens dos grupos:
        nomes <- resp[[nresp]][,(1:length(grupos.esc))]
        resp[[nresp]] <- resp[[nresp]][,-(1:length(grupos.esc))]
        # elimina colunas com o erro padro e mantm somente colunas com estimativas:
        resp[[nresp]] <- resp[[nresp]][,1:(ncol(resp[[nresp]])/2)]
        # calcula o CV
#        respcv <- c(respcv, list(respse[[nresp]] / resp[[nresp]]))
        if (proporcao & ((proporcao.totais=="proporcao") | (possib[nrow(possib),l]==length(dominios))))
          {
          respropaux <- matrix(0,ncol=1,nrow=nrow(nomes))
          respropseaux <- matrix(0,ncol=1,nrow=nrow(nomes))
          cat("\n", paste("Estimando proporo", paste(grupos.esc, collapse=" x ")), ":\n")          
          for (coluna in colunas)
            {
            resprop <- list(svyby(as.formula(paste("~",grupos.esc[1])),
              as.formula(paste("~", paste(c(grupos.esc[2:length(grupos.esc)],coluna),collapse="+"))), 
              desenho, svymean, na.rm=T, drop.empty.groups=F))
            i.elimina <- resprop[[1]][,coluna] %in% 0
            if (any(i.elimina)) resprop[[1]] <- resprop[[1]][!i.elimina,]
            for (e in possib[,l][1:(length(possib[,l])-1)])
              {
              i.elimina <- resprop[[1]][,dominios[e]] %in% elimina[[e]]
              if (any(i.elimina)) resprop[[1]] <- resprop[[1]][-which(i.elimina),]
              }
            respropse <- SE(resprop[[1]])
            resprop[[1]] <- resprop[[1]][,-(1:length(grupos.esc))]
            resprop[[1]] <- resprop[[1]][,1:(ncol(resprop[[1]])/2)]
#            respropcv <- list(respropse[[1]] / resprop[[1]])
            eliminatemp <- paste(grupos.esc[1],unlist(elimina[length(dominios)]),sep="")
            i.elimina <- vector()
            for (d in eliminatemp)  i.elimina <- c(i.elimina, grep(d,colnames(resprop[[1]])))
            if (length(i.elimina)>0) resprop[[1]] <- resprop[[1]][,-i.elimina]
            eliminatemp <- paste(grupos.esc[1],unlist(elimina[length(dominios)]),sep="")
            i.elimina <- vector()
            for (d in eliminatemp)  i.elimina <- c(i.elimina, grep(d,colnames(resprop[[1]])))
            if (length(i.elimina)>0) respropse[[1]] <- respropse[[1]][,-i.elimina]
            resprop <- as.vector(unlist(t(resprop[[1]])))
            respropse <- as.vector(unlist(t(respropse[[1]])))
            respropaux <- cbind(respropaux,resprop)
            respropseaux <- cbind(respropseaux,respropse)
            }
            resprop <- cbind(nomes,respropaux)
            respropse <- cbind(nomes,respropseaux)
            resprop <- resprop[,-(1:(length(grupos.esc)+1))]
            respropse <- respropse[,-(1:(length(grupos.esc)+1))]
            colnames(resprop) <- colunas
            colnames(respropse) <- colunas
            tabelaprop <- rbind(tabelaprop,resprop)
            tabelapropse <- rbind(tabelapropse,respropse)
          }
        }
      }
    ####  arruma as estimativas na tabela
    itens <- rev(itens)
    tabela <- data.frame()
    tabelase <- data.frame()
    # Junta todas as linhas calculadas em uma tabela
    for (i in 1:length(resp)) tabela <- rbind(tabela,resp[[i]])
    for (i in 1:length(respse)) tabelase <- rbind(tabelase,respse[[i]])
    # Constri tabela completa de propores
    if (proporcao)
      {
      tabelapropaux <- tabela
      tabelapropseaux <- tabelase
      if (proporcao.totais == "um")
        {
        tabelapropaux[,] <- 1
        tabelapropseaux[,] <- 0
        }
      for (i in 1:length(rownames(tabelaprop)))
        {
        tabelapropaux[grep(rownames(tabelaprop[i,]),rownames(tabelapropaux)),] <- tabelaprop[i,]
        tabelapropseaux[grep(rownames(tabelapropse[i,]),rownames(tabelapropseaux)),] <- tabelapropse[i,]
        }
      tabelaprop <- tabelapropaux
      tabelapropse <- tabelapropseaux
      }
    nomes <- matrix("",nrow=nrow(tabela),ncol=length(itens))
    for (i in 1:nrow(tabela))
      {
      nome <- unlist(strsplit(rownames(tabela[i,]),".",fixed=T))
      for (j in 1:length(nome))
        {
        colnome <- grep(nome[j],itens)
        nomes[i,colnome] <- nome[j]
        }
      }
    for (i in ncol(nomes):1)
      {
      tabela <- data.frame(factor(nomes[,i],levels=c("",itens[[i]])),tabela)
      tabelase <- data.frame(factor(nomes[,i],levels=c("",itens[[i]])),tabelase)
      if (proporcao)
        {
        tabelaprop <- data.frame(factor(nomes[,i],levels=c("",itens[[i]])),tabelaprop)
        tabelapropse <- data.frame(factor(nomes[,i],levels=c("",itens[[i]])),tabelapropse)
        }
      }
    tabela <- tabela[do.call(order,tabela[,1:length(itens)]),]
    tabelase <- tabelase[do.call(order,tabelase[,1:length(itens)]),]
    if (proporcao)
      {
      tabelaprop <- tabelaprop[do.call(order,tabelaprop[,1:length(itens)]),]
      tabelapropse <- tabelapropse[do.call(order,tabelapropse[,1:length(itens)]),]
      }
    nomes <- character(nrow(tabela))
    for (i in 1:length(itens))
      nomes[!(tabela[,i]=="")] <- apply(cbind(rep(paste(c(rep("  ",i-1)),collapse=""),
      sum(!tabela[,i]=="")),as.character(tabela[!(tabela[,i]==""),i])),1,paste,collapse="")
    tabela <- as.matrix(tabela[,-(1:length(dominios))])
    tabelase <- as.matrix(tabelase[,-(1:length(dominios))])
    rownames(tabela) <- nomes    
    rownames(tabelase) <- nomes
    if (proporcao)
      {
    tabelaprop <- as.matrix(tabelaprop[,-(1:length(dominios))])
    tabelapropse <- as.matrix(tabelapropse[,-(1:length(dominios))])
    rownames(tabelaprop) <- nomes    
    rownames(tabelapropse) <- nomes
      }
    } else
    {                        # Acertar quando tiver s um dominio
    tabela <- as.matrix(resp[[1]])
    tabelase <- as.matrix(respse[[1]])
    if (proporcao)
      {
      tabelaprop <- resprop
      tabelapropse <- respropse
      }
    }
  colnames(tabela) <- colunas
  colnames(tabelase) <- colunas
  if (proporcao)
    {
    colnames(tabelaprop) <- colunas
    colnames(tabelapropse) <- colunas
    }
  # Apaga as linhas onde esto domnios vazios (Giu 2006.12.08)
  if (!dominios.vazios)
    {
    tabela <- tabela[!apply(is.na(tabela),1,all),]
    tabelase <- tabelase[!apply(is.na(tabelase),1,all),]
    if (proporcao)
      {
      tabelaprop <- tabelaprop[!apply(is.na(tabelaprop),1,all),]
      tabelapropse <- tabelapropse[!apply(is.na(tabelapropse),1,all),]
      }
    }
  # Calcula a linha de total geral se pedido (Giu 2006.12.12)
  if (total.geral)
    {
    desenho <- update(desenho, Total=factor(rep(1,nrow(desenho$variables)),labels="Total"))
    cat("\n", "Estimando Total:", "\n")
    resp <- list(svyby(as.formula(paste("~ ", paste(colunas, collapse= "+"))),
            ~Total, desenho, svytotal, verbose=T, drop.empty.groups=F))
    respse <- list(SE(resp[[1]]))
    resp[[1]] <- resp[[1]][,-1]
    resp[[1]] <- resp[[1]][,1:(ncol(resp[[1]])/2)]
#    respcv <- list(respse[[1]] / resp[[1]])
    tabelaux <- rbind(as.matrix(resp[[1]]),tabela)
    colnames(tabelaux) <- colnames(tabela)
    tabela <- tabelaux
    tabelaseaux <- rbind(as.matrix(respse[[1]]),tabelase)
    colnames(tabelaseaux) <- colnames(tabelase)
    tabelase <- tabelaseaux
    }  
  tabela <- round(tabela)
  tabelase <- round(tabelase)
  tabelacv <- round(100*tabelase/tabela, digits = digitos.cv)
  if (proporcao)
    {
    tabelapropcv <- round(100*tabelapropse/tabelaprop, digits = digitos.cv)
    if (desvio.padrao)
      {
    return(list(totais=tabela, desvio.padrao=tabelase, cv=tabelacv,
                proporcao=tabelaprop, cv.desvio.padrao=tabelapropse, cv.proporcao=tabelapropcv))
      } else
      return(list(totais=tabela, cv=tabelacv, proporcao=tabelaprop, cv.proporcao=tabelapropcv))
    } else
    {
    if (desvio.padrao)
      {
      return(list(totais=tabela, desvio.padrao=tabelase, cv=tabelacv))
      } else
      return(list(totais=tabela, cv=tabelacv))
    }
}
"le.pesquisa" <-
function(dicionario, pathname.in, pathname.out=NA, codigos, nomes=NA, quant=NA, tbloco=2000)
{
t1 <-Sys.time()

inicios<-numeric(0)
tamanhos<-numeric(0)
for (k in 1:length(codigos))
{
if (all(dicionario$cod!=codigos[k]))
  stop(paste("Varivel", codigos[k], "no existe em", pathname.in))
inicios[k] <- dicionario$inicio[dicionario$cod==codigos[k]]
tamanhos[k] <- dicionario$tamanho[dicionario$cod==codigos[k]]
}

if (length(nomes)==1)
  if (is.na(nomes)) nomes <- codigos

if (length(nomes)>1)
  nomes[is.na(nomes)] <- codigos[is.na(nomes)]

arq<-file(pathname.in)
open(arq)

cont=1
#nlinhas = 2000
dados <- numeric(0)
dadostemp2 <- numeric(0)
nlidos = 0
#quant =388000
#windows(width = 7, height = 2)
waitbar()
while(cont)
	{
	dadostemp <- scan(file=arq, what="", sep=";", nlines=tbloco, quiet=T)
	coluna <- substr(dadostemp, inicios[1], inicios[1]+tamanhos[1]-1)
	dadostemp2 <- data.frame(type.convert(coluna))
	if (length(inicios)>1)
	for (k in 2:length(inicios))
		{
		coluna <- substr(dadostemp, inicios[k], inicios[k]+tamanhos[k]-1)
		#coluna <- gsub(".", " ", coluna, fixed=T)
		dadostemp2 <- cbind(dadostemp2, data.frame(type.convert(coluna)))
		}
	if(length(dadostemp)<tbloco) cont=0
	rm(dadostemp)
	dados <- rbind(dados, dadostemp2)
	nlidos <- nrow(dados)
	if (is.na(quant))
		barplot(nlidos, width=.8, horiz = T, xlim=c(0,nlidos+1000), ylim=c(0,1), col="red", main=paste("Lendo", pathname.in))
	else
		
    waitbar(nome=paste("Lendo", pathname.in), k=nlidos/quant)
    #texto <- round(nlidos/quant*100)
    #a<-barplot(nlidos/quant, width=.8, horiz = T, xlim=c(0,1), ylim=c(0,1), col="red", main=paste("Lendo", pathname.in))
		#text(x=nlidos/quant/2, y=a, labels=paste(texto, "%", sep=""), font=2, col="white")
	}
close(arq)
t2 <- Sys.time()
rm(dadostemp2)
cat("\n Dados lidos de:")
cat("\n", pathname.in)

cat("\n", nrow(dados), "linhas  x ", ncol(dados), "colunas\nNomes das colunas:\n")
colnames(dados) <- nomes
print(colnames(dados))

if (!is.na(pathname.out) & !pathname.out=="")
	{
	save(dados, file=pathname.out)
	cat("\nDados salvos em:\n", pathname.out)
	cat("\n\n")
	}
dev.off()
print(t2-t1)
cat("\n\n\n")
dados
}
"media.pond" <-
function(x, pesos, dom)
{
#
# Calcula a mdia da varivel 'x', ponderada pela varivel 'pesos', para cada
#     domnio existente na varivel 'dom'.
# Se 'x' for matriz ou data-frame, ser calculada uma mdia para cada coluna de
#     'x' e para cada domnio definido na varivel 'dom'. Nesse caso, 'dom' deve
#     ser um vetor com nmero de elementos igual ao nmero de linhas de 'x'.
# Se 'x' for vetor, 'dom' pode ser vetor ou uma lista com vrios vetores com 
#     mesmo nmero de elementos de 'x'. Nesse caso, sero calculadas mdias 
#     cruzadas da varivel 'x' entre os vrios nveis de domnios existentes em
#     'dom'.

p <- numeric(0)

if ((is.matrix(x) | is.data.frame(x)) & !is.list(dom) & (is.vector(dom) | is.factor(dom)))
  {
  ncolunas <- ncol(x)
  for (k in 1:ncolunas) p <- cbind(p, tapply(x[,k]*pesos, dom, sum)/tapply(pesos,dom,sum))
  colnames(p) <- colnames(x)
  return(p)
  }
if (is.vector(x))
  {
  p <- tapply(x*pesos, dom, sum)/tapply(pesos,dom,sum)
  return(p)
  }
if ((is.matrix(x) | is.data.frame(x)) & is.list(dom))
  stop("Varivel 'dom' no pode ser lista quando 'x'  matriz ou data-frame.")
}

"merge.blocos" <-
function(dados1, dados2, tbloco=3000)
{
# Realiza um merge entre os objetos dados1 e dados2, que podem ser matrizes ou
#	data-frames. O merge  realizado em blocos, permitindo a manipulao de 
# grandes volumes de dados, como  o caso da PNAD.
# As colunas chaves so aquelas cujos nomes so comuns entre objetos 'dados1' e
#	'dados2'.
# O argumento 'tbloco' deve especificar o nmero de linhas que sero processadas
#	de cada vez e, se no for especificado, assume-se o valor 3000, que foi
#	utilizado eficientemente num computador com 512MB de memria RAM. Para 
#	computadores com menos memria, 'tbloco' deve ser menor que 3000.


t1 <- Sys.time()
cat("Merge. Dados iniciais:\n")
cat("dados1 ")
cat(dim(dados1))
cat("\ndados2 ")
cat(dim(dados2))
if (nrow(dados1)<nrow(dados2))
{
dadostemp <- dados1
dados1 <- dados2
dados2 <- dadostemp
rm(dadostemp)
}

nlinhas <- nrow(dados1)
nomescomuns <- colnames(dados2)[(colnames(dados2) %in% colnames(dados1))]
#dados1 <- dados1[ do.call(order, as.data.frame(dados1[,nomescomuns])) ,]
#dados2 <- dados2[ do.call(order, as.data.frame(dados2[,nomescomuns])) ,]
dados <- data.frame()
continua <- TRUE
passo=0
waitbar()
while (continua)
	{
	if (nrow(dados1)<(tbloco))
	{
		d1 <- dados1[1:nrow(dados1),]
		continua <- FALSE
	}
	else
	{
		d1 <- dados1[1:tbloco,]
		dados1 <- dados1[-c(1:tbloco),]
	}
	d <-  merge(dados2, d1, sort=FALSE)
	dados <- rbind(dados, d)
	passo<-passo+1
	waitbar(nome=paste("Merge"), k=passo/(trunc(nlinhas/tbloco)+1))
	}
dev.off()
rownames(dados) <- 1:nrow(dados)
cat("\nDados finais:\n")
cat(dim(dados))
cat("\n")
print(Sys.time() - t1)
dados
}

"waitbar" <-
function(nome=NA, k=NA)
{
# Barra de espera utilizada nas funes "le.pesquisa" e "merge.blocos".
# Indica o andamento processo em valor percentual.

if (is.na(k)) 
	{
	windows(width = 7, height = 2)
	}
else
	{
	k<-k*100
	a<-barplot(k, width=.8, horiz = T, xlim=c(0,100), 
		ylim=c(0,1), col="darkgreen", main=nome)
	texto <- round(k)
	text(x=k/2, y=a, labels=paste(texto, "%", sep=""), 
			font=2, col="white")
	}
}

