« previous next »
Pages: [1] |   Go Down

Author Topic: General Hill Climbing Wrapper Function  (Read 1762 times)

0 Members and 1 Guest are viewing this topic.

Rod

  • Newt
  • Posts: 185
General Hill Climbing Wrapper Function
« on: March 17, 2022, 09:07:10 PM »
I have seen the hill-climbing approach used in this forum and I think its a good approach for a lot of code I write.
I thought it would be good to write wrapper recursive functions for linear, 2d and 3d hill climbing that look for the best approximate result.

Example linear wrapper function that would would find the approximate nearest point on a pollyine would take these arguments,

a function that results in a number value eg. '(lambda (dist) (distance pt (vlax-curve-getPointAtDist en dist)))
a sorting function '< (looking for the lowest value or shortest distance)
a maximum number of repetitions 50
and a minimum tolerance/ error value 0.01
min search value 0
max search value (vlax-curve-getdistatparam en (vlax-curve-getendparam en))

The wrapper would then try different distances along the polyline looking for the one with the lowest value (closest point) and then recursively try new points close to the nearest point found until the maximum number of repetitions have been reach, or our search distance is less than the minimum tolerance/ error value.
The result would be the distance along the polyine to the closest point.

How would you go about this.

I hope my idea is clear.

Cheers, Rod.


« Last Edit: March 17, 2022, 10:30:03 PM by Rod »
Logged
"All models are wrong, some models are useful" - George Box

BIGAL

  • Swamp Rat
  • Posts: 1409
  • 40 + years of using Autocad
Re: General Hill Climbing Algorithim
« Reply #1 on: March 17, 2022, 09:20:11 PM »
As clear as the mud from the floods here.

Post an image or dwg explaining your sort of contradicting yourself in what you ask for, just find closest pt from a selected group of points to a pline ?
Logged
A man who never made a mistake never made anything

Rod

  • Newt
  • Posts: 185
Re: General Hill Climbing Algorithim
« Reply #2 on: March 17, 2022, 10:27:16 PM »
*EDIT - BIGAL hope you are alright, some people have really copped a tough time with the floods

I'm not looking for an individual task more how would you write the wrapper function.

The wrapper function searches for the value that gives the best (lowest or highest or whatever) then recursively improves on the best found answer until a suitable answer is found.
https://en.wikipedia.org/wiki/Hill_climbing

This technique is used on many approximation tasks eg.
Linear search
min dist
closest point to
min bounding box

2d search
largest inscribed circle
minimum circumscribed circle

Here is my quick and dirty version and an example of a minDist command that uses the wrapper function.

Code - Auto/Visual Lisp: [Select]
  1. (defun evenlyDivide (minNo maxNo div / spacing lst item)
  2.   ;;div cannot be less than or equal to 1
  3.   (setq spacing (/ (- maxNo minNo) (float (- div 1))))
  4.   (setq lst (list (float minNo)))
  5.   (setq item minNo)
  6.   (repeat (- div 1)
  7.     (setq item (+ item spacing))
  8.     (setq lst (cons item lst))
  9.   ) ;_ end of repeat
  10.   (reverse lst)
  11. ) ;_ end of defun
  12.  
  13. (defun getBestResult (func lst comp / results bestResult)
  14.   (setq results (mapcar func lst))
  15.   (setq bestResult (car results))
  16.   (foreach result (cdr results)
  17.     (if (apply comp (list result bestResult))
  18.       (setq bestResult result)
  19.     ) ;_ end of if
  20.   ) ;_ end of foreach
  21.   (nth (vl-position bestResult results) lst)
  22. ) ;_ end of defun
  23.  
  24. (defun linearSearch (func comp maxRep minS maxS error curRep div / spacing lst bestResult)
  25.   (setq spacing (/ (- maxS minS) div))
  26.   (setq lst (evenlyDivide minS maxS div))
  27.   (setq bestResult (getBestResult func lst comp))
  28.   (setq curRep (1+ curRep))
  29.   (if (or (>= curRep maxRep) (< (abs (- bestResult minS)) error) (< (abs (- bestResult maxS)) error))
  30.     bestResult
  31.     (linearSearch func
  32.                   comp
  33.                   maxRep
  34.                   (max (- bestResult spacing) minS)
  35.                   (min (+ bestResult spacing) maxS)
  36.                   error
  37.                   curRep
  38.                   div
  39.     ) ;_ end of linearSearch
  40.   ) ;_ end of if
  41. ) ;_ end of defun
  42.  
  43. (defun c:minDist (/ en1 en2 dist pt1)
  44.   (setq en1 (car (entsel)))
  45.   (setq en2 (car (entsel)))
  46.   (setq dist (linearSearch '(lambda (dist)
  47.                               (distance (setq pt (vlax-curve-getPointAtDist en1 dist)) (vlax-curve-getclosestpointto en2 pt))
  48.                             ) ;_ end of lambda
  49.                            '<
  50.                            10
  51.                            0
  52.                            (vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))
  53.                            0.001
  54.                            1
  55.                            50
  56.              ) ;_ end of linearSearch
  57.   ) ;_ end of setq
  58.   (setq pt1 (vlax-curve-getpointatdist en1 dist))
  59.   (command "line" pt1 (vlax-curve-getclosestpointto en2 pt1) "")
  60.   (princ)
  61. ) ;_ end of defun
  62.  
  63.  
« Last Edit: March 17, 2022, 10:47:55 PM by Rod »
Logged
"All models are wrong, some models are useful" - George Box

Rod

  • Newt
  • Posts: 185
Re: General Hill Climbing Wrapper Function
« Reply #3 on: March 17, 2022, 10:31:48 PM »
Here is a roll-my-own version of vlax-curve-getClosestPointTo to that uses the wrapper function

Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ()
  2.   (setq en (car (entsel)))
  3.   (setq pt (getpoint))
  4.   (setq dist (linearSearch '(lambda (dist) (distance pt (vlax-curve-getPointAtDist en dist)))
  5.                            '<
  6.                            10
  7.                            0
  8.                            (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
  9.                            0.001
  10.                            1
  11.                            50
  12.              ) ;_ end of linearSearch
  13.   ) ;_ end of setq
  14.   (command "line" pt (vlax-curve-getpointatdist en dist) "")
  15. ) ;_ end of defun
Logged
"All models are wrong, some models are useful" - George Box

ScottMC

  • Newt
  • Posts: 191
Re: General Hill Climbing Wrapper Function
« Reply #4 on: August 12, 2023, 07:46:08 PM »
Just added other conversions [btw, clips of un.noted authors lisp included]
  Please view and make corrections to simplify. THANKS
Code: [Select]
(defun evenlyDivide (minNo maxNo div / spacing lst item)
    ;; https://www.theswamp.org/index.php?topic=57444.msg609257#msg609257
;; div cannot be less than or equal to 1
(setq spacing (/ (- maxNo minNo) (float (- div 1))))
(setq lst (list (float minNo)))
(setq item minNo)
(repeat (- div 1)
(setq item (+ item spacing))
(setq lst (cons item lst))
) ;_ end of repeat
(reverse lst)
) ;_ end of defun
 
(defun getBestResult (func lst comp / results bestResult)
(setq results (mapcar func lst))
(setq bestResult (car results))
(foreach result (cdr results)
(if (apply comp (list result bestResult))
(setq bestResult result)
) ;_ end of if
) ;_ end of foreach
(nth (vl-position bestResult results) lst)
) ;_ end of defun
 
(defun linearSearch (func comp maxRep minS maxS error curRep div / spacing lst bestResult)
(setq spacing (/ (- maxS minS) div))
(setq lst (evenlyDivide minS maxS div))
(setq bestResult (getBestResult func lst comp))
(setq curRep (1+ curRep))
(if (or (>= curRep maxRep) (< (abs (- bestResult minS)) error) (< (abs (- bestResult maxS)) error))
bestResult
(linearSearch func
comp
maxRep
(max (- bestResult spacing) minS)
(min (+ bestResult spacing) maxS)
error
curRep
div
) ;_ end of linearSearch
) ;_ end of if
) ;_ end of defun

(defun c:di2 (/ en1 en2 dist pt1 p2) ;; line between 2 entities from nearest edges
    (princ "\n Line at Minimum.Nearest Points of 2 Objects <+dist>..")
(setq en1 (car (entsel "\n Select First Object..<curved.first>")))
(setq en2 (car (entsel "\n Select Second Object..")))
(setq dist (linearSearch '(lambda (dist)
(distance (setq pt (vlax-curve-getPointAtDist en1 dist)) (vlax-curve-getClosestPointTo en2 pt))
) ;_ end of lambda
'<
10
0
(vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))
0.001
1
50
) ;_ end of linearSearch
) ;_ end of setq
(setq pt1 (vlax-curve-getPointAtDist en1 dist))
(command "line" pt1 (vlax-curve-getClosestPointTo en2 pt1) "")
    (setq p2 (vlax-curve-getClosestPointTo en2 pt1))                   ;; set p2 coord
    (setq d22 (distance pt1 p2))                                                 ;; calc length
    (princ (strcat "\n Nearest Distance Between: "(rtos d22 2 4))) ;; print w/info
    (princ)
) ;_ end of defun

;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; returns the length or the perimeter of selected object

 (defun c:loo (/ en curve len) ;; object length
(princ "\n..Length of Object \(T\), <not.pick.points>..")
  (if (setq en (entsel))
    (progn
      (setq curve (vlax-ename->vla-object (car en)))
      (if (vl-catch-all-error-p
            (setq len (vl-catch-all-apply
                        'vlax-curve-getDistAtParam
                        (list curve
                              (vl-catch-all-apply
                                'vlax-curve-getEndParam
                                (list curve)
                              )
                        )
                      )
            )
          )
        nil
        len
      )
    )
  )
)

(defun c:cmd (/ en1 en2 dist pt1 p2) ;; circle between 2 entities from nearest edges
    (princ "\n Circle at Minimum.Nearest Points of 2 Objects <+dist>..")
(setq en1 (car (entsel "\n Select First Object..<curve.first>")))
(setq en2 (car (entsel "\n Select Second Object..")))
(setq dist (linearSearch '(lambda (dist)
(distance (setq pt (vlax-curve-getPointAtDist en1 dist)) (vlax-curve-getClosestPointTo en2 pt))
) ;_ end of lambda
'<
10
0
(vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))
0.001
1
50
) ;_ end of linearSearch
) ;_ end of setq
(setq pt1 (vlax-curve-getPointAtDist en1 dist))
(command "circle" "2P" pt1 (vlax-curve-getClosestPointTo en2 pt1) "") ;; copied+changed object inserted
    (setq p2 (vlax-curve-getClosestPointTo en2 pt1))                   ;; set p2 coord
    (setq d22 (distance pt1 p2))                                                 ;; calc length
    (princ (strcat "\n Nearest Distance Between: "(rtos d22 2 4))) ;; print w/info
    (princ)
) ;_ end of defun

(defun c:pmd (/ en1 en2 dist pt1 p2) ;; point between 2 entities from nearest edges
    (princ "\n Point at Mid of Minimum.Nearest Points of 2 Objects <+point.dist>..")
(setq en1 (car (entsel "\n Select First Object..<curved.first>")))
(setq en2 (car (entsel "\n Select Second Object..")))
(setq dist (linearSearch '(lambda (dist)
(distance (setq pt (vlax-curve-getPointAtDist en1 dist)) (vlax-curve-getClosestPointTo en2 pt))
) ;_ end of lambda
'<
10
0
(vlax-curve-getdistatparam en1 (vlax-curve-getendparam en1))
0.001
1
50
) ;_ end of linearSearch
) ;_ end of setq
(setq pt1 (vlax-curve-getPointAtDist en1 dist))
(command "circle" "2P" pt1 (vlax-curve-getClosestPointTo en2 pt1) "")
    (setq p2 (vlax-curve-getClosestPointTo en2 pt1))                   ;; set p2 coord
   
    (if (setq s (ssget "_L" '((0 . "CIRCLE")))) ;; change circle into point
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i))))
      (if (entmake (list '(0 . "POINT") (assoc 10 (entget e))))
(entdel e)
      )
    )
    )

    (setq d22 (distance pt1 p2))                                                 ;; calc length
    (princ (strcat "\n Nearest Distance to Point: "(rtos (* 0.5 d22) 2 4))) ;; print w/info
    (princ)
) ;_ end of defun
Logged
Pages: [1] |   Go Up
« previous next »