Fonte de Dados

Bibliotecas

library(knitr)
require(xlsx)

Download dos Dados

Obtem Tabela de Concessão.

tmp <- tempfile()
download.file("http://www.prefeitura.sp.gov.br/cidade/secretarias/upload/transportes/SPTrans/2014/janeiro/remuneracao/Concessao-010114.xlsx", 
              destfile=tmp, method="curl")
#Le a tabela em excel. 
concessao.table <- read.xlsx(tmp, sheetIndex=1)
#Remove o arquivo temporario.
unlink(tmp)

Obtem Tabela de Permissão

#Repete o mesmo processo para tabela de permissao.

tmp <- tempfile()
download.file("http://www.prefeitura.sp.gov.br/cidade/secretarias/upload/transportes/SPTrans/2014/janeiro/remuneracao/Permissao-010114.xls", 
              destfile=tmp, method="curl")
#Le a tabela em excel. 
permissao.table <- read.xlsx(tmp, sheetIndex=1)
#Remove o arquivo temporario.
unlink(tmp)

Obtem Tabela de Passageiros Transportados

tmp <- tempfile()
download.file("http://www.prefeitura.sp.gov.br/cidade/secretarias/upload/transportes/SPTrans/2014/janeiro/passageiros/Passag-20140101.xls", 
              destfile=tmp, method="curl")
#Le a tabela em excel. 
passageiro.table <- read.xlsx(tmp, sheetIndex=1)
#Remove o arquivo temporario.
unlink(tmp)

Pre-Processamento (Excel-> CSV)

Extração dos Custos por Empresa

As tabelas de demonstrativos de remuneração contém mais informação do que precisamos para análise dos custos por passageiros. Se olharmos as duas tabelas de demonstrativos na Fonte, encontraremos um pouco que escondido nos itens 8 e 10 os custos das empresas.

Infelizmente, o nome e area das colunas não apenas não seguem um padrão, como também estão separados em uma ou duas linhas. Devido a formatação da tabela, a leitura em memoria gera colunas extras sem conteúdo. Este pre-processamento é feito aqui, mas acaso a quantidade de colunas mude, o que pode ser possível após o vencimento dos contratos em ambas as tabelas, esta limpeza pode não mais funcionar.

#library(stringr)
#Função para localizar e extrair somente os custos da empresa.
find.company.start.index <- function(regex,file){
    #company.index <- grepl(pattern=string.to.find,x=file[,1],ignore.case=TRUE)    
    #company.index <- which(company.index == TRUE) + 1
    #return(file[company.index:nrow(file),])
    return(file[grepl(regex,file[,1]),])
}
#library("stringr")
#indices <- !is.na(str_match(words,'([9]).([0-9]).*')[,1])

clean.concessao.table.errors <- function(table){
    #Remoção das ultimas duas colunas geradas por erro da leitura da tabela excel devido a formatacao original.
    table <- table[,c(-ncol(table),-(ncol(table)-1))]
    #Nomeação das Colunas (Arquivo original contem os nomes em mais de uma linha)
    colnames(table) <- c("Empresa","Consórcio Bandeirante de Transporte","Sambaíba Transportes Urbanos Ltda.","Consórcio Plus","Via Sul Transportes Urbanos Ltda.","Consórcio Unisul","Consórcio Sete","Consórcio Sudoeste de Transporte","Ambiental Transp. Urb. S.A.","Express Transp. Urb Ltda","TOTAL")
    return(table)
}
clean.permissao.table.errors <- function(table){
    #Remoção das ultimas duas colunas geradas por erro da leitura da tabela excel devido a formatacao original.
    table <- table[,c(-ncol(table),-(ncol(table)-1),-(ncol(table)-2))]
    #Nomeação das Colunas
    colnames(table) <- c("Empresa","Consórcio Transcooper Fênix","Consórcio Transcooper Fênix","Consórcio Aliança Paulistana","Transcooper","Consórcio Aliança Cooperpeople","Consórcio Auhto Pam","Consórcio Auhto Pam",
"Consórcio Unicoopers Cooperalfa")
    return(table)
}
companies.concessao <- find.company.start.index('([8]).([0-9]).*',concessao.table)
companies.concessao <- clean.concessao.table.errors(companies.concessao)

companies.permissao <- find.company.start.index('([9]).([0-9]).*',permissao.table)
companies.permissao <- clean.permissao.table.errors(companies.permissao)

Exibição dos Dados Pre-Processados

Após a extração do que nos interessa, exibo aqui como ficaram os dados de 1/1/2014 nas três tabelas usadas referenciadas na Fonte.

Concessão

kable(companies.concessao)
Empresa Consórcio Bandeirante de Transporte Sambaíba Transportes Urbanos Ltda. Consórcio Plus Via Sul Transportes Urbanos Ltda. Consórcio Unisul Consórcio Sete Consórcio Sudoeste de Transporte Ambiental Transp. Urb. S.A. Express Transp. Urb Ltda TOTAL
1 OPERAÇÃO 01/01/14 - VENCIMENTO 08/01/14 NA NA NA NA NA NA NA NA NA NA
100 8.1. Viação Gato Preto Ltda. 23160.05 0 0 0 0 0 0 0 0 23160.05
101 8.2. Viação Santa Brígida Ltda. 154368.05 0 0 0 0 0 0 0 0 154368.05
102 8.3. Sambaíba Transportes Urbanos Ltda. 0 287799.4 0 0 0 0 0 0 0 287799.4
103 8.4. Consórcio Plus 0 0 386448.75 0 0 0 0 0 0 386448.75
104 8.5. Via Sul Transportes Urbanos Ltda. 0 0 0 170364.9 0 0 0 0 0 170364.9
105 8.6. VIP - Transportes Urbanos Ltda. 0 0 0 0 42976.99 0 0 0 0 42976.99
106 8.7. Tupi Transportes Urbanos Piratininga Ltda. 0 0 0 0 59091 0 0 0 0 59091
107 8.8. Mobibrasil Transp Urbano Ltda. 0 0 0 0 89956.67 0 0 0 0 89956.67
108 8.9. Viação Cidade Dutra Ltda. 0 0 0 0 154901.56 0 0 0 0 154901.56
109 8.10. VIP - Transportes Urbanos Ltda. 0 0 0 0 0 104803.28 0 0 0 104803.28
110 8.11. Viação Campo Belo Ltda. 0 0 0 0 0 15676.03 0 0 0 15676.03
111 8.12. Transkuba Transportes Gerais Ltda. 0 0 0 0 0 71350.73 0 0 0 71350.73
112 8.13. Viação Gatusa Transportes Urb. Ltda. 0 0 0 0 0 57481.72 0 0 0 57481.72
113 8.14. Consórcio Sete 0 0 0 0 0 169501.04 0 0 0 169501.04
114 8.15. Viação Gato Preto Ltda. 0 0 0 0 0 0 61751.09 0 0 61751.09
115 8.16. Transpass Transp. de Pass. Ltda 0 0 0 0 0 0 108733.74 0 0 108733.74
116 8.17. Ambiental Transportes Urbanos S.A. 0 0 0 0 0 0 0 4717.97 0 4717.97
117 8.18. Express Transportes Urbanos Ltda 0 0 0 0 0 0 0 0 17758.23 17758.23

Permissão

Note que contrário a tabela de concessão, a tabela de totais aqui e também na fonte não contém os valores finais (!) e portanto não podemos mais confiar no restante da análise nesta coluna.

kable(companies.permissao)
Empresa Consórcio Transcooper Fênix Consórcio Transcooper Fênix Consórcio Aliança Paulistana Transcooper Consórcio Aliança Cooperpeople Consórcio Auhto Pam Consórcio Auhto Pam Consórcio Unicoopers Cooperalfa
56 9.1. Fênix 22551.74 15334.86 0 0 0 0 0 0
57 9.2. Transcooper 103497.03 55662.42 0 77295.31 0 0 0 0
58 9.3. Paulistana 0 0 52602.17 0 0 0 0 0
59 9.4. Paulistana I 0 0 60637.21 0 0 0 0 0
60 9.5. Paulistana II 0 0 15849.7 0 0 0 0 0
61 9.6. Nova Aliança 0 0 9819.27 0 10318.72 0 0 0
62 9.7. Transcooper II 0 0 0 44422.09 0 0 0 0
63 9.8. Transcooper III 0 0 0 38964.26 0 0 0 0
64 9.9. Transcooper IV 0 0 0 7786.89 0 0 0 0
65 9.10. Coopertranse 0 0 0 0 74820.83 0 0 0
66 9.11. Cooperpam 0 0 0 0 0 138098.75 151770.7 0
67 9.12. Cooperlider 0 0 0 0 0 81576.35 0 0
68 9.13. Cooperalfa 0 0 0 0 0 0 0 25478.52
69 9.14. Unicoopers 0 0 0 0 0 0 0 53821.91
70 9.15. Parcela de remuneração repassada diretamente ao cooperado. 0 0 0 0 0 0 0 0

Passageiros Transportados

Como esta tabela é grande, então apenas as primeiras linhas serão exibidas. De imediato, podemos observar que o nome das empresas não são exatamente iguais aos das tabelas de demonstrativo por concessão e permissão. Esta pequena diferença torna a análise muito mais complicada ao cruzar as tabelas, pois será necessário usar métricas de similaridade ou alguma heuristica para saber que dois nomes diferentes nas duas empresas são similares.

kable(head(passageiro.table))
DATA TIPO AREA EMPRESA LINHA PASSAGEIROS.PAGANTES.EM.DINHEIRO…A. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.COMUM…B. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.ESTUDANTE…C.. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.VALE.TRANSPORTE…D. PASSAGEIROS.PAGANTES.INTEGRAÇÕES.METRÔ.E.CPTM…E. PASSAGEIROS.PAGANTES…F…..A…B…C…D…E. PASSAGEIROS.INTEGRAÇÕES.ÔNIBUS….ÔNIBUS…G. PASSAGEIROS.COM.GRATUIDADE…H. TOTAL.PASSAGEIROS.TRANSPORTADOS…I…..F…G…H. NA.
2014-01-01 CONCESSAO AREA 1 GATO PRETO 800010 - TERM LAPA/PCA RAMOS 195 202 15 189 73 674 673 215 1562 NA
2014-01-01 CONCESSAO AREA 1 GATO PRETO 853810 - VILA IARA/PAISSANDU 7 4 0 6 0 17 13 3 33 NA
2014-01-01 CONCESSAO AREA 1 GATO PRETO 854210 - BRASILANDIA/PCA DO CORREIO 424 439 42 390 52 1347 621 335 2303 NA
2014-01-01 CONCESSAO AREA 1 GATO PRETO 854510 - PENTEADO/METRO BARRA FUNDA 143 138 25 149 101 556 273 123 952 NA
2014-01-01 CONCESSAO AREA 1 GATO PRETO 901410 - MORRO GRANDE/TERMINAL LAPA 169 238 21 176 115 719 371 189 1279 NA
2014-01-01 CONCESSAO AREA 1 GATO PRETO 916210 - JD.ALMANARA/RIO BRANCO 32 54 4 21 0 111 60 45 216 NA

Cruzamento de Tabelas por Concessão

Pre-Processamento (Remoção de acentos, upper case, etc.)

Uma métrica de similaridade é a de “Distancia de Edição”. Basicamente todos os caracteres de duas strings são comparados conforme sua ordem no alfabeto para calcular a sua proximidade. Usando isso para toda a string, podemos tentar cruzar as tabelas. Antes disso, no entanto, precisamos pre-processar as strings para simplificar o processo de comparação.

Vamos começar definindo uma função que substitui letras que contém acentos por sua versão sem acentos.

#Source: http://pt.stackoverflow.com/questions/46473/remover-acentos
rm_accent <- function(str,pattern="all") {
  # Rotinas e funções úteis V 1.0
  # rm.accent - REMOVE ACENTOS DE PALAVRAS
  # Função que tira todos os acentos e pontuações de um vetor de strings.
  # Parâmetros:
  # str - vetor de strings que terão seus acentos retirados.
  # patterns - vetor de strings com um ou mais elementos indicando quais acentos deverão ser retirados.
  #            Para indicar quais acentos deverão ser retirados, um vetor com os símbolos deverão ser passados.
  #            Exemplo: pattern = c("´", "^") retirará os acentos agudos e circunflexos apenas.
  #            Outras palavras aceitas: "all" (retira todos os acentos, que são "´", "`", "^", "~", "¨", "ç")
  if(!is.character(str))
    str <- as.character(str)

  pattern <- unique(pattern)

  if(any(pattern=="Ç"))
    pattern[pattern=="Ç"] <- "ç"

  symbols <- c(
    acute = "áéíóúÁÉÍÓÚýÝ",
    grave = "àèìòùÀÈÌÒÙ",
    circunflex = "âêîôûÂÊÎÔÛ",
    tilde = "ãõÃÕñÑ",
    umlaut = "äëïöüÄËÏÖÜÿ",
    cedil = "çÇ"
  )

  nudeSymbols <- c(
    acute = "aeiouAEIOUyY",
    grave = "aeiouAEIOU",
    circunflex = "aeiouAEIOU",
    tilde = "aoAOnN",
    umlaut = "aeiouAEIOUy",
    cedil = "cC"
  )

  accentTypes <- c("´","`","^","~","¨","ç")

  if(any(c("all","al","a","todos","t","to","tod","todo")%in%pattern)) # opcao retirar todos
    return(chartr(paste(symbols, collapse=""), paste(nudeSymbols, collapse=""), str))

  for(i in which(accentTypes%in%pattern))
    str <- chartr(symbols[i],nudeSymbols[i], str)

  return(str)
}

Utilizamos essa função a seguir, além também de remover os códigos de cada empresa que aparecem nos demonstrativos, uma vez que calcular a sua distância poderia gerar errors na comparação.

#Remove codigos e transforma em caixa baixa
companies.concessao$Empresa <- lapply(strsplit(as.character(companies.concessao$Empresa)," "),"[",-1)
companies.concessao$Empresa <- tolower(sapply(companies.concessao$Empresa,function(x) paste(x,collapse=' ')))
companies.concessao$Empresa <- rm_accent(companies.concessao$Empresa)

#Remove codigos e transforma em caixa baixa
companies.permissao$Empresa <- lapply(strsplit(as.character(companies.permissao$Empresa)," "),"[",-1)
companies.permissao$Empresa <- tolower(sapply(companies.permissao$Empresa,function(x) paste(x,collapse=' ')))
companies.permissao$Empresa <- rm_accent(companies.permissao$Empresa)

#Nao posusi codigos, apenas coloca em caixa baixa e remove coluna extra gerada por erro de formatacao.
passageiro.table$EMPRESA <- tolower(passageiro.table$EMPRESA)
passageiro.table <- passageiro.table[,-ncol(passageiro.table)]

Por fim, se podemos reduzir o número de palavras que iremos comparar para encontrar a mesma empresa em outra tabela, reduzimos também a chance de mapear para nome de empresas diferentes. Neste caso, na tabela de contagem de passageiros, sabemos que as empresas também são divididas por concessão e permissão, então podemos separar os dois grupos antes de compara-las, reduzindo assim o número de possibilidades.

#Separa passageiros de empresas por concessao e por permissao
is.concessao <- ifelse(passageiro.table$TIPO=="CONCESSAO",TRUE,FALSE)
passageiro.concessao <- passageiro.table[is.concessao,]
passageiro.permissao <- passageiro.table[!is.concessao,]

Cruzamento por Distância de Edição

Agora que temos os dois grupos, vamos tentar o cruzamento dos nomes nas duas tabelas para concessão e observar se a metrica é viável ou não para o restante da analise.

library(RecordLinkage)
#See also http://www.markvanderloo.eu/yaRb/2013/09/07/a-bit-of-benchmarking-with-string-distances/

similarity.join.aux <- function(string,lookup){
 index <- which.max(levenshteinSim(string,lookup))   
 return(index)
}

similarity.join <- function(vector1,vector2){
    indexes <- sapply(vector1,similarity.join.aux,vector2)    
    df <- data.frame(vector1,vector2[indexes])
    return(df)
}
df <- similarity.join(passageiro.concessao$EMPRESA,companies.concessao$Empresa)
colnames(df) <- c("tabela.passageiros","tabela.concessao")
#Para inspeção, basta observar apenas as linhas da tabela não duplicadas
kable(df[!duplicated(df), ])
tabela.passageiros tabela.concessao
1 gato preto viacao gato preto ltda.
10 santa brigida viacao santa brigida ltda.
66 sambaiba sambaiba transportes urbanos ltda.
163 expandir express transportes urbanos ltda
170 vip ii viacao santa brigida ltda.
256 ambiental ambiental transportes urbanos s.a.
268 novo horizonte consorcio sete
300 via sul viacao cidade dutra ltda.
375 cidade dutra viacao cidade dutra ltda.
390 mobibrasil mobibrasil transp urbano ltda.
410 tupi transkuba transportes gerais ltda.
435 campo belo viacao campo belo ltda.
478 gatusa viacao gato preto ltda.
485 transkuba mobibrasil transp urbano ltda.
499 vip consorcio plus
536 transpass transpass transp. de pass. ltda

Cruzamento por Heuristica

Infelizmente, podemos notar que algumas empresas não tiveram o mapeamento correto. Uma outra heuristica que podemos tentar utilizar é notar que o nome das empresas na tabela de passsageiros parece sempre estar contido nos seus respectivos nomes nas tabelas de demonstrativos. De fato, talvez a ideia de renomear as empresas na outra tabela tenha sido de manter apenas o que identifica unicamente a empresa em ambas as tabelas. (e.g. Ltda. ou viação são comuns a mais do nome de uma empresa).

Podemos usar isso como heuristica, e usar a primeira palavra do nome da empresa da tabela de passageiros para tentar cruzar com as de demonstrativos. Redefinimos portanto a função de comparação não mais usando a metrica de distancia de edição, mas para apenas que encontre a primeira ocorrencia da primeira palavra da empresa da tabela de passageiros na respectiva tabela de demonstrativos.

similarity.join.aux <- function(string,lookup){
    string <- unlist(strsplit(string," "))[1]
    #index <- grepl(string,lookup) Grepl confundiria 'via' com 'viacao' uma vez que nao leva em conta espacos.
    #As 4 linhas seguintes separam por espaco e realizam a comparacao de forma correta.
    list <- strsplit(lookup," ")
    position <- sapply(list,function(x) which(x== string))
    position <- sapply(position, function(x) length(x) > 0)
    index <- which.max(position)
    return(index)
}
empresas <- array(NA,(length(companies.concessao$Empresa)+1))
empresas[2:length(empresas)] <- companies.concessao$Empresa

df <- similarity.join(passageiro.concessao$EMPRESA,empresas)
colnames(df) <- c("tabela.passageiros","tabela.concessao")
#Para inspeção, basta observar apenas as linhas da tabela não duplicadas
kable(df[!duplicated(df), ])
tabela.passageiros tabela.concessao
1 gato preto viacao gato preto ltda.
10 santa brigida viacao santa brigida ltda.
66 sambaiba sambaiba transportes urbanos ltda.
163 expandir NA
170 vip ii vip - transportes urbanos ltda.
256 ambiental ambiental transportes urbanos s.a.
268 novo horizonte NA
300 via sul via sul transportes urbanos ltda.
375 cidade dutra viacao cidade dutra ltda.
390 mobibrasil mobibrasil transp urbano ltda.
410 tupi tupi transportes urbanos piratininga ltda.
435 campo belo viacao campo belo ltda.
478 gatusa viacao gatusa transportes urb. ltda.
485 transkuba transkuba transportes gerais ltda.
499 vip vip - transportes urbanos ltda.
536 transpass transpass transp. de pass. ltda

Notamos que todos os mapeamentos agora são corretos, no entanto a tabela esta incompleta. Isso é preferível, uma vez que é mais facil identificar na tabela mapeamentos incompletos do que erroneos. Resta então observar o que levou a falta de mapeamento na tabela para as empresas de nome expandir e novo horizonte. Se inspecionarmos a tabela de Demonstrativo Detalhado Concessão (1/1/2014), isso fica claro:

A empresa expandir não é citada em nenhum momento no documento. A única forma de identificar o nome é observando neste caso que na tabela de Passageiros Transportados (1/1/2014) ela pertence a area 3, e observando-se as colunas da tabela de Demonstrativo Detalhado Concessão (1/1/2014) a única empresa com esta area é a Consórcio Plus. Infelizmente, como os consórcios podem incluir mais de uma empresa, como é o caso do Consórcio Unisul, seria arriscado criar uma heuristica de mapeamento utilizando área (além da separação em linhas dos consórcios e das areas que apresentaria dificuldades na aplicação do script em outras tabelas). Neste caso, somente por análise manual poderíamos identificar esta empresa.

O caso da empresa nova horizonte é ainda mais bizarro. Realizando o mesmo procedimento, notamos que ela pertence a area 4, e que a mesma nem sequer consta (!!!) no detalhamento de pagamentos.

Cruzamento de Tabelas por Permissão

Como observamos que o cruzamento por heuristica não gerou mapeamentos erroneos, mas somente incompletos, utilizamos o mesmo para cruzar a tabela de passageiros com a de permissão.

Cruzamento por Heuristica

empresas <- array(NA,(length(companies.permissao$Empresa)+1))
empresas[2:length(empresas)] <- companies.permissao$Empresa

df <- similarity.join(passageiro.permissao$EMPRESA,empresas)
colnames(df) <- c("tabela.passageiros","tabela.permissao")
#Para inspeção, basta observar apenas as linhas da tabela não duplicadas
kable(df[!duplicated(df), ])
tabela.passageiros tabela.permissao
1 fenix fenix
9 transcooper transcooper
75 nova alianca nova alianca
78 paulistana paulistana
105 paulistana i paulistana
129 paulistana ii paulistana
178 transcooper ii transcooper
200 transcooper iii transcooper
213 transcooper iv transcooper
218 coopertranse coopertranse
254 cooperlider cooperlider
285 cooperpam cooperpam
391 cooperalfa cooperalfa
400 uniccoopers NA
416 unicoopers unicoopers

No caso do cruzamento para Demonstrativo Detalhado Permissão (1/1/2014), notamos somente uma empresa onde o mapeamento não foi possível, devido a um erro de digitação com um ‘c’ adicional uniccoopers. No entanto, observamos um novo problema com a heuristica: Existem empresas de mesmo nome seguidas de numeração. Para lidar com o problema, extendemos a função de comparação para comparar não somente uma palavra, mas todas.

similarity.join.aux <- function(string,lookup){
    find.word <- function(string,lookup){
    #index <- grepl(string,lookup) Grepl confundiria 'via' com 'viacao' uma vez que nao leva em conta espacos.
    #As 4 linhas seguintes separam por espaco e realizam a comparacao de forma correta.
    list <- strsplit(lookup," ")
    position <- sapply(list,function(x) which(x== string))
    position <- sapply(position, function(x) length(x) > 0)
    return(as.integer(position))
    }

    string <- unlist(strsplit(string," "))
    #Criaremos um vetor de score para cada posicao de empresa na outra tabela. Por exemplo
    #"transcooper ii" serao duas palavras. "transcooper" sera identificada em "transcooper ii"
    #"transcooper iii" e "transcooper iv" ; "ii" por sua vez pode ser identificado em "transcooper ii" 
    #e em "paulistana ii". Como o score de "transcooper ii" sera maior somando-se as buscas das palavras
    #"transcooper" e "ii", o mapeamento sera feito corretamente para "transcooper ii"!
    score <- array(0,length(string[1]))
    for(word in string){
        score <- score + find.word(word,lookup)    
    }
    index <- which.max(score)
    return(index)
}

df <- similarity.join(passageiro.permissao$EMPRESA,empresas)
colnames(df) <- c("tabela.passageiros","tabela.permissao")
#Para inspeção, basta observar apenas as linhas da tabela não duplicadas
kable(df[!duplicated(df), ])
tabela.passageiros tabela.permissao
1 fenix fenix
9 transcooper transcooper
75 nova alianca nova alianca
78 paulistana paulistana
105 paulistana i paulistana i
129 paulistana ii paulistana ii
178 transcooper ii transcooper ii
200 transcooper iii transcooper iii
213 transcooper iv transcooper iv
218 coopertranse coopertranse
254 cooperlider cooperlider
285 cooperpam cooperpam
391 cooperalfa cooperalfa
400 uniccoopers NA
416 unicoopers unicoopers

Com a nova heuristica usando multiplas palavras, podemos observar que não mais ocorrem mapeamentos incorretos.

Ranking de Empresas versus Numero de Passageiros

Remuneração Total por Empresa

Como as duas tabelas não contem necessariamente o total, calculamos a coluna total a partir dos valores individuais de cada empresa.

#Concessao
custos <- companies.concessao[,2:(ncol(companies.concessao))]
custos <- lapply(custos,as.character)
custos <- data.frame(lapply(custos,as.numeric))
companies.concessao$TOTAL <- rowSums(custos[,1:(ncol(custos)-1)],na.rm=TRUE)

#Permissao
custos <- companies.permissao[,2:(ncol(companies.permissao))]
custos <- lapply(custos,as.character)
custos <- data.frame(lapply(custos,as.numeric))
companies.permissao$TOTAL <- rowSums(custos[,1:(ncol(custos)-1)],na.rm=TRUE)

Por fim geramos a tabela inicialmente desejada que demonstra a remuneração da empresa em 1/1/2014 e o seu número de passageiros por tipo de passageiros. A tabela a seguir mostra o resultado do cruzamento.

#Cruzamento Permissão
empresas <- array(NA,(length(companies.permissao$Empresa)+1))
empresas[2:length(empresas)] <- companies.permissao$Empresa
cruzamento.permissao <- similarity.join(passageiro.permissao$EMPRESA,empresas)
#Cruzamento Concessão
empresas <- array(NA,(length(companies.concessao$Empresa)+1))
empresas[2:length(empresas)] <- companies.concessao$Empresa
cruzamento.concessao <- similarity.join(passageiro.concessao$EMPRESA,empresas)
#Merge Row-wise
cruzamento <- rbind(cruzamento.concessao,cruzamento.permissao)
cruzamento <- cruzamento[!duplicated(cruzamento), ]
colnames(cruzamento) <- c("passageiros","demonstrativos")
#Merge Row-Wise
custos <- rbind(companies.permissao[,c("Empresa","TOTAL")],companies.concessao[,c("Empresa","TOTAL")])
#Inner join (NAs serao desconsiderados)
df <- merge(cruzamento,passageiro.concessao,by.x="passageiros",by.y="EMPRESA")
df <- merge(df,custos,by.x="demonstrativos",by.y="Empresa",all.x=TRUE)

kable(head(df))
demonstrativos passageiros DATA TIPO AREA LINHA PASSAGEIROS.PAGANTES.EM.DINHEIRO…A. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.COMUM…B. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.ESTUDANTE…C.. PASSAGEIROS.PAGANTES.BILHETE.ÚNICO.VALE.TRANSPORTE…D. PASSAGEIROS.PAGANTES.INTEGRAÇÕES.METRÔ.E.CPTM…E. PASSAGEIROS.PAGANTES…F…..A…B…C…D…E. PASSAGEIROS.INTEGRAÇÕES.ÔNIBUS….ÔNIBUS…G. PASSAGEIROS.COM.GRATUIDADE…H. TOTAL.PASSAGEIROS.TRANSPORTADOS…I…..F…G…H. TOTAL
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 316010 - TERM.V.PRUDENTE/ TERM D PEDRO 104 100 11 74 18 307 231 60 598 4717.97
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 411310 - GENTIL DE MOURA/PCA REPUBLICA 441 457 45 377 242 1562 552 294 2408 4717.97
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 200210 - TERM P D PEDRO II/TERM BANDEIR 14 98 4 58 13 187 294 110 591 4717.97
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 210010 - TERM V CARRAO/PCA DA SE CIRC 226 278 21 163 27 715 427 219 1361 4717.97
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 303210 - TERM VILA CARRAO/CIRCULAR 46 96 8 52 0 202 153 72 427 4717.97
ambiental transportes urbanos s.a. ambiental 2014-01-01 CONCESSAO AREA 4 313910 - JD VILA FORMOSA/PCA CLOVIS 42 55 5 31 2 135 80 56 271 4717.97

Note no entanto que o custo da remuneração sendo por empresa é repetido para cada linha. Nos resta remover a coluna de linhas e somar o total de passageiros em todas as linhas para a empresa.

df <- df[,c(-2,-3,-4,-6)]
df <- aggregate(. ~ demonstrativos + AREA,df,sum)



df <- df[with(df, order(-TOTAL)), ]
colnames(df) <- c("EMPRESAS",
                  "AREA",
                  "PASSAGEIROS PAGANTES EM DINHEIRO (A)",
                  "PASSAGEIROS PAGANTES BILHETE UNICO COMUM (B)",
                  "PASSAGEIROS PAGANTES BILHETE UNICO ESTUDANTE (C)",
                  "PASSAGEIROS PAGANTES BILHETE UNICO VALE TRANSPORTE (D)",
                  "PASSAGEIROS PAGANTES INTEGRAÇÕES METRO E CPTM (E)",
                  "PASSAGEIROS PAGANTES (F) = (A + B + C + D + E)",
                  "PASSAGEIROS INTEGRAÇÕES ONIBUS -> ONIBUS (G)",
                  "PASSAGEIROS COM GRATUIDADE (H)",
                  "TOTAL PASSAGEIROS TRANSPORTADOS (I) = (F + G + H)",
                  "R$ TOTAL")
kable(df)
EMPRESAS AREA PASSAGEIROS PAGANTES EM DINHEIRO (A) PASSAGEIROS PAGANTES BILHETE UNICO COMUM (B) PASSAGEIROS PAGANTES BILHETE UNICO ESTUDANTE (C) PASSAGEIROS PAGANTES BILHETE UNICO VALE TRANSPORTE (D) PASSAGEIROS PAGANTES INTEGRAÇÕES METRO E CPTM (E) PASSAGEIROS PAGANTES (F) = (A + B + C + D + E) PASSAGEIROS INTEGRAÇÕES ONIBUS -> ONIBUS (G) PASSAGEIROS COM GRATUIDADE (H) TOTAL PASSAGEIROS TRANSPORTADOS (I) = (F + G + H) R$ TOTAL
3 sambaiba transportes urbanos ltda. AREA 2 23997 25282 2885 19873 10120 82157 36346 12751 131254 27916541.80
6 via sul transportes urbanos ltda. AREA 5 12698 15104 1519 11450 6102 46873 22945 7923 77741 12777367.50
4 vip - transportes urbanos ltda. AREA 3 53752 58670 5836 46446 13382 178086 83348 34866 296300 12709103.22
2 viacao santa brigida ltda. AREA 1 13865 14702 1704 13757 4516 48544 24259 6870 79673 8644610.80
15 transpass transp. de pass. ltda AREA 8 9009 8787 1109 9947 4453 33305 14352 3134 50791 3588213.42
14 vip - transportes urbanos ltda. AREA 7 14210 28780 2682 27516 6760 79948 58450 8626 147024 2955605.40
9 viacao cidade dutra ltda. AREA 6 7469 13266 1223 10480 2906 35344 32420 5421 73185 2323523.40
7 mobibrasil transp urbano ltda. AREA 6 6269 8117 792 7068 1455 23701 13357 3977 41035 1799133.40
10 vip - transportes urbanos ltda. AREA 6 5094 6260 718 7346 1406 20824 11274 3060 35158 1477802.70
16 viacao gato preto ltda. AREA 8 4368 5818 566 6424 2092 19268 13908 3056 36232 1443489.38
11 transkuba transportes gerais ltda. AREA 7 5181 7202 627 7605 1572 22187 13633 2253 38073 998910.22
8 tupi transportes urbanos piratininga ltda. AREA 6 5525 6131 702 6150 1903 20411 9009 2769 32189 886365.00
1 viacao gato preto ltda. AREA 1 3526 4098 414 3470 2104 13612 8724 2732 25068 764200.26
12 viacao campo belo ltda. AREA 7 9161 16375 1429 16923 4898 48786 39106 5689 93581 674069.29
13 viacao gatusa transportes urb. ltda. AREA 7 1627 2831 213 3684 949 9304 8011 1093 18408 402372.04
5 ambiental transportes urbanos s.a. AREA 4 2490 2433 204 1616 400 7143 3982 1843 12968 56615.64