Шустрый
Профиль
Группа: Участник
Сообщений: 56
Регистрация: 22.3.2009
Где: Украна, Донецк
Репутация: нет
Всего: нет
|
В программке я подсчитал колличество одинаковых слов в процедуре PoiskSlov, но для меня стало сложней удалить их и оставить всего по одному экземпляру слова. Кто может помогите мне. вот программка: | Код |
Program Anton;
Uses Crt,Printer;
Const
Nmax= 50; { макс.кол-во элементов в массиве строк St }
Enter = 13; { код клавиши Enter }
Escape = 27; { код клавиши Esc }
PressKey = 'Нажмите клавишу Enter';
AlphaBet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; { латинский алфавит }
Separs = ' .,;'; { список разделителей }
Type
String66 = string[66]; { тип строки текста }
StringAr = array[1..Nmax] of String66;
Ttext=record
slovo:string[16];
povtor:integer;
end;
Var
i, { параметр цикла }
n, { кол-во строк в массиве St }
NumberFile, { номер входного файла }
KolLetter,Koli { количество отмеченных букв }
: byte;
NumberWord,nach,kon
: integer; { текущий номер слова в тексте }
IndPrinter : boolean; { индикатор использования принтера }
ch, { символ текста }
Reply : char; { символ ответа на запрос программы }
S1,S2, { строки для преобразования чисел }
Sw, { очередное слово текста }
NameInFile : String66;{ имя входного файла }
St,sq : StringAr; { массив строк текста }
TabWord { массив слов таблицы результатов }
: array[1..26] of Ttext;
nword:integer;
TabNumberWord { массив номеров слов в таблице результатов }
: array[1..26] of integer;
FileText : text; { исходный файл }
FileOut { выходной файл }
: file of String66;
S:string[255];
{ ----------------------------------------------------------------- }
Procedure WaitEnter;
{ Задержка выполнения программы до тех пор,пока не будет нажата }
{ клавиша Enter }
Var S:char;
Begin
Repeat S:=ReadKey;
Until ord(S) = Enter;
End { WaitEnter };
{ ------------------------------------------------------------------ }
Procedure PrintString(X,Y:integer; S:string);
{ Вывод строки S с позиции X строки экрана с номером Y }
Begin
GotoXY(X,Y);
Write(S);
End { PrintString };
{ ------------------------------------------------------------------ }
Procedure PrintKeyAndWaitEnter;
{ Вывод строки-константы PressKey с позиции 1 строки экрана 25 и }
{ задержка выполнения программы до нажатия клавиши Enter }
Begin
PrintString(1,25,PressKey);
WaitEnter;
ClrScr;
End { PrintKeyAndWaitEnter };
{ ------------------------------------------------------------------ }
Procedure ControlPageScreen(Var j,KeyExit:byte);
{ Контроль размера страницы на экране }
Const LengthPage=23; { кол-во строк на одной странице }
S='След.страница - "Enter", конец просмотра - "Esc"';
Var ch : char;
Begin
Inc(j); KeyExit:=0;
If j=LengthPage then
Begin
j:=0;
PrintString(1,25,S);
Repeat
ch:=ReadKey; KeyExit:=ord(ch);
Until (KeyExit=Enter) or (KeyExit=Escape);
ClrScr;
End;
End { ControlPageScreen };
{ ---------------------------------------------------------------------- }
Procedure ScreenText(S:string);
{ Вывод на экран массива строк St }
Var i : integer;
j,KeyExit : byte;
Begin
ClrScr; j:=0;
Writeln(S);
For i:=1 to n do
Begin
Writeln(St[i]);
ControlPageScreen(j,KeyExit);
If KeyExit=Escape then Exit;
End;
PrintKeyAndWaitEnter;
End { ScreenText };
{ ------------------------------------------------------------------ }
Procedure PrinterText;
{ Печать на принтере исходного текста }
Var i : integer;
Begin
Writeln(Lst);
Writeln(Lst,' И С Х О Д Н Ы Й Т Е К С Т');
For i:=1 to n do
Writeln(Lst,St[i]);
End { PrinterText };
{ ------------------------------------------------------------------ }
Procedure ScreenTabResult;
{ Вывод на экран таблицы результатов }
Var i : integer;
j,KeyExit : byte;
Begin
ClrScr; j:=1;
Writeln(' Таблица результатов');
For i:=1 to nword do
Begin
Writeln(i:3,' ',TabWord[i].slovo:16 ,' ',TabWord[i].povtor);
ControlPageScreen(j,KeyExit);
If KeyExit=Escape then
Exit;
End;
PrintKeyAndWaitEnter;
End { ScreenTabResult };
{ ------------------------------------------------------------------ }
Procedure ScreenOutFile;
{ Вывод на экран выходного файла }
Var i : integer;
j,KeyExit : byte;
Begin
Seek(FileOut,0);
ClrScr; j:=0;
Writeln(' В Ы Х О Д Н О Й Ф А Й Л');
While not eof(FileOut) do
Begin
Read(FileOut,S1);
Writeln(S1);
ControlPageScreen(j,KeyExit);
If KeyExit=Escape then
Exit;
End;
PrintKeyAndWaitEnter;
End { ScreenOutFile };
{ ------------------------------------------------------------------ }
Procedure PrinterOutFile;
{ Печать на принтере выходного файла }
Var i : integer;
Begin
Seek(FileOut,0);
Writeln(Lst); Writeln(Lst);
Writeln(Lst,' В Ы Х О Д Н О Й Ф А Й Л');
While not eof(FileOut) do
Begin
Read(FileOut,S1);
Writeln(Lst,S1);
End;
End { PrinterOutFile };
{ ------------------------------------------------------------------ }
Function SignBegin(S:string66; k:byte):byte;
{ Поиск начала слова в строке S }
Var i : byte;
Begin
SignBegin:=0;
For i:=k to length(S) do
If Pos(S[i],Separs)=0 then
Begin
SignBegin:=i; Exit
End;
End { SignBegin };
{ ------------------------------------------------------------------ }
Function SignEnd(S:string66; k:byte):byte;
{ Поиск конца слова в строке S }
Var i : byte;
Begin
SignEnd:=0;
For i:=k to length(S) do
If Pos(S[i],Separs)>0 then
Begin
SignEnd:=i; Exit
End;
SignEnd:=length(S)+1;
End { SignEnd };
{ ------------------------------------------------------------------ }
Procedure PoiskSlov;
Var nach,kon,j, k,l: integer;
{ sq : string[16];}
Fl,cond: boolean;
Begin
for k:=1 to n do
begin
cond:=true;
kon:=0;
while cond do
begin
nach:=SignBegin(st[k],kon+1);
if nach=0 then
cond:=false
else
begin
kon:=SignEnd(st[k],nach+1);
if kon=0 then
begin
kon:=length(st[k])+1; Cond:=false;
end;
sw:= copy(st[k], nach, kon-nach);
Fl:=true;
For j:=1 to nword do
begin
If Sw=Tabword[j].slovo then
Begin
inc(TabWord[j].povtor);
Fl:=false;
Break;
End;
end;
if fl=true then
Begin
j:=1;
while (j<=nword) and (sw>TabWord[j].slovo) do
inc(j);
inc(nword);
for l:=nword downto j+1 do
TabWord[l]:=TabWord[l-1];
TabWord[j].slovo:=Sw;
TabWord[j].povtor:=1;
end;
end;
end; end;
end;
{ ------------------------------------------------------------------ }
Procedure WriteTabResult;
{ Запись таблицы результатов в выходной файл }
Var i : byte;
Begin
ScreenTabResult;
S1:=' ';
Write(FileOut,S1);
S1:=' ТАБЛИЦА ВЫХОДНЫХ РЕЗУЛЬТАТОВ';
Write(FileOut,S1);
S1:='------------------------------------------------------------';
Write(FileOut,S1);
S2:=': N п/п : Буква : Номер слова : Слово : Povtoreni ';
Write(FileOut,S2); Write(FileOut,S1);
s1:='';
For i:=1 to nword do
Begin
Str(i:2,S1); Str(TabWord[i].povtor,S2);
S1:=S1+' '+TabWord[i].slovo+' '+ S2;
Write(FileOut,S1);
End;
End { WriteTabResult };
{ ------------------------------------------------------------------ }
{ ------------------------------------------------------------------ }
Procedure DeleteSpaces;
{ Удаление в тексте избыточных пробелов }
Var i,j : byte;
Begin
For i:=1 to n do
Begin
S1:=St[i];
j:=1;
While j<length(S1) do
If S1[j]=' ' then
Begin
ch:=S1[j+1];
If Pos(ch,Separs)>0 then
Delete(S1,j,1)
Else
Inc(j);
End
Else
Inc(j);
If S1[length(S1)]=' ' then
Delete(S1,length(S1),1);
If S1[1]=' ' then
Delete(S1,1,1);
St[i]:=S1;
End;
End { DeleteSpaces };
{ ------------------------------------------------------------------ }
Procedure RightBorder;
{ Выравнивание скорректированного текста по правой границе }
Var is,l,l1,l2,
k,k1,k2 : byte;
CondText,CondString : boolean;
Begin
If n<2 then
Exit;
S1:=St[1]; l1:=length(S1);
i:=2; is:=0; CondText:=true;
While CondText do
Begin
S2:=St[i]; l2:=length(S2);
If (l1+l2)<66 then
Begin
S1:=S1+' '+S2; l1:=length(S1);
Inc(i);
If i>n then
CondText:=false
End
Else
Begin
k:=66-l1;
If k>0 then
Begin
CondString:=true;
While CondString do
Begin
k1:=SignBegin(S2,1);
k2:=SignEnd(S2,k1+1);
If S2[k2]<>' ' then
Inc(k2);
l:=k2-k1;
If l1+l<=66 then
Begin
Sw:=Copy(S2,k1,k2-k1);
S1:=S1+' '+Sw;
Delete(S2,1,k2-1);
End
Else
CondString:=false;
End;
Inc(is); St[is]:=S1;
S1:=S2;
If S1[1]=' ' then
Delete(S1,1,1);
l1:=length(S1);
Inc(i);
If i>n then
CondText:=false;
End;
End;
End;
n:=is+1; St[n]:=S1;
End { RightBorder };
{ ------------------------------------------------------------------ }
Begin
{ Установка соответствия между внутренним и внешним файлами }
ClrScr;
Writeln('Укажите номер входного файла (0..9)');
Read(NumberFile); Str(NumberFile:1,S1);
NameInFile:='InText'+S1+'.txt';
Assign(FileText,NameInFile);
Assign(FileOut,'OutText.dat');
{ Открытие используемых файлов }
Reset(FileText);
Rewrite(FileOut);
{ Запрос об использовании принтера }
IndPrinter:=false;
Writeln('Будет ли использован принтер ? (Да,Нет)');
Reply:=ReadKey;
If Reply in ['Д','д','L','l'] then
IndPrinter:=true;
{ Ввод и печать исходных данных }
n:=0;
While not eof(FileText) do
Begin
Inc(n);
Readln(FileText,St[n]);
End;
ScreenText('Исходный текст');
If IndPrinter then
PrinterText;
{ Установка таблицы результатов в исходное состояние }
For i:=1 to 26 do
Begin
TabNumberWord[i]:=0;
TabWord[i].slovo:='';
tabword[i].povtor:=0;
End;
nword:=0;
{ Формирование таблицы результатов и удаление отмеченных слов }
PoiskSlov;
writetabresult;
{ Удаление в тексте избыточных пробелов }
DeleteSpaces;
ScreenText('Текст после удаления избыточных пробелов');
{ Выравнивание скорректированного текста по правой границе }
RightBorder;
ScreenText('Текст после выравнивания по правой границе');
{ Запись преобразованного текста в выходной файл }
S1:=' ';
Write(FileOut,S1);
S1:=' П Р Е О Б Р А З О В А Н Н Ы Й Т Е К С Т';
Write(FileOut,S1);
For i:=1 to n do
Write(FileOut,St[i]);
{ Чтение и печать выходного файла }
ScreenOutFile;
If IndPrinter then
PrinterOutFile;
{ Закрытие файлов }
Close(FileText); Close(FileOut);
End.
|
Есть много не нужных процедур на них можно не обращать внимания имя файла INTEX1. Это сообщение отредактировал(а) antonkonikov - 22.3.2009, 22:20
Присоединённый файл ( Кол-во скачиваний: 5 )
prog.rar 13,72 Kb |
Удалить одинаковые слова, Пожалуйста помогите мне 
Дата 22.3.2009, 22:17 (
Загрузка ...
Дата 23.3.2009, 18:42 (
