Здравствуйте, Бондаренко Сергей Николаевич!

Итак, как мы обсудили, во что получилось.

(Вторая программа получилась какая-то перемудрёная -- да и задание такое.)

1)

[code h=200]program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

var s:string;
i:integer;
begin
writeln('Vvedite stroku:');
readln(s); // читаем строку
i:=0; // начинаеv перебор символов с нуля
// (строка может оказыться пустой)
while i<=length(s)-1 do // пока не дошли последнего
// (точка в конце уже не интересует
begin
inc(i); // берём следующий символ
while (s[i]='.') and ( s[i+1]='.') do
delete(s,i,1); // проверяем и если надо удалаем
// пока не ликвидировали цепочку дальше по i не двигаемся
end;
writeln('Resultat:',s);
readln;
end.[/code]

2)
[code h=200]program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

var s:string;
istart1,iend1,istart2,iend2:integer; // начало и конец слова
n,k:integer;
w:string;

function NextWord(s:string; var istart,iend:integer):string;
// поиск следующего слова
begin
inc(iend);
istart:=iend; // ставим на начало следующего слова, т.е. после пробела
while (iend<=length(s)) and (s[iend]<>' ') do
// сдвигаем iend, пока не найдём пробел или конец строки
inc(iend);
NextWord:=copy(s,istart,iend-istart); // выделяем найденное слово
end;

begin
//writeln('Vvedite stroku');
//readln(s);
s:='qwe asd zxc rty qwe asd zxc qwe asd qwe';
writeln('Vvedite kolichestvo povtorov');
readln(n);
istart1:=0;
iend1:=0;
repeat
w:=NextWord(s,istart1,iend1); // берём следующее слово
istart2:=0;
iend2:=0;
k:=0;
while iend2<=length(s) do // двигаемся до конца строки
if NextWord(s,istart2,iend2)=w // если следующее совпадает с выбранным
then inc(k); // считаем его
if k=n // если слово поторяется заданное кооличество раз
then begin
delete(s,istart1,iend1-istart1+1); // удаляем выбранное слово
// вместе со следующим пробелом
dec(istart1);
istart2:=0;
iend2:=0;
while iend2<=length(s) do // снова двигаемся до конца строки
if NextWord(s,istart2,iend2)=w // если совпало
then begin
delete(s,istart2,iend2-istart2+1); // удаляем его
dec(istart2);
iend2:=istart2;
end;

end;
until iend1>length(s);
writeln(s);
readln;
end.
[/code]

3)
[code h=200]program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

type point = record
x,y:real;
end;

function IsRegular(a,b,c:point):boolean;
// функция проверяет регулярность трёх точек
// т.е. образуют ли они равносторонний треугольник
var l1,l2,l3:real;
q:boolean;
begin
// вычисляем длины сторон
l1:=sqrt(sqr(a.x-b.x) + sqr(a.y-b.y));
l2:=sqrt(sqr(a.x-c.x) + sqr(a.y-c.y));
l3:=sqrt(sqr(b.x-c.x) + sqr(b.y-c.y));
// проверяем равны между собой все стороны (с точностью до 1e-7)
IsRegular:= (abs(l1-l2)<1e-7) and (abs(l2-l3)<1e-7);
end;

var s:string;
i,j,k,n:integer;
m:array of point;
flag:boolean;

begin
// Исходные данные. Задаю в программе -- можно
// переделать на read.
n:=7;
SetLength(m,n);
m[0].x:=3.00000000000000; m[0].y:=3.00000000000000;
m[1].x:=3.50000000000000; m[1].y:=3.86602540378444;
m[2].x:=2.50000000000000; m[2].y:=3.86602540378444;
m[3].x:=2.00000000000000; m[3].y:=3.00000000000000;
m[4].x:=2.50000000000000; m[4].y:=2.13397459621556;
m[5].x:=3.50000000000000; m[5].y:=2.13397459621556;
m[6].x:=4.00000000000000; m[6].y:=3.00000000000000;

flag:=true; // флаг -- признак того, что набор точек регулярен
// т.е. пока не найдено комбинации точек,
// нарушающей наложенное требование
i:=0; // Первая точка из пары
repeat
j:=i+1; // Вторая точка из пары (номера до i уже на рассматриваются
repeat
k:=0; // Третья точка
while (k<n) and not IsRegular(m[i],m[j],m[k]) do
// Перебираем, пока не кончатся точки или пока не встретим
// третью точку, образуюущую равност. треугольник с парой
inc(k);
// writeln(i,' ',j,' ',k<n); // Вывод на экран результата для пары
flag:= k<n; // Запоминаем, была ли найдена нужная точка или
// индекс k дошёл до конца массива ничего не найдя
inc(j);
until not flag or (j>=n-1); // Выход по флагу или по достижению конца индекса
inc(i);
until not flag or (i>=n-2); // Выход по флагу или по достижению конца индекса
if flag
then writeln('The set is regular')
else writeln('The set is NOT regular');
readln;
end.[/code]