Поиск палиндрома максимальной длины

Разминка для мозгов » Задачи » Поиск палиндрома максимальной длины

Добавлено: 04.03.08 в 09:24

Палиндромом называют последовательность символов, которая читается как слева направо, так и справа налево. Найти во введённой строке подстроку-палиндром максимальной длины.

СПРЯТАТЬ РЕШЕНИЕ/ОТВЕТ

program MaxPal;
var
	s,p : string;
	i,k,n : integer;
{----------------------------------------------------------}
function IsPal(s:string):boolean; {detects where s is palindrome}
var 
	i,n : integer;
begin
IsPal := true;
n := length(s);
for i := 1 to n div 2 do
	if (s[i] <> s[n-i+1]) then 
		begin
		IsPal := false;
		break;
		end;
end;
{----------------------------------------------------------}
begin
readln(s);
n := length(s);
k := n; {we are hunting for palindrome of k chars}
p := '';
while (k > 0) AND (p = '') do
	begin
	for i := 1 to n-k+1 do {possible start positions for k-palindrome}
		begin
		if IsPal(copy(s,i,k)) then
			begin
			p := copy(s,i,k);
			break;
			end;
		end;
	dec (k) {no k-palindrome, lower our expectations}
	end;
writeln (p);
end.

ПОКАЗАТЬ РЕШЕНИЕ/ОТВЕТ

Комментарии

Google says:

Аноним (04.10.09):

плохая задача

Сергей (18.10.09):

Это вы зря. Задача интересна и заставляет подумать.

Аноним (21.04.15):

Программа ищет палиндромы в числе, но ее легко модернизировать,чтоб считывала строку
Program MaxPal;
Const N=10;
Var A:array[1..N,1..2] of byte; X:longint; I:byte;

Function Palindrome(X:longint):boolean;
Var A,B:longint;
Begin
A:=0; B:=X;
Repeat
A:=A*10+B mod 10;
B:=B div 10;
Until B=0;
If A=X Then Palindrome:=true Else Palindrome:=false
End;

Procedure MaxPalindrome(Var X:longint; I:byte);
Var D:longint; K:byte;
Begin
If I>1 Then begin
A[I,2]:=0;
While A[I,2]<>1 do begin MaxPalindrome(X,I-1);
Inc(A[I,2]);
MaxPalindrome(X,I-1); End; End;
If I=1 then begin
D:=0;
For K:=1 to N do
If A[K,2]=1 Then D:=D*10+A[K,1];
If (Palindrome(D)) and (D>X) Then X:=D; End;
End;

Procedure Divideetimpera(X:longint; Var I:byte);
Begin
I:=1;
Repeat
A[I,1]:=X mod 10;
X:=X div 10;
Inc(I);
Until X=0;
Dec(I);
End;

Begin
Readln(X);
Divideetimpera(X,I);
X:=0;
MaxPalindrome(X,I);
Writeln(X);
End.

Аноним (22.04.15):

Ой, сорян, там ошибка был)))
Program MaxPal;
Const N=10;
Var A:array[1..N,1..2] of byte; X:longint; I:byte;
Function Palindrome(X:longint):boolean;
Var A,B:longint;
Begin
A:=0; B:=X;
Repeat
A:=A*10+B mod 10;
B:=B div 10;
Until B=0;
If A=X Then Palindrome:=true Else Palindrome:=false
End;
Procedure MaxPalindrome;
Var D:longint; K:byte;
Begin
D:=0;
For K:=1 to N do
If A[K,2]=1 Then D:=D*10+A[K,1];
If (Palindrome(D)) and (D>X) Then X:=D;
End;
Procedure DialZO(Var X:longint; I:byte);
Var D:longint;
Begin
If I>1 Then begin
A[I,2]:=0;
DialZO(X,I-1);
Inc(A[I,2]);
DialZO(X,I-1); End;
If I=1 then begin
A[I,2]:=0;
MaxPalindrome;
Inc(A[I,2]);
MaxPalindrome; End;
End;
Procedure Divideetimpera(Var X:longint; Var I:byte);
Begin
I:=1;
Repeat
A[I,1]:=X mod 10;
X:=X div 10;
Inc(I);
Until X=0;
Dec(I);
End;
Begin
Readln(X);
Divideetimpera(X,I);
DialZO(X,I);
Writeln(X);
End.

кроу (29.12.15):

кроу кроу

		Сборник задач разного уровня сложности по математике, информатике, физике, химии, программированию, экономике etc. Логические задачи, SQL задачи, решение задач. Задачи с ответами, а также нерешённые задачи. Petruchek.Info

Petruchek.Info

Поиск палиндрома максимальной длины