Netlogo : Uploading a gis shapefile and preventing two polygons from overlapping - gis

Good morning.
I upload a shapefile and ask patches with the centroid of each polygons to set some properties from the shapefile attributes.
gis:set-world-envelope (gis:envelope-of shpefile)
ask patches [set pcolor white]
gis:set-drawing-color black
gis:draw shapefile 0.5
;; ask patches gis:intersecting BE_WAL_Parcels_2015
;; [ set is-farm? true]
let n 1
foreach gis:feature-list-of BE_WAL_Parcels_2015 [
polygone ->
let center-point gis:location-of gis:centroid-of polygone
let x-coordinate item 0 center-point
let y-coordinate item 1 center-point
;; I need to add here the possibility to move the centroid of one px and py
ask patch x-coordinate y-coordinate [
ifelse (ID-parcel = 0) [
;; set an ID to the patch
set ID-temp n
set ID-parcel gis:property-value polygone "ID_PRCL"
set ID-farm gis:property-value polygone "ID_FARM"
[ set pcolor red
print x-coordinate]
]
set n n + 1
]
I added an ifelse condition to make sure that one polygons centroid is not overlapping a precedent computed polygon (set pcolor to red). I know that 1871 polygons are overlapping each other, see the a small part of the world:
I'd like to add the following action: if the patches is already defined with an id-parcel, then move to the closest one that is empty.
I'm now sure where to write that since the ifelse is inside a ask patch procedure...
Moreover, I've been playsing with the world size and patch size to minimize the risk of overlapping but the shapefile seems to adapt to the world size/patch size. Is there a way to increase the number of patches inside one polygon ? So make the patches smaller without decreasing the size of polygons
I attach here printscreen of a small part of the world as support

My second question is still OPEN (world and patch size) but I managed to find a way out (at least, it looks like OK) for my first question by sprouting a turtle on any patches that welcome a parcel from the shapefile, and afterwards checking whether there is already a turtle on the patche before assigning the next parcels. Here below is the few lines of codes. Any comment is obviously welcome ! :)
to setup-parcels
ca
reset-timer
resize-world 1500 * 0 ( 1500 * 1 ) ( 1500 * -1 ) 1500 * 0
gis:load-coordinate-system "BE_WAL_Parcels2006_Netlogo_selection_2.prj"
set BE_WAL_Parcels_2006 gis:load-dataset "BE_WAL_Parcels2006_Netlogo_selection_2.shp"
gis:set-world-envelope (gis:envelope-of BE_WAL_Parcels_2006)
ask patches [set pcolor white]
gis:set-drawing-color black
gis:draw BE_WAL_Parcels_2006 0.5
let n 1
foreach gis:feature-list-of BE_WAL_Parcels_2006 [
polygone ->
let center-point gis:location-of gis:centroid-of polygone
let x-coordinate item 0 center-point
let y-coordinate item 1 center-point
let occupied turtles with [xcor = x-coordinate AND ycor = y-coordinate]
ifelse any? occupied [
set x-coordinate (item 0 center-point + 1)
set y-coordinate (item 1 center-point + 1)
ask patch x-coordinate y-coordinate [
sprout 1
set ID-parcel gis:property-value polygone "ID_PRCL"
print ID-parcel
set ID-farm gis:property-value polygone "ID_FARM"
]
]
[
ask patch x-coordinate y-coordinate [
sprout 1
set ID-parcel gis:property-value polygone "ID_PRCL"
set ID-farm gis:property-value polygone "ID_FARM"
]
]
set n n + 1
]
clear-turtles
end

Related

finding difference between list elements in Tcl

I am a beginner in using Tcl. I am using it as VMD (molecular visualization) software uses it as a scripting language.
I have a list of co-ordinates of atom positions for a protein like: {{1 2 3} {7 9 13}, ...} I have a separate list of the same length with different positions say: {{3 5 2} {7 3 8}, ...}.
VMD has an inbuilt vecsub function which can subtract {1 2 3} and {3 5 2} to give {-2 -3 1}. I have written a foreach loop to iterate on the entire list and calculate vecsub.
My code is as follows:\
set sel1 [atomselect 0 "protein"] # selecting protein1
set sel2 [atomselect 1 "protein"] # selecting protein2
# create a list of same length as protein to store values
# $sel1 get index returns length of protein
foreach i [$sel1 get index] {
lappend x 0
}
# veclength2 returns square of vector length
# $sel1 get {x y z} returns a position list as described earlier
foreach i [$sel1 get index] {
lset x $i [expr [veclength2 [vecsub [lindex [$sel1 get {x y z}] $i] [lindex [$sel2 get {x y z}] $i]]]]
}
Is there another way to do this in Tcl? Similar to python array subtraction perhaps?
I would try this, but it's just a guess
set x [lmap p1 [$sel1 get {x y z}] p2 [$sel2 get {x y z}] {
expr [veclength2 [vecsub $p1 $p2]]
}]
With this, there's no need to pre-declare $x

Misaligned between imported GIS files and network (nodes have X and Y coordinates) - NetLogo

I, once again have a question. My previous solution to my problem didn't work as I expected. To remind you, I imported some polygons and had a problem setting some turtles (cities) in the NetLogo world appropriately (to read GIS coordinates from non-gis file and set their position in the world, more on Netlogo doesen't recognize the GIS coordinates in the defined envelope of the world, it treats them as netologo world coordinates). So, in the end, I came up with a solution to transform the GIS coordinates in NetLogo coordinates (nl-x and nl-y procedures). The cities are actually in graphml format with x and y attributes. So, my code is this:
extensions [nw gis]
directed-link-breed [highways highway]
breed [cities city]
highways-own [ name ]
cities-own [ x y ]
globals [ paldrino ]
to setup
ca
;; set the world envelope
gis:load-coordinate-system "wgs84.prj"
set paldrino gis:load-dataset "paldrino.shp"
let world ( gis:envelope-of paldrino )
gis:set-world-envelope (world)
;; Make them visible
foreach gis:feature-list-of paldrino [ ;for each polygon
polygon ->
let temp-color one-of base-colors
ask patches gis:intersecting polygon [
set pcolor temp-color
]]
;; load network
nw:set-context cities highways
nw:load-graphml "highway-network.graphml"
ask cities[
set xcor nl-x(read-from-string x) ;; if I put set xcor read-from-string x, then it will put all the nodes in one point in Netlogo world, same for setxy fix-x(read-from-string x) fix-y (read-from-string y)
set ycor nl-y (read-from-string y)
]
end
to-report nl-x [#x]
let world gis:envelope-of paldrino
let minx item 0 world
let maxx item 1 world
report ((#x - minx) / (maxx - minx)) * (max-pxcor - min-pxcor) + min-pxcor
end
to-report nl-y [#y]
let world gis:envelope-of paldrino
let miny item 2 world
let maxy item 3 world
report ((#y - miny) / (maxy - miny)) * (max-pycor - min-pycor) + min-pycor
end
In the end, the problem is that NetLogo doesn't perfectly align those two files: polygons (paldrino) and network (cities). Approximately it put them ok, but I need them to be perfectly set in the world. For example, some cities should have been in one polygon, but they are in the adjacent polygon.
So, for example, this is how NetLogo puts them:
And this is how they should be (read in QGIS):
If anyone please can help me or point me in another direction. I start losing my mind.
Thank you!

Small shift when transforming from GIS to netlogo coordinates

When storing turtle coordinates as GIS coordinates, and then loading them into NetLogo by converting them back to NetLogo coordinates, there is a slight shift in position.
This is the code I use to store NetLogo to GIS coordinates:
let env gis:envelope-of agentToStore
file-open "agentLocations.csv"
file-print (word first env "," last env)
file-close
And this is the code I use to convert GIS coordinates back to NetLogo coordinates (here x and y are coordinates read from the file):
let envelope gis:world-envelope
let xscale (max-pxcor - min-pxcor) / (item 1 envelope - item 0 envelope)
let yscale (max-pycor - min-pycor) / (item 3 envelope - item 2 envelope)
if x >= item 0 envelope and x <= item 1 envelope
and y >= item 2 envelope and y <= item 3 envelope[
let netlogo-x (x - item 0 envelope) * xscale + min-pxcor
let netlogo-y (y - item 2 envelope) * yscale + min-pycor
ask patch (ceiling netlogo-x) (floor netlogo-y) [sprout 1]
]
Without 'ceiling' and 'floor', the loaded agent is always shifted by a cell in NetLogo. However even with ceiling and floor, there is still a small shift by in GIS space for some agents, which affects my output. Is there a better way of doing this?

Canvas widget has wrong size after resize

I have a canvas widget which shows a gradient. This is done by drawing lines from its top to bottom each with a slightly different color. To achieve this, in the function that draws the line I check the height of the canvas and draw lines according to it. The problem is, that the first time its drawn, or when the widget is resized (when it's resized, I call the drawing function) the result I get from the command winfo height $legendCanvas is wrong and the drawing is bad, only when I recall the function again, it gets the right value and the drawing results are good. I've tried adding update idletasks at the start of the method, it doesn't work.
The relevant canvas is called legendCanvas
itcl::body siReportAttackersMatrix::setThreshold {{val ""}} {
update idletasks
# some unrelated code here
# ...
#redraw the legend
$legendCanvas delete line all
set range [expr {$maxVal*1.0-$minVal}]
set step [expr {$range/[winfo height $legendCanvas]}]
for {set y 0} {$y < [winfo height $legendCanvas]} {incr y} {
# some unrelated code that calculated the color
set id [$legendCanvas create line 0 $y [winfo width $legendCanvas] $y -fill $color]
}
set textX [expr {[winfo width $legendCanvas]/2}]
set id [$legendCanvas create text $textX 0 -anchor n -text [expr {int($maxVal * 1000)}]]
set id [$legendCanvas create text $textX [winfo height $legendCanvas] -anchor s -text [expr {int($minVal * 1000)}]]
foreach fraction [list 2 4 [expr {4/3.0}]] {
set textY [expr {int([winfo height $legendCanvas]*1.0/$fraction)}]
set textValue [expr {int(($maxVal-$minVal)*(1-1.0/$fraction)*1000)}]
set id [$legendCanvas create text $textX $textY -anchor center -text $textValue]
}
}
in order to conserve space I've removed code that is irellevent to the problem, like calculating the color, some more functions that the method does and bindings on the different items in the canvas
Screen pics of the results:
On creation (on the left), After recalling the method(on the right):
On resize (on the left), After recalling the method (on the right):
The simplest way of fixing this is to recompute the gradient whenever that canvas widget receives a <Configure> event. In particular, the %h and %w substitutions in the <Configure> event tell you what the size of the widget is being set to, though the basic Tk infrastructure will also save those values into the widget record (where winfo height and winfo width can retrieve them).
# Something like this; you might want to tweak the binding
bind $legendCanvas <Configure> { doRescale %W %w %h }
You're advised to have a procedure (or method) that just handles this; other operations that require the rescaling (such as the initial setup code) can just call it as necessary.

Has anyone seen a programming puzzle similar to this?

"Suppose you want to build a solid panel out of rows of 4×1 and 6×1 Lego blocks. For structural strength, the spaces between the blocks must never line up in adjacent rows. As an example, the 18×3 panel shown below is not acceptable, because the spaces between the blocks in the top two rows line up.
There are 2 ways to build a 10×1 panel, 2 ways to build a 10×2 panel, 8 ways to build an 18×3 panel, and 7958 ways to build a 36×5 panel.
How many different ways are there to build a 64×10 panel? The answer will fit in a 64-bit signed integer. Write a program to calculate the answer. Your program should run very quickly – certainly, it should not take longer than one minute, even on an older machine. Let us know the value your program computes, how long it took your program to calculate that value, and on what kind of machine you ran it. Include the program’s source code as an attachment.
"
I was recently given a programming puzzle and have been racking my brains trying to solve it. I wrote some code using c++ and I know the number is huge...my program ran for a few hours before I decided just to stop it because the requirement was 1 minute of run time even on a slow computer. Has anyone seen a puzzle similar to this? It has been a few weeks and I can't hand this in anymore, but this has really been bugging me that I couldn't solve it correctly. Any suggestions on algorithms to use? Or maybe possible ways to solve it that are "outside the box". What i resorted to was making a program that built each possible "layer" of 4x1 and 6x1 blocks to make a 64x1 layer. That turned out to be about 3300 different layers. Then I had my program run through and stack them into all possible 10 layer high walls that have no cracks that line up...as you can see this solution would take a long, long, long time. So obviously brute force does not seem to be effective in solving this within the time constraint. Any suggestions/insight would be greatly appreciated.
The main insight is this: when determining what's in row 3, you don't care about what's in row 1, just what's in row 2.
So let's call how to build a 64x1 layer a "row scenario". You say that there are about 3300 row scenarios. That's not so bad.
Let's compute a function:
f(s, r) = the number of ways to put row scenario number "s" into row "r", and legally fill all the rows above "r".
(I'm counting with row "1" at the top, and row "10" at the bottom)
STOP READING NOW IF YOU WANT TO AVOID SPOILERS.
Now clearly (numbering our rows from 1 to 10):
f(s, 1) = 1
for all values of "s".
Also, and this is where the insight comes in, (Using Mathematica-ish notation)
f(s, r) = Sum[ f(i, r-1) * fits(s, i) , {i, 1, 3328} ]
where "fits" is a function that takes two scenario numbers and returns "1" if you can legally stack those two rows on top of each other and "0" if you can't. This uses the insight because the number of legal ways to place scenario depends only on the number of ways to place scenarios above it that are compatible according to "fits".
Now, fits can be precomputed and stored in a 3328 by 3328 array of bytes. That's only about 10 Meg of memory. (Less if you get fancy and store it as a bit array)
The answer then is obviously just
Sum[ f(i, 10) , {i, 1, 3328} ]
Here is my answer. It's Haskell, among other things, you get bignums for free.
EDIT: It now actually solves the problem in a reasonable amount of time.
MORE EDITS: With a sparse matrix it takes a half a second on my computer.
You compute each possible way to tile a row. Let's say there are N ways to tile a row. Make an NxN matrix. Element i,j is 1 if row i can appear next to row j, 0 otherwise. Start with a vector containing N 1s. Multiply the matrix by the vector a number of times equal to the height of the wall minus 1, then sum the resulting vector.
module Main where
import Data.Array.Unboxed
import Data.List
import System.Environment
import Text.Printf
import qualified Data.Foldable as F
import Data.Word
import Data.Bits
-- This records the index of the holes in a bit field
type Row = Word64
-- This generates the possible rows for given block sizes and row length
genRows :: [Int] -> Int -> [Row]
genRows xs n = map (permToRow 0 1) $ concatMap comboPerms $ combos xs n
where
combos [] 0 = return []
combos [] _ = [] -- failure
combos (x:xs) n =
do c <- [0..(n `div` x)]
rest <- combos xs (n - x*c)
return (if c > 0 then (x, c):rest else rest)
comboPerms [] = return []
comboPerms bs =
do (b, brest) <- choose bs
rest <- comboPerms brest
return (b:rest)
choose bs = map (\(x, _) -> (x, remove x bs)) bs
remove x (bc#(y, c):bs) =
if x == y
then if c > 1
then (x, c - 1):bs
else bs
else bc:(remove x bs)
remove _ [] = error "no item to remove"
permToRow a _ [] = a
permToRow a _ [_] = a
permToRow a n (c:cs) =
permToRow (a .|. m) m cs where m = n `shiftL` c
-- Test if two rows of blocks are compatible
-- i.e. they do not have a hole in common
rowCompat :: Row -> Row -> Bool
rowCompat x y = x .&. y == 0
-- It's a sparse matrix with boolean entries
type Matrix = Array Int [Int]
type Vector = UArray Int Word64
-- Creates a matrix of row compatibilities
compatMatrix :: [Row] -> Matrix
compatMatrix rows = listArray (1, n) $ map elts [1..n] where
elts :: Int -> [Int]
elts i = [j | j <- [1..n], rowCompat (arows ! i) (arows ! j)]
arows = listArray (1, n) rows :: UArray Int Row
n = length rows
-- Multiply matrix by vector, O(N^2)
mulMatVec :: Matrix -> Vector -> Vector
mulMatVec m v = array (bounds v)
[(i, sum [v ! j | j <- m ! i]) | i <- [1..n]]
where n = snd $ bounds v
initVec :: Int -> Vector
initVec n = array (1, n) $ zip [1..n] (repeat 1)
main = do
args <- getArgs
if length args < 3
then putStrLn "usage: blocks WIDTH HEIGHT [BLOCKSIZE...]"
else do
let (width:height:sizes) = map read args :: [Int]
printf "Width: %i\nHeight %i\nBlock lengths: %s\n" width height
$ intercalate ", " $ map show sizes
let rows = genRows sizes width
let rowc = length rows
printf "Row tilings: %i\n" rowc
if null rows
then return ()
else do
let m = compatMatrix rows
printf "Matrix density: %i/%i\n"
(sum (map length (elems m))) (rowc^2)
printf "Wall tilings: %i\n" $ sum $ elems
$ iterate (mulMatVec m) (initVec (length rows))
!! (height - 1)
And the results...
$ time ./a.out 64 10 4 6
Width: 64
Height 10
Block lengths: 4, 6
Row tilings: 3329
Matrix density: 37120/11082241
Wall tilings: 806844323190414
real 0m0.451s
user 0m0.423s
sys 0m0.012s
Okay, 500 ms, I can live with that.
I solved a similar problem for a programming contest tiling a long hallway with tiles of various shapes. I used dynamic programming: given any panel, there is a way to construct it by laying down one row at a time. Each row can have finitely many shapes at its end. So for each number of rows, for each shape, I compute how many ways there are to make that row. (For the bottom row, there is exactly one way to make each shape.) Then the shape of each row determines the number of shapes that the next row can take (i.e. never line up the spaces). This number is finite for each row and in fact because you have only two sizes of bricks, it is going to be small. So you wind up spending constant time per row and the program finishes quickly.
To represent a shape I would just make a list of 4's and 6's, then use this list as a key in a table to store the number of ways to make that shape in row i, for each i.