Pascal hiba? Se'gítsete'k Vuknak, a kis rókának (valamit még írnom k'ellett, m rövid volt a kérdés)

Fogalmam sincs, mi a baj a kódoddal, igaz, annyira szörnyű látvány, hogy eszembe se jutott belenézni.

Bizonyára van fifikásabb módja is, de én a magam részéről a string karaktereit sorban megvizsgálnám, és ha 's' vagy 'o', akkor átmásolnám egy másik stringbe. A végén pedig megnézném, hogy az új string tartalmazza-e a 'sos'-t.

tabaki kolléga elképzelése nagyon jó, írtam rá egy függvényt hátha kell még valakinek:

function myFound(subchar, s : string) : boolean;

var i : byte;

temp : string;

halmaz : set of char;

begin

temp := '';

halmaz := [];

myFound := False;

for i := 1 to Length(subchar) do if not (subchar[i] in halmaz) then halmaz := halmaz + [subchar[i]];

for i := 1 to Length(s) do if s[i] in halmaz then temp := temp + s[i];

myFound := Pos(subchar, temp) <> 0;

end;

@SimkoL:

Mmm, ez tetszik. Nekem persze nem is jutott eszembe ilyen szépen általánosítani a feladatot. De azért utólag közlöm az én próbálkozásomat is, hátha első blikkre érthetőbb.

Kérdező, a kérdésedből nem derült ki, hogy miért olvastad rekord-tömbbe az adatokat, ezt a részét én elhagytam. Itt a programom:

program soskereso_00;

var

sor : string;

fajl : text;

function Van_sos(szoveg : string) : boolean;

var

i : byte;

seged : string;

begin

           seged := '';

           for i := 1 to Length(szoveg) do

                       if szoveg[i] in ['o','s'] then seged := seged+szoveg[i];

           if Pos('sos', seged)>0 then Van_sos := True else Van_sos := False;

end;

BEGIN

           Assign(fajl, 'stringek.txt');

           {$I-} Reset(fajl); {$I+}

           if IOResult=0 then

                       while not Eof(fajl) do

                                   begin

                                   ReadLn(fajl, sor);

                                   if Van_sos(sor) then WriteLn(sor);

                                   end

           else begin

                       WriteLn('Nem talalom a STRINGEK.TXT fajlt!');

           end;

           ReadLn;

END.

A stringek.txt nálam Weöres Sándor Ócska Sírversek ciklusát tartalmazza:

[link]

A futtatás eredménye:

Bajusz Balázs voltam, ez a tény és való,

s nem sujt agyon senkit ílyen rossz barátság.

mindig szűz volt szegény pára,

Bábota Szilveszter, kustánszegi oskolamester,

Ime sírja Bakos Vincének,

Mit bánod már, hogy sohasem szívleltek a lányok,

Frászkarikán szánkáz kutyafarka varangyos a banda

Ilyesmire gondolok:

//tabaki:

function Van_sos(szoveg : string) : boolean;

var

i : byte;

seged : string;

begin

           seged := '';

           for i := 1 to Length(szoveg) do

                       if szoveg[i] in ['o','s'] then

                                   if seged[Length(seged)] <> szoveg[i] then seged := seged+szoveg[i];

           if Pos('sos', seged)>0 then Van_sos := True else Van_sos := False;

end;

//SimkoL:

function myFound(subchar, s : string) : boolean;

var i : byte;

temp : string;

halmaz : set of char;

begin

           temp := '';

           halmaz := [];

           myFound := False;

           for i := 1 to Length(subchar) do if not (subchar[i] in halmaz) then halmaz := halmaz + [subchar[i]];

           for i := 1 to Length(s) do if s[i] in halmaz then

                       if temp[Length(temp)] <> s[i] then temp := temp + s[i];

           myFound := Pos(subchar, temp) <> 0;

end;

Vagy pedig megkeressük a stringben az első és utolsó s-t és ha 'szorult' közéjük legalább egy o akkor rendben.

program Project1;

uses strutils;

var s: string;

first, last : byte;

begin

s := 'zsíroskenyér';

first := Pos('s', s);

last := Length(s) + 1 - Pos('s', ReverseString(s));

WriteLn(first, ' ', last, ' ', Pos('o', s));

if (Pos('o', s) > first) and (Pos('o', s) < last) then WriteLn(s);

ReadLn;

end.

@SimkoL:

!!!

:D