Sprawdzanie długości wyrazów w linijce.

0

Witam, mam problem z pewnym zadaniem. Mam z pliku zczytać linijki z wyrazami i sprawdzić w których linijkach każdy wyraz ma tyle samo znaków. w każdej linijce jest po 5 wyrazów różnej długości.
np.

rezas orkan dialog bamb pudel
wrona rossa slowo gwert rezas
kruk azer ekran drty reza
karmel kytap hello kytap patyk
czekolada otof pajacyk tptpt foto
ciastko palma kabaret galme lampa
kwas koko ala okohl oko
biurko parkiet ola gruszka cebula
kartofel parkiet ayszkm raban czekolada

(ważne, na końcu każdej linijki jest spacja!)

W teorii (przynajmniej tak mi się wydaje) kod powinien działać, ale oczywiście tak nie jest a sam nie mogę wpaść gdzie jest błąd..

const
n=200;

var
plik:text;
tab:array[1..n] of string;
i,j,l:integer;
k:integer;
z:integer;
dlugosc:array[1..5] of integer;
pierwszy:boolean;

begin
assign(plik,'wyrazy.txt');
reset(plik);

pierwszy:=true;
k:=1;

for i:=1 to n do readln(plik,tab[i]);

close(plik);

for i:=1 to n do
begin
     z:=length(tab[i]);
     for j:=1 to z do
     begin
          if (tab[i][j]=' ') and (pierwszy=false) then
          begin
               dlugosc[k]:=j-1-dlugosc[k-1];
               k:=k+1;
          end;
          if (tab[i][j]=' ') and (pierwszy=true) then
          begin
               dlugosc[k]:=j-1;
               pierwszy:=false;
               k:=k+1;
          end;
     end;
     writeln;
     if (((dlugosc[1] = dlugosc[2]) and (dlugosc[2] = dlugosc[3])) and ((dlugosc[3] = dlugosc[4]) and (dlugosc[4] = dlugosc[5]))) then
     begin
          writeln('linijka nr ',j);
     end;
     k:=1;
     pierwszy:=true;

end;
readln;

end.
0

po co tyle tablic i zmiennych

Jak ci coś nie pasuje to pisz

const
 N = 10;

var
 F:Text;
 Str:String;
 Y,X,Z:Integer;
 TAB:array[0..N,0..4] of Integer;
begin

 Assign(F,'C:\test.txt');
 Reset(F);

for X := 0 to N do begin
 ReadLn(F,Str);
 WriteLn;
 WriteLn(Str);
 for Y := 0 to 4 do begin
  if Y = 4 then begin
   WriteLn(Length(Copy(Str,1,Length(Str))),' ',Copy(Str,1,Length(Str)));
   TAB[X,Y]:=Length(Copy(Str,1,Length(Str)));
   Delete(Str,1,Length(Str));
  end else begin
   WriteLn(Length(Copy(Str,1,Pos(' ',Str)-1)),' ',Copy(Str,1,Pos(' ',Str)-1));
   TAB[X,Y]:=Length(Copy(Str,1,Pos(' ',Str)-1));
   Delete(Str,1,Pos(' ',Str));
  end;
 end;
end;
 Close(F);

for X := 0 to N do begin
  for Y := 0 to 4 do begin
    for Z := 0 to 4 do begin
     if (TAB[X,Y] = TAB[X,Z]) AND (TAB[X,Y] <> 0) then WriteLn('W linii [',X+1,'] wyraz [',Y+1,'] ma tyle samo znakow co[',Z+1,']');
    end;
  end;
end;

tak poza tym to jakim prawem stosujesz dwu-wymiarowe tablice tab[i][j]=' ' jak zadeklarowane masz jedno tab:array[1..n] of string;
po co resetować k:=1;
jeżeli pętla for robi to sama
___ tutaj
/
for i:=1 to n do readln(plik,tab[i]);

poczytaj sobie o tablicach, pętlach i formatowaniu string'ów (ciągów znaków)

a i zapomniałem, po c**** mi dał ktos -1 ?
co niby

k:integer;
z:integer;
dlugosc:array[1..5] of integer;
pierwszy:boolean;

było potrzebne ? bo w moim kodzie tego nie ma ;]

0

używam podwójnej tablicy ponieważ string jest tablicą charów a moją pętla sprawdzam znak po znaku, wiele razy takie coś stosowałem i działało..
resetuje k sam bo tak mi było wygodniej, nie mam ograniczenia pamięci czy czasu na działanie programu więc nie jest to też błędne.

i raczej prosiłbym o napisanie gdzie jest kawałek/błąd w moim kodzie niż pisaniu od podstaw innego, nie chodzi mi o gotowca

0

nie musisz ładować wszystkich linijek do tablicy, zrób w pętli ładowanie jednej (readln) i od razu ją sprawdzaj.

podobnie

if (((dlugosc[1] = dlugosc[2]) and (dlugosc[2] = dlugosc[3])) and ((dlugosc[3] = dlugosc[4]) and (dlugosc[4] = dlugosc[5]))) then

nie musisz zapamiętywać wszystkich długości i potem wszystkich porównywać. wystarczy że (znowu w pętli) porównasz drugą, trzecią, czwartą piątą — z pierwszą. jeśli którakolwiek się różni od pierwszej, przerywasz pętlę i nie sprawdzasz dalszych, tylko przechodzisz do następnej linii.

0

Wydaje mi się, że proqix trochę przekombinował z algorytmem (mnogość funkcji Length i Copy mnie odstrasza od analizy kodu ;)), więc ja, mam nadzieję, uproszczę

const
  n = 200;

var
  plik: text;
  tab: array[1..n] of string;
  i, j, k, IleLinii, IleLiter, KtoryWyraz: Integer;
  DlugoscWyrazu: array[1..5] of Integer;
  TyleSamoZnakow: Boolean;

begin
  Assign(plik, 'wyrazy.txt');
  Reset(plik);
  IleLinii:= 0;
  while not Eof(plik) do begin
    Inc(IleLinii);
    Readln(plik, tab[IleLinii]);
  end;
  Close(plik);

  for i:= 1 to IleLinii do begin
    KtoryWyraz:= 1;
    IleLiter:= 0;
    for j:= 1 to Length(tab[i]) do begin
      if tab[i][j] = ' ' then begin
        DlugoscWyrazu[KtoryWyraz]:= IleLiter;
        Inc(KtoryWyraz);
        IleLiter:= 0;
      end
      else Inc(IleLiter);
    end;

    TyleSamoZnakow:= true;
    for k:= 1 to 4 do
      if DlugoscWyrazu[k] <> DlugoscWyrazu[k+1]
      then TyleSamoZnakow:= false;
    if TyleSamoZnakow then Writeln('Linijka nr ', i);
  end;
  Readln;
end.
0

@simplex
za optymalność kodu dostał byś pizde, po po co ci tyle zmiennych no ale dobra jeżeli to program na zaliczenie to może być ale jak chodzi o początki nauki programowania to jak tak będzie ktoś robił to np grę to zamiast 3GB potrzebne będzie 4 i co, poza tym słabe algorytmy na gorszych kompach będą mulić grę no ale to tak na przyszłość...

fakt
zamiast

 if Y = 4 then begin
   WriteLn(Length(Copy(Str,1,Length(Str))),' ',Copy(Str,1,Length(Str)));
   TAB[X,Y]:=Length(Copy(Str,1,Length(Str)));
   Delete(Str,1,Length(Str));
  end else begin
   WriteLn(Length(Copy(Str,1,Pos(' ',Str)-1)),' ',Copy(Str,1,Pos(' ',Str)-1));
   TAB[X,Y]:=Length(Copy(Str,1,Pos(' ',Str)-1));
   Delete(Str,1,Pos(' ',Str));
  end;

można

   TAB[X,Y]:=Length(Copy(Str,1,Pos(' ',Str)-1));
   Delete(Str,1,Pos(' ',Str)-1));

nie zauważyłem jak skopiowałem cytat (testowy) to on nie ma spacji na końcu...

WriteLn(Length(Copy(Str,1,Pos(' ',Str)-1)),' ',Copy(Str,1,Pos(' ',Str)-1));

testowo mi wypisywał co ile ma znaków... więc to można usunąć...

weź ty się ogarnij, nie obraź się ale

mnogość funkcji Length i Copy mnie odstrasza od analizy kodu
to są podstawy, a ich nie jest tak dużo.

@tariel36
no cóż ja podałem gotowca byś sobie przeanalizował i zauważył jak duży masz nie działający kod a jak można to zmieścić w mniejszym.
a co od tego

 if (((dlugosc[1] = dlugosc[2]) and (dlugosc[2] = dlugosc[3])) and ((dlugosc[3] = dlugosc[4]) and (dlugosc[4] = dlugosc[5]))) then

to nie rozumiem, bo jeżeli któreś z działań zwróci False to cała linijka idzie do kosza to chyba logiczne...

jak coś robisz to rób to porządnie a nie na odczep sie bo wejdzie to ci w nawyk

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