Skip to content

Commit

Permalink
split osm ways at intersections and add elevation profile to splited …
Browse files Browse the repository at this point in the history 
…ways

(see also issue Project-OSRM#271)
  • Loading branch information
Jens Thiele committed Mar 5, 2013
1 parent bec4e44 commit bfad81f
Show file tree
Hide file tree
Showing 22 changed files with 2,676 additions and 0 deletions.
392 changes: 392 additions & 0 deletions waysplit/apply-way-splits.scm
View file

Large diffs are not rendered by default.

53 changes: 53 additions & 0 deletions waysplit/fastsxml2xml.scm
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*- |#
:; exec gosh -I. -- $0 "$@"
;;;
;;; convert sxml stream to osm xml
;;;
;;; Copyright (c) 2013 Jens Thiele <[email protected]>
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;

(use sxml2xml)
(use pipe)

(define (main args)
(set-pipe-buffer-size! (current-output-port) (ash 1 20))
(print "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
(print "<osm version=\"0.6\" generator=\"fastsxml2sxml\">")
(flush)
(let1 writer (make-xml-writer (current-output-port))
(until (read) eof-object? => expr
(xml-writer-write writer expr)
(xml-writer-write writer "\n"))
(close-xml-writer writer))
(gc)
(gc)
(print "</osm>")
0)
63 changes: 63 additions & 0 deletions waysplit/fastxml2sxml.scm
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,63 @@
#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*- |#
:; exec gosh -I. -- $0 "$@"
;;;
;;; convert osm xml to sxml stream
;;;
;;; Copyright (c) 2013 Jens Thiele <[email protected]>
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
(use srfi-1) ;; for older gauche (filter was in srfi-1)
(use xml2sxml)
(use sxml.adaptor) ;; for assert
(define whitespace?
(compose boolean #/^\s*$/))

(define (whitespace-filter expr)
(assert (list? expr))
(cons (car expr)
(filter (lambda(x)
(or (not (string? x))
(not (whitespace? x))))
(cdr expr))))

(define (main args)
(let* ((reader (make-xml-reader (current-input-port)))
(handle-node (lambda()
(let1 expr (xml-reader-node reader)
(when expr
(write (whitespace-filter expr))
(newline))))))
(assert (and (xml-reader-read reader)
(xml-reader-read reader)))
(handle-node)
(while (xml-reader-next reader)
(handle-node))
(close-xml-reader reader))
0)
259 changes: 259 additions & 0 deletions waysplit/huge-sparse-bitmap.scm
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,259 @@
;;;
;;; huge sparse (persistent) bitmap
;;;
;;; Copyright (c) 2013 Jens Thiele <[email protected]>
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; todos:
;;; - allow #t as default bit value?!
;;; - rename to huge-sparse-persistent-bitmap?
;;; - allow to use without filename (create temporary db?!)
;;; - or maybe constructor should take dbm object instead of filename?
;;; (or dict object? what about sync?)
;;; - use gauche's object system?
;;;

(define-module huge-sparse-bitmap
(use dbm.gdbm)
(use binary.pack) ;; danger: old gauche version is broken
(use gauche.collection)
(use sxml.adaptor) ;; for assert
(use rfc.zlib) ;; danger: old gauche version is broken
(use lru-cache)
(use util.list)
(export make-huge-sparse-bitmap
huge-sparse-bitmap-get-bit
huge-sparse-bitmap-set-bit!
huge-sparse-bitmap-unset-bit!
huge-sparse-bitmap-sync
))

(select-module huge-sparse-bitmap)

;; disable assert
;;(define-macro (assert e) )

(define (enc-ber n)
(assert (exact? n))
(pack "w" (list n) :to-string? #t))

(define (dec-ber s)
(assert (string? s))
(let1 n (car (unpack "w" :from-string s))
(assert (exact? n))
n))

(define (enc-zip n)
(assert (exact? n))
(deflate-string (number->string n 32) :window-bits -15))

(define (dec-zip s)
(assert (string? s))
(let1 n (string->number (inflate-string s :window-bits -15) 32)
(assert (exact? n))
n))

(define (enc-zip-2 n)
(assert (exact? n))
(deflate-string (number->string n 32) :window-bits -15 :strategy Z_RLE))

(define (dec-zip-2 s)
(assert (string? s))
(let1 n (string->number (inflate-string s :window-bits -15) 32)
(assert (exact? n))
n))

;; uh
;; maybe use something more like:
;; (with-output-to-string (lambda() (write-uint 64 255)))
(define (enc-bin n)
(let1 bs (number->string n 2)
(pack "b*" (list (string-append (make-string (- 8 (modulo (size-of bs) 8)) #\0)
bs))
:to-string? #t)))

(define (dec-bin s)
(string->number (car (unpack "b*" :from-string s)) 2))

(define enc-base32 (cute number->string <> 32))
(define dec-base32 (cute string->number <> 32))

;; note: must be a otherwise invalid key!
;; all allowed key decoding routings must fail!
;; => disallow bin and ber as key encoding for now (see below)
(define-constant *meta-key* "_M")

(assert (not (guard (e [else #f])
(dec-zip *meta-key*))))

(assert (not (guard (e [else #f])
(dec-zip-2 *meta-key*))))

;; (assert (not (guard (e [else #f])
;; (dec-ber *meta-key*))))

;; (assert (not (guard (e [else #f])
;; (dec-bin *meta-key*))))

(assert (not (guard (e [else #f])
(dec-base32 *meta-key*))))

;; (define enc number->string)
;; (define dec string->number)

;; todo: not really a good encoding for us!
;;(define enc enc-ber)
;;(define dec dec-ber)

;; (define enc enc-zip)
;; (define dec dec-zip)

(define (real-pair? x)
(and (pair? x) (not (list? x))))

(define (slot? s)
(and (real-pair? s)
(exact? (car s))
(exact? (cdr s))))

(define (slot-set-bit s x v)
(assert (slot? s))
(let1 r (cons (car s)
(copy-bit x (cdr s) v))
(assert (slot? r))
r))

(define (slot-get-bit s x)
(assert (slot? s))
(logbit? x (cdr s)))

(define bitstring (cut number->string <> 2))

(define (bit-stats n)
(let1 bs (bitstring n)
;; todo: use integer-length/bit-count/first-set-bit/logcount?!
(/ (size-of (filter (cut eq? #\1 <>) bs)) (size-of bs))))

(define (encode&decode name)
(apply values
(assoc-ref `((zip . (,enc-zip ,dec-zip))
(zip-2 . (,enc-zip-2 ,dec-zip-2))
(ber . (,enc-ber ,dec-ber))
(bin . (,enc-bin ,dec-bin))
(base32 . (,enc-base32 ,dec-base32)))
name)))

(define (make-huge-sparse-bitmap filename
:key
(slot-size 512)
(key-code 'base32)
(value-code 'base32)
(cache-size 16)
(rw-mode :write)
)

;;#?=(list slot-size key-code value-code cache-size)
(let ((db (dbm-open <gdbm> :path filename :rw-mode rw-mode)))
;; load options from db if it already exists
(if-let1 meta (dbm-get db *meta-key* #f)
(receive (s k v)
(apply values (read-from-string meta))
(unless (and (= s slot-size)
(eq? k key-code)
(eq? v value-code))
;; todo: we really should use db meta data as defaults
(error "options don't match db"))))
;; save options to db
(when (not (eq? rw-mode :read))
(dbm-put! db *meta-key* (write-to-string (list slot-size key-code value-code))))
(receive (enc-key dec-key) (encode&decode key-code)
;; disallow bin and ber as key encoding (see above)
(when (member key-code '(ber bin))
(error "not allowed as key-code " key-code))
(receive (enc-value dec-value) (encode&decode value-code)
(let ((read-slot-value (lambda(k)
(assert (exact? k))
(if-let1 v (dbm-get db (enc-key k) #f)
(dec-value v)
0)))
(write-slot-value (lambda(k v)
(assert (exact? k))
(dbm-put! db (enc-key k) (enc-value v))
)))
(let1 cache (if (> cache-size 0)
(make-lru-cache read-slot-value write-slot-value :cache-size cache-size)
'())

(define read-slot
(let1 get (assoc-ref cache 'get read-slot-value)
(lambda(sid)
(cons sid (get sid)))))

(define write-slot!
(let1 put! (assoc-ref cache 'put! write-slot-value)
(lambda(s)
(put! (car s) (cdr s)))))

(define (set-bit! b v)
(receive (q r) (quotient&remainder b slot-size)
(write-slot!
(slot-set-bit
(read-slot q) r v)))
v)

(define (get-bit b)
(receive (q r) (quotient&remainder b slot-size)
(slot-get-bit (read-slot q) r)))

(define sync
(let1 cache-sync (assoc-ref cache 'sync (lambda ()))
(lambda()
(cache-sync)
;; todo: generic dbm api is missing sync
;; how to sync db then?
;; we can only close and re-open?
;; for now use gdbm specific api
(assert (ref db 'gdbm-file))
(gdbm-sync (ref db 'gdbm-file)))))

`((set! . ,set-bit!)
(get . ,get-bit)
(sync . ,sync))))))))

(define (huge-sparse-bitmap-get-bit bm b)
((assoc-ref bm 'get) b))

(define (huge-sparse-bitmap-set-bit! bm b :optional (v #t))
((assoc-ref bm 'set!) b v))

(define (huge-sparse-bitmap-unset-bit! bm b)
((assoc-ref bm 'set!) b #f))

(define (huge-sparse-bitmap-sync bm)
((assoc-ref bm 'sync)))
Loading

0 comments on commit bfad81f

Please sign in to comment.