poj 1318

Word Amalgamation

Time Limit: 1000MS
Memory Limit: 10000K

Total Submissions: 4967
Accepted: 2608

Description

In millions of newspapers across the United States there is a word game called Jumble. The object of this game is to solve a riddle, but in order to find the letters that appear in the answer it is necessary to unscramble four words. Your task is to write a program that can unscramble words.

Input

The input contains four parts: 1) a dictionary, which consists of at least one and at most 100 words, one per line; 2) a line containing XXXXXX, which signals the end of the dictionary; 3) one or more scrambled 'words' that you must unscramble, each on a line by itself; and 4) another line containing XXXXXX, which signals the end of the file. All words, including both dictionary words and scrambled words, consist only of lowercase English letters and will be at least one and at most six characters long. (Note that the sentinel XXXXXX contains uppercase X's.) The dictionary is not necessarily in sorted order, but each word in the dictionary is unique.

Output

For each scrambled word in the input, output an alphabetical list of all dictionary words that can be formed by rearranging the letters in the scrambled word. Each word in this list must appear on a line by itself. If the list is empty (because no dictionary words can be formed), output the line "NOT A VALID WORD" instead. In either case, output a line containing six asterisks to signal the end of the list.

Sample Input

tarp
given
score
refund
only
trap
work
earn
course
pepper
part
XXXXXX
resco
nfudre
aptr
sett
oresuc
XXXXXX

Sample Output

score
******
refund
******
part
tarp
trap
******
NOT A VALID WORD
******
course
******

这个题………

真的很水

话说当年莫名其妙想用XXX做………

然后发现……

就是一快排啊

不多说了

看代码………..

View Code

var
a: array [ 1 .. 100 ] of string[ 6 ];
s0:string[ 6 ];
ch:char;
b,c: array [ 1 .. 100 ] of string[ 6 ];
sum,i,j,summ,num:longint;
t: array [ 0 .. 6 ] of char;
procedure qs(r,l:longint);
var
i,j:longint;
x,y:char;
begin
i: = r; j: = l;
x: = t[(i + j) div 2 ];
repeat
while t[i] < x do inc(i);
while t[j] > x do dec(j);
if i <= j then
begin
y: = t[i];
t[i]: = t[j];
t[j]: = y;
inc(i);
dec(j);
end ;
until i > j;
if i < l then qs(i,l);
if j > r then qs(r,j);
end ;
procedure init;
begin
repeat
inc(sum);
summ: = 0 ;
while not eoln do
begin
read(ch);
if ch = ' X ' then
begin
dec(sum);
readln;
exit;
end ;
inc(summ);
t[summ]: = ch;
b[sum]: = b[sum] + ch;
end ;
qs( 1 ,summ);
for i: = 1 to summ do a[sum]: = a[sum] + t[i];
readln;
until sum < 0 ;
end ;
procedure qss(r,l:longint);
var
i,j:longint;
x,y:string[ 6 ];
begin
i: = r; j: = l;
x: = c[(i + j) div 2 ];
repeat
while c[i] < x do inc(i);
while c[j] > x do dec(j);
if i <= j then
begin
y: = c[i];
c[i]: = c[j];
c[j]: = y;
inc(i);
dec(j);
end ;
until i > j;
if i < l then qss(i,l);
if j > r then qss(r,j);
end ;
procedure doit;
begin
repeat
summ: = 0 ;
s0: = '' ;
while not eoln do
begin
read(ch);
if ch = ' X ' then exit;
inc(summ);
t[summ]: = ch;
end ;
qs( 1 ,summ);
num: = 0 ;
for i: = 1 to summ do s0: = s0 + t[i];
readln;
for i: = 1 to sum do
if s0 = a[i] then
begin
inc(num);
c[num]: = b[i];
end ;
if num = 0 then
writeln( ' NOT A VALID WORD ' )
else
begin
qss( 1 ,num);
for i: = 1 to num do
writeln(c[i]);
end ;
writeln( ' ****** ' );
until num < 0 ;
end ;

begin
assign(input, ' input.in ' );
assign(output, ' output.out ' );
reset(input);
rewrite(output);
sum: = 0 ;
init;
doit;
close(input);
close(output);
end .

转载于:https://www.cnblogs.com/leve/archive/2011/02/27/1966475.html