полиндромы

← →
~Aid~ (2006-10-25 00:35) [0]

дана строка
надо определить сколько в ней полиндромов(слова разделены одним или несколькоми пробелами)
как сделать по-быстрому?

← →
~Aid~ (2006-10-25 00:46) [1]

короче протестите прогу

program Project1;

{$APPTYPE CONSOLE}

uses
SysUtils;

function polindromGOOD(s1:string;a,b:integer):boolean;
var k,l:integer;
begin
l:=b;
result:=true;
for k:=a to b do
begin
if s1[k]<>s1[l] then begin result:=false;exit;end;
dec(l);
end;
end;
var
s:string;
i,j,count,n1,n2: integer;
flag:boolean;
begin
count:=0;
readln(s);
s:=" "+s+" ";
for i:=1 to length(s) do
begin
if s[i]=" " then
begin
n1:=i+1;
for j:=i+1 to length(s) do
begin
if s[j]=" "
then
begin
n2:=j-1;
if j-i=1 then break;
flag:=polindromGOOD(s,n1,n2);
if flag = true then inc(count)
else break;

end;
end;
end;
end;
writeln(count);
readln;
end.

← →
Наиль © (2006-10-25 00:49) [2]

1. Во вторую строку добавляешь по букве из первой строки до ближайшего пробела.
2. В третью строку помещаешь перевернутую вторую.
3. Сравниваешь вторую и третью строку, если равны увеличиваешь счётчик.
4. Делаешь вторую строку пустой.
5. Если не конец строки, то п.1

← →
DrPass © (2006-10-25 00:50) [3]

Замечание первое: пАлиндром пишется через "А" :)

← →
~Aid~ (2006-10-25 00:53) [4]

точно DrPass опечатался...

← →
~Aid~ (2006-10-25 00:54) [5]

Наиль © у меня проще...

вы просто проверьте правильно ли я сделал

← →
Орион © (2006-10-25 00:58) [6]

> [5] ~Aid~ (25.10.06 00:54)

а запустить самому не судьба?

← →
~Aid~ (2006-10-25 01:00) [7]

нет сейчас под рукой дельфы
я в блокноте написал
попутный вопрос:
как определить сколько строк находится в данный моментв TMemo

← →
Орион © (2006-10-25 01:01) [8]

> [7] ~Aid~ (25.10.06 01:00)

Memo1.Lines.Count

← →
Наиль © (2006-10-25 01:02) [9]

> вы просто проверьте правильно ли я сделал

Работает

> как определить сколько строк находится в данный моментв
> TMemo

Memo1.Lines.Count

← →
~Aid~ (2006-10-25 01:03) [10]

спасибо

> if flag = true then inc(count)

if flag then inc(count) - так правельнее

а по программе: я бы рекурсию не делал, какой в ней смысл?

Что-то типа:
function Check(AText: string): Boolean; var i, Len: integer; begin Result:=True; Len:=Length(AText); for i:=1 to (Len div 2) do if AText[i]<>AText[Len-i+1] then begin Result:=False; Break; end; end;

Основной алгоритм:
- выделил подстроку из строки (функции Fetch, TrimLeft)
- прогнал через Check, если True, то Inc(Count)

хы-хы) сегодня явно не мой день: рекурсии у тебя нет - у меня глюки.
Но код перепиши.

Честно выдрано из Indy =)
function Fetch(var AInput: string; const ADelim: string; const ADelete: Boolean): string; var LPos: Integer; begin if ADelim = #0 then begin // AnsiPos does not work with #0 LPos := Pos(ADelim, AInput); end else begin //? may be AnsiUpperCase? LPos := Pos(UpperCase(ADelim), UpperCase(AInput)); end; if LPos = 0 then begin Result := AInput; if ADelete then begin AInput := ""; {Do not Localize} end; end else begin Result := Copy(AInput, 1, LPos - 1); if ADelete then begin //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the //remaining part is larger than the deleted AInput := Copy(AInput, LPos + Length(ADelim), MaxInt); end; end; end;

Ну и короче говоря:

var Text, Buf: string; i, Count: Integer; begin for i:=0 to Memo1.Lines.Count-1 do begin Text:=Memo1.Lines[i]; Count:=0; while Text<>"" do begin Buf:=Fetch(Text, " "); Text:=TrimLeft(Text); if Check(Buf) then Inc(Count); end; MessageDlg("В строке "IntToStr(i)+" "+IntToStr(Count)+" палиндромов", mtCustom, [mbOK], 0); end; end;

полиндромы Найти похожие ветки