Program generujący ciągi liczbowe

0

Witajcie forumowicze! Przejdę do konkretu, mianowicie mam wykonać na zaliczenie program, który generuje n 6cio liczbowych ciągów z zakresu 1-49. Problemem jest dla mnie to że każdy kolejny ciąg nie może zawierać liczb z poprzednich ciągów ( jeśli ciąg pierwszy to [1,3,5,7,8,9] to następne ciągi nie mogą zawierać tych liczb). Jak wiadomo przy takim założeniu mogę wygenerować maksymalnie 8 ciągów. Niestety nie jestem zbyt dobry w Pascalu..

program project1;
uses CRT;
var i,j,k,n,s,x,OK:integer;
A:array[1..100,1..6] of integer;
begin
ClrScr;
write('Podaj liczbe ciagow: ');
readln(n);
if n>8 then writeln(' NIE MA TYLU CIAGOW! program wygeneruje do 8 6-cio liczbowych ciagow z zakresu 1-49 ')
else
if n<=8 then
randomize;
for i:=1 to n do
    for j:=1 to 6 do
        repeat
        OK:=1;
            repeat
            A[i,j]:=random(49);
            until A[i,j]<>0;
                for k:=1 to j-1 do
                if (A[i,k]=A[i,j]) then OK:=0;
        until OK<>0;
   for i:=1 to n do
    for s:=1 to 5 do
        for j:=1 to 2 do
            if A[i,j]>A[i,j+1] then
            begin
            if n>8 then break
            else
            if n<=8 then
            x:=A[i,j]; A[i,j]:=A[i,j+1]; A[i,j+1]:=x;
            end;
if n<=8 then writeln('WYNIKI');
for i:=1 to n do
    begin
    if n>8 then break
        else
        if n<=8 then
    writeln(i,' ciag: ');
    for j:=1 to 6 do
        begin
        writeln(' ',A[i,j]);
        end;
    writeln;
    readln;
end;
readkey;
end. 

Proszę pomóżcie mi jeśli umiecie dokończyć program, za pomoc będę bardzo wdzięczny!

0

Spełniłem obywatelski obowiązek.

program project1;

uses 
  CRT;

var 
  i, j, k, n, s, x, OK: Integer;
  A: array [1..100, 1..6] of Integer;

begin
  ClrScr;
  Write('Podaj liczbe ciagow: ');
  Readln(n);
  if n > 8 then 
    Writeln('NIE MA TYLU CIAGOW! Program wygeneruje do 8 6-cio liczbowych ciagow z zakresu 1-49 ')
  else if n <= 8 then
  randomize;
  for I := 1 to n do
    for J := 1 to 6 do
      repeat
        OK := 1;
        repeat
          A[I, J] := Random(49);
        until A[i,j]<>0;
        
        for k := 1 to J - 1 do
          if A[I, K] = A[I, J]) then OK := 0;
      until OK <> 0;
  for I := 1 to n do
    for s := 1 to 5 do
      for j:=1 to 2 do
        if A[I, J] > A[I, J+1] then
          begin
            if n > 8 then 
              Break
            else if n <= 8 then
              x := A[I, J]; 
            A[I, J] := A[I, J+1]; 
            A[I, J+1] := x;
          end;

  if n <= 8 then Writeln('WYNIKI');
  for I := 1 to n do
    begin
      if n > 8 then 
        Break
      else if n <= 8 then Writeln(I, ' ciag: ');
      for J := 1 to 6 do
        Writeln(' ', A[I, J]);
        
      Writeln;
      Readln;
    end;
  ReadKey;
end.
0

A teraz pare uwag.

var 
  i, j, k, n, s, x, OK: Integer;
  A: array [1..100, 1..6] of Integer;

Nazywaj jakoś sensownie zmienne. Np zamiast A bardzo fajną nazwą byłoby Tablica (zważywszy na to że jest to jedyna tablica w programie).

  if n > 8 then 
    Writeln('NIE MA TYLU CIAGOW! Program wygeneruje do 8 6-cio liczbowych ciagow z zakresu 1-49 ')
  else if n <= 8 then
  randomize;

Jeżeli liczba jest nie jest większa od 8 to NA PEWNO jest mniejsza lub równa 8, wiec ten warunek if n <= 8 jest zupełnie nie potrzebny.

A[I, J] := Random(49);

Ten kod wylosuje liczbę 0-48, nie 1-49. Żeby to poprawić zastosuj Random(49) + 1;.

Zamiast ciągle wstawiać to

 if n > 8 then 
  Break
else

Mógłbyś raz wstawić to

if n <= 8 then
  begin
    //cały kod programu.
  end;

lub

 if <= 8 then Exit;
 if n <= 8 then
   x := A[I, J]; 
   A[I, J] := A[I, J+1]; 
   A[I, J+1] := x;

Tu chyba powinno stać begin..end;

1

Nie zadałeś pytania. Ja za to mam kilka do Ciebie:
A: array [1..100, 1..6] of Integer; - dlaczego 100 ?

repeat
   A[I, J] := Random(49);
until A[i,j]<>0;

A jaki efekt dałoby:

A[I,J] := Random(49) + 1;

?
Czy gdy warunek n > 8 się nie spełni czy może n mieć inną wartość niż n <= 8 ?

EDIT:
Sortowanie masz kiepiskie. Dlaczego tam j jest od 1 do 2?

0

I akurat nie mam co robić, oraz jestem miły więc ten Twój mozolnie napisany program zamienię na coś normalnego.

program Project2;

uses
  SysUtils;

type
  TSeries = array [0..5] of Integer;

var
  SeriesCount: Integer;
  Series : array of TSeries;
  K: Integer;

procedure ShowSeries();
var I, J: Integer; temp: string;
begin
  for I := 0 to High(Series) do
    begin
      for J := 0 to 4 do
        temp := temp + IntToStr(Series[I][J]) + ', ';
      temp := temp + IntToStr(Series[I][5]) + ', ';
      Writeln('Seria ', I, ': ', temp);
      temp := '';
    end;
end;

function IsNumberInSeries(aSeries: TSeries; aNumer: Integer): Boolean;
var I: Integer;
begin
  Result := False;
  for I := 0 to 5 do  
    if aSeries[I] = aNumer then
      begin
        Result := True; 
        Break;
      end;
end;

function RandomSeries(): TSeria;
var I: Integer; temp: integer;
begin
  for I := 0 to 5 do 
    begin
      repeat
        temp := Random(49) + 1;
      until not IsNumberInSeries(Result, temp);
      Result[I] := temp;
    end;
end;

begin
  Writeln('Podaj ile ciagow chcesz wylosowac');
  Readln(SeriesCount);
  SetLength(Series, SeriesCount);
  for K := 0 to SeriesCount do
    Series[K] := RandomSeries();
  
  ShowSeries;
  Readln;
end.

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