This puzzle was originally posted on a mailing list for the Icon
programming language. Thought members of this group might also
want to give it a shot.
VIER and NEUN represent 4-digit squares, each letter denoting a
distinct digit. You are asked to find the value of each, given the
further requirement that each uniquely determines the other.
The "further requirement" means that of the numerous pairs of
answers, choose the one in which each number only appears once
in all of the pairs.
Steve Graham
----- Posted via NewsOne.Net: Free (anonymous) Usenet News via the Web -----
http://newsone.net/ -- Free reading and anonymous posting to 60,000+ groups
NewsOne.Net prohibits users from posting spam. If this or other posts
made through NewsOne.Net violate posting guidelines, email ·····@newsone.net
>This puzzle was originally posted on a mailing list for the Icon
>programming language. Thought members of this group might also
>want to give it a shot.
>VIER and NEUN represent 4-digit squares, each letter denoting a
>distinct digit. You are asked to find the value of each, given the
>further requirement that each uniquely determines the other.
>The "further requirement" means that of the numerous pairs of
>answers, choose the one in which each number only appears once
>in all of the pairs.
Here's a pretty "LOOPy" way of doing it...
;;;; VIER and NEUN are four digit numbers that are perfect squares.
;;;; Choose the values for V, I, E, R, N, and U from [0 .. 9]
(defun squarep-slow (x)
(= 0
(multiple-value-bind (v rm)
(truncate (sqrt x))
rm)))
(defparameter *squares*
(make-array 10001))
(loop for i from 1 to 10000
when (squarep-slow i)
do (setf (aref *squares* i) t))
(defun squarep (x)
(aref *squares* x))
(defun amt (v1 v2 v3 v4)
(+ v4 (* 10 (+ v3 (* 10 (+ v2 (* 10 v1)))))))
;;;; Choose the values for V, I, E, R, N, and U from [0 .. 9]
(defun findvier ()
(let ((answers '()))
(loop
with digits = (loop
for i from 0 to 9
collect i)
for v in digits
do (loop
with lv = (remove v digits)
for i in lv
do (loop
with li = (remove i lv)
for e in li
do (loop
with le = (remove e li)
for r in le
do (loop
with lr = (remove r le)
for n in lr
do (loop
with ln = (remove n lr)
for u in ln
for vier = (amt v i e r)
for neun = (amt n e u n)
when (and (squarep vier) (squarep neun))
do (push (list vier neun) answers)))))))
answers))
..
6. Break [16]> (findvier)
((7569 4624) (7569 1681) (7056 1521) (6241 9409) (4761 5625) (4356 1521)
(1764 5625) (1369 5625) (1369 4624) (961 5625) (961 4624) (361 5625)
(361 4624) (169 5625) (169 4624)
)
6. Break [16]>
--
(concatenate 'string "cbbrowne" ·@acm.org")
http://vip.hex.net/~cbbrowne/finances.html
Rules of the Evil Overlord #177. "If a scientist with a beautiful and
unmarried daughter refuses to work for me, I will not hold her
hostage. Instead, I will offer to pay for her future wedding and her
children's college tuition." <http://www.eviloverlord.com/>
<········@my-deja.com> wrote in message ·················@news.netmar.com...
> This puzzle was originally posted on a mailing list for the Icon
> programming language. Thought members of this group might also
> want to give it a shot.
>
> VIER and NEUN represent 4-digit squares, each letter denoting a
> distinct digit. You are asked to find the value of each, given the
> further requirement that each uniquely determines the other.
>
> The "further requirement" means that of the numerous pairs of
> answers, choose the one in which each number only appears once
> in all of the pairs.
You mean if I know what VIER is there exists only one unique sol'n
for NEUN and vice versa? Cute, that leaves only one case.
Geoff - I may not know Lisp, but my Prolog's not bad! :-)
"Geoff Summerhayes" <·············@hNoOtSmPaAiMl.com> wrote in message
···················@corp.supernews.com...
>
> <········@my-deja.com> wrote in message
·················@news.netmar.com...
> > This puzzle was originally posted on a mailing list for the Icon
> > programming language. Thought members of this group might also
> > want to give it a shot.
> >
> > VIER and NEUN represent 4-digit squares, each letter denoting a
> > distinct digit. You are asked to find the value of each, given the
> > further requirement that each uniquely determines the other.
> >
> > The "further requirement" means that of the numerous pairs of
> > answers, choose the one in which each number only appears once
> > in all of the pairs.
>
> You mean if I know what VIER is there exists only one unique sol'n
> for NEUN and vice versa? Cute, that leaves only one case.
>
> Geoff - I may not know Lisp, but my Prolog's not bad! :-)
If you like Prolog you should look at Screamer:
http://www.cis.upenn.edu/~screamer-tools/home.html
Marc
In article <············@news.netmar.com>, ········@my-deja.com wrote:
> This puzzle was originally posted on a mailing list for the Icon
> programming language. Thought members of this group might also
> want to give it a shot.
>
> VIER and NEUN represent 4-digit squares, each letter denoting a
> distinct digit. You are asked to find the value of each, given the
> further requirement that each uniquely determines the other.
>
> The "further requirement" means that of the numerous pairs of
> answers, choose the one in which each number only appears once
> in all of the pairs.
No doubt APL is shorter, but good old perl ain't too bad...
#!/usr/local/bin/perl
for $a(32..99){b:for $b(32..99){
@cnt=();
for(1..8){$cnt[substr($a*$a.$b*$b,$_-1,1)].=$_}
for(0..9){next b if(sort{$b<=>···@cnt)[$_]!=(58,36,7,4,2,1)[$_]}
$a{$a}++;$b{$b}++;$p{$a}=$b
}}
while(($a,$b)=each%p){print$a*$a," ",$b*$b,"\n"if$a{$a}*$b{$b}==1}
Bruce Hoult wrote:
>
> In article <············@news.netmar.com>, ········@my-deja.com wrote:
>
> > This puzzle was originally posted on a mailing list for the Icon
> > programming language. Thought members of this group might also
> > want to give it a shot.
> >
> > VIER and NEUN represent 4-digit squares, each letter denoting a
> > distinct digit. You are asked to find the value of each, given the
> > further requirement that each uniquely determines the other.
> >
> > The "further requirement" means that of the numerous pairs of
> > answers, choose the one in which each number only appears once
> > in all of the pairs.
>
> No doubt APL is shorter, but good old perl ain't too bad...
>
> #!/usr/local/bin/perl
> for $a(32..99){b:for $b(32..99){
> @cnt=();
> for(1..8){$cnt[substr($a*$a.$b*$b,$_-1,1)].=$_}
> for(0..9){next b if(sort{$b<=>···@cnt)[$_]!=(58,36,7,4,2,1)[$_]}
> $a{$a}++;$b{$b}++;$p{$a}=$b
> }}
> while(($a,$b)=each%p){print$a*$a," ",$b*$b,"\n"if$a{$a}*$b{$b}==1}
No doubt perl is shorter but this naive Smalltalk implementation is more
intention revealing ;-)
---------------------------
| squares neuns pairs tallies results |
squares := (1000 sqrt ceiling to: 9999 sqrt truncated)
collect: [ :n | n squared printString ].
neuns := squares select: [ :string |
string first == string last
and: [string asSet size==3]].
pairs := OrderedCollection new.
tallies := Bag new.
squares do: [ :square |
neuns do: [ :neun |
((square at: 3 )==(neun at: 2)
and: [(square,neun) asSet size = 6])
ifTrue: [
pairs add: square -> neun.
tallies add: square; add: neun ]]].
results := pairs select: [ :pair |
(tallies occurrencesOf: pair key) == 1
and: [(tallies occurrencesOf: pair value) == 1]]
---------------------------
this code yields results =
OrderedCollection ('6241'->'9409')
Cheers!
Reinout Heeck
-------------
·····@desk.org
In Python:
from math import sqrt
def uniq(chars):
d = {}
for c in chars:
d[c] = 1
return d.keys()
vs = []
ns = []
sqrs = ["%d" % n**2 for n in range(sqrt(1000)+1, sqrt(9999))]
for vier in sqrs:
for neun in sqrs:
if (neun[0] == neun[3] and neun[1] == vier[2] and
len(uniq(vier + neun)) == 6):
vs.append(vier)
ns.append(neun)
for v, n in zip(vs, ns):
if vs.count(v) == ns.count(n) == 1:
print "Found", v, n
To all the peopl who have posted solutions.
I am collecting them and will publish a few, in particular the APL and J
ones but some written in other languages as well for comparison, hopefully
not to feed a silly language flame war, on a small magazine of the British
APL Association, for which I am now the editor.
You can have a look at an online version of the magazine at this webpage:
http://www.vector.org.uk/ where you can find sample of articles published in
the printed version. As you can see while a serious magazine, it's also
reasonably informal, therefore there is no shame at all involved in having
published code which could be thought as less than optimal. Instead, there's
a good chance that a version quickly hacked together would have some
pedagogic and exemplar value because it shows what the language is capable
of when put to the edges.
Anyway, my question is: if the author of any of the solution appeared in
these newsgroups (I have APL, J, K, MUMPS, Common Lisp, Dylan, Smalltalk,
Perl, Python from which to choose from) strongly objects to have his
solution published against his or her name, to please let me know and I will
remove the solution from my pool. Otherwise I'll work on the assumption that
by posting a message in a public newsgroups the author implicitely indicated
that, while not necessary proud, does not mind to see his work published for
public consumption.
By the way, it's quite likely that the readers of Vector are less than the
sums of the readers of these newgroups...
Thank you everybody, and I hope you shared my fun in the solution of the
little puzzle and in the comparison of the different languages.
--
WildHeart'2k1 (at home)
Stefano,
I'm been quite pleased with the reception which this puzzle has received,
particularly in the APL newsgroup. You can see a compilation of most of the
solutions at http://members.home.net/js.graham/vierneun.html
Best of luck.
Steve Graham
P.S. Would anyone be interested in another, slightly more complex puzzle???
===
"Stefano Lanzavecchia" <········@hotmail.com> wrote in message
·················@pegasus.tiscalinet.it...
> To all the peopl who have posted solutions.
> I am collecting them and will publish a few, in particular the APL and J
> ones but some written in other languages as well for comparison, hopefully
> not to feed a silly language flame war, on a small magazine of the British
> APL Association, for which I am now the editor.
> You can have a look at an online version of the magazine at this webpage:
> http://www.vector.org.uk/ where you can find sample of articles published
in
> the printed version. As you can see while a serious magazine, it's also
> reasonably informal, therefore there is no shame at all involved in having
> published code which could be thought as less than optimal. Instead,
there's
> a good chance that a version quickly hacked together would have some
> pedagogic and exemplar value because it shows what the language is capable
> of when put to the edges.
>
> Anyway, my question is: if the author of any of the solution appeared in
> these newsgroups (I have APL, J, K, MUMPS, Common Lisp, Dylan, Smalltalk,
> Perl, Python from which to choose from) strongly objects to have his
> solution published against his or her name, to please let me know and I
will
> remove the solution from my pool. Otherwise I'll work on the assumption
that
> by posting a message in a public newsgroups the author implicitely
indicated
> that, while not necessary proud, does not mind to see his work published
for
> public consumption.
>
> By the way, it's quite likely that the readers of Vector are less than the
> sums of the readers of these newgroups...
>
> Thank you everybody, and I hope you shared my fun in the solution of the
> little puzzle and in the comparison of the different languages.
> --
> WildHeart'2k1 (at home)
>
>
You missed Marc Battyani's solution. The Lisp versions you included look a
little verbose.
--------------->>>>>>
I should work, but couldn't resist...
A Lisp version:
(let ((sqrs (loop for i from (ceiling (sqrt 1000)) upto (isqrt 9999)
collect (format nil "~d" (* i i))))
(vns '()))
(dolist (vier sqrs)
(dolist (neun sqrs)
(when (and (char= (aref neun 0)(aref neun 3))
(char= (aref vier 2)(aref neun 1))
(char/= (aref vier 0)(aref vier 1)(aref vier 2)
(aref vier 3)(aref neun 0)(aref neun 2)))
(push (list vier neun) vns))))
(loop for (v n) in vns do
(if (= 1 (count v vns :key #'first)(count n vns :key #'second))
(format t "~%Found ~a ~a~%~%" v n))))
Found 6241 9409
Marc
"Steve Graham" <·········@home.com> wrote in message
·······························@news2.rdc2.tx.home.com...
> Stefano,
>
> I'm been quite pleased with the reception which this puzzle has
received,
> particularly in the APL newsgroup. You can see a compilation of most of
the
> solutions at http://members.home.net/js.graham/vierneun.html
>
> Best of luck.
>
>
> Steve Graham
>
> P.S. Would anyone be interested in another, slightly more complex
puzzle???
>
> ===
>
> "Stefano Lanzavecchia" <········@hotmail.com> wrote in message
> ·················@pegasus.tiscalinet.it...
> > To all the peopl who have posted solutions.
> > I am collecting them and will publish a few, in particular the APL and J
> > ones but some written in other languages as well for comparison,
hopefully
> > not to feed a silly language flame war, on a small magazine of the
British
> > APL Association, for which I am now the editor.
> > You can have a look at an online version of the magazine at this
webpage:
> > http://www.vector.org.uk/ where you can find sample of articles
published
> in
> > the printed version. As you can see while a serious magazine, it's also
> > reasonably informal, therefore there is no shame at all involved in
having
> > published code which could be thought as less than optimal. Instead,
> there's
> > a good chance that a version quickly hacked together would have some
> > pedagogic and exemplar value because it shows what the language is
capable
> > of when put to the edges.
> >
> > Anyway, my question is: if the author of any of the solution appeared in
> > these newsgroups (I have APL, J, K, MUMPS, Common Lisp, Dylan,
Smalltalk,
> > Perl, Python from which to choose from) strongly objects to have his
> > solution published against his or her name, to please let me know and I
> will
> > remove the solution from my pool. Otherwise I'll work on the assumption
> that
> > by posting a message in a public newsgroups the author implicitely
> indicated
> > that, while not necessary proud, does not mind to see his work published
> for
> > public consumption.
> >
> > By the way, it's quite likely that the readers of Vector are less than
the
> > sums of the readers of these newgroups...
> >
> > Thank you everybody, and I hope you shared my fun in the solution of the
> > little puzzle and in the comparison of the different languages.
> > --
> > WildHeart'2k1 (at home)
> >
> >
>
>
"Wade Humeniuk" <········@cadvision.com> wrote in message
·················@news3.cadvision.com...
> You missed Marc Battyani's solution. The Lisp versions you included look
a
> little verbose.
>
> --------------->>>>>>
>
> I should work, but couldn't resist...
> A Lisp version:
>
> (let ((sqrs (loop for i from (ceiling (sqrt 1000)) upto (isqrt 9999)
> collect (format nil "~d" (* i i))))
> (vns '()))
> (dolist (vier sqrs)
> (dolist (neun sqrs)
> (when (and (char= (aref neun 0)(aref neun 3))
> (char= (aref vier 2)(aref neun 1))
> (char/= (aref vier 0)(aref vier 1)(aref vier 2)
> (aref vier 3)(aref neun 0)(aref neun 2)))
> (push (list vier neun) vns))))
> (loop for (v n) in vns do
> (if (= 1 (count v vns :key #'first)(count n vns :key #'second))
> (format t "~%Found ~a ~a~%~%" v n))))
>
> Found 6241 9409
>
> Marc
>
Very nice, I'm ashamed to be included in such company. If I'd known
my solution would be the only one in the Prolog NG, I would have spent
time writing a better solution. For interests sake, my total
development time on the problem was about 10 minutes. 5 to write something
that provided all the pairs, then after reading the problem again and
finally
understanding the last part, 5 more putting the finish on, including
cleaning up and finding reasonable names for the predicates. I assume Lisp
was about
the same, I was wondering how other languages did, time-wise. Of course, the
nice
thing about Prolog is that it is suited for this kind of thing, the
description
of the problem *is* the program.
Geoff
P.S. Steve, bring them on, haven't had this much fun since finding the
on-line
acm contest judge.
Can't help be throw a very verbose and fly right at it Delphi solution
in... Certaily isn't 5 lines like the K solution, but then I can't read
the K solution ;^).
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Function Match(I,J : Integer): Boolean;
Procedure FindMatches;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Function TForm1.Match(I,J : Integer): Boolean;
Var S : String;
K, L : Byte;
Begin
Result := False; // Assume no match
S := IntToStr(Sqr(I)) + IntToStr(Sqr(J)); // Build string
If (S[3] <> S[6]) or (S[5] <> S[8]) then // Check the E's and N's
Exit; // Exit if not matched
S := S[1] + S[2] + S[3] + S[4] + S[5] + S[7]; // Remove dup E's and N's
For K := 1 to Length(S) - 1 Do // Scan for dups
For L := K + 1 to Length(S) Do
If S[K] = S[L] then // If dup found
Exit; // Exit
Result := True; // Good match if this far
End;
Procedure TForm1.FindMatches;
Var I, J, A, B : Byte;
Begin
For I := 34 to 89 do
Begin
A := I div 10; B := I mod 10; // Get digits
If A <> B then // Can't work if equal
Begin
J := A + (B * 10); // Transpose digits
If Match(I,J) then // Check for match
Memo1.Lines.Add( 'VIER = ' + IntToStr(Sqr(I)) +
' NEUN = ' + IntToStr(Sqr(J)) +
' (' + IntToStr(I) + ',' + IntToStr(J) + ')');
End;
End;
End;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindMatches;
end;
end.
Jeff.
"Steve Graham" <·········@home.com> wrote in message ·······························@news2.rdc2.tx.home.com...
> I'm been quite pleased with the reception which this puzzle has received,
> particularly in the APL newsgroup. You can see a compilation of most of the
> solutions at http://members.home.net/js.graham/vierneun.html
It is interesting to look at the solution strategies followed. Unfortunately
I can't read (most) of them... It would be nice if there were explanations of
the diverse approaches for non-multilinguists to read.
For instance, APL has a 5 line solution, but seems to use a monstrous
array on which it does pattern matching? I could (and would like to)
learn a great deal by implementing such strategies in other languages.
-marcel
> It is interesting to look at the solution strategies followed.
Unfortunately
> I can't read (most) of them... It would be nice if there were explanations
of
> the diverse approaches for non-multilinguists to read.
As far as I can tell, apart from minor details, the Python, Smalltalk and
Dylan (and the Ocaml I derived mixing the 3 I just mentioned) are pretty
much the same.
The prolog solution is interesting because it almost literally (in English)
implement the statement of the problem.
> For instance, APL has a 5 line solution, but seems to use a monstrous
> array on which it does pattern matching? I could (and would like to)
> learn a great deal by implementing such strategies in other languages.
The APL and J solutions (and the K derived from the latter), while harder to
read, also implement the statement quite literally but only to trained eyes.
In particular the array mentioned is of moderate size. In one of the
solutions proposed, the outer product of all the possible squares is still
only a less than 5000 elements array (68*68).
I would be glad to get into the details of the APL or J solutions, but once
I tried and I quickly figured out that it would require too many details on
the languages themselves.
J (and K) and all its documentation and tutorials can be downloaded for free
from the web pages of the vendors producing the interpreters and, if
interested, I recommend the download. The installation procedure is, in both
cases, very easy and quite unintrusive and the documentation includes
primers which explain a good deal about the language and can guide a
beginner to become proficient enough to understand the solutions proposed.
--
WildHeart'2k1
"WildHeart'2k1" <············@apl.it> wrote in message
··················@stargate1.inet.it...
>
>
> The prolog solution is interesting because it almost literally (in English)
> implement the statement of the problem.
>
Unfortunately, the Prolog solution has a flaw in it that isn't exposed because
the problem only has one solution. write/1 doesn't allow backtracking, the
program as it stood only produced the first solution it came across.
My revised solution follows, I've altered the digit-picking logic to do the
comparisons automatically instead of having to hand-code them, takes longer
but is scalable. create_number/3 is also more general than before.
I've also altered some of the variable names to make the logic a little clearer.
leading_digit(X,L,[X|L]) :-
member(X,[1,2,3,4,5,6,7,8,9]),
\+ member(X,L).
digit(X,L,[X|L]) :-
member(X,[0,1,2,3,4,5,6,7,8,9]),
\+ member(X,L).
pure_square(A) :-
B is round(sqrt(A)), A is B * B.
create_number([],N,N).
create_number([H|T],N,NR):-
N1 is N*10+H,
create_number(T,N1,NR).
passes_criteria(V,I,E,R,N,U,VIER,NEUN) :-
create_number([V,I,E,R],0,VIER),
create_number([N,E,U,N],0,NEUN),
pure_square(VIER),pure_square(NEUN).
possible_solutions(VIER,NEUN) :-
leading_digit(V,[],L), leading_digit(N,L,L1),
digit(I,L1,L2), digit(E,L2,L3),
digit(R,L3,L4), digit(U,L4,_),
passes_criteria(V,I,E,R,N,U,VIER,NEUN).
count_matches(_,[],0).
count_matches([X,Y],[[X,_]|T],V):-!,count_matches([X,Y],T,V1),V is V1 + 1.
count_matches([X,Y],[[_,Y]|T],V):-!,count_matches([X,Y],T,V1),V is V1 + 1.
count_matches(A,[_|T],V):-count_matches(A,T,V).
solve(V,N):-
bagof([X,Y],possible_solutions(X,Y),Possibles),
member([V,N],Possibles),
count_matches([V,N],Possibles,Count),
1 is Count.
% d:/prolog/lisp.prolog compiled 0.00 sec, 5,780 bytes
?- solve(VIER,NEUN).
VIER = 6241
NEUN = 9409 ;
No
?-
---Geoff---
I coded up a Prolog + CLP(FD) solution. I have a well-documented
version of it available, but since no one else provided comments,
I won't either. :-) The CLP(FD) engine I am using is provided
by Sicstus Prolog. The run time is about 40msec on a Sparc Ultra10.
% sictus prolog file: vn.pl
:- use_module(library(clpfd)).
:- use_module(library(lists)).
solve(P,Q) :-
setof((PP,QQ), pair(PP,QQ), Pairs),
unique(Pairs, (P,Q)).
unique(Pairs, (P,Q)) :-
select((P,Q), Pairs, Rs),
\+ member((P,_), Rs),
\+ member((_,P), Rs),
\+ member((Q,_), Rs),
\+ member((_,Q), Rs).
pair(P,Q) :-
domain([V,I,E,R,N,U], 0, 9),
P #= V*1000 + I*100 + E*10 + R,
Q #= N*1000 + E*100 + U*10 + N,
V #> 0,
N #> 0,
domain([X1,X2,Y1,Y2], 0, 9),
X #= X1*10 + X2,
Y #= Y1*10 + Y2,
X1 #> 0,
Y1 #> 0,
P #= X*X,
Q #= Y*Y,
all_different([V,I,E,R,N,U]),
labeling([], [P,Q]).
% eof
Mike
--
Michael C. Horsch
Department of Computer Science
University of Saskatchewan
http://www.cs.usask.ca/faculty/horsch/home.shtml
I looked on decitions in different languages - python looked best - most
easily understood and fairly short.
I cannot understand prolog decition at all. Of course it is my fault
also.
Michael Horsch wrote:
> I coded up a Prolog + CLP(FD) solution. I have a well-documented
> version of it available, but since no one else provided comments,
> I won't either. :-) The CLP(FD) engine I am using is provided
> by Sicstus Prolog. The run time is about 40msec on a Sparc Ultra10.
>
> % sictus prolog file: vn.pl
> :- use_module(library(clpfd)).
> :- use_module(library(lists)).
>
> solve(P,Q) :-
> setof((PP,QQ), pair(PP,QQ), Pairs),
> unique(Pairs, (P,Q)).
>
> unique(Pairs, (P,Q)) :-
> select((P,Q), Pairs, Rs),
> \+ member((P,_), Rs),
> \+ member((_,P), Rs),
> \+ member((Q,_), Rs),
> \+ member((_,Q), Rs).
>
> pair(P,Q) :-
> domain([V,I,E,R,N,U], 0, 9),
> P #= V*1000 + I*100 + E*10 + R,
> Q #= N*1000 + E*100 + U*10 + N,
> V #> 0,
> N #> 0,
> domain([X1,X2,Y1,Y2], 0, 9),
> X #= X1*10 + X2,
> Y #= Y1*10 + Y2,
> X1 #> 0,
> Y1 #> 0,
> P #= X*X,
> Q #= Y*Y,
> all_different([V,I,E,R,N,U]),
> labeling([], [P,Q]).
>
> % eof
>
> Mike
> --
> Michael C. Horsch
> Department of Computer Science
> University of Saskatchewan
> http://www.cs.usask.ca/faculty/horsch/home.shtml
On Wed, 11 Apr 2001 17:40:36 -0400, Mikhail Gambarian wrote:
>I looked on decitions in different languages - python looked best - most
>easily understood and fairly short.
>I cannot understand prolog decition at all. Of course it is my fault
>also.
The Prolog definition is without doubt the most straightforward -- but you
have to know a little bit about Prolog to understand it. Prolog is a
logical programming language -- you state the logical constraints, and
Prolog generates code which meets those constraints.
Look at the code, and notice how everything it says is simply a
restatement of the original problem description. There's hardly room for
a bug (said with a wry smile).
I believe that a good programmer should take time every once in a while to
learn a really different language, different from all the others you know.
Prolog is a good candidate.
-Billy
>Michael Horsch wrote:
>
>> I coded up a Prolog + CLP(FD) solution. I have a well-documented
>> version of it available, but since no one else provided comments,
>> I won't either. :-) The CLP(FD) engine I am using is provided
>> by Sicstus Prolog. The run time is about 40msec on a Sparc Ultra10.
>>
>> % sictus prolog file: vn.pl
>> :- use_module(library(clpfd)).
>> :- use_module(library(lists)).
>>
>> solve(P,Q) :-
>> setof((PP,QQ), pair(PP,QQ), Pairs),
>> unique(Pairs, (P,Q)).
>>
>> unique(Pairs, (P,Q)) :-
>> select((P,Q), Pairs, Rs),
>> \+ member((P,_), Rs),
>> \+ member((_,P), Rs),
>> \+ member((Q,_), Rs),
>> \+ member((_,Q), Rs).
>>
>> pair(P,Q) :-
>> domain([V,I,E,R,N,U], 0, 9),
>> P #= V*1000 + I*100 + E*10 + R,
>> Q #= N*1000 + E*100 + U*10 + N,
>> V #> 0,
>> N #> 0,
>> domain([X1,X2,Y1,Y2], 0, 9),
>> X #= X1*10 + X2,
>> Y #= Y1*10 + Y2,
>> X1 #> 0,
>> Y1 #> 0,
>> P #= X*X,
>> Q #= Y*Y,
>> all_different([V,I,E,R,N,U]),
>> labeling([], [P,Q]).
>>
>> % eof
>>
>> Mike
>> --
>> Michael C. Horsch
>> Department of Computer Science
>> University of Saskatchewan
>> http://www.cs.usask.ca/faculty/horsch/home.shtml
>
--
-William "Billy" Tanksley
It's plain to see that I am not an ace MLer... But for completeness...
Here's my contribution in Ocaml.
let range from to_ =
let rec r_ from to_ acc =
if from > to_ then
List.rev acc
else r_ (from + 1) to_ (from :: acc)
in
r_ from to_ [];;
let vierneun =
let squares =
let lbound = truncate(ceil(sqrt(1000.0)))
and ubound = truncate(sqrt(9999.0))
and strsq f = string_of_int (f * f) in
List.map strsq (range lbound ubound)
in let countuniq s =
let rec c_ s i acc count =
if i<String.length s then
if List.mem (String.get s i) acc then
c_ s (i+1) acc count
else
c_ s (i+1) ((String.get s i)::acc) (count+1)
else
count
in
c_ s 0 [] 0
in let uniqpairs vn =
let rec u_ v_ n_ acc disn disv =
match (v_,n_) with
(hv_::tv_, hn_::tn_) -> if List.mem hv_ tv_ ||
List.mem hn_ tn_ ||
List.mem hn_ disn ||
List.mem hv_ disv then
u_ tv_ tn_ acc (hn_::disn) (hv_::disv)
else
u_ tv_ tn_ ((hv_,hn_)::acc) disn disv
| ([],[]) -> acc
| (_,_) -> acc
in match vn with
(vier_s,neun_s) -> u_ vier_s neun_s [] [] []
in let neun =
List.filter (function n -> (String.get n 3)=(String.get n 0)) squares
in let select vn =
match vn with
(v_,n_) -> (String.get v_ 2)=(String.get n_ 1) &&
6=countuniq (v_^n_)
and allpairs =
List.flatten (List.map (function i1 -> List.map (function i2 -> (i1,i2))
neun) squares)
in let pairs =
List.split (List.filter select allpairs)
in
uniqpairs pairs;;
=================================
vierneun;;
- : (string * string) list = ["6241", "9409"]
--
WildHeart'2k1 (at home)
[········@my-deja.com]
:
: VIER and NEUN represent 4-digit squares, each letter denoting a
: distinct digit. You are asked to find the value of each, given the
: further requirement that each uniquely determines the other.
:
: The "further requirement" means that of the numerous pairs of
: answers, choose the one in which each number only appears once
: in all of the pairs.
Here's a CL solution:
(defun lists-match (list1 list2)
(loop with map = ()
for elt1 in list1
for elt2 in list2
do (let ((a1 (find elt1 map :key #'car)) ;; same as assoc
(a2 (find elt2 map :key #'cdr))) ;; "reverse" assoc
(cond ((and (null a1) (null a2))
(push (cons elt1 elt2) map))
((not (eq a1 a2))
(return nil))))
finally (return t)))
(defun integer->digits (i &optional (base 10))
(loop while (> i 0)
with digits = ()
do (multiple-value-bind (n rest)
(floor i base)
(push rest digits)
(setq i n))
finally (return digits)))
(defun all-vier-neun-answers ()
(let ((squares (loop for i from 32 to 99 collect (* i i)))
(answers ()))
(dolist (n1 squares)
(let ((digits1 (integer->digits n1)))
(when (lists-match digits1 '(n e u n))
(dolist (n2 squares)
(let ((digits2 (integer->digits n2)))
(when (lists-match (nconc digits2 digits1)
'(v i e r n e u n))
(push (cons n2 n1) answers)))))))
answers))
(defun vier-neun ()
(let ((all-answers (all-vier-neun-answers))
(unique-answers ()))
(dolist (answer all-answers)
(unless (find-if (lambda (ans)
(and (not (eq answer ans))
(or (= (car answer) (car ans))
(= (cdr answer) (cdr ans)))))
all-answers)
(push answer unique-answers)))
unique-answers))
* (vier-neun)
((6241 . 9409))
--
Knut Arild Erstad
Nobody loves me but my mother, and she could be jivin' too.
-- B.B King
··········@ii.uib.no (Knut Arild Erstad) writes:
> [········@my-deja.com]
> :
> : VIER and NEUN represent 4-digit squares, each letter denoting a
> : distinct digit. You are asked to find the value of each, given the
> : further requirement that each uniquely determines the other.
> :
> : The "further requirement" means that of the numerous pairs of
> : answers, choose the one in which each number only appears once
> : in all of the pairs.
>
> Here's a CL solution:
hmmm..
anybody did it by hand?
I picked up the subject from the J Forum. Follows a quote
from my message there:
-[cut]--------------------------------------------------
Here is an adaptation of Roger's alrorithm in C.
I don't know how to post it on [Steve Graham's] collection, but
this might restore the decency to "conventional" languages.
Also it shows how a language like J can serve as a great
prototyping tool.
#include <stdio.h>
#include <string.h>
void main(void)
{ int i, j, k, n=0; wchar_t p[1000], v[]=L"vierneun", s[9];
for (i=32;i<=99;i++) for (j=32;j<=99;j++) {
swprintf(s,L"%04d%04d",i*i,j*j);
for (k=0;k<8;k++) if (wcschr(s,s[k])-s != wcschr(v,v[k])-v) break;
if (k==8) { p[n++] = i*i; p[n++] = j*j; } }
for (i=0;i<n;i+=2) if (wcschr(p,p[i]) == wcsrchr(p,p[i])
&& wcschr(p,p[i+1]) == wcsrchr(p,p[i+1])) break;
printf("%04d%04d\n",p[i],p[i+1]);
}
"John D. Baker" <········@***.net> wrote:
> I've been following this thread with interest. It's
> always illuminating to see how different people
> and different tools come up with very different
> solutions.
>
> Looking over the compilation at:
>
> http://members.home.net/js.graham/vierneun.html
>
> It struck me that no "conventional" C, C++, VB, Java, COBOL
> solutions have been been posted. This puzzle illustrates why
> oddball programming languages persist despite a relentless
> and oppressive effort by the software industry to
> generate standard commodity programmers. In many cases, like
> this one, they are more productive, creative and
> fun!
>
> --
> John D. Baker
> ·······@kos.net
-[cut]--------------------------------------------------
In article <············@news.netmar.com>,
<········@my-deja.com> writes:
>This puzzle was originally posted on a mailing list for the Icon
>programming language. Thought members of this group might also
>want to give it a shot.
>
>VIER and NEUN represent 4-digit squares, each letter denoting a
>distinct digit. You are asked to find the value of each, given the
>further requirement that each uniquely determines the other.
>
>The "further requirement" means that of the numerous pairs of
>answers, choose the one in which each number only appears once
>in all of the pairs.
>
>
>Steve Graham
>
----- Posted via NewsOne.Net: Free (anonymous) Usenet News via the Web -----
http://newsone.net/ -- Free reading and anonymous posting to 60,000+ groups
NewsOne.Net prohibits users from posting spam. If this or other posts
made through NewsOne.Net violate posting guidelines, email ·····@newsone.net