- There is a city with a fairly high density (50 people per km2)
- There is an area around the city with a medium density (10 people per km2)
- The rest of the area has a very low density (1 person per km2)
- Make a map (matrix) of the population density
- Make a map of the concentration
- Check all the grid cells where the concentration is above the threshold
- Multiply these grid cells with the number of people living there
- Sum over all the grid cells
- For a bonus: visualise the data
- Syntax errors in procs like linearx that are used as NAP function
- Procedures that are used as functions get arguments in the form of
{[$nx] [$ny]}
# gis_analysis.tcl # Use NAP for analysing the impact of a plume of smoke on a # populated area # package require Tk package require nap namespace import NAP::* # linearx -- # Construct the x-coordinate of a rectilinear grid # # Arguments: # nx Number of cells in x-direction # ny Number of cells in y-direction # xmin Minimum x-coordinate # xmax Maximum x-coordinate # # Result: # 2D array with x-coordinates # # Note: # We need to deal with the reference count of the returned # NAO (NAP data object) as the local variable that holds it # will cease to exist when the procedure returns # proc linearx {nx ny xmin xmax} { nap "xstep = (xmax-xmin)/(nx-1)" nap "x = xmin + xstep * (0 .. nx-1)" nap "x = reshape(x, {[$nx] [$ny]})" $x set count 2 -keep return $x } # lineary -- # Construct the y-coordinate of a rectilinear grid # # Arguments: # nx Number of cells in x-direction # ny Number of cells in y-direction # ymin Minimum x-coordinate # ymax Maximum x-coordinate # # Result: # 2D array with x-coordinates # proc lineary {nx ny ymin ymax} { nap "y = transpose(linearx($nx,$ny,$ymin,$ymax))" $y set count 2 -keep return $y } # uniform -- # Construct a grid with a unform value # # Arguments: # nx Number of cells in x-direction # ny Number of cells in y-direction # value Value to be used # # Result: # 2D array with a uniform value # proc uniform {nx ny value} { nap "v = reshape(($nx*$ny)#$value, {[$nx] [$ny]})" $v set count 2 -keep return $v } # fillCircle -- # Fill cells in an existing grid that lie within a given circle # # Arguments: # grid Grid to be partially filled # x X-coordinate of the grid points # y Y-coordinate of the grid points # xcentre X-coordinate of the centre of the circle # ycentre Y-coordinate of the centre of the circle # radius Radius of the circle # value Value to be used # # Result: # 2D array with a filled-up area # proc fillCircle {grid x y xcentre ycentre radius value} { nap "v = (hypot(($x-$xcentre),($y-$ycentre)) < $radius)? $value : $grid" $v set count 2 -keep return $v } # gaussian -- # Create a matrix containing a Gaussian plume # # Arguments: # x X-coordinate of the grid points # y Y-coordinate of the grid points # xorig X-coordinate of the origin of the plume # yorig Y-coordinate of the origin of the plume # disp (Transversal) dispersion rate # wind Wind velocity # # Result: # 2D array with a plume in positive x-direction (unscaled) # proc gaussian {x y xorig yorig disp wind} { # 1 -y**2/(Dx/u) # ----- e # sqrt(2piDx/u) # # x given in km, hence a factor 1000 nap "pi = 4.0*atan(1.0)" nap "v = (1.0/sqrt(2.0*pi*disp*x/wind)) * exp( - y*y/(disp*x*1000.0/wind) )" $v set count 2 -keep return $v } # classes -- # Fill in values for each class # # Arguments: # matrix Matrix with class numbers # values Values to fill in per class # # Result: # 2D array with values filled in # proc classes {matrix values} { set classno 0 nap "result = matrix" foreach value [$values value] { nap "result = (matrix == classno)? value : result" incr classno } $result set count 2 -keep return $result } # # Set up the map with the population # set nx 100 set ny 100 nap "x = linearx($nx, $ny, 0.0, 50.0)" nap "y = lineary($nx, $ny, -25.0, 50.0)" nap "population = uniform($nx, $ny, 1)" ;# Very low density # # Fill in the urban and suburban areas # nap "population = fillCircle($population, $x, $y, 50.0, -5.0, 30.0, 2)" nap "population = fillCircle($population, $x, $y, 40.0, 10.0, 10.0, 3)" # # The plume of smoke # nap "conc = 40.0 * gaussian($x, $y, 0.0, 0.0, 10.0e-3, 5.0)" # # Which cells have a "high" concentration? # nap "irritating = conc > 0.2" # # Compute the number of people that will suffer: # - Mark the cells with a high concentration (simply: value of # irritating times the type of population density) # - Count the cells per category (via the unary tally operator #) # - Multiply each category with the number of people per cell # - Sum all categories # nap "influenced = #reshape(irritating*population,{[expr {$nx*$ny}]})" set area_per_cell [expr {50.0*50.0/($nx*$ny)}] nap "casualties = sum( influenced * {0 1 10 50} * $area_per_cell )" nap "casualties_per_category = influenced * {0 1 10 50} * $area_per_cell" catch { console show } puts "Number of casualties: [$casualties value]" puts "Per category:" puts "Category\tNumber\tArea:" set values [lrange [$casualties_per_category value] 1 end] set influenced_area [lrange [$influenced value] 1 end] foreach c {Low Medium High} v $values a $influenced_area { puts "$c\t\t$v\t[expr {$a*$area_per_cell}]" } # # Now some pictures # Note: # We have not defined any coordinates for the 2D datasets ... # plot_nao casualties_per_category -type bar -title "Casualties per category" plot_nao [nap "conc>0.2? conc : _"] -title "Concentration" plot_nao [nap "classes(population,{0 1 10 50})"] -title "Population density"
Here are the pictures:
See also Analyzing Remote Sensing Data with NAP