СРОЧНО ПЛИИИИИЗ!!!! ДАЮ 75 Баллов →Pascal ABC←Алексей готов к финальной стадии своего...

Question

СРОЧНО ПЛИИИИИЗ!!!! ДАЮ 75 Баллов →Pascal ABC←Алексей готов к финальной стадии своего проекта! Он хочет узнать, сколько людей имеют номер телефона с «зеркальной частью». Содержащими зеркальную часть, Алексей считает такие номера, в которых можно найти последовательность цифр w-x-y-y-x-w, либо x-y-y-x (при этом w, x, y не равны друг другу, иначе номер красивым не считается!) Например, 4123321 – последовательность с зеркальной частью, а 1234321 – нет. Помогите статистику Алексею провести это важное исследование и выяснить, какое количество номеров среди представленных содержат зеркальную часть.Формат входных данныхВ первой строке вводится N (0 < N < 100) - количество номеров. В следующей строке вводится N чисел разрядностью от пяти до девяти знаков.Формат выходных данныхВыведите количество номеров, у которых есть зеркальная часть.Примеры:входные данные 6345284482 7658668 74554766 76133145 837567 923342выходные данные4

Answer 1

Для решения задачи с Вашими входными данными подходит, но может быть ошибка с другими данными, о которых я не подумал.

Var a:array [1..9] of integer;

i,n,q,u,o,p,y:integer;

begin

read (n);

For i:=1 to n do begin

read (u);

q:=u;

while q<>0 do begin

p:=p+1;

q:=q div 10;

end;

q:=u;

For o:=1 to p do begin

a[o]:=q mod 10;

q:=q div 10;

end;

For o:=3 to p do

If (a[o]=a[o-1]) and (o>2) and (a[o+1]=a[o-2]) and (a[o]<>a[o+1]) and (p<>4) then y:=y+1 else

If (p>6) and (a[o]=a[o-1]) and (o>3) and (a[o+1]=a[o-2]) and (a[o+2]=a[o-3]) and (a[o]<>a[o+1]) and (a[o+1]<>a[o+2]) and (a[o]<>a[o+2]) and (p<>6) then y:=y+1;

For o:=1 to p do

a[o]:=-1;

p:=0;

end;

write (y);

end.

Comments

К сожалению "срочно" решить не получилось. Как увидел - так решил, заняло минут 15-25(

---

var i,j,n,m,nmb,k,cnt: integer; s: string; ch: char;begin readln(n); cnt:=0; for i:=1 to n do begin read(nmb); s:=IntToStr(nmb); for j:=1 to length(s)-3 do begin ch:=s[j]; s[j]:='*'; k:=Pos(ch,s); if (k=j+3) or (k=j+5) then begin m:=j+1; while (k>0) and (m begin ch:=s[m]; s[m]:='*'; k:=Pos(ch,s); m:=m+1; end; if k=m then cnt:=cnt+1; end; end; end; writeln(cnt);end.

---

6345284482 7658668 74554766 76133145 837567 9233424