XP is just a number PerlMonks

### (Golf) Word squares

by japhy (Canon)
 on Aug 13, 2001 at 20:44 UTC Need Help??

Word squares are like really simple crossword puzzles. There are no black squares, the grid is a square, and the "down" clues are the same as the "across" clues.

So, given a list of words, construct a word square out of them. Here is an example:

```division of a road: _ _ _ _
a location:         _ _ _ _
in proximity to:    _ _ _ _
hearing organs:     _ _ _ _
The solution:
 ```L A N E A R E A N E A R E A R S```
So, given some list of strings, return the strings in the order they would appear (down or across) in the grid. My solution uses two functions, and thus, I have decided that character count will include the "sub ...".
```#23456789_123456789_123456789_123

sub Q{my\$j=pop;my@l=map\$\$_[\$j],@_
;for(@_){return"@\$_",Q(@_,++\$j)if
"@{[sort@\$_]}"eq"@{[sort@l]}"}()}
sub S{Q map([split//],@_),\$"=""}
My code is (updated, thanks to abstracts) 131 characters.

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

Replies are listed 'Best First'.
Re: (Golf) Word squares
by abstracts (Hermit) on Aug 14, 2001 at 00:05 UTC
 Update5: Thanks larryk for the suggestion, 77 now```sub Z{ @_=@l=sort{.5<=>rand}@_;join('',reverse@l)eq(join'',map{map{chop}@l}@l +)?@_:&Z } [download]```

Update4: Okay, last update, sorry (87 now)

```sub Z{
@_=@l=map{splice@_,rand@_,1}@_;join('',reverse@l)eq(join'',map{map{cho
+p}@l}@l)?@_:Z(@_)
}

Update3:Okay, so I'm bad at golf :-) (now at 98)

```sub Z{
for(;;){@_=@l=map{splice@_,rand@_,1}@_;return@_ if join('',reverse@l)e
+q join'',map{map{chop}@l}@l}
}

Update2: Using for(;;) instead of while(1) -- count = 101;

```sub Z{
for(;;){@l=map{splice@_,rand@_,1}@_;@_=@l;return@_ if join('',reverse@
+l)eq join'',map{map{chop}@l}@l}
}

Original:

Hello

Here is my shot at 102 using permutation trial and error, enjoy

```my @ar = qw/NEAR LANE EARS AREA/ ;
# @ar = qw/LINGO MILLS SMOCK IDIOM LOGIC/;

print "\$_\n" for Z(@ar);

sub Z{
while(1){@l=map{splice@_,rand@_,1}@_;@_=@l;return@_ if join('',reverse
+@l)eq join'',map{map{chop}@l}@l}
}

Aziz,,,

updates removed: my updates (which I have removed from this post) didn't work!

------
```@_=@l=sort{rand cmp rand}@_;join('',reverse@l)eq(join'',map{map{chop}@
+l}@l)?@_:&Z #81
```   larryk
perl -le "s,,reverse killer,e,y,rifle,lycra,,print"```
annoyingly, "line" and "ikea" fit as well in the example...
Re: (Golf) Word squares
by Cirollo (Friar) on Aug 13, 2001 at 21:18 UTC
This assumes that your list of words can fit together to form such a square. Obviously there is going to be a finite number of such squares, and I would think that it wouldn't be an incredibly huge number, since it's fairly difficult to come up with a set of words that works (and it gets even harder if you want a larger square).

It would be interesting to see a program that crunches through a word list (such as /usr/share/lib/dict/words) and 'discovers' combinations of words that can be made into word squares.

Actually they are more numerous than you might think... I played around with them a looong time ago, and came up with this one for my last name 'Mills'.

• Mills' Idiom: "Lingo, Logic, Smock."  M I L L S I D I O M L I N G O L O G I C S M O C K
Any suggestion as to what "Lingo, Logic, Smock" might mean?

I'll update this node with the code I used, as soon as I can find it.

-Blake

Well, the idea is you're given a set of words that will fit into such a grid.

As for your request, I think it wouldn't be too challenging to write such a program. I shall try now.

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;

Actually, I started writing a program to do just that a few months ago. I don't think I ever finished it, and I think now it's gathering dust in the rather large ~/scripts playground on my laptop.

I'll have to try to dig it up when I get home, unless you post your better, faster and more elegant solution first. :)

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://104481]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (5)
As of 2024-08-11 03:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When will the AI bubble burst?

Results (22 votes). Check out past polls.

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.