For Programmers: Free Programming Magazines  


Home > Archive > Prolog > January 2006 > problem:4x4magicSquare in prolog









You are viewing an archived Text-only version of the thread. To view this thread in it's original format and/or if you want to reply to this thread please [click here]

 

Author problem:4x4magicSquare in prolog
lee.jinsong802@googlemail.com

2006-01-15, 7:12 pm

:-dynamic zerlegung/5.
%Zerlegung(C,N1,N2,N3,N4).
:-dynamic counter/1.
%counter(_C).
return.

init:-asserta(counter(0)),zerlegen(1,2).
zerlegen(17,_N).
zerlegen(N1,N2):-
N1=3D16,N2=3D16->
return;
not(N1=3D17),%wenn N1=3D17,dann endet
N2=3D17->
_N1 is N1+1,zerlegen(_N1,1);%wenn N2=3D17,dann
++N1,weite
N1 =3D N2->
_N2 is
N2+1,zerlegen(N1,_N2);%=E7=AC=AC=E4=B8=8
0=E4=BA=8C=E4=B8=AA=E6=95=B0=E4=B8=
=8D=E8=83=BD=E7=9B=B8=E7=AD=89
17 is N1+N2->
zerlegen_besonder(N1,N2);%wenn N1+N2=3D17,muss besonder
handeln
zerlegen_ander(N1,N2,1).

zerlegen_ander(N1,N2,N3):-
(N3=3DN1;N3=3DN2)-> %N3 =E5=92=8C=E5=89=8D=E4=B8=A4=E4=BD=
=8D=E4=B8=8D=E7=AD=89
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N4 is 34-N1-N2-N3,
(_N4=3DN1;_N4=3DN2)-> %N4 =E5=92=8C=E5=89=8D=E4=B8=A4=E4=
=BD=8D=E4=B8=8D=E7=AD=89
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N4 is 34-N1-N2-N3,
N3 >=3D _N4->
%N3=E5=A4=A7=E4=BA=8E=E7=AD=89=E4=BA=8EN
4,=E5=88=99=E5=AF=BB=E6=89=BE=E4=B8=
=8B=E4=B8=80=E4=B8=AAN2
_N2 is N2+1,
zerlegen(N1,_N2);
_N4 is 34-N1-N2-N3,
_N4 >=3D1,_N4 =3D< 16-> %N4=E5=9C=A81=E5=92=8C16=E4=B9=8B=
=E9=97=B4
erzeugen(N1,N2,N3,_N4),
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N3 is N3+1,zerlegen_ander(N1,N2,_N3).



zerlegen_besonder(N1,N2):-
(N1=3D1;N2=3D1)->
gleichhandel(N1,N2,2);
gleichhandel(N1,N2,1).

gleichhandel(N1,N2,8):-
(N1=3D8;N2=3D8)->
_N2 is N2+1,zerlegen(N1,_N2);
erzeugen(N1,N2,8,9),_N2 is
N2+1,zerlegen(N1,_N2). %=E5=A6=82=E6=9E=9C=E6=AD=A4=E5=A4=84=E4
=B8=8D=E5=81=
=9A=E5=A4=84=E7=90=86,=E4=BC=9A=E5=AF=BC
=E8=87=B4=E5=BE=AA=E7=8E=AF.
gleichhandel(N1,N2,17):-_N2 is N2+1,zerlegen(N1,_N2).
%gleichhandel(1,16,16):-zerlegen(2,1).
gleichhandel(N1,N2,N3):-% N1+N2=3D17 ,und N1 oder N2 ist nicht gleich 1
not(N3=3D17),
not(N3=3D8),
(N3=3DN1;N3=3DN2)->
%=E5=A6=82=E6=9E=9CN3=E7=AD=89=E4=BA=8E=
E5=89=8D=E4=B8=A4=E4=BD=8D=E4=B8=AD=
=E7=9A=84=E4=B8=80=E4=BD=8D,=E5=88=99=E5
=8A=A01,=E8=BF=9B=E8=A1=8C=E4=B8=8B=
=E4=B8=80=E4=B8=AA.
_N3 is N3+1,
gleichhandel(N1,N2,_N3);
_N3 is N3+1, %
=E6=9E=9CN3=E4=B8=8D=E7=AD=89=E4=BA=8E=E
5=89=8D=E4=B8=A4=E4=BD=8D=E4=B8=AD=
=E7=9A=84=E4=BB=BB=E4=BD=95=E4=B8=80=E4=
BD=8D,=E5=88=99=E5=8A=A0=E4=B8=80=
=E4=B8=AAzerlegung,=E8=BF=9B=E8=A1=8C=E4
=B8=8B=E4=B8=80=E4=B8=AA
_N4 is 17-N3,
erzeugen(N1,N2,N3,_N4),
gleichhandel(N1,N2,_N3).


erzeugen(N1,N2,N3,N4):- %=E4=BA=A7=E7=94=9F=E4=BB=A5N1,N2=E5=BC=
80=E5=A4=B4=
=E7=9A=84=E6=BB=A1=E8=B6=B3=E5=92=8C=E4=
B8=BA34=E7=9A=84=E6=8E=92=E5=88=97
counter(_C),
retract(counter(_)),
_Count is _C+2,
asserta(counter(_Count)),
_C1 is _C+1,
assertz(zerlegung(_C1,N1,N2,N3,N4)),

%nl,write('erzeugen'),write(_C1),write('
:'),write(N1),tab(3),write(N2),tab(=
3),write(N3),tab(3),write(N4),
_C2 is _C+2,

%nl,write('erzeugen'),write(_C2),write('
:'),write(N1),tab(3),write(N2),tab(=
3),write(N4),tab(3),write(N3),

assertz(zerlegung(_C2,N1,N2,N4,N3)).%nl,write('erzeugen2').

test_zerlegen:- retractall(zerlegung(_,_,_,_,_)),init,co
unter(_C),write('cou=
nter
=3D'),write(_C).



/*-------------------------------------------------------------------------=
--------------------
zu konstruktieren die Matrix
---------------------------------------------------------------------------=
--------------------*/

:-dynamic casenummber/1.
casenummber(0).


test_matrix:-
zerlegung(_,A11,A12,A13,A14),%line1
zerlegung(_,A21,A22,A23,A24),
not(member(A21,[A11,A12,A13,A14])), %line2
not(member(A22,[A11,A12,A13,A14])),
not(member(A23,[A11,A12,A13,A14])),
not(member(A24,[A11,A12,A13,A14])),
zerlegung(_,A31,A32,A33,A34), %line3
not(member(A31,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A32,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A33,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A34,[A11,A12,A13,A14,A21,A22,
A23,A24])),
A41 is 34-A11-A21-A31,%line 4
A42 is 34-A12-A22-A32,
A43 is 34-A13-A23-A33,
A44 is 34-A14-A24-A34,

not(member(A41,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A42,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A43,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A44,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),
A41>0,A41<17, A41\=3D=3DA42,A41\=3D=3DA43,A41\=3D=3DA4
4,
A42>0,A42<17, A42\=3D=3DA43,A42\=3D=3DA44,
A43>0,A43<17, A43\=3D=3DA44,
A44>0,A44<17,
34 is A41+A42+A43+A44,
34 is A11+A22+A33+A44,
34 is A14+A23+A32+A41,
nl,write('['),

write(A11),write(','),write(A12),write('
,'),write(A13),write(','),write(A14=
),write(','),

write(A21),write(','),write(A22),write('
,'),write(A23),write(','),write(A24=
),write(','),

write(A31),write(','),write(A32),write('
,'),write(A33),write(','),write(A34=
),write(','),

write(A41),write(','),write(A42),write('
,'),write(A43),write(','),write(A44=
),
write(']'),
/* nl,nl,

write(A11),tab(3),write(A12),tab(3),writ
e(A13),tab(3),write(A14),nl,nl,

write(A21),tab(3),write(A22),tab(3),writ
e(A23),tab(3),write(A24),nl,nl,

write(A31),tab(3),write(A32),tab(3),writ
e(A33),tab(3),write(A34),nl,nl,

write(A41),tab(3),write(A42),tab(3),writ
e(A43),tab(3),write(A44),nl,nl,
nl, */
casenummber(_X),
_Num is _X+1,
retract(casenummber(_)),asserta(casenumm
ber(_Num)),
fail.

what`s the problem with it?it `s running so slowly?

Bart Demoen

2006-01-16, 3:57 am

lee.jinsong802@googlemail.com wrote:
> :-dynamic zerlegung/5.

[...]
> what`s the problem with it?it `s running so slowly?
>


Most probably the fact that you use assert/retract. But to be sure ...

Could you repost your program without comments, properly indented and with the query you
find too slow ? Also: what problem are you trying to solve ?

Cheers

Bart Demoen
lee.jinsong802@googlemail.com

2006-01-16, 7:04 pm


pls just give me a hand for correcting the follwing program: 4x4
magic square, output all results. however it must be done in about
10mins im computer.

i need too long time(2-3 hours) to run my program . there must be
something wrong inside.



% Author:
% Date: 2006-1-13
:-dynamic zerlegung/5.
%Zerlegung(C,N1,N2,N3,N4).
:-dynamic counter/1.
%counter(_C).
return.

init:-asserta(counter(0)),zerlegen(1,2).
zerlegen(17,_N).
zerlegen(N1,N2):-
N1=16,N2=16->
return;
not(N1=17),
N2=17->
_N1 is N1+1,zerlegen(_N1,1);
N1 = N2->
_N2 is N2+1,zerlegen(N1,_N2);
17 is N1+N2->
zerlegen_besonder(N1,N2);
zerlegen_ander(N1,N2,1).

zerlegen_ander(N1,N2,N3):-
(N3=N1;N3=N2)->
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N4 is 34-N1-N2-N3,
(_N4=N1;_N4=N2)->
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N4 is 34-N1-N2-N3,
N3 >= _N4->
_N2 is N2+1,
zerlegen(N1,_N2);
_N4 is 34-N1-N2-N3,
_N4 >=1,_N4 =< 16->
erzeugen(N1,N2,N3,_N4),
_N3 is N3+1,zerlegen_ander(N1,N2,_N3);
_N3 is N3+1,zerlegen_ander(N1,N2,_N3).



zerlegen_besonder(N1,N2):-
(N1=1;N2=1)->
gleichhandel(N1,N2,2);
gleichhandel(N1,N2,1).

gleichhandel(N1,N2,8):-
(N1=8;N2=8)->
_N2 is N2+1,zerlegen(N1,_N2);
erzeugen(N1,N2,8,9),_N2 is
N2+1,zerlegen(N1,_N2).
gleichhandel(N1,N2,17):-_N2 is N2+1,zerlegen(N1,_N2).

gleichhandel(N1,N2,N3):-
not(N3=17),
not(N3=8),
(N3=N1;N3=N2)->
_N3 is N3+1,
gleichhandel(N1,N2,_N3);
_N3 is N3+1,
_N4 is 17-N3,
erzeugen(N1,N2,N3,_N4),
gleichhandel(N1,N2,_N3).


erzeugen(N1,N2,N3,N4):-
counter(_C),
retract(counter(_)),
_Count is _C+2,
asserta(counter(_Count)),
_C1 is _C+1,
assertz(zerlegung(_C1,N1,N2,N3,N4)),
_C2 is _C+2,
assertz(zerlegung(_C2,N1,N2,N4,N3)).

test_zerlegen:- retractall(zerlegung(_,_,_,_,_)),init,co
unter(_C),write('counter
='),write(_C).



/*---------------------------------------------------------------------------------------------
zu konstruktieren die Matrix
-----------------------------------------------------------------------------------------------*/

:-dynamic casenummber/1.
casenummber(0).


test_matrix:-
zerlegung(_,A11,A12,A13,A14),
zerlegung(_,A21,A22,A23,A24),
not(member(A21,[A11,A12,A13,A14])),
not(member(A22,[A11,A12,A13,A14])),
not(member(A23,[A11,A12,A13,A14])),
not(member(A24,[A11,A12,A13,A14])),
zerlegung(_,A31,A32,A33,A34),
not(member(A31,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A32,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A33,[A11,A12,A13,A14,A21,A22,
A23,A24])),
not(member(A34,[A11,A12,A13,A14,A21,A22,
A23,A24])),
A41 is 34-A11-A21-A31,
A42 is 34-A12-A22-A32,
A43 is 34-A13-A23-A33,
A44 is 34-A14-A24-A34,

not(member(A41,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A42,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A43,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),

not(member(A44,[A11,A12,A13,A14,A21,A22,
A23,A24,A31,A32,A33,A34])),
A41>0,A41<17, A41\==A42,A41\==A43,A41\==A44,
A42>0,A42<17, A42\==A43,A42\==A44,
A43>0,A43<17, A43\==A44,
A44>0,A44<17,
34 is A41+A42+A43+A44,
34 is A11+A22+A33+A44,
34 is A14+A23+A32+A41,
nl,write('['),

write(A11),write(','),write(A12),write('
,'),write(A13),write(','),write(A14),wri
te(','),

write(A21),write(','),write(A22),write('
,'),write(A23),write(','),write(A24),wri
te(','),

write(A31),write(','),write(A32),write('
,'),write(A33),write(','),write(A34),wri
te(','),

write(A41),write(','),write(A42),write('
,'),write(A43),write(','),write(A44),
write(']'),
/* nl,nl,

write(A11),tab(3),write(A12),tab(3),writ
e(A13),tab(3),write(A14),nl,nl,

write(A21),tab(3),write(A22),tab(3),writ
e(A23),tab(3),write(A24),nl,nl,

write(A31),tab(3),write(A32),tab(3),writ
e(A33),tab(3),write(A34),nl,nl,

write(A41),tab(3),write(A42),tab(3),writ
e(A43),tab(3),write(A44),nl,nl,
nl, */
casenummber(_X),
_Num is _X+1,
retract(casenummber(_)),asserta(casenumm
ber(_Num)),
fail.

Jan Wielemaker

2006-01-16, 7:04 pm

On 2006-01-16, lee.jinsong802@googlemail.com <lee.jinsong802@googlemail.com> wrote:
>
> pls just give me a hand for correcting the follwing program: 4x4
> magic square, output all results. however it must be done in about
> 10mins im computer.
>
> i need too long time(2-3 hours) to run my program . there must be
> something wrong inside.


If you write in German and use unreadable layout you cannot expect that
many replies. Bart gave you the suggestion to fix the layout and avoid
assert/retract. Thats a very good start. I'll do one predicate.

> zerlegen(17,_N).
> zerlegen(N1,N2):-
> N1=16,N2=16->
> return;
> not(N1=17),
> N2=17->
> _N1 is N1+1,zerlegen(_N1,1);
> N1 = N2->
> _N2 is N2+1,zerlegen(N1,_N2);
> 17 is N1+N2->
> zerlegen_besonder(N1,N2);
> zerlegen_ander(N1,N2,1).


Why two clauses, one with a single case and the other with multiple
using if-then-else?? There is something to be said for both, but
mixing is generally very bad style. Also, `return' is not part of
Prolog, so either this case doesn't occur or your program misbehaves
(if your prolog doesn't trap undefined predicates as errors) or your
program generates an error. One style might be:

zerlegen(17, _) :- !.
zerlegen(16, 16) :- !.
zerlegen(N, 17) :- !,
N1 is N + 1,
zerlegen(N1, 17).
zerlegen(N, N) :- !,
N2 is N + 1,
zerlegen(N, N2).
zerlegen(N1, N2) :-
17 =:= N1 + N2, !,
zerlegen_besonder(N1,N2).
zerlegen(N1, N2) :-
zerlegen_ander(N1,N2,1).

I think this is the correct translation of this predicate. This
version doesn't leave a choicepoint for N1=17. It also doesn't
call return. It will only be a bit faster. Avoiding assert/retract
can make a real diference.

--- Jan
Bart Demoen

2006-01-16, 7:04 pm

lee.jinsong802@googlemail.com wrote:
> pls just give me a hand for correcting the follwing program: 4x4
> magic square, output all results. however it must be done in about
> 10mins im computer.


Please tell us which is the query.
Please tell us which Prolog system you are using.

lee.jinsong802@googlemail.com

2006-01-18, 7:58 am


Bart Demoen wrote:
> lee.jinsong802@googlemail.com wrote:
>
> Please tell us which is the query.
> Please tell us which Prolog system you are using.


a 4x4 magic square mit all answer and output
with swi-prolog

Bart Demoen

2006-01-18, 7:02 pm

lee.jinsong802@googlemail.com wrote:
> Bart Demoen wrote:
>
>
>
> a 4x4 magic square mit all answer and output
> with swi-prolog
>


What is the query ?

?- test_matrix.

No



?- test_zerlegen.
counter
=2064

Yes

both almost immediately.

If you want us to help you, help us making help you easier, by telling
us at least what the query is.

BTW, when is your deadline ?
Sponsored Links







Also available: Server administration forum archive | Web Design forum archive | Software forum archive | Hardware reviews archive

Copyright 2008 codecomments.com