Post by a***@spenarnc.xs4all.nlRespect!
Of you introduce control words like that, it is hard to understand without
explanation.
Would you care to paraphrase the line I have lifted out of the program.
Groetjes Albert
Hi,
I tried to apply what I already done with CLP previously to this problem
Euler problem 177.
The solution I found is not really acceptable because it depends on the
tolerance to consider a float approximately as an integer.
But I still concerned with the CLP in forth.
Here is a new simplified version of applying CLP to this problem in
forth (gforth)
The code begins here
\ Euler_177
\ ----- for CLP
0 value vals_num
20 value vals_num_max
0 value min_val
0 value max_val
0 value nloops_prec
0 value nloops
0 value constraint_num
30 value max_num_constraints
0 value constraint_count
: values dup 1+ to vals_num 0 ?do 0 value loop ;
: fvalues 0 ?do 0e fvalue loop ;
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
create constraints_stack max_num_constraints cells allot
constraints_stack max_num_constraints cells erase
constraints_stack value constraints_stack_pointer
: push_to_constraints_stack
constraints_stack_pointer cell+ to constraints_stack_pointer
constraints_stack_pointer !
;
: pop_from_constraints_stack
constraints_stack_pointer dup @
swap cell- to constraints_stack_pointer
;
: update_constraints
constraint_num 1+ dup to constraint_count to constraint_num
nloops nloops_prec <> if
1 loop_loc constraint_num + c!
nloops to nloops_prec
then
;
: resolve_constraints
loop_loc constraint_num + c@ if
postpone loop
then
constraint_num 1- to constraint_num
;
: .---> nloops 1+ to nloops postpone do postpone i postpone to ;
immediate
: ----> postpone to ; immediate
: a| postpone then resolve_constraints ; immediate
: t| postpone then resolve_constraints ; immediate
: a?,
postpone min_val postpone max_val postpone 1+ postpone within
postpone if
update_constraints ['] a| push_to_constraints_stack
; immediate
: t?,
postpone if
update_constraints ['] t| push_to_constraints_stack
; immediate
: _begin_ ; immediate
: _end_
constraint_count 0 do
pop_from_constraints_stack execute
loop
; immediate
\ ---------end for CLP
\ Euler Problem 177
8 values DAC BAC ABD CBD BCA DCA CDB ADB
1 to min_val
179 to max_val
0 value count_max
8 fvalues aa bb cc dd ee ff gg hh
4 fvalues tab tcd tb tc
5 fvalues bx cx cy dx dy
1e to bx
2 fvalues dcx dcy
3 fvalues |ac| |dc| |bd|
: count_max++ count_max 1+ to count_max ;
3.16025e-3 fvalue tolerance_integer
: approx_integer f- fabs tolerance_integer f< ;
: approx_good fdup fround ftuck approx_integer ;
: rad>deg 180e f* pi f/ approx_good if f>s else fdrop -1 then ;
: deg>rad s>f pi f* 180e f/ ;
: DCA_calc \ Calculates the angle DCA using the rule of sines in a
triangle
\ I took the points A(0,0), B(bx,0), C (cx,cy) and
D(dx,dy), with bx = 1 for example
\ When we have the angles DAC, BAC, ABD and CBD, the points
C and D are well defined
\ geometrically so that cx, cy, dx and dy can be obtained
(analytic geometry)
\ and we can calculate the lengths |ac|, |bd| and |dc|
\ and then calculate the angle DCA
\
DAC deg>rad to aa
BAC deg>rad to bb
ABD deg>rad to cc
CBD deg>rad to dd
aa bb f+ ftan to tab
cc dd f+ ftan to tcd
bb ftan to tb
cc ftan to tc
bx tcd f* tcd tb f+ f/ to cx
tb cx f* to cy
bx tc f* tc tab f+ f/ to dx
tab dx f* to dy
cx dx f- to dcx
cy dy f- to dcy
cx fdup f* cy fdup f* f+ fsqrt to |ac|
dx bx f- fdup f* dy fdup f* f+ fsqrt to |bd|
dcx fdup f* dcy fdup f* f+ fsqrt to |dc|
CBD deg>rad fsin |bd| f* |dc| f/ fasin rad>deg BCA -
;
: solve
0 to count_max \ initialize the count of
the acceptable solutions
_begin_ \ begin solving with CLP
formalisme
180 1 .---> DAC DAC a?, \ from 1 to 179 choose
the value of the angle DAC,
\ if it is acceptable, go
ahead else choose the next
\ value for DAC and test
if acceptable ...
180 1 .---> BAC BAC a?, \ the same as above but
for BAC
DAC BAC + 180 <= t?, \ verify that the angle
BAD <= 180 (convex quadrilateral)
\ if it is true go ahead
else step back (backtrack)
180 1 .---> ABD ABD a?,
180 DAC - BAC - ABD - ----> ADB ADB a?,
180 1 .---> CBD CBD a?,
ABD CBD + 180 <= t?,
180 BAC - ABD - CBD - ----> BCA BCA a?, \ in the triangle ABC, we
have BAC+ABC+BCA = 180
\ so we can get BCA =
180-BAC-ABC = 180 -BAC-(ABD+CBD)
\ and if it is accepted
go ahead else backtrack
DCA_calc ----> DCA DCA a?, \ Here, we use the rule
of sines for the triangle ACD,
\ that states:
\ sin(CBD)/|cd| =
sin(BCD)/|bd| =sin(BDC)/|bc|
\ where |cd|, |bd| and
|bc| are the lengths of CD, BD and
\ BC segments. and from
that, we can write:
\ sin(CBD)/|cd| =
sin(BCD)/|bd|, so we can get
\ sin(BCD) =
sin(CBD)*|bd|/|cd|, and
\ BCD =
arcsin(sin(CBD)*|bd|/|cd|), but
\ BCD = BCA + DCA and BCA
is known, so we obtain:
\ DCA =
arcsin(sin(CBD)*|bd|/|cd|)-BCA
\ and this formula is
programmed in the word DCA_calc
DCA BCA + 180 <= t?,
180 CBD - BCA - DCA - ----> CDB CDB a?,
ADB CDB + 180 <= t?,
DAC BAC + ABD CBD +
BCA DCA + CDB ADB +
+ + + 360 = t?, \ The sum of the interior
angles of quadrilatrals = 360
count_max++ \ count the acceptable 8
angles (solutions)
_end_ \ the end of the CLP
;
: .solution count_max 8 / . ; \ I suppose (to be
verified) there are 8 similarities
\ 4 by rotation and 2 by
mirror symmetry ==> 4*2 = 8
: Euler_177 solve .solution ;
The code ends here.
I'm still playing with different simple CLP implementations in forth and
I haven't yet stabilized for a convenient approach.
Ahmed