В текстовом файле input.txt записан русский текст. Найти в тексте слова, содержащие не менее трех букв из последнего слова текста
Категория: Delphi/Pascal
2012-02-26 21:29:36
code: #pascal
Program PascalGuru; var s:string; f,t:text; {-----------------------------------------------} function preobr(s:string):string; label 1,2,3; var i,j,l,p,n,kol:integer; gl,zp,slovo,poslednee,cifra:string; m:array [1..80] of string; begin zp:='!?*,.'; {все знаки препинания} gl:='аоуыэяеёюи'; cifra:='0123456789'; {начало разбиения предложения на слова} p:=pos(' ',s); i:=0; repeat inc(i); slovo:=copy(s,1,p-1); m[i]:=slovo; delete(s,1,p); p:=pos(' ',s); until p=0; n:=i+1; m[n]:=s; {массив со словами} {--конец разбиения предложения на слова} for i:=1 to n-1 do {проход по массиву слов строки} begin s:=m[i]; poslednee:=m[n]; {последнее слово, с которым будем сравнивать } for j:=1 to length(poslednee) do {удаляем в последнем слове знаки препинания} if pos(poslednee[length(poslednee)],zp)<>0 then delete(poslednee,length(poslednee),1); 1: {удаляем в последнем слове цифры } for j:=1 to length(poslednee) do if (pos(poslednee[length(poslednee)],cifra)<>0) then begin delete(poslednee,j,1); goto 1; end; 2: {удаляем в последнем слове повторяющиеся буквы } for j:=1 to length(poslednee) do for l:=1 to length(poslednee) do if (j<>l) and (poslednee[j]=poslednee[l]) then begin delete(poslednee,j,1); goto 2; end; {"p" - будет переменной содержащей ДЛИНУ слова} if pos(s[length(s)],zp)<>0 then p:=length(s)-1 else p:=length(s); {если есть знак препинания - не учитываем его} kol:=0; for j:=1 to length(poslednee) do if pos(poslednee[j],s)<>0 then inc(kol); if kol>2 then begin s:=s+'('; kol:=0; for j:=1 to length(poslednee) do if pos(poslednee[j],s)<>0 then begin s:=s+poslednee[j]; s[pos(poslednee[j],s)]:=UpCase(s[pos(poslednee[j],s)]); {в заглавные} inc(kol); if kol=3 then goto 3; end; 3: m[i]:=s+')'; end; end; {--- конец преобразования строки} s:=''; {запишем всю строку(обновлённую) сначала} for i:=1 to n do s:=s+m[i]+' '; preobr:=s; end; {-----------------------------------------------} begin assign(f,'input.txt'); reset(f); assign(t,'output.txt'); rewrite(t); while not eof(f) do begin readln(f,s); writeln(t, preobr(s) ); end; writeln('Файл успешно записан...'); close(f); close(t); readln; end.
Поделиться: