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做………

然后发现……

就是一快排啊

不多说了

看代码………..

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.