Очередная несложная разминка для начинающих.

← →
MBo (2002-05-20 09:28) [0]

Определить, является ли данная строка палиндромом (перевертышем).
Пример: А роза упала на лапу Азора

← →
Romkin (2002-05-20 12:13) [1]

А тестовые строки для проверки правильности?
К примеру, "abc dcba" - палиндром?

← →
MBo (2002-05-20 13:35) [2]

Он дивен, палиндром, и ни морд, ни лап не видно...
Аду! Игру, Рихтер! - орет хирург-иуда.
Морда казаха за кадром
Лом о смокинги гни, комсомол
Лена набила рожу мужу - муж орал и банан ел
Лезу на санузел
Madam I’m Adam

← →
ION T (2002-05-20 14:19) [3]

Лови:

function IsPalindrom(InStr: string): boolean; var inv: array of char; i: integer; delim: set of char; begin delim:= [" ", "-", ",", "."]; InStr:= AnsiLowerCase(InStr); for i:= length(InStr) downto 1 do if InStr[i] in delim then delete(InStr, i, 1); SetLength(inv, length(InStr)); for i:= 0 to length(InStr)- 1 do inv[i]:= InStr[length(InStr)- i]; if string(inv)= InStr then Result:= true else Result:= false; end;

Можно немного оптимизировать оба цикла, но мне сейчас в лом...

← →
MBo (2002-05-20 14:37) [4]

ОК.
Учтены почти все подводные камни.
Об оптимизации пока речи не идет.
Надеюсь, еще кто-нибудь напряжет голову и пальцы :)

← →
Ev_genus (2002-05-20 15:17) [5]

function pol(s:string):boolean;
var i, l:byte; begin pol:=true; for i:=1 to length(s) do while not (s[i] in ["a".."z", "A".."Z"]) do delete(s, i, 1); l:=i; for i:=1 to l div 2 do if upcase(s[i])<>upcase(s[l-i+1]) then begin pol:=false break; end; end;

← →
MBo (2002-05-20 15:20) [6]

Ошибки отметить или пока не надо?

← →
Romkin (2002-05-20 15:35) [7]

А можно я? :-))
function isPalindrome(const Value: ansistring): Boolean; const alfaSet: set of ansiChar = ["A".."Z","А".."Я", "0".."9"]; var i,j: Integer; s: AnsiString; begin s := Value; i := 1; j := Length(s); s := ansiUpperCase(s); while (i < j) do begin while (i < Length(s)) and (not (s[i] in alfaSet)) do Inc(i); while (j > 1) and (not (s[j] in alfaSet)) do Dec(j); Result := (i <= j); if s[i] <> s[j] then begin Result := False; Break; end; Inc(i); Dec(j); end; end;

← →
MBo (2002-05-20 15:48) [8]

У, какой Romkin педант, даже const предусмотрел. ;)
QuickSort вспоминается ;)

← →
Alx2 (2002-05-20 16:07) [9]

Вот польза от Const сомнительна. Все равно локальная строчка сидит. У меня почти то же самое. Но рекурсия вместо цикла (а то повторяться некрасиво:) ):
Function isPalindrom(S: String): Boolean; Const ValidSet = ["A".."Z", "А".."Я", "0".."9"]; Var len: Integer; Function Test(idx1, idx2: Integer): Boolean; Begin While (idx1 < idx2) And Not (S[idx1] In ValidSet) Do inc(idx1); While (idx1 < idx2) And Not (S[idx2] In ValidSet) Do dec(idx2); Result := (idx1 >= idx2) Or (S[idx1] = S[idx2]) And Test(idx1 + 1, idx2 - 1); End; Begin S := AnsiUpperCase(S); len := Length(S); Result := Test(1, len); End;

← →
Alx2 (2002-05-20 16:11) [10]

Блин, кое-что выкинуть забыл :(
Вот так:
Function isPalindrom(S: String): Boolean; Const ValidSet = ["A".."Z", "А".."Я", "0".."9"]; Function Test(idx1, idx2: Integer): Boolean; Begin While (idx1 < idx2) And Not (S[idx1] In ValidSet) Do inc(idx1); While (idx1 < idx2) And Not (S[idx2] In ValidSet) Do dec(idx2); Result := (idx1 >= idx2) Or (S[idx1] = S[idx2]) And Test(idx1 + 1, idx2 - 1); End; Begin S := AnsiUpperCase(S); Result := Test(1, length(S)); End;

← →
MBo (2002-05-20 16:21) [11]

>Ev_genus
вместо
for i:=1 to length(s)
надо
for i:=length(s) downto 1

Жду решения от IronHawk.

← →
Kozhanov (2002-05-20 16:26) [12]

Ещё полиндомчик господа :

Аргентина манит негра

Удачи !

← →
Alx2 (2002-05-20 16:29) [13]

Но самое изящное, думаю, через PChar :)

← →
Виктор Щербаков (2002-05-20 16:32) [14]

> Жду решения от IronHawk.

Решение от IronHawk:
Написать в форум вопрос:
"Как узнать перевертыш строка или нет?"
Получить десяток правильных ответов и несмотря на это, развести флейм постов на 100-200 с переносом в "потрепаться" естественно.

← →
Alx2 (2002-05-20 16:34) [15]

>Kozhanov © (20.05.02 16:26)
Я это не про негра :))

← →
Kozhanov (2002-05-20 16:39) [16]

А что если делать через сумму числовых представлений
символов ?

Просьба не бить ногами за предложение :)

← →
MBo (2002-05-20 16:43) [17]

через сумму не знаю как, а
byte(s[1]) XOR byte(s[N])
можно использовать или hash вычислять с начала и с конца до середины

← →
Kozhanov (2002-05-20 17:02) [18]

> MBo
Cумма отменяется.
Видимо нужно в одном цикле идти
с начала и с конца строки до середины и
сравнивать числовые представления символов, как-то
так : Ord(ScrString[ii]) и Ord(ScrString[n - ii])
Если хотя бы будет одно неравенство, то энто не полиндром.
(Это конечно не факт, что именно так будет работать, но я думаю
что если копать в эту сторону может что и получиться эффективного)

← →
MBo (2002-05-20 17:12) [19]

см ev_genus с моей поправкой позже

← →
SPeller (2002-05-20 17:22) [20]

function Test(const S:string):boolean;
var st:string;i:integer;
begin
st:=uppercase(s);
i:=1;
result:=true;
while i<=length(st)do
if (st[i]=",") or (st[i]=" ")then delete(st,i,1) else inc(i);
for i:=1 to round(length(st)/2) do
if st[i]<>st[length(st)-i+1] then result:=false;
end;

← →
SPeller (2002-05-20 17:23) [21]

function Test(const S:string):boolean;
var st:string;i:integer; begin st:=uppercase(s); i:=1; result:=true; while i<=length(st)do if (st[i]=",") or (st[i]=" ")then delete(st,i,1) else inc(i); for i:=1 to round(length(st)/2) do if st[i]<>st[length(st)-i+1] then result:=false; end;

← →
SPeller (2002-05-20 17:24) [22]

Блин, хоть и два раза, но всё-равно без косяков не обошлось....
:-))

← →
MBo (2002-05-20 17:29) [23]

>SPeller
у тебя выбрасываются только два не нужных символа, а их может быть и больше - например, ! . Чтобы все это учесть, надежнее использовать in, как в приведенных примерах или хоть Pos в
строке "A..ZA..Я". Хочу отметить, что удаление бкдет быстрее, если, как и в случае с for, идти с конца строки с Dec(i)

← →
SPeller (2002-05-20 17:42) [24]

MBo © (20.05.02 17:29)

Ну поставить ещё парочку or .... а так скорость особо то не будет различаться. Для гигагерцовых проциков, которыми сейчас пользуются это не проблема. Хотя я тоже сторонник оптимизации кода по времени выполнения.

← →
Delirium (2002-05-20 17:53) [25]

Решил и я с мастерами поиграть:
function isP(S:String):boolean; var L,U:String; i:integer; begin U:=AnsiUpperCase(S); L:=AnsiLowerCase(S); i:=1; while i<=Length(U) do if U[i]=L[i] then begin Delete(U,i,1); Delete(L,i,1); end else Inc(i); i:=1; While i<=Length(U) div 2 do if U[i]=U[Length(U)-i+1] then begin Delete(U,i,1); Delete(U,Length(U)-i+1,1); end else Inc(i); Result:=Length(U) in [0,1]; end;

← →
MBo (2002-05-20 18:07) [26]

хм, тоже вариант ;)

← →
SPeller (2002-05-20 18:38) [27]

Воспользуемся примером Delirium © (20.05.02 17:53)

function Test(const S:string):boolean; var st,st2:string;i:integer; begin st:=uppercase(s); st2:=lowercase(s); result:=true; i:=1; while i<=Length(st) do if st[i]=st2[i] then begin Delete(st,i,1); Delete(st2,i,1); end else Inc(i); for i:=1 to length(st) div 2 do if st[i]<>st[length(st)-i+1] then result:=false; end;

← →
MBo (2002-05-20 18:43) [28]

>SPeller
в первый раз не заметил - после result:=false надо прерывать цикл, иначе при совпадении последних (средних) символов будет в любом случае true.

← →
SPeller (2002-05-21 02:52) [29]

2MBo © (20.05.02 18:43)

Нет. Проверьте хорошенько. Я уже как-то спорил на эту тему. Приведу цитату: "отличие в том, что нет части else...". Ну проверьте сами, если st[i]=st[length(st)-i+1] условие выполнится?

← →
MBo (2002-05-21 08:01) [30]

Да, я не прав, невнимательно посмотрел. Недостаток только в излишней работе железного коня ;)

← →
xGrey (2002-05-21 14:25) [31]

Не удержался :) и решил запостить свой вариант:
function PalenomValidate(StrUser: string): WordBool; var StrTemp : string; i : integer; begin StrUser:=AnsiLowerCase(StringReplace(StrUser," ","",[rfReplaceAll])); SetLength(StrTemp,Length(StrUser)); for i:=Length(StrUser) downto 1 do StrTemp[Length(StrUser)-i+1]:=StrUser[i]; result:=WordBool(pos(StrTemp,StrUser)); end;

← →
MBo (2002-05-21 14:47) [32]

>xGrey
не учтены другие лишние символы, кроме пробела

← →
kaif (2002-05-21 14:52) [33]

Нельзя использовать string.
А вдруг перевертыш длинный, например 10Гбайт?
:)

← →
MBo (2002-05-21 14:59) [34]

>kaif
хочешь БД использовать? ;))

← →
SPeller (2002-05-21 15:12) [35]

Тут байтовый массив нужен. Эт точно.:)

← →
xGrey (2002-05-21 15:18) [36]

To MBo:
Что Вы имеете ввиду под "другими лишними символами"?
Оптимизацию алгоритма и его реализацию?
Если нет, то приведите пример палиндрома, при котором моя ф-ция не будет работать

То kaif
Да, действительно :)

← →
MBo (2002-05-21 15:39) [37]

>xGrey
Аду! Игру, Рихтер! - орет хирург-иуда
восклицательные знаки и тире подпортят. Несколько StringReplace понадобится.
А реализация нормальная, только IMHO ни к чему pos делать
просто Result:=StrTemp=StrUser;

← →
SPeller (2002-05-21 15:41) [38]

← →
xGrey (2002-05-21 15:55) [39]

>MBo
Согласен, не подумал...

← →
igorr (2002-05-21 16:36) [40]

Опять опоздал :))
Вот мой вариант с исключением завершающих символов.

function Pal(var Str:String):Boolean; var i,FinPos:integer; ReverseStr:string; begin Str:=UpperCase(Str); for i:=Length(Str) downto 1 do if Str[1]=Str[i] then begin FinPos:=i; Break; end; SetLength(ReverseStr,FinPos); for i:=1 to FinPos do ReverseStr[i]:=Str[FinPos-i+1]; Result:=Pos(ReverseStr,Str)<>0; if FinPos<5 then Result:=False; //ограничение длины палиндрома end;

Очередная несложная разминка для начинающих. Найти похожие ветки