Вот задали такую задачку:
В текстовом файле записаны слова. Определить, сколько раз встречается каждое слово и вывести в обратном порядке.
Прошу выслать код
Вобщем я бы делал так
Гость, а
Ага прошу прощенья.Значит по поводу того как расположены слова, это всё равно. А вот по поводу кол-ва слов
это я промахнулся постараюсь доделать
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.
комментарии бы не помешали мне...
а как добавить процедуру, чтобы она выводила слова по частоте появления?
avaness, ты знаешь, я тут вспомнил об одной программке, которую когда-то делал... По-моему, она очень даже подходит для твоего задания... Возможно, придется поменять некоторые символы, но в общем - очень похоже:
http://forum.pascal.net.ru/index.php?s=&showtopic=3103&view=findpost&p=27718
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®
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©;
//******
//tree:=nil;
writeln;
Delete©;
end;
readln;
end.