[Pascal] Sprawdź czy dany tekst jest palindromem

Dla specjalistów Programowanie
#1

Witam, muszę napisać programik sprawdzający czy dany wyraz jest palindromem - czyli czy przepisany od tyłu jest taki sam jak ten zwykły (np. kajak).

uses crt;

var

tekst,l:string;

a:integer;

begin

clrscr;

write ('Wpisz wyraz: ');

readln (tekst);

a:=(length (tekst));

write ('Ten wyraz od tylu to: ');

repeat

l:=(copy (tekst,a,1));

write (l);

a:=a-1;

until a=0;

writeln;

if tekst = l then writeln ('Ten tekst jest palindromem')

else writeln ('Ten tekst nie jest palindromem');

readln;

end.

Przepisany od tyłu tekst się zgadza, ale nie działa sprawdzanie czy jest on palindromem. Proszę o pomoc.

@Edit:

Już chyba wiem w czym jest problem - zmienna l zapamiętuje tylko pierwszą literę danego wyrazu, a nie cały odwrócony wyraz, można to łatwo zauważyć zmieniając write (l); na writeln (l); gdzie każda litera zostaje wypisana w następnej linii. Tylko jak to naprawić? Jak złapać wypisany tekst do zmiennej? :smiley:

#2

Poprawiony kod:

uses crt;

var

tekst,l,s:string;

a:integer;

begin

 clrscr;

 write ('Wpisz wyraz: ');

 readln (tekst);

 a:=(length (tekst));

 write ('Ten wyraz od tylu to: ');

 repeat

  l:=(copy (tekst,a,1));

  write (l);

  s := s+l;

  a:=a-1;

 until a=0;

 writeln;

 WriteLn(s);

 if tekst = s then writeln ('Ten tekst jest palindromem')

 else writeln ('Ten tekst nie jest palindromem');

 readln;

end.
#3

No tak, to banalne :smiley:

Dzięki bardzo za oświecenie mnie!

#4

Jeżeli potrzebujesz jedynie sprawdzić czy podany tekst jest palindromem to znacznie prostsze będzie to:

vartekst:string;p,k:integer;begin;write ('Wpisz wyraz: ');readln (tekst);p:=1;k:=length(tekst);pk)and(tekst[p]=tekst[k]) dobegin(p);Dec(k);end;pk then writeln ('Ten tekst nie jest palindromem')writeln ('Ten tekst jest palindromem');readln;end. [/code]Jednak a ni twój algorytm ani też ten powyżej nie uznaje za palindrom wyraz "Kobyła ma mały bok", mimo że nim jest. Aby algorytm "uwzględniał" ten oraz podobne palindromy to musi być nieco bardziej skomplikowany:
[code=php]var tekst:string;p,k:integer;begin('Wpisz wyraz: ');ReadLn(tekst);p:=1;k:=Length(tekst);pk dobeginwhile (pk)and(Pos(tekst[p],' '#9)0) do Inc(p);while (pk)and(Pos(tekst[k],' '#9)0) do Dec(k);if UpCase(tekst[p])UpCase(tekst[k]) then Break;Inc(p);Dec(k);end;pk then WriteLn('Ten tekst nie jest palindromem')WriteLn('Ten tekst jest palindromem');ReadLn;end. Jednak nawet ten algorytm nie uzna za palindrom napis: "KOBYŁA ma mały bok", aby to też zostało uznane trzeba dopisać własną wersje UpCase()
#5

@Up No tak, twoje rozwiązanie też są dobre, dzięki :slight_smile:

A jeszcze prosiłbym o pomoc w jednym zadaniu:

Program ma usunąć wszystkie spacje z danego tekstu

uses crt;

var

tekst:string;

x:byte;

begin

clrscr;

write ('Wpisz tekst: ');

readln (tekst);

x:=(pos (' ',tekst));

writeln (delete (tekst,x,1));

readln;

end.

Tu mi występuje błąd Error in expression wskazując na delete. Oczywiście zdaję sobie sprawę, że póki co program usunie tylko jedną spację. Proszę o pomoc.

#6

Argumentem procedury Writeln nie może być procedura (w tym przypadku Delete), ale może być funkcja, której wynik jest typu String lub Char, np:

Writeln(Chr(65)); { Drukuje literę A }

Póki co, to Twój program nie usunie żadnej spacji!. Niżej masz przykład, jak to można rozwiązać

var s, s1: string;

    i: Integer;

begin

  s:= 'napis testowy';

  s1:= '';

  for i:= 1 to Length(s) do

   if s[i] <> ' ' then s1:= s1 + s[i];

  Writeln(s1);

end;
#7

Dzięki bardzo, pozdrawiam.