Topic: CHALLENGE : Rectangles

[Swift]

It is fast enough Kerry, that was solved in Mathcad. If I was going to write a routine for that it would take me a great deal longer to simplify those equations than it would to write the program. The beauty of that system is that once you have the core matrix functions worked all you have to do is build the matrices for each application and voila!

I think I'll try to write something up this weekend, but the why behind how works is outside the scope of a single book. I think it would be easy enough to write a user manual type article about it.

[Kerry]

Here's 2 options ...
The code that does the work is actually quite compact, the rest is fluff ...
.. these seem fairly fast.
The fitRectangle2 result seems to be more in line with David's posted Mathcad solution.

/// kwb

Command: (fitRectangle)

 After 34 attempts, the solution is 987.1477421877141
 The base angle is 18.31035073198846

Command: (fitRectangle2)

 After 47 attempts, the solution is 987.1477421881225
 The base angle is 18.31035073352091


Command: (benchmark '((fitRectangle  1000.0 500.0 200.0) (fitRectangle2  1000.0 500.0 200.0)))

Elapsed milliseconds for 32768 iteration(s)/ relative Timing :

    (FITRECTANGLE2 1000.0 500.0 200.0).....1797 / 1.009 <slowest>
    (FITRECTANGLE 1000.0 500.0 200.0)......1781 / 1 <fastest>

edit added : I commented out the prompts for the Benchmark testing

Code: [Select]

(DEFUN fitrectangle2
       (width height depth /)
  ;; kwb .. proof of concept code
  ;; based on ( (W+H)/(L+D)^2) + (W-H)/(L-D)^2) = 2
  ;; where W and H is larger rectangle, L and D is smaller inscribed rectangle.
  ;; .. could be optimised ..
  ;;
  (SETQ break   nil
        attempt 0
        fuzz    1.0e-14
        maxlen  (EXPT (+ (EXPT width 2)
                         (EXPT height 2)
                      )
                      0.5
                )
        minlen  0
  )
  (IF
    (> depth
       (EXPT (+ (EXPT (/ height 2.0) 2)
                (EXPT (/ width 2.0) 2)
             )
             0.5
       )
    )
     (PROMPT "\n No solution is possible"
     )
     ;;
     ;; else
     (PROGN
       (WHILE (NOT break)
         (SETQ attempt (1+ attempt)
               ;; set up a halving solution
               leng    (+ (/ (- maxlen minlen) 2)
                          minlen
                       )
               tmp     (- 2.0
                          (+ (EXPT
                               (/ (+ width height)
                                  (+ depth leng)
                               )
                               2
                             )
                             (EXPT
                               (/ (- width height)
                                  (- depth leng)
                               )
                               2
                             )
                          )
                       )
         )
         (IF (< (ABS tmp) fuzz)
           (SETQ break T)
           ;; else     
           (IF (MINUSP tmp)
             (SETQ minlen leng)
             ;; else
             (SETQ maxlen leng)
           )
         )
       )
       (PROMPT
         (STRCAT
           "\n After "
           (ITOA attempt)
           " attempts, the solution is "
           (RTOS leng 2 16)
         )
       )
       (PROMPT
         (STRCAT
           "\n The base angle is "
           (ANGTOS
             (-
               (kdub:asin
                 (/
                   height
                   (EXPT (+ (EXPT leng 2)
                            (EXPT depth 2)
                         )
                         0.5
                   )
                 )
               )
               (ATAN depth leng)
             )
             0
             15
           )
         )
       )
     )
  )
  (PRINC)
)

Code: [Select]

(DEFUN fitrectangle
       (width height depth /)
  ;;
  ;; for MWK.ctsa .. proof of concept ..
  ;; based on algorithm by George C. for TSD < in C++ >
  ;; kwb 1998 apr 16
  ;; note w and h are half rectangle values ..
  (SETQ w       (* width 0.5)
        h       (* height 0.5)
        d       (* depth 1.0)
        maxb    d
        minb    0.0
        exptd   (EXPT d 2)
        fuzz    0.0000001
        attempt 0
        break   nil
  )
  (IF
    (> d
       (EXPT (+ (EXPT h 2) (EXPT w 2))
             0.5
       )
    )
     (PROMPT "\n No solution is possible"
     )
     ;;
     ;; else
     (PROGN
       (WHILE (NOT break)
         (SETQ attempt (1+ attempt)
               b       (+ (/ (- maxb minb) 2) minb)
               exptb   (EXPT b 2)
               c       (EXPT (- exptd exptb) 0.5)
               o       (+ (- exptd (* exptb 2))
                          (* 2 b h)
                       )
               x       (/ o (* c 2))
               e       (- x w)
         )
         (IF (< (ABS e) fuzz)
           (SETQ break T)
           ;; else     
           (IF (> e 0)
             (SETQ maxb b)
             ;; else
             (SETQ minb b)
           )
         )
       )
       (SETQ len
              (* 2
                 (EXPT
                   (- (+ (EXPT (- h b) 2)
                         (EXPT w 2)
                      )
                      (EXPT (* d 0.5) 2)
                   )
                   0.5
                 )
              )
       )
       (PROMPT
         (STRCAT
           "\n After "
           (ITOA attempt)
           " attempts, the solution is "
           (RTOS len 2 15)
         )
       )
       (PROMPT
         (STRCAT "\n The base angle is "
                 (ANGTOS (ATAN c b) 0 15)
         )
       )
     )
  )
  (PRINC)
)


Code: [Select]

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; arcsine (inverse sine) accepts an argument in the range
;;; -1.0 to 1.0 inclusive, and returns an angle in radians in
;;; the range -pi/2 to pi/2 inclusive.
(defun kdub:asin (num)
  (cond ((> (abs num) 1.0)
         (alert (strcat " Arc-sine error in (KDUB:asin ." "\n Spitting the dummy"))
         (exit)
        )
        ((zerop num) 0.0)
        ((= num 1.0) (* pi 0.50))
        ((= num -1.0) (- (* pi 0.50)))
        (t (atan num (sqrt (- 1.0 (* num num)))))
  )
)


[Swift]

Kerry your code is certainly more compact than mine would be!

I got started on explaining mine but didn't get finished this weekend, hopefully I'll have something up in a couple of days.

[Bryco]

Love this thread.
Swamp pride.

[CAB]

Very well done Kerry, as usual. 

[whdjr]

I am the only one that thinks Swift's inner box is not a rectangle?  It looks more like a parallelogram.

CHALLENGE : Rectangle pegs in Rectangular holes ..

Provide geometry proof or code to determine the length of a rectangular shape to fit into a rectangular hole as shown

[Maverick®]

  I'm a little warped so it looks right to me.   

[Kerry]

Maverick's proclivity aside ;

Will,
David's solution has the values for A , B and length correct, he just has a wonky drawing .. so I'd assumed he was drawing in architectural mode, not civil ...

[Swift]

Will: it's a scaling issue with the picture, check the numbers.

Kerry: that hurts.

[LE]

Interesting solutions and challenge- you guys rock! -

Very nice, approach you got in the George C. algorithm - Kerry.

Btw, who is he? - just out of curiosity.


And to master Swift, great post.


Thanks.

[Greg B]

Very well done Kerry, as usual. 

You know he posted the challenge right?

[Kerry]

Sorry David ... I was feeling frivolous

Luis,
George is a C/C++ Programmer acquaintance/associate here in Brisbane.
The fitRectangle is a translation of some C code he wrote years ago.
The fitrectangle2 is based on a pure math formulae I found on the net < didn't record the source >  

( ((W+H)/(L+D))^2) + ((W-H)/(L-D))^2) = 2

getting it into lisp wasn't too hard, once I understood what was happening.

[Kerry]

Very well done Kerry, as usual. 

You know he posted the challenge right?

I think he may know that, Greg. He probably knows I've had a few years to work on a solution as well.

[Mark]

Great thread, even better challenge! Kudos to all .... and you too Kerry.

[Maverick®]

  Hopefully Swift you knew I was jabbing ya.  The only thing I could do like that is drive a square peg into a round hole with a big hammer.

  I'm still a little burned over you blowing me up all the time in UT.