「ソートされていないリスト」とは、ポイントのセットが完成している間、それらがどの順序で移動されたかわからないことを意味すると思いますか?
ガウス ノイズは基本的に無視する必要があります。元のノイズのないパスを再構築する試みを可能にする情報はまったく与えられません。したがって、私たちができる最善のことは、ポイントが正しいと仮定することだと思います。
この時点で、タスクは「一連のポイントを通る最適なパスを見つける」ことで構成され、「最適」はあいまいなままです。ユークリッド空間で一連の点を並べ替えようとするコードを作成しました。直線がより直線になる並べ替えを優先します。メトリクスは簡単に実装できましたが、それに基づく順序付けを改善する良い方法が思いつかなかったので、ランダムにポイントを交換してより良い配置を探しました。
そこで、これを行う PLT スキーム コードをいくつか示します。
#lang scheme
(require (only-in srfi/1 iota))
; a bunch of trig
(define (deg->rad d)
(* pi (/ d 180)))
(define (rad->deg r)
(* 180 (/ r pi)))
(define (euclidean-length v)
(sqrt (apply + (map (lambda (x) (expt x 2)) v))))
(define (dot a b)
(apply + (map * a b)))
(define (angle-ratio a b)
(/ (dot a b)
(* (euclidean-length a) (euclidean-length b))))
; given a list of 3 points, calculate the likelihood of the
; angle they represent. straight is better.
(define (probability-triple a b c)
(let ([av (map - a b)]
[bv (map - c b)])
(cos (/ (- pi (abs (acos (angle-ratio av bv)))) 2))))
; makes a random 2d point. uncomment the bit for a 3d point
(define (random-point . x)
(list (/ (random 1000) 100)
(/ (random 1000) 100)
#;(/ (random 1000) 100)))
; calculate the likelihood of an entire list of points
(define (point-order-likelihood lst)
(if (null? (cdddr lst))
1
(* (probability-triple (car lst)
(cadr lst)
(caddr lst))
(point-order-likelihood (cdr lst)))))
; just print a list of points
(define (print-points lst)
(for ([p (in-list lst)])
(printf "~a~n"
(string-join (map number->string
(map exact->inexact p))
" "))))
; attempts to improve upon a list
(define (find-better-arrangement start
; by default, try only 10 times to find something better
[tries 10]
; if we find an arrangement that is as good as one where
; every segment bends by 22.5 degrees (which would be
; reasonably gentle) then call it good enough. higher
; cut offs are more demanding.
[cut-off (expt (cos (/ pi 8))
(- (length start) 2))])
(let ([vec (list->vector start)]
; evaluate what we've started with
[eval (point-order-likelihood start)])
(let/ec done
; if the current list exceeds the cut off, we're done
(when (> eval cut-off)
(done start))
; otherwise, try no more than 'tries' times...
(for ([x (in-range tries)])
; pick two random points in the list
(let ([ai (random (vector-length vec))]
[bi (random (vector-length vec))])
; if they're the same...
(when (= ai bi)
; increment the second by 1, wrapping around the list if necessary
(set! bi (modulo (add1 bi) (vector-length vec))))
; take the values from the two positions...
(let ([a (vector-ref vec ai)]
[b (vector-ref vec bi)])
; swap them
(vector-set! vec bi a)
(vector-set! vec ai b)
; make a list out of the vector
(let ([new (vector->list vec)])
; if it evaluates to better
(when (> (point-order-likelihood new) eval)
; start over with it
(done (find-better-arrangement new tries cut-off)))))))
; we fell out the bottom of the search. just give back what we started with
start)))
; evaluate, display, and improve a list of points, five times
(define points (map random-point (iota 10)))
(define tmp points)
(printf "~a~n" (point-order-likelihood tmp))
(print-points tmp)
(set! tmp (find-better-arrangement tmp 10))
(printf "~a~n" (point-order-likelihood tmp))
(print-points tmp)
(set! tmp (find-better-arrangement tmp 100))
(printf "~a~n" (point-order-likelihood tmp))
(print-points tmp)
(set! tmp (find-better-arrangement tmp 1000))
(printf "~a~n" (point-order-likelihood tmp))
(print-points tmp)
(set! tmp (find-better-arrangement tmp 10000))
(printf "~a~n" (point-order-likelihood tmp))
(print-points tmp)
