funkcja - zwracanie pierwszego słowa

0

Witam
Mam taki oto program tyle że nie działa on tak jak powinien.

function getword(var s:string) : string;
 begin
   readln(s);
   while pos(#32,s) > 0 do
     begin
     while copy(s,1,1) = #32 do
     delete(s,1,1);
     writeln(copy(s,1,pos(#32,s)-1));
     delete(s,1,pos(#32,s));
   end;
   if s<>'' then
   writeln(s);
   readln
 end;

var s:string;
begin
  writeln('Wpisz teraz jakies zdanie i nacisnij ENTER:');
  writeln;
  getword(s);
end.

W tej chwili tak funkcja w sumie niczego nie zwraca (równie dobrze mogłoby jej nie być). Co zrobić aby funkcja zwracała pierwsze od lewej słowo znajdujące się w "s"? tzn. żeby każde słowo było tak jakby osobno zwracane.

Proszę o pomoc.
Pozdrawiam

0

Przy założeniiu, że pierwszy wyraz oddziela jedna spacja (#32) to raczej tak najprościej...

program ogarniaj_podstawy_do_korzystania_z_google_nie_miej_obawy;

{$APPTYPE CONSOLE}

function GetWord(S : string) : string;
var
  X : integer;
begin
  Result := '';
  X := Pos(#32, S);
  if X > 0 then
  begin
    Result := Copy(S, 1, X - 1);
  end;
end;

var
  S : string;
begin
  Write('Wpisz teraz jakies zdanie i nacisnij ENTER: ');
  Readln(S);
  Writeln(GetWord(S));
  Readln;
end.

I na przyszłośc taguj swoje wątki przynajmniej nazwą środowiska i języka jakich dotyczy pytanie, a pytania takie jak to o banalne podstawy zadawaj w dziale Newbie.

0
function GetWord(var Str:String;const Delimeter:String):String;
var P:Integer;
begin
  P:=Pos(Delimeter,Str);
  if P>0 then
  begin
    Result:=Copy(Str,1,P-1);
    Delete(Str,1,P+Length(Delimeter)-1);
  end
  else
  begin
    Result:=Str;
    SetLength(Str,0);
  end;
end;
// wywołanie:
S:='ala ma kota';
s1:=GetWord(S,' ');
s2:=GetWord(S,' ');
s3:=GetWord(S,' ');
// lub
S:='ala ma kota';
while Length(S)>0 do WriteLn(GetWord(S,' '));
0

@olesio środowisko to Free Pascal. Wywaliło takie błędy:

dsds.pas(5,10) Error: Identifier not found "Result"
dsds.pas(9,12) Error: Identifier not found "Result"
dsds.pas(20,4) Fatal: There were 2 errors compiling module, stopping
dsds.pas(0) Fatal: Compilation aborted

0

ok program @_13th_Dragon to chyba to, mam tak:

function GetWord(var s:String;const Delimeter:String):String;
var P:Integer;
begin
  P:=Pos(Delimeter,s);
  if P>0 then
  begin
    GetWord:=Copy(s,1,P-1);
    Delete(s,1,P+Length(Delimeter)-1);
  end
  else
  begin
    GetWord:=s;
    SetLength(s,0);
  end;
end;

var s:string;
begin
readln(s);
while Length(S)>0 do WriteLn(GetWord(S,' '));
readln
end.

Jak wsadzić ten kawałek kodu z mojego pierwszego programu?

delete(s,1,1);
     writeln(copy(s,1,pos(#32,s)-1));
     delete(s,1,pos(#32,s));

Chodzi o to, że jak napiszę "Ala ma kota" z dwoma spacjami żeby też zadziałało jak należy.
Pozdrawiam

0

Kod, który podesłal kAzek ma przecież możliwośc ustawienia dowolnego separatora czyli i dwóch spacji także. A mój kod działa pod FreePascalem jak dodasz na początku kodu dyrektywe kompilatora: {$MODE DELPHI}

0

@olesio twój kod wypisuje tylko jeden wyraz (np. napiszesz "ala ma kota" to wypisze tylko "ala").

ma przecież możliwośc ustawienia dowolnego separatora czyli i dwóch spacji także

no ale ilość spacji może być różna, zależy ile poda użytkownik, nie może być to od górnie zdefiniowane że np. zawsze będą wpisywane dwie spacje

0

Napisałeś, że chcesz wydobyć pierwsze słowo i zarówno mój kod jak i kAzka to robi. Jak chcesz podzielić na wyrazy względem separatora to skorzystaj w FPC z modułu Classes i koniecznie dodaj {$MODE DELPHI} żeby się kompilator nie czepiał, że nie wie co to Result. Ewentualnie przerób sobie te funkcje aby dodawała do statycznej albo dynamicznej tablicy stringów.

function Explode(Str : string; Separator : string) : TStringList;
var
  X : integer;
begin
  Result := TStringList.Create;
  X := Pos(Separator, Str);
  while X > 0 do
  begin
    Result.Add(Copy(Str, 1, X - 1));
    if X <= Length(Str) then
    begin
      Str := Copy(Str, X + Length(Separator), Length(Str));
    end;
    X := Pos(Separator, Str);
  end;
  if (Length(Str) > 0) then
  begin
    Result.Add(Str);
  end;
end;

W Turbo Pascalu napisałem kiedyś taki przykład. Ale FPC ma już z tego co widze bez problemową obslugę tablic dynamicznych, także jak nie chcesz używac TStringList to sobie poniższy kod przerób dla tablicy dynamicznej, nie jest to problem - wystarczy zwiększać jej rozmiar przez SetLength.

program gles;

const
  AFileName = 'D:\data.txt';
  LeftChars : array[boolean] of string = (#32, #32#32);
type
  TStringArray10 = array[1..10] of string;
var
  TF : Text;
  S, Line : string;
  I, Code : integer;
  Arr : TStringArray10;

procedure Explode(Str : string; Separator : string; var AnArr : TStringArray10);
var
  I, X : integer;
begin
  I := Low(AnArr);
  X := Pos(Separator, Str);
  while X > 0 do
  begin
    if I <= High(AnArr) then
    begin
      AnArr[I] := Copy(Str, 1, X - 1);
      I := I + 1;
    end;
    if X <= Length(Str) then
    begin
      Str := Copy(Str, X + Length(Separator), Length(Str));
    end;
    X := Pos(Separator, Str);
  end;
  if (Length(Str) > 0) then
  begin
    if I <= High(AnArr) then
    begin
      AnArr[I] := Str;
    end;
  end;
end;

begin
  Assign(TF, AFileName);
{$I-}
  Reset(TF);
{$I+}
  if IOResult <> 0 then
  begin
    Writeln('Nie mozna wczytac lub brak pliku: ', AFileName, '!');
  end
  else
  begin
    while not EOF(TF) do
    begin
      for I := Low(Arr) to High(Arr) do
      begin
        Arr[I] := '';
      end;
      Readln(TF, Line);
      S := Copy(Line, 1, Pos(#32, Line) - 1);
      Val(S, I, Code);
      if (Code = 0) and (I <= High(Arr)) then
      begin
        S := Copy(Line, Pos(#32, Line) + 1, MaxInt);
        Explode(S, #32, Arr);
        for I := Low(Arr) to High(Arr) do
        begin
          if Arr[I] <> '' then
          begin
            Writeln(LeftChars[I < High(Arr)], I, ': ', Arr[I]);
          end
          else
          begin
            Break;
          end;
        end;
        Writeln;
      end;
    end;
    Close(TF);
  end;
  Readln;
end.
0

i koniecznie dodaj {$MODE DELPHI} żeby się kompilator nie czepiał, że nie wie co to Result
lepiej {$MODE OBJFPC}, bo DELPHI wyłącza rozszerzenia specyficzne dla Free Pascala.

0

Napisałeś, że chcesz wydobyć pierwsze słowo i zarówno mój kod jak i kAzka to robi.

Program kAzka wypisuje wyraz po wyrazie. A twój tylko pierwszy wyraz. Chodziło mi o to aby z każdym wykonaniem funkcji zostało zwracane kolejne słowo (nie wiem jak to inaczej opisać).

Mój pierwszy program nie potrzebował żadnej funkcji żeby działał poprawnie jak ktoś wpisze np. dwie lub trzy spacje między wyrazami.

0

tak nie należy robić. wykorzystaj funkcję Explode z przykładu, który dostałeś powyżej. zwraca listę TStringList słów w stringu.

{$mode objfpc}
uses classes;

// tu wklej funkcję Explode

var lista:TStringList;
begin
  lista := Explode('ala ma kota',' ');
  for i:=0 to lista.count-1 do
    writeln(lista[i]);
  lista.Free; // listę trzeba zwolnić gdy już nie jest potrzebna
end.
0

@Azarien brak tablicy:

First compilation of c:\program files\fpc\2.4.0\bin\i386-win32\dsdsd.pas
dsdsd.pas(29,8) Error: Identifier not found "i"
dsdsd.pas(29,7) Error: Ordinal expression expected
dsdsd.pas(29,7) Error: Illegal counter variable
dsdsd.pas(30,20) Error: Identifier not found "i"
dsdsd.pas(32,4) Fatal: There were 4 errors compiling module, stopping
dsdsd.pas(0) Fatal: Compilation aborted

jak ona ma wyglądać?

0

Może daruj sobie programowanie, jeżeli nie umiesz samodzielnie wpaść na to żeby dodać zmienną dla pętli, o ktorej może z pośpiechu zapomniał Azarien. Trzeba trochę samodzielnie myśleć - kombinowac, a jak kompilator wyświetli jakieś błedy to się do nich stosowac i poprawiać kod lub go uzupełniać. Ja rozumiem podstawy, dział Newbie i tak dalej. Ale powinieneś najpierw poczytać podstawowe kursy, a dopiero później brać się za rozbijanie łańcucha tekstowego na elementy. Masz poniżej jak to powinno wyglądać, ale i tak zaraz będzie 100 kolejnych pytań pewnie ;/

program rece_opadaja;

{$MODE OBJFPC}

uses
  Classes;

function Explode(Str : string; Separator : string) : TStringList;
var
  X : integer;
begin
  Result := TStringList.Create;
  X := Pos(Separator, Str);
  while X > 0 do
  begin
    Result.Add(Copy(Str, 1, X - 1));
    if X <= Length(Str) then
    begin
      Str := Copy(Str, X + Length(Separator), Length(Str));
    end;
    X := Pos(Separator, Str);
  end;
  if (Length(Str) > 0) then
  begin
    Result.Add(Str);
  end;
end;

var
  I : integer;
  Lista : TStringList;
begin
  Lista := Explode('ala ma kota', ' ');
  for I := 0 to Lista.Count - 1 do
    Writeln(Lista[I]);
  Lista.Free;
  Readln;
end.
0

Chyba po to jest to forum aby zadawać pytania?! z resztą nie ważne zrobiłem to inaczej (krócej), nie dodając do tego żadnej specjalnej funkcji.

function GetWord(var s:String;const Delimeter:String):String;
var P:Integer;
begin
          repeat
            P:=Pos(Delimeter,s);
            if p=1 then
            delete(s,1,Length(Delimeter));
          until p<>1;

  P:=Pos(Delimeter,s);
  if P>0 then
  begin
    GetWord:=Copy(s,1,P-1);
    Delete(s,1,P+Length(Delimeter)-1);
  end
  else
  begin
    GetWord:=s;
    SetLength(s,0);
  end;
end;

var s:string;
begin
readln(s);
while Length(S)>0 do WriteLn(GetWord(s,' '));
readln
end.

Dodałem tą pętlę repeat. Czy ten sposób jest dobry? Działać w każdym razie działa. :)

0

działać może działa, ale dobry styl programowania wymaga, by funkcja
• pobierała parametry
• zwracała wynik - jako wartość zwracaną lub do parametrów przekazywanych przez referencję

u ciebie funkcja pobiera dwa stringi (oba przez referencję), zwraca jakąś wartość, ale przy tym uszkadza jedną z danych wejściowych. dlatego pisałem wcześniej, że „tak nie należy robić”.

0

Witam
Postanowiłem dalej rozbudowywać istniejący program.
Chciałbym aby program obliczył ile różnych słów znajduje się w pliku A.TXT, przy czytaniu ma korzystać z GetWord.
Dodałem tablicę bo gdzieś te słowa trzeba umieszczać. Teraz trzeba sprawdzić czy słowo występuje w tablicy, jeśli tak to zwiększyć licznik wystąpień. Na końcu wypisać wszystko. Trochę zagmatwałem ale pokarzę jak to ma wyglądać:
wpisuje: Ala i Ala. Wypisuje mi:
Ala 2
i 1
Tak zacząłem:

function GetWord(var s:String;const Delimeter:String):String;
var P:Integer;
begin
  repeat
    P:=Pos(Delimeter,s);
    if p=1 then
    delete(s,1,Length(Delimeter));
  until p<>1;

  {P:=Pos(Delimeter,s);}
  if P>0 then
  begin
    GetWord:=Copy(s,1,P-1);
    Delete(s,1,P+Length(Delimeter)-1);
  end
  else
  begin
    GetWord:=s;
    SetLength(s,0);
  end;
end;


const max=2000;
type
  T1 = record
     s:string;
     n:longint;
end;

var s:string;
    tab:array[1..max] of T1;
    n:integer;
    t:text;

begin
assign(t, 'C:\A.txt\');
reset(t);

{while Length(s)>0 do WriteLn(GetWord(s,' '));}

for n:=1 to max do
read(t, tab[n]);

close(t);
readln
end.

Proszę o pomoc.
Pozdrawiam

0

I pewnie oczekujesz że pascala pisali jasnowidzowie, którzy przewidzieli ze napiszesz taką strukturę T1 i funkcja read w którą wbudowany został sztuczny Prorok Delfijski będzie wiedziała co chcesz wstawić w string'a a co w longint'a?

0

Przepraszam, zapomniałem napisać po prostu.
s: string; {słowo}
n: longint; {ile razy występuje w pliku}

0

@_13th_Dragon to rozumiem że istniejąca funkcja jest bezużyteczna w tym przypadku? Szkoda. Wydawało mi się że nada się idealne.

0

Tu bardziej się przyda coś w ten deseń:

function NextWord(var p:Text;const Delims:String):String;
var ch:Char;
begin
  Result:='';
  while not Eof(p) do
  begin
    Read(p,ch);
    if Pos(ch,Delims)<=0 then
    begin
      Result:=ch;
      while not Eof(p) do
      begin
        Read(p,ch);
        if Pos(ch,Delims)>0 then Exit;
        Result:=Result+ch;
      end;
    end;
  end;
end;

procedure list;
var p:Text;
begin
  Assign(p,'words.pas');
  Reset(p);
  while not Eof(p) do WriteLn(NextWord(p,' ,.!?:;()[]{}<>\/*+-='''#9#13#10#26));
  Close(p);
end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1