Вот задали такую задачку:
В текстовом файле записаны слова. Определить, сколько раз встречается каждое слово и вывести в обратном порядке.
Прошу выслать код

Вобщем я бы делал так

Только слова в файле должны идти в одну строку через пробел.

Гость, а
?

Взялся - так делай полностью... Кстати, в условии НИЧЕГО не сказано про то, как слова расположены в файле. Кто позволил тебе делать такое упрощение: ?

Ага прошу прощенья.Значит по поводу того как расположены слова, это всё равно. А вот по поводу кол-ва слов
это я промахнулся постараюсь доделать

спасибо, что не оставили мою проблему без внимания!

не работает!!!

Ну если надо определить сколько раз встречается каждое слово, а не количиство разных слов, то вот...

uses crt;
type
    mas= array[1..100] of string[25];
const path='d:\temp.dat';

procedure create_file(s:string);
var t:text;
    temp:string;
begin
temp:='ab bc c c km b';
assign(t,s);
rewrite(t);
writeln(t,temp);
close(t);
end;

function take_array(s:string; var ar:mas):integer;
var f:text;
    i:integer;
    ch:char;
begin
assign(f,s);
reset(f);
i:=1;
while not eof(f) do
      begin
           read(f,ch);
           if (ch=' ') or (ch=#13) then
              inc(i)
           else
               ar[i]:=ar[i]+ch;
      end;
close(f);
take_array:=i;
end;

procedure num_dif(ar:mas; n:integer);
var i,j,num:integer;
begin
num:=0;
for j:=1 to n do
    begin
         for i:=1 to n do
             if ar[j]=ar[i] then inc(num);
         writeln(j,' word ',num,' times - ',ar[j]);
         num:=0;
    end;
end;

procedure inverse(ar:mas; n:integer);
var i:integer;
begin
for i:=n downto 1 do
    writeln(ar[i]);
end;

var ar:mas; num:integer;
begin
create_file(path);
num:=take_array(path,ar);
clrscr;
num_dif(ar,num);
readln;
clrscr;
inverse(ar,num);
readln;
end.

BOKUL, у меня к Вам есть некоторые вопросы по коду. Что это означает?
"const path='d:\temp.dat';"
"temp:='ab bc c c km b';"
"if (ch=' ') or (ch=#13) then
inc(i)
else
ar[i]:=ar[i]+ch;"

"procedure num_dif(ar:mas; n:integer);"(что она делает?)


а почему не выводит в обратнои порядке?


а, всё - догнал - работает!
тока не пойму - как убрать последнюю строку "8 word 1 times - " . То есть при выводе всех слов последняя строка не заполнена - она не нужна - как её удалить?

а если ещё и по частоте появления вывести, сильно муторно? если не трудно - черканите. буду очень признателен!

комментарии бы не помешали мне...

а как добавить процедуру, чтобы она выводила слова по частоте появления?

avaness, ты знаешь, я тут вспомнил об одной программке, которую когда-то делал... По-моему, она очень даже подходит для твоего задания... Возможно, придется поменять некоторые символы, но в общем - очень похоже:

Частотный словарь

volvo, я фигово шарю в этих кодах.
я ты не можешь доделать код, который прислал BOKUL?
то есть добавить процедуру выведения слов по частоте появления?
частотный словарь, который ты писал, оооочень сложный для меня. препод ни за что не поверит, что это моих рук работа...
пожалуйста, если сможешь - доделай код BOKULa
мне надо сдать прогу завтра в 8.30 утра.

Пишешь процедуру и потом вызываешь ее в основной программе

Лови...

procedure different(ar:mas; n:integer);
var i,j,k,num,sum:integer;
    ar_buf:mas;
    b:boolean;
begin
num:=0;
sum:=0;
for j:=1 to n do
    begin
         b:=false;
         for k:=1 to num do
             if ar[j]=ar_buf[k] then b:=true;
         if b=false then
            begin
                 for i:=j to n do
                     if ar[j]=ar[i] then inc(sum);
                 inc(num);
                 ar_buf[num]:=ar[j];
                 writeln(ar[j],' : ',sum,' times');
                 sum:=0;
            end;
    end;
end;

Успел?

успеть-то успел...
но прогу забраковал препод (типа - "не универсальная")
Мне теперь нужно сделать прогу с помощью бинарных деревьев. Прога уже почти готова. Надо только дописать процедуры, чтобы слова выводились по частоте появления. Принцип таков: надо из одного дерева скопировать данные в другое, а потом в другом дереве изменить критерий вывода (cnt) и потом вывести на экран.
Кто-нибудь в курсе – как это делать?
Мне надо к утру завтрашнего дня.
Код только надо чуть-чуть дописать, препод код, который я высылаю, посмотрел - всё нормально, только дописать надо процедурки.
(прога должна быть в консоли)

program  durilka;

{$APPTYPE CONSOLE}


type Droot=^doot;
     doot = record
     cnt:integer;
     inf:string;
     next:droot;
     end;
    PRoot=^Root;
    Root = record
    cnt:integer;
    inf:string;
    Left:PRoot;
    Right:PRoot;
    end;

Procedure Add(var Root:Proot;i:string);

begin
if Root<>nil then
with Root^ do
begin
  if inf<i then Add(Right,i)
      else
       if inf>i then Add(Left,i)
         else
           if inf=i then
           Inc(cnt);

end
 else
 begin
{добавляем новый узел}
 New(Root);
  with Root^ do
  begin
    Inf:=i;
    cnt:=1;
    Left:=Nil;
    Right:=Nil;
  end
 end
end; {end procedure add}

{ процедура печати элементов дерева в порядке убывания значения }
Procedure Print(P:Proot);

   begin
    if P<>Nil then with P^ do
     begin
    { обход справа налево}
     Print(left);
            writeln(inf, '(', cnt, ')');
     print(right);
    end;
end;


Procedure Delete(R:PRoot);
   begin
     if R<>Nil then begin
     Delete(R^.right);
     Delete(R^.left);
     DisPose(r)
   end;
end;


{программа}
var F:text;
    Filename:string;
    inf:string;
    c:Proot;
    tree2:Droot;
    {Count:integer;}

    begin



//write('input filename - ');readln(Filename);
Assign(f,'f.txt');
{$I-} reset(f); {$I+}
  if IOResult<>0 then
  begin
   writeln('error!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
   exit
  end;
c:=Nil;
{заполняем дерево дв.поиска}
   {write('Enter are word - ');
   read(inf);
   Count:=0;}
   while not eof(f) do
    begin
     readln(f,inf);
     Add(c,inf);


    end;
     {Writeln('Count');}
  Close(f);
if c=Nil then
writeln('file is empty')
else
 begin
   writeln('####->4321->####');
Print(c);
//******
//tree:=nil;

 writeln;
Delete(c);
end;
readln;
end.

Текстовый файл отдельно создавал. Его содержание:


Ну чё - кто-нибудь поможет мне?

Ага... А завтра тебе твой препод скажет, что и это решение неуниверсально... Окажется, что надо через стеки реализовывать, например. Сейчас прям, будем десятки раз править... Ты сразу ТОЧНОЕ задание давай, а уж потом, извини... "Коней на переправе не меняют" (С)

когда препод давал мне эту задачу - в условии НЕ БЫЛО указано - с помощью чего делать. И уж тем более не говорилось об УНИВЕРСАЛЬНОСТИ проги. Я сам в шоке.