Matematické Fórum

for i:= 1 to (k-1) do and (k+1) to  m do

na takovou syntaxi jsi přišel kde?

prostě k tomu řádku kde vypisuješ hodnoty přidej podmínku, že i<>k a j<>k

diky moc :-)

Tady je konzolová aplikace
Matice je generována z náhodných čísel.

program Matice2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type Tpole=array of array of Integer; //natypovani pole pro matici
var i,j,m,n,k,x,pokr,konec:Integer;
  anone:string;
  a,b:Tpole; //matice A (maximalne 10 radku a 10 sloupcu) a B


begin
  Randomize;
  pokr := 0; //Promenna pro moznost pokracovani
  WriteLn('-----------------------------------Matice----------------------------------'); //Uvodni vypis
  WriteLn;
  WriteLn(' Na vstupu se zadaji rozmery matice A o m radcich a n sloupcich,');
  WriteLn(' kde m a n jsou cela cisla z intervalu <1,10> a cislo mensi rovno');
  WriteLn(' mensimu cislu z m a n, tedy z intervalu <1,min(m,n)>');
  WriteLn(' Na vystupu je pak matice z vynechanym k-tym radkem a sloupcem');
  while pokr=0 do
  begin
    m := -1;
    n := -1;
    k := -1;
    SetLength(a,0);
    SetLength(b,0);
    WriteLn;
    WriteLn(' Vstup');
    //zadani poctu radku
    repeat//Dokud se nezada cislo porad opakujeme zadani
      try
        WriteLn;
        Write(' Zadej pocet radku matice m: ');
        ReadLn(m);
      except
        on EInOutError do //Osetrení spatnych vstupu-napr.pismena,
        begin//nebo cisla vetsi nez 2147483647 (rozsah Integer)
          WriteLn(' m musi byt cele cislo z intervalu <1,10>');
          m := -1;
        end;
      end;
    until m<>-1;
    if (m<1)or(m>10) then //Pokud zadame cislo mimo interval
      repeat//tak to nedovolime
        WriteLn(' m musi byt cele cislo z intervalu <1,10>');
        WriteLn;
        Write(' Zadej pocet radku matice m: ');
        ReadLn(m);
      until (m>=1)and(m<=10);
    //zadani poctu sloupcu
    repeat//Dokud se nezada cislo porad opakujeme zadani
      try
        Write(' Zadej pocet sloupcu matice n: ');
        ReadLn(n);
      except
        on EInOutError do //Osetrení spatnych vstupu-napr.pismena,
        begin//nebo cisla vetsi nez 2147483647 (rozsah Integer)
          WriteLn(' n musi byt cele cislo z intervalu <1,10>');
          n := -1;
        end;
      end;
    until n<>-1;
    if (n<1)or(n>10) then //Pokud zadame cislo mimo interval
      repeat//tak to nedovolime
        WriteLn(' n musi byt cele cislo z intervalu <1,10>');
        WriteLn;
        Write(' Zadej pocet sloupcu matice n: ');
        ReadLn(n);
      until (n>=1)and(n<=10);
    //zadani cisla k
    repeat//Dokud se nezada cislo porad opakujeme zadani
      try
        Write(' Zadej vynechany radek a sloupec k: ');
        ReadLn(k);
      except
        on EInOutError do //Osetrení spatnych vstupu-napr.pismena,
        begin//nebo cisla vetsi nez 2147483647 (rozsah Integer)
          WriteLn(' k musi byt cele cislo z intervalu <1,min(m,n)>');
          k := -1;
        end;
      end;
    until k<>-1;
    if m<n then
      x := m
    else
      x := n;
    if (k<1)or(k>x) then //Pokud zadame cislo mimo interval
      repeat//tak to nedovolime
        WriteLn(' k musi byt cele cislo z intervalu <1,min(m,n)>');
        WriteLn;
        Write(' Zadej vynechany radek a sloupec k: ');
        ReadLn(k);
      until (k>=1)and(k<=x);

    SetLength(a,m,n);
    for i := 0 to m-1 do //naplnime matici A nahodnymi cisly od 1 do 100
      for j := 0 to n-1 do
        a[i,j] := Random(100)+1;

    k := k-1;  //k-1 proto, ze mame pole (matici) cislovanou od 0
    SetLength(b,m,n);  //budou same nuly
    for i := 0 to m-1 do  //naplnime matici B (vynechame k-ty radek a sloupec
      for j := 0 to n-1 do
        if ((i<>k)and(j<>k)) then
          b[i,j] := a[i,j];


    WriteLn(' Vystup');
    WriteLn;
    WriteLn(' Zobrazeni naplnene matice A typu '+IntToStr(m)+'x'+IntToStr(n)+':');
    WriteLn;
    for i := 0 to m-1 do
    begin
      for j := 0 to n-1 do
        Write(a[i,j]:4);
      WriteLn;
    end;
    WriteLn;
    WriteLn(' Zobrazeni matice B typu '+IntToStr(m-1)+'x'+IntToStr(n-1)+' s vynechanym '+IntToStr(k+1)+'. radkem a sloupcem:');
    WriteLn;

    for i := 0 to m-1 do
    begin
      for j := 0 to n-1 do
        if b[i,j]<>0 then   //kdyz neni nula vypiseme
          Write(b[i,j]:4);
      if i<>k then   //kdyz  neni radek s nulama tak piseme na novy
        WriteLn;
    end;
    WriteLn;
    konec := 0;
    repeat//Opakujeme vyzvu, dokud nenapisme a nebo n
      Write(' Nova matice? [a/n] '); //Chceme-li novou matici napiseme a
      ReadLn(anone);
      if (anone='n')or(anone='N')or(anone='a')or(anone='A') then
        konec := 1
      else
      begin
        WriteLn;
        WriteLn(' Musis zadat a nebo n');
      end;
    until konec<>0;
    if (anone='n')or(anone='N') then //V pripade ze napiseme n + ENTER - program skonci
      pokr := 1;
  end;

end.