extra/vin/vin.factor

   1 ! Copyright (C) 2021 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: assocs combinators combinators.short-circuit kernel make
   5 math sequences strings ;
   6
   7 IN: vin
   8
   9 <PRIVATE
  10
  11 CONSTANT: TRANSLITERATION H{ }
  12
  13 "0123456789" [ swap TRANSLITERATION set-at ] each-index
  14 "ABCDEFGH" [ 1 + swap TRANSLITERATION set-at ] each-index
  15 "JKLMNOPQR" [ 1 + swap TRANSLITERATION set-at ] each-index
  16 "STUVWXYZ" [ 2 + swap TRANSLITERATION set-at ] each-index
  17 CHAR: O TRANSLITERATION delete-at
  18 CHAR: Q TRANSLITERATION delete-at
  19
  20 CONSTANT: WEIGHTS { 8 7 6 5 4 3 2 10 0 9 8 7 6 5 4 3 2 }
  21
  22 PRIVATE>
  23
  24 : valid-vin? ( vin -- ? )
  25     {
  26         [ length 17 = ]
  27         [ [ "ABCDEFGHJKLMNPRSTUVWXYZ0123456789" member? ] all? ]
  28         [
  29             [ 8 swap nth ]
  30             [ WEIGHTS swap 0 [ TRANSLITERATION at * + ] 2reduce 11 mod ] bi
  31             dup 10 = [ drop CHAR: X = ] [ CHAR: 0 + = ] if
  32         ]
  33     } 1&& ;
  34
  35 <PRIVATE
  36
  37 CONSTANT: MANUFACTURERS H{
  38     { "AFA" "Ford South Africa" }
  39     { "AAV" "Volkswagen South Africa" }
  40     { "JA3" "Mitsubishi" }
  41     { "JHM" "Honda" }
  42     { "JHG" "Honda" }
  43     { "JHL" "Honda" }
  44     { "KM8" "Hyundai" }
  45     { "KMH" "Hyundai" }
  46     { "KNA" "Kia" }
  47     { "KNB" "Kia" }
  48     { "KNC" "Kia" }
  49     { "KNM" "Renault Samsung" }
  50     { "KPA" "Ssangyong" }
  51     { "KPT" "Ssangyong" }
  52     { "L56" "Renault Samsung" }
  53     { "L5Y" "Merato Motorcycle Taizhou Zhongneng" }
  54     { "LDY" "Zhongtong Coach, China" }
  55     { "LGH" "Dong Feng (DFM), China" }
  56     { "LKL" "Suzhou King Long, China" }
  57     { "LSY" "Brilliance Zhonghua" }
  58     { "LTV" "Toyota Tian Jin" }
  59     { "LVS" "Ford Chang An" }
  60     { "LVV" "Chery, China" }
  61     { "LZM" "MAN China" }
  62     { "LZE" "Isuzu Guangzhou, China" }
  63     { "LZG" "Shaanxi Automobile Group, China" }
  64     { "LZY" "Yutong Zhengzhou, China" }
  65     { "MA1" "Mahindra" }
  66     { "MA3" "Suzuki India" }
  67     { "MA7" "Honda Siel Cars India" }
  68     { "MAL" "Hyundai" }
  69     { "MC2" "Volvo Eicher commercial vehicles limited." }
  70     { "MHR" "Honda Indonesia" }
  71     { "MNB" "Ford Thailand" }
  72     { "MNT" "Nissan Thailand" }
  73     { "MMB" "Mitsubishi Thailand" }
  74     { "MMM" "Chevrolet Thailand" }
  75     { "MMT" "Mitsubishi Thailand" }
  76     { "MM8" "Mazda Thailand" }
  77     { "MPA" "Isuzu Thailand" }
  78     { "MP1" "Isuzu Thailand" }
  79     { "MRH" "Honda Thailand" }
  80     { "MR0" "Toyota Thailand" }
  81     { "NLE" "Mercedes-Benz Turk Truck" }
  82     { "NM0" "Ford Turkey" }
  83     { "NM4" "Tofas Turk" }
  84     { "NMT" "Toyota Turkiye" }
  85     { "PE1" "Ford Phillipines" }
  86     { "PE3" "Mazda Phillipines" }
  87     { "PL1" "Proton, Malaysia" }
  88     { "SAL" "Land Rover" }
  89     { "SAJ" "Jaguar" }
  90     { "SAR" "Rover" }
  91     { "SCA" "Rolls Royce" }
  92     { "SCC" "Lotus Cars" }
  93     { "SCE" "DeLorean Motor Cars N. Ireland (UK)" }
  94     { "SCF" "Aston" }
  95     { "SDB" "Peugeot UK" }
  96     { "SFD" "Alexander Dennis UK" }
  97     { "SHS" "Honda UK" }
  98     { "SJN" "Nissan UK" }
  99     { "SU9" "Solaris Bus & Coach (Poland)" }
 100     { "TK9" "SOR (Czech Republic)" }
 101     { "TDM" "QUANTYA Swiss Electric Movement (Switzerland)" }
 102     { "TMB" "Škoda (Czech Republic)" }
 103     { "TMK" "Karosa (Czech Republic)" }
 104     { "TMP" "Škoda trolleybuses (Czech Republic)" }
 105     { "TMT" "Tatra (Czech Republic)" }
 106     { "TM9" "Škoda trolleybuses (Czech Republic)" }
 107     { "TN9" "Karosa (Czech Republic)" }
 108     { "TRA" "Ikarus Bus" }
 109     { "TRU" "Audi Hungary" }
 110     { "TSE" "Ikarus Egyedi Autobuszgyar, (Hungary)" }
 111     { "TSM" "Suzuki, (Hungary)" }
 112     { "UU1" "Renault Dacia, (Romania)" }
 113     { "VF1" "Renault" }
 114     { "VF3" "Peugeot" }
 115     { "VF6" "Renault (Trucks & Buses)" }
 116     { "VF7" "Citroën" }
 117     { "VF8" "Matra" }
 118     { "VLU" "Scania France" }
 119     { "VNE" "Irisbus (France)" }
 120     { "VSE" "Suzuki Spain (Santana Motors)" }
 121     { "VSK" "Nissan Spain" }
 122     { "VSS" "SEAT" }
 123     { "VSX" "Opel Spain" }
 124     { "VS6" "Ford Spain" }
 125     { "VS9" "Carrocerias Ayats (Spain)" }
 126     { "VV9" "TAUROSpain" }
 127     { "VWV" "Volkswagen Spain" }
 128     { "VX1" "Zastava / Yugo Serbia" }
 129     { "WAG" "Neoplan" }
 130     { "WAU" "Audi" }
 131     { "WBA" "BMW" }
 132     { "WBS" "BMW M" }
 133     { "WDB" "Mercedes-Benz" }
 134     { "WDC" "DaimlerChrysler" }
 135     { "WDD" "McLaren" }
 136     { "WEB" "Evobus GmbH (Mercedes-Bus)" }
 137     { "WF0" "Ford Germany" }
 138     { "WMA" "MAN Germany" }
 139     { "WMW" "MINI" }
 140     { "WP0" "Porsche" }
 141     { "W0L" "Opel" }
 142     { "WVW" "Volkswagen" }
 143     { "WV1" "Volkswagen Commercial Vehicles" }
 144     { "WV2" "Volkswagen Bus/Van" }
 145     { "XL9" "Spyker" }
 146     { "XMC" "Mitsubishi (NedCar)" }
 147     { "XTA" "Lada/AutoVaz (Russia)" }
 148     { "YK1" "Saab" }
 149     { "YS2" "Scania AB" }
 150     { "YS3" "Saab" }
 151     { "YS4" "Scania Bus" }
 152     { "YV1" "Volvo Cars" }
 153     { "YV4" "Volvo Cars" }
 154     { "YV2" "Volvo Trucks" }
 155     { "YV3" "Volvo Buses" }
 156     { "ZAM" "Maserati Biturbo" }
 157     { "ZAP" "Piaggio/Vespa/Gilera" }
 158     { "ZAR" "Alfa Romeo" }
 159     { "ZCG" "Cagiva SpA" }
 160     { "ZDM" "Ducati Motor Holdings SpA" }
 161     { "ZDF" "Ferrari Dino" }
 162     { "ZD4" "Aprilia" }
 163     { "ZFA" "Fiat" }
 164     { "ZFC" "Fiat V.I." }
 165     { "ZFF" "Ferrari" }
 166     { "ZHW" "Lamborghini" }
 167     { "ZLA" "Lancia" }
 168     { "ZOM" "OM" }
 169     { "1C3" "Chrysler" }
 170     { "1C6" "Chrysler" }
 171     { "1D3" "Dodge" }
 172     { "1FA" "Ford Motor Company" }
 173     { "1FB" "Ford Motor Company" }
 174     { "1FC" "Ford Motor Company" }
 175     { "1FD" "Ford Motor Company" }
 176     { "1FM" "Ford Motor Company" }
 177     { "1FT" "Ford Motor Company" }
 178     { "1FU" "Freightliner" }
 179     { "1FV" "Freightliner" }
 180     { "1F9" "FWD Corp." }
 181     { "1GC" "Chevrolet Truck USA" }
 182     { "1GT" "GMC Truck USA" }
 183     { "1G1" "Chevrolet USA" }
 184     { "1G2" "Pontiac USA" }
 185     { "1G3" "Oldsmobile USA" }
 186     { "1G4" "Buick USA" }
 187     { "1G6" "Cadillac USA" }
 188     { "1GM" "Pontiac USA" }
 189     { "1G8" "Saturn USA" }
 190     { "1HD" "Harley-Davidson" }
 191     { "1J4" "Jeep" }
 192     { "1ME" "Mercury USA" }
 193     { "1M1" "Mack Truck USA" }
 194     { "1M2" "Mack Truck USA" }
 195     { "1M3" "Mack Truck USA" }
 196     { "1M4" "Mack Truck USA" }
 197     { "1M9" "Mynatt Truck & Equipment" }
 198     { "1NX" "NUMMI USA" }
 199     { "1P3" "Plymouth USA" }
 200     { "1R9" "Roadrunner Hay Squeeze USA" }
 201     { "1VW" "Volkswagen USA" }
 202     { "1XK" "Kenworth USA" }
 203     { "1XP" "Peterbilt USA" }
 204     { "1YV" "Mazda USA (AutoAlliance International)" }
 205     { "2C3" "Chrysler Canada" }
 206     { "2CN" "CAMI" }
 207     { "2D3" "Dodge Canada" }
 208     { "2FA" "Ford Motor Company Canada" }
 209     { "2FB" "Ford Motor Company Canada" }
 210     { "2FC" "Ford Motor Company Canada" }
 211     { "2FM" "Ford Motor Company Canada" }
 212     { "2FT" "Ford Motor Company Canada" }
 213     { "2FU" "Freightliner" }
 214     { "2FV" "Freightliner" }
 215     { "2FZ" "Sterling" }
 216     { "2G1" "Chevrolet Canada" }
 217     { "2G2" "Pontiac Canada" }
 218     { "2G3" "Oldsmobile Canada" }
 219     { "2G4" "Buick Canada" }
 220     { "2HG" "Honda Canada" }
 221     { "2HK" "Honda Canada" }
 222     { "2HM" "Hyundai Canada" }
 223     { "2NV" "Nova Bus Canada" }
 224     { "2P3" "Plymouth Canada" }
 225     { "2V4" "Volkswagen Canada" }
 226     { "2WK" "Western Star" }
 227     { "2WL" "Western Star" }
 228     { "2WM" "Western Star" }
 229     { "3D3" "Dodge Mexico" }
 230     { "3FA" "Ford Motor Company Mexico" }
 231     { "3FE" "Ford Motor Company Mexico" }
 232     { "3P3" "Plymouth Mexico" }
 233     { "3VW" "Volkswagen Mexico" }
 234     { "4RK" "Nova Bus USA" }
 235     { "4US" "BMW USA" }
 236     { "4UZ" "Frt-Thomas Bus" }
 237     { "4V1" "Volvo" }
 238     { "4V2" "Volvo" }
 239     { "4V3" "Volvo" }
 240     { "4V4" "Volvo" }
 241     { "4V5" "Volvo" }
 242     { "4V6" "Volvo" }
 243     { "4VL" "Volvo" }
 244     { "4VM" "Volvo" }
 245     { "4VZ" "Volvo" }
 246     { "5N1" "Nissan USA" }
 247     { "5NP" "Hyundai USA" }
 248     { "6AB" "MAN Australia" }
 249     { "6F4" "Nissan Motor Company Australia" }
 250     { "6F5" "Kenworth Australia" }
 251     { "6FP" "Ford Motor Company Australia" }
 252     { "6G1" "General Motors-Holden (post Nov 2002)" }
 253     { "6G2" "Pontiac Australia (GTO & G8)" }
 254     { "6H8" "General Motors-Holden (pre Nov 2002)" }
 255     { "6MM" "Mitsubishi Motors Australia" }
 256     { "6T1" "Toyota Motor Corporation Australia" }
 257     { "6U9" "Privately Imported car in Australia" }
 258     { "8AG" "Chevrolet Argentina" }
 259     { "8GG" "Chevrolet Chile" }
 260     { "8AP" "Fiat Argentina" }
 261     { "8AF" "Ford Motor Company Argentina" }
 262     { "8AD" "Peugeot Argentina" }
 263     { "8GD" "Peugeot Chile" }
 264     { "8A1" "Renault Argentina" }
 265     { "8AK" "Suzuki Argentina" }
 266     { "8AJ" "Toyota Argentina" }
 267     { "8AW" "Volkswagen Argentina" }
 268     { "93U" "Audi Brazil" }
 269     { "9BG" "Chevrolet Brazil" }
 270     { "935" "Citroën Brazil" }
 271     { "9BD" "Fiat Brazil" }
 272     { "9BF" "Ford Motor Company Brazil" }
 273     { "93H" "Honda Brazil" }
 274     { "9BM" "Mercedes-Benz Brazil" }
 275     { "936" "Peugeot Brazil" }
 276     { "93Y" "Renault Brazil" }
 277     { "9BS" "Scania Brazil" }
 278     { "93R" "Toyota Brazil" }
 279     { "9BW" "Volkswagen Brazil" }
 280     { "9FB" "Renault Colombia" }
 281 }
 282
 283 H{
 284     { "JA" "Isuzu" }
 285     { "JF" "Fuji Heavy Industries" }
 286     { "JK" "Kawasaki" }
 287     { "JM" "Mazda" }
 288     { "JN" "Nissan" }
 289     { "JS" "Suzuki" }
 290     { "JT" "Toyota" }
 291     { "KL" "Daewoo General Motors South Korea" }
 292     { "1G" "General Motors USA" }
 293     { "1H" "Honda USA" }
 294     { "1L" "Lincoln USA" }
 295     { "1N" "Nissan USA" }
 296     { "2G" "General Motors Canada" }
 297     { "2M" "Mercury" }
 298     { "2T" "Toyota Canada" }
 299     { "3G" "General Motors Mexico" }
 300     { "3H" "Honda Mexico" }
 301     { "3N" "Nissan Mexico" }
 302     { "4F" "Mazda USA" }
 303     { "4M" "Mercury" }
 304     { "4S" "Subaru-Isuzu Automotive" }
 305     { "4T" "Toyota" }
 306     { "5F" "Honda USA-Alabama" }
 307     { "5L" "Lincoln" }
 308     { "5T" "Toyota USA - trucks" }
 309 } [
 310     swap "ABCDEFGHJKLMNPRSTUVWXYZ1234567890"
 311     [ suffix MANUFACTURERS set-at ] 2with each
 312 ] assoc-each
 313
 314 CONSTANT: REGIONS H{ }
 315
 316 {
 317     { "12345" "North America" }
 318     { "STUVWXYZ" "Europe" }
 319     { "ABCDEFGH" "Africa" }
 320     { "JKLMNPR" "Asia" }
 321     { "67" "Oceania" }
 322     { "890" "South America" }
 323 } [
 324     swap [ REGIONS set-at ] with each
 325 ] assoc-each
 326
 327 CONSTANT: COUNTRIES H{ }
 328
 329 {
 330     { "South Africa" "A" "ABCDEFGH" }
 331     { "Japan" "J" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 332     { "South Korea" "K" "LMNPR" }
 333     { "China" "L" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 334     { "India" "M" "ABCDE" }
 335     { "Indonesia" "M" "FGHJK" }
 336     { "Thailand" "M" "LMNPR" }
 337     { "Philippines" "P" "ABCDE" }
 338     { "Malaysia" "P" "LMNPR" }
 339     { "Taiwan" "R" "FG" }
 340     { "United Kingdom" "A" "ABCDEFGHJKLM" }
 341     { "Germany" "S" "NPRST" }
 342     { "Germany" "W" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 343     { "Poland" "S" "UVWXYZ" }
 344     { "Switzerland" "T" "ABCDEFGH" }
 345     { "Czech Republic" "T" "JKLMNP" }
 346     { "Hungary" "T" "RSTUV" }
 347     { "Portugal" "T" "W" }
 348     { "Austria" "V" "ABCDE" }
 349     { "France" "V" "FGHJKLMNPR" }
 350     { "Spain" "V" "STUVW" }
 351     { "Yugoslavia" "V" "XYZ12" }
 352     { "Netherlands" "X" "LMN" }
 353     { "USSR" "X" "STUVW" }
 354     { "Russia" "X" "34567890" }
 355     { "Belgium" "Y" "ABCDE" }
 356     { "Finland" "Y" "FGHJK" }
 357     { "Sweden" "Y" "STUVW" }
 358     { "Italy" "Z" "ABCDEFGHJKLMNPR" }
 359     { "United States" "1" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 360     { "United States" "4" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 361     { "United States" "5" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 362     { "Canada" "2" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 363     { "Mexico" "3" "ABCDEFGHJKLMNPRSTUVWXYZ1234567890" }
 364     { "Australia" "6" "ABCDEFGHJKLMNPRSTUVW" }
 365     { "New Zealand" "7" "ABCDE" }
 366     { "Argentina" "8" "ABCDE" }
 367     { "Chile" "8" "FGHJ" }
 368     { "Venezuela" "8" "XYZ12" }
 369     { "Brazil" "9" "ABCDE" }
 370     { "Brazil" "9" "3456789" }
 371     { "Columbia" "9" "FGHJ" }
 372 } [
 373     first3 [ suffix COUNTRIES set-at ] 2with each
 374 ] each
 375
 376 : wmi% ( wmi -- )
 377     {
 378         [ "wmi" ,, ]
 379         [ MANUFACTURERS at "manufacturer" ,, ]
 380         [ first REGIONS at "region" ,, ]
 381         [ 2 head COUNTRIES at "country" ,, ]
 382     } cleave ;
 383
 384 : vds% ( vds -- )
 385     {
 386         [ "vds" ,, ]
 387     } cleave ;
 388
 389 : vis% ( vis -- )
 390     {
 391         [ "vis" ,, ]
 392         [ first "123456789ABCDEFGHJKLMNPRSTVWXY" index [ 2001 + "year" ,, ] when* ]
 393         [ second 1string "assembly_plant" ,, ]
 394     } cleave ;
 395
 396 PRIVATE>
 397
 398 : parse-vin ( vin -- details )
 399     [
 400         {
 401             [ [ 0 3 ] dip subseq wmi% ]
 402             [ [ 3 9 ] dip subseq vds% ]
 403             [ [ 9 17 ] dip subseq vis% ]
 404         } cleave
 405     ] H{ } make ;