[Keith Vetter] 2007-07-08 : the '''TIGER''' [GIS] dataset [http://www.census.gov/geo/www/tiger/index.html] [http://en.wikipedia.org/wiki/Topologically_Integrated_Geographic_Encoding_and_Referencing] from the US Census Bureau is a huge collection of information about roads, rivers, lakes, and other areas the census tracts. It is organized by state and county. The dataset is completely public domain. It is thought that map quest, yahoo maps, etc. all used the TIGER dataset as the basis for their mapping web services. This program combines TIGER with Google Maps. It lets you search for road names in TIGER data files, and extract the road course with all its bends and twists. Finally, it will display the result in a web page using Google Maps and its javascript API. '''WARNING''' to run tclTiger you must first download at least one TIGER data file. To do so, first you need a five-digit state/county FIPS code. For this, goto http://www.census.gov/geo/www/fips/fips65/index.html. Second, you need to download the actual TIGER data. Download the appropriate file from http://www.census.gov/geo/www/tiger/tiger2006se/tgr2006se.html. Then unzip the data file in the tclTiger directory or in a sub-directory below it. ---- [KPV] Here's an explanation how it works. There are two separate phases in the process: the first is extracting the data from the TIGER dataset, the second is displaying it in Google Maps. The first step of the first phase is to locate the user specified entity in the TIGER dataset. The key here is the RT1 file which contains the name of every TIGER entity. So we search that file, comparing the user supplied name with the TIGER ''feature name'' field for matches. We also match on the ''feature prefix'' and ''feature type'' if given. (One nice improvement here would be to allow some sort of fuzzy matching, such as wild cards or Soundex.) For each match, we note the '''TLID''' field (TIGER/Line ID) and the starting and ending latitude and longitude. Even in the simple case of matching a single road, there will still probably be multiple matching lines because most roads are broken into a chain of roads. So the second step is build the chains by matching one segments starting position with another segments ending positions. The last step is to fill in intermediary positions for each segment. This information is in the RT2 file and is keyed by the '''TLID''' field. Each line contains up to 10 additional route positions, and a given TLID may have multiple lines (check the ''sequence'' field). The Google Map phase is pretty simple. Most of the hard work is done in the javascript code in a hard-coded HTML template. The only tcl work is to format the route data into javascript and to insert it into the template. The ultimate step is to save the javascript and HTML to a file and start up a browser. Thanks here to [Invoking Browsers]. ---- ##+########################################################################## # # tclTiger.tcl -- extracts route data from TIGER RT1 files and them # views them using Google Maps javascipt # by Keith Vetter. July 2007 # package require Tk package require tile set D(fips) "39 089" set D(prefix) "E" set D(name) College set D(type) St set D(roadNames) "" set S(colors) [list \#FF0000 \#0000FF \#00FF00 \#FFFF00 \#00FFFF \#FF00FF] set S(width) 6 set S(noRT2) 0 proc DoDisplay {} { global D set fipsList [GetFipsList] wm title . "Tcl Tiger" DoMenus label .b1 option add *Label.font "[font actual [.b1 cget -font]] -weight bold" option add *Labelframe.font "[font actual [.b1 cget -font]] -weight bold" destroy .b1 . config -padx 10 -pady 10 label .title -text "Tcl Tiger" -font "Times 48 bold" -relief raised labelframe .left -text "User Input" -padx 10 -pady 20 label .middle -font {Times 48 bold} -text \u2192 labelframe .right -text "Tiger Names" -padx 10 -pady 20 grid .title - - -sticky ew -pady {0 20} grid .left .middle .right -sticky news grid config .middle -pady {0 20} grid config .right -sticky news grid columnconfigure . 2 -weight 1 grid rowconfigure . 1 -weight 1 # Left side set w .left label $w.fips -text "FIPS:" ::ttk::combobox $w.efips -values $fipsList -width 8 \ -state readonly -textvariable ::D(fips) label $w.prefix -text "Prefix:" entry $w.eprefix -textvariable ::D(prefix) -justify center label $w.name -text "Name:" entry $w.ename -textvariable ::D(name) -justify center label $w.type -text "Type:" entry $w.etype -textvariable ::D(type) -justify center ::ttk::button $w.lookup -text "Lookup Road" -command Lookup grid $w.fips $w.efips -sticky w -pady {0 10} grid $w.prefix $w.eprefix grid $w.name $w.ename grid $w.type $w.etype grid $w.lookup - -pady {10 0} grid rowconfigure $w 1000 -weight 1 focus $w.eprefix # Right side set w .right listbox .roadnames -listvariable ::D(roadNames) -height 6 \ -yscrollcommand ".sb_y set" scrollbar .sb_y -orient v -command ".roadnames yview" ::ttk::button .browse -text "Google Maps" -command Browser ConfigRight disabled grid .roadnames .sb_y -in $w -sticky ns grid config .roadnames -sticky news grid .browse - -in $w -pady {10 0} grid rowconfig $w 1000 -weight 1 foreach arr [trace info variable D] { eval trace remove variable D $arr } trace variable D w DTracer bind all {console show} update event generate .left.eprefix <> } proc DoMenus {} { menu .m -tearoff 0 . configure -menu .m .m add cascade -menu .m.file -label "File" -underline 0 .m add cascade -menu .m.help -label "Help" -underline 0 menu .m.file -tearoff 0 .m.file add command -label "Remove temp files" -underline 0 -command Cleanup .m.file add separator .m.file add command -label "Exit" -command exit -underline 1 menu .m.help -tearoff 0 .m.help add command -label "Help" -underline 0 -command MissingFIPS .m.help add separator .m.help add command -label "About" -underline 0 -command About } proc MissingFIPS {{die 0}} { set txt "tclTiger Instructions\n\n" append txt "tclTiger needs you to have downloaded at least one RT1\n" append txt "file from the US Census web site.\n" append txt "\n" append txt "To do so, first you need a five-digit state/county FIPS code.\n" append txt "For this, goto:\n" append txt "\n" append txt " http://www.census.gov/geo/www/fips/fips65/index.html\n" append txt "\n" append txt "Second, you need to download the actual TIGER data. Goto the\n" append txt "following web site, then goto the state you picked and then\n" append txt "download the appropriate data file. You'll need to unzip the\n" append txt "data file in the same directory as tclTiger or in a\n" append txt "sub-directory below it.\n" append txt "\n" append txt " http://www.census.gov/geo/www/tiger/tiger2006se/tgr2006se.html\n" if {$die} {wm withdraw .} tk_messageBox -icon error -message $txt if {$die} exit } proc ConfigRight {how} { if {$how eq "normal"} { .roadnames config -bg [lindex [.roadnames config -bg] 3] .browse config -state normal } else { .roadnames config -bg grey75 .browse config -state disabled } } proc DTracer {var1 var2 op} { .left.lookup config -state [expr {$::D(name) eq "" ? "disabled" : "normal"}] ConfigRight disabled } proc GetFipsList {} { global FIPS set fips {} set dirs [concat . [glob -nocomplain -type d *]] foreach dir $dirs { foreach fname [glob -directory $dir -nocomplain TGR*.RT1] { set tail [file tail $fname] set this "[string range $tail 3 4] [string range $tail 5 7]" lappend fips $this set FIPS($this) $fname } } if {$fips eq ""} { MissingFIPS 1 } if {[lindex $fips $::D(fips)] == -1} { set ::D(fips) [lindex $fips 0] } return $fips } proc Lookup {} { global D FIPS set tigerFile $FIPS($D(fips)) ::tclTiger::BuildRoad $tigerFile $D(prefix) $D(name) $D(type) set all [::tclTiger::GetAllNames] set how normal if {$all eq ""} { set all [list "No match"] set how disabled } set D(roadNames) $all ConfigRight $how } proc InitBrowser {} { if {[info exists ::S(web,cmd)]} return package require registry set app [registry get {HKEY_CLASSES_ROOT\.html} {}] set ::S(web,cmd) \ [registry get HKEY_CLASSES_ROOT\\$app\\shell\\open\\command {}] } proc Browser {} { InitBrowser set fname [::tclTiger::BuildWebpage] #set url "file:///[file nativename [file normalize $fname]]" set url "file:///[file normalize $fname]" if {[string first "%1" $::S(web,cmd)] != -1} { set cmd [string map [list "%1" $url] $::S(web,cmd)] } else { set cmd "$S(web,cmd) $url" } #regsub -all {\\} $cmd / cmd eval exec $cmd & } # http://wiki.tcl.tk/557 proc InitBrowser {} { if {[info exists ::S(web,cmd)]} return # It *is* generally a mistake to switch on $tcl_platform(os), particularly # in comparison to $tcl_platform(platform). For now, let's just regard it # as a stylistic variation subject to debate. switch $::tcl_platform(os) { Darwin { set command [list open %1] } HP-UX - Linux - SunOS { foreach executable {mozilla netscape iexplorer opera konqueror lynx w3m links galeon konqueror mosaic firefox amaya browsex elinks} { set executable [auto_execok $executable] if [string length $executable] { # Do you want to mess with -remote? How about other browsers? set command [list $executable %1] break } } } {Windows 95} - {Windows NT} { #set command "[auto_execok start] {} [list $url]" package require registry set app [registry get {HKEY_CLASSES_ROOT\.html} {}] set command \ [registry get HKEY_CLASSES_ROOT\\$app\\shell\\open\\command {}] regsub -all {\\} $command / command } } if {! [info exists command]} { tk_messageBox -icon error -message \ "Please tell CL that ($::tcl_platform(os), $::tcl_platform(platform)) is not yet ready for browsing." exit } set ::S(web,cmd) $command } proc Cleanup {} { catch {eval file delete [glob -nocomplain _*.html]} } proc About {} { package require textutil set width 60 set txt "tcl Tiger\nby Keith Vetter, July 2007" set para(0) "Topologically Integrated Geographic Encoding and " append para(0) "Referencing, or TIGER, is a format used " append para(0) "by the United States Census Bureau to describe " append para(0) "land attributes such as roads, buildings, rivers, and " append para(0) "lakes, as well as areas such as census tracts. TIGER was " append para(0) "developed to support and improve the Bureau's process of " append para(0) "taking the Decennial Census. (source: wikipedia)" set para(0) [::textutil::adjust $para(0) -length $width] set para(1) "This program combines TIGER with Google Maps. It " append para(1) "lets you extract from TIGER data files a road " append para(1) "(or other geographical item) and have it displayed " append para(1) "on a web page utilizing the Google Maps API." set para(1) [::textutil::adjust $para(1) -length $width] set para(2) "WARNING: to run tclTiger you must first download " append para(2) "at least one TIGER data file. See HELP for " append para(2) "download instructions." set para(2) [::textutil::adjust $para(2) -length $width] set txt "$txt\n\n$para(0)\n\n$para(1)\n\n$para(2)" tk_messageBox -message $txt } ################################################################ # # TIGER CODE # catch {namespace delete ::tclTiger} ;# Clean up for debugging namespace eval ::tclTiger { variable ROUTE variable STREETS variable NAMES variable SS variable htmlFile variable template set template { tclTiger

Tcl Tiger

} } ##+########################################################################## # # BuildRoad -- extracts from the specified tiger file the # road route info for the specified road. # proc ::tclTiger::BuildRoad {tigerFile prefix name type} { variable htmlFile set htmlFile [string tolower [string trim "$prefix $name $type"]] set htmlFile _[string map {" " _} $htmlFile.html] ::tclTiger::GetStreet $tigerFile $prefix $name $type ::tclTiger::MakeChain } ##+########################################################################## # # BuildWebpage -- creates web page with Google Map javascript to show # the road extracted by BuildRoad. # proc ::tclTiger::BuildWebpage {} { variable htmlFile variable template set clrs [::tclTiger::GetAllColors] set names [::tclTiger::GetAllNames 1] set rTxt [::tclTiger::GetAllRoutesHTML] #set fin [open template.html r] #set template [read $fin] ; list #close $fin set html [string map [list "SUBSTITUTE_COLORS_HERE" $clrs] $template] ; list set html [string map [list "SUBSTITUTE_NAMES_HERE" $names] $html] ; list set html [string map [list "SUBSTITUTE_ROUTE_HERE" $rTxt] $html] ; list set fout [open $htmlFile w] puts -nonewline $fout $html close $fout return $htmlFile } ##+########################################################################## # # GetStreet -- extracts all lines matching our road name. If prefix or # type is empty then it matches all. # proc ::tclTiger::GetStreet {tigerFile prefix name type} { variable NAMES variable STREETS unset -nocomplain NAMES set prefix [string tolower $prefix] set name [string tolower $name] set type [string tolower $type] set tlids {} set fin [open $tigerFile r] while {[gets $fin line] >= 0} { foreach {fullName tprefix tname ttype} [::tclTiger::ExtractName $line] break if {$name ne $tname} continue if {$prefix ne "" && $prefix ne $tprefix} continue if {$type ne "" && $type ne $ttype} continue set tlid [string range $line 5 14] set latlon [::tclTiger::ExtractLatLon $line] lappend tlids [concat $tlid $latlon] set NAMES([string trim $tlid]) $fullName } close $fin set STREETS $tlids ::tclTiger::GetFullLatLon $tigerFile } ##+########################################################################## # # ExtractName -- extracts road name with prefix and type from a RT1 line # proc ::tclTiger::ExtractName {line} { set FEDIRP [string trim [string range $line 17 18]] set FENAME [string trim [string range $line 19 48]] set FETYPE [string trim [string range $line 49 52]] set name [string trim "$FEDIRP $FENAME $FETYPE"] set FEDIRP [string tolower $FEDIRP] set FENAME [string tolower $FENAME] set FETYPE [string tolower $FETYPE] return [list $name $FEDIRP $FENAME $FETYPE] } ##+########################################################################## # # ExtractLatLon -- extracts latitude and longitude from a RT1 line # proc ::tclTiger::ExtractLatLon {line} { set lat1 [string range $line 200 208] set lon1 [string range $line 190 199] set lat2 [string range $line 219 227] set lon2 [string range $line 209 218] set lat1 "[string range $lat1 0 end-6].[string range $lat1 end-5 end]" set lon1 "[string range $lon1 0 end-6].[string range $lon1 end-5 end]" set lat2 "[string range $lat2 0 end-6].[string range $lat2 end-5 end]" set lon2 "[string range $lon2 0 end-6].[string range $lon2 end-5 end]" set lat1 [string trim $lat1] set lon1 [string trim $lon1] set lat2 [string trim $lat2] set lon2 [string trim $lon2] return [list $lat1 $lon1 $lat2 $lon2] } ##+########################################################################## # # MakeChain -- links streets together which share end points. # Result is put into ROUTE # proc ::tclTiger::MakeChain {} { variable STREETS variable ROUTE variable SS variable NAMES unset -nocomplain ROUTE unset -nocomplain SS unset -nocomplain OPP foreach datum $STREETS { foreach {tlid lat1 lon1 lat2 lon2} $datum break lappend SS($lat1,$lon1) $tlid lappend SS($lat2,$lon2) $tlid set OPP($lat1,$lon1,$tlid) $lat2,$lon2 set OPP($lat2,$lon2,$tlid) $lat1,$lon1 } set ends {} foreach arr [array names SS] { if {[llength $SS($arr)] == 1} { lappend ends $arr } } set n [expr {[llength $ends]/2}] set seg 0 while {$ends ne {}} { set nextNode [lindex $ends 0] set ends [lrange $ends 1 end] set nextRoad $SS($nextNode) set rChain {} set nChain $nextNode while {1} { lappend rChain $nextRoad set lastRoad $nextRoad set lastNode $nextNode set nextNode $OPP($lastNode,$lastRoad) lappend nChain $nextNode set nextRoad [::tclTiger::OtherRoad $lastRoad $nextNode] if {$nextRoad == ""} break } set ROUTE($seg,rChain) $rChain set ROUTE($seg,nChain) $nChain set ROUTE($seg,name) $NAMES($lastRoad) incr seg set n [lsearch $ends $nextNode] set ends [lreplace $ends $n $n] } set ROUTE(cnt) $seg } ##+########################################################################## # # OtherRoad -- returns the other road which enters a given node # proc ::tclTiger::OtherRoad {road node} { variable SS set n [lsearch $SS($node) $road] if {$n == -1} { return "" } return [lindex $SS($node) [expr {1 - $n}]] } ##+########################################################################## # # GetAllColors -- returns javascript for the color for each road drawn # proc ::tclTiger::GetAllColors {} { variable ROUTE set clrs {} for {set i 0} {$i < $ROUTE(cnt)} {incr i} { set clr [lindex $::S(colors) [expr {$i % [llength $::S(colors)]}]] lappend clrs "'$clr'" } set txt "var colors = \[" append txt [join $clrs ", "] append txt "];" return $txt } ##+########################################################################## # # GetAllNames -- gets the names for each matching road # proc ::tclTiger::GetAllNames {{javascript 0}} { variable ROUTE variable NAMES set rnames {} for {set i 0} {$i < $ROUTE(cnt)} {incr i} { set tlid [lindex $ROUTE($i,rChain) 0] lappend rnames $NAMES($tlid) } if {! $javascript} { return $rnames} set txt "var names = \['" append txt [join [string map {' \\'} $rnames] "', '"] append txt "'];" return $txt } ##+########################################################################## # # GetAllRoutesHTML -- returns javascript for every road we're drawing # proc ::tclTiger::GetAllRoutesHTML {} { variable ROUTE set txt "var routes = \[\n"; for {set i 0} {$i < $ROUTE(cnt)} {incr i} { set txt2 [::tclTiger::GetRouteHTML $i] append txt $txt2 } set txt [string trimright $txt ","] append txt " ];"; return $txt } ##+########################################################################## # # GetRouteHTML -- returns javascript for a given road # proc ::tclTiger::GetRouteHTML {idx} { set latlon [::tclTiger::GetRouteXY $idx] set txt "" append txt " \[\n" foreach {lat lon} $latlon { append txt " new GLatLng($lat,$lon),\n" } set txt [string trimright $txt "\n,"] append txt "\n ],\n"; return $txt variable ROUTE set nChain $ROUTE($idx,nChain) set txt "" append txt " \[\n" foreach datum $nChain { foreach {lat lon} [split $datum ","] break append txt " new GLatLng($lat,$lon),\n" } append txt " ],\n"; return $txt } ##+########################################################################## # # GetRouteXY -- returns the lat,lon for every point on a road # proc ::tclTiger::GetRouteXY {idx} { variable ROUTE variable LATLON set nChain $ROUTE($idx,nChain) set rChain $ROUTE($idx,rChain) set xy {} foreach {latlon} $nChain tlid $rChain { if {$tlid eq ""} break foreach {sLat sLon} [split $latlon ","] break foreach {rLat rLon} $LATLON($tlid) break set rxy $LATLON($tlid) if {$rLat ne $sLat || $rLon ne $sLon} { set rxy [::tclTiger::LatLonReverse $rxy] } set xy [concat $xy $rxy] } return $xy } ##+########################################################################## # # LatLonReverse -- reverses a lat lon list # proc ::tclTiger::LatLonReverse {xy} { set a {} foreach {lat lon} $xy { set a [concat $lat $lon $a] } return $a } ##+########################################################################## # # GetFullLatLon -- digs out of RT2 all the bends in a road # proc ::tclTiger::GetFullLatLon {tigerFile} { variable LATLON variable STREETS unset -nocomplain LATLON set tlids {} foreach datum $STREETS { set tlid [lindex $datum 0] if {! [info exists LATLON($tlid)]} { lappend tlids $tlid set LATLON($tlid) [lrange $datum 1 end] } } if {$tlids eq {}} return if {$::S(noRT2)} return regsub -nocase {1$} $tigerFile {2} tigerFile2 if {! [file readable $tigerFile2]} return set fin [open $tigerFile2 r] while {[gets $fin line] >= 0} { set tlid [string trim [string range $line 5 14]] if {[lsearch $tlids $tlid] == -1} continue set seq [string index $line 17] set idx [expr {2 + 20*($seq-1)}] set ten [::tclTiger::Extract10LatLon $line] set LATLON($tlid) [eval linsert [list $LATLON($tlid)] $idx $ten] } close $fin } ##+########################################################################## # # Extract10LatLon -- extracts the 10 lat,lon pairs in a RT2 line # proc ::tclTiger::Extract10LatLon {line} { set line2 [string range $line 18 end] set latlons {} foreach {. lon lat} [regexp -all -inline {(.{10})(.{9})} $line2] { if {$lon eq "+000000000"} continue set lat "[string range $lat 0 end-6].[string range $lat end-5 end]" set lon "[string range $lon 0 end-6].[string range $lon end-5 end]" set lat [string trim $lat] set lon [string trim $lon] lappend latlons $lat $lon } return $latlons } ##+########################################################################## # # ToMappoint -- debugging routine that saves a lat,lon list to a # format which mappoint can import. # proc ToMappoint {tlid {fname foo.txt}} { set txt "name\tlatitude\tlongitude\n" set idx -1 foreach {lat lon} $::tclTiger::LATLON($tlid) { append txt "p[incr idx]\t$lat\t$lon\n" } set fout [open $fname w] puts -nonewline $fout $txt close $fout } ################################################################ DoDisplay return ---- [Category Geography]