Администраторы группы

  • Аватар

Олимпиада по информатике. Готовимся побеждать!

Открытая группа активность: 4 ч., 34 мин. назад

Группа для тех, кто намеревается побеждать на районных и региональных олимпиадах по информатике.
Здесь можно будет найти олимпиадные задания, задачи повышенной сложности, обсудить оптимальные алгоритмы решений
Памятка для участников олимпиады

Сайт Информатикс – регистрирууемся, решаем, продвигаемся в рейтинге

Программирование на Pascal. (записей: 71)

← Форум группы   Все форумы
  • Аватар LukasTrickster - 1 мес. назад:

    Количество элементов больших обоих соседей
    https://informatics.msk.ru/mod/statements/view3.php?id=208&chapterid=68#1

    const
      Q=100;
    
    var
      a,b,c:longint;
      z:array [0..Q] of longint;
    
    BEGIN
    read(a);
    read(z[1]);
    for b:=2 to a do
      read(z[b]);
    for b:=2 to a-1 do
      if (z[b] > z[b-1]) and (z[b] > z[b+1]) then c:=c+1;
    
    write(c);
    end.
    
  • Аватар LukasTrickster - 1 нед., 3 дн. назад:

    Задание на урок

    uses crt;
    
    var
      a,b,c,d:byte;
      z:array [1..4,1..3] of byte;
    
    BEGIN
    ClrScr;
    randomize;
    
    for a:=1 to 4 do
      for b:=1 to 3 do
        z[a,b]:=random(10);
    
    for a:=1 to 4 do
      for b:=1 to 3 do
        begin
          GOtoXY(a*4,b*3);
          write(z[a,b]);
        end;
    
    c:=0;
    for a:=1 to 4 do
      c:=c+z[a,1];
    writeln(' ');
    write('Сумма всех чисел первого столбика по горизонтали:=',c);
    
    c:=0;
    for a:=1 to 4 do
      c:=c+z[a,2];
      writeln(' ');
    write('Сумма всех чисел второго столбика по горизонтали:=',c);
    
    c:=0;
    for a:=1 to 4 do
      c:=c+z[a,3];
      writeln(' ');
    write('Сумма всех чисел третьего столбика по горизонтали:=',c);
    
    c:=0;
    for b:=1 to 3 do
      c:=c+z[1,b];
      writeln(' ');
    write('Сумма всех чисел первого столбика по вертикали:=',c);
    
    c:=0;
    for b:=1 to 3 do
      c:=c+z[2,b];
      writeln(' ');
    write('Сумма всех чисел второго столбика по вертикали:=',c);
    
    c:=0;
    for b:=1 to 3 do
      c:=c+z[3,b];
      writeln(' ');
    write('Сумма всех чисел третьего столбика по вертикали:=',c);
    
    c:=0;
    for b:=1 to 3 do
      c:=c+z[4,b];
      writeln(' ');
    write('Сумма всех чисел четвёртого столбика по вертикали:=',c);
    
    c:=0;
    for a:=1 to 4 do
      for b:=1 to 3 do
        c:=c+z[a,b];
        writeln(' ');
    write('Сумма всех чисел этой матрицы:=',c);
    END.
    
  • Аватар LukasTrickster - 1 нед. назад:

    Задание на урок

    [/pascal]
    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,e,f:byte;
      z:array [1..Q,1..Q] of byte;
    
    BEGIN
    
    read(c);
    
    randomize;
    
    for a:=1 to c do
      for b:=1 to c do
        z[a,b]:=random(10);
    
    e:=0;
    d:=z[4,1];
    for b:=1 to c do
      if 5<z[4,b] then e:=e+1;
    
    d:=z[4,1];
    for b:=1 to c do
      if d<z[4,b] then d:=z[4,b];
    
    for a:=1 to c do
      for b:=1 to c do
        begin
          gotoxy(a*3,b*2);
          write(z[a,b]);
        end;
    
    f:=0;
    for a:=1 to c do
      if z[a,4] = 22 then f:=a;
    
    writeln(' ');
    write('Ячейка со значением =5 содержится в столбце №',f,' строки матрицы №4 ');
    
    writeln(' ');
    write('максимальное значение в 4 стобце = ',d);
    
    writeln(' ');
    write('вот столько значений в 4 столбце больше 5 = ',e);
    
    END.
    /[pascal]
  • Аватар LukasTrickster - 6 дн., 9 ч. назад:

    КОДИЩЕ !

    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,e,f:byte;
      z:array [1..Q,1..Q] of byte;
    
    procedure MaxX(x:byte);
    
    var
      max,i:byte;
    
    begin 
    
    max:=z[x,1];
    for i:=1 to c do
      if max<z[x,i] then max:=z[x,i];
    writeln(' ');
    write('максимальное значение в стобце',x,'=',max);
    
    end;
    
    BEGIN
    
    read(c);
    
    randomize;
    
    for a:=1 to c do
      for b:=1 to c do
        z[a,b]:=random(10);
    
    e:=0;
    d:=z[4,1];
    for b:=1 to c do
      if 5<z[4,b] then e:=e+1;
    
    for a:=1 to c do
      for b:=1 to c do
        begin
          gotoxy(a*3,b*2);
          write(z[a,b]);
        end;
    
    f:=0;
    for a:=1 to c do
      if z[a,4] = 22 then f:=a;
    
    writeln(' ');
    write('Ячейка со значением =5 содержится в столбце №',f,' строки матрицы №4 ');
    
    write('максимальное значение в стобце в каком столбце');
    read(d);
    MaxX(d); 
    
    writeln(' ');
    write('вот столько значений в 4 столбце больше 5 = ',e);
    
    END.
    
  • Аватар prepod - 5 дн., 19 ч. назад:

    Ну вот так мы постепенно, несколько хаотично, но эволюционируем к структурному программированию)

  • Аватар LukasTrickster - 3 дн., 6 ч. назад:

    Могу и дальше кодить и сотворить подпрограммы с другими основными операциями применяемыми к матрице но ЛЕнь да и тут уже много вопросов скопилось боюсь что дальнейший кодинг приведёт к монстру уже космического масштаба

    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,e:word;
      z:array [1..Q,1..Q] of word;
    
    procedure Mas; //Подпрограмма для вызова матрицы со случайными числами
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to a do
        for j:= 1 to b do
          begin
            gotoxy(i*4,j*3);
            z[i,j]:=random(10);
            writeln(z[i,j]);
          end;
    
    end;
    
    procedure MaxXY; //Подпрограмма для определения максимального значения матрицы или отдельных столбцов матрицы (2х)
    
    var
      i,j,g:word;
    
    begin
    
    g:=0;
    
    if c = 1
      then
        for i:=1 to a do
          for j:=1 to b do
            if g < z[i,j] then g:=z[i,j];
    
    if c = 1 then write('Наибольшее число во всей матрице равно ',g);
    
    g:=0;
    
    if c = 2
      then
        for j:=1 to a do
          if g < z[d,j] then g:=z[d,j];
    
    if c = 2 then write('Наибольшее число в столбике №',d,' по горизантали равно ',g);
    
    g:=0;
    
    if c = 3
      then
        for i:=1 to b do
          if g < z[i,d] then g:=z[i,d];
    
    if c = 3 then write('Наибольшее число в столбике №',d,' по вертикали равно ',g);
    
    end;
    
    BEGIN
    
    write('Введите количество столбиков по горизантали ');
    read(a);
    write('Введите количество столбиков по вертикали ');
    read(b);
    mas;
    
    writeln('1 - наибольшее число во всей матрице ');
    writeln('2 - наибольшее число в столбике по горизантали ');
    writeln('3 - наибольшее число в столбике по вертикали');
    read(c);
    if (c = 2) or (c = 3) then write('номер столбика ');
    if (c = 2) or (c = 3) then read(d);
    if (c <> 1) or (c <> 2) or (c <> 3) then write('Вы ввели некорректное число попробуйте снова ');
    if (c <> 1) or (c <> 2) or (c <> 3) then read(c);
    MaxXY;
    
    END.
    
  • Аватар root - 3 дн., 5 ч. назад:

    А я давно, практически изначально предупреждал, что «программирование» — это далеко не только и даже не столько написание кода.
    Но самое вкусное даже не в этом, а в перспективах верификации. Особенно — учебных задач.

  • Аватар LukasTrickster - 2 дн., 15 ч. назад:

    Сыро

    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,e,f:word;
      z:array [1..Q,1..Q] of word;
    
    procedure MasZ (x,y: byte); //Подпрограмма для заполнения матрицы случайными числами от 0 до 9
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            z[i,j]:=random(10);
          end;
    
    end;
    
    procedure MasO (x,y: byte); //Подпрограмма для вызова матрицы
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            gotoxy(i*4,j*3);
            writeln(z[i,j]);
          end;
    
    end;
    
    procedure MaxXY; //Подпрограмма для определения максимального или минимального значения матрицы или отдельных столбцов матрицы (2х)
    
    var
      i,j,g:word;
    
    begin 
    
    // Максимальные
    
    g:=z[1,1];
    
    if c = 1
      then
        for i:=1 to a do
          for j:=1 to b do
            if g < z[i,j] then g:=z[i,j];
    
    if c = 1 then write('Наибольшее число во всей матрице равно ',g);
    
    g:=z[1,j];
    
    if c = 2
      then
        for j:=1 to a do
          if g < z[d,j] then g:=z[d,j];
    
    if c = 2 then write('Наибольшее число в столбце №',d,' равно ',g);
    
    g:=z[i,1];
    
    if c = 3
      then
        for i:=1 to b do
          if g < z[i,d] then g:=z[i,d];
    
    if c = 3 then write('Наибольшее число в строке №',d,' равно ',g);
    
    // Минимальные
    
    g:=z[1,1];
    
    if c = 1
      then
        for i:=1 to a do
          for j:=1 to b do
            if g > z[i,j] then g:=z[i,j];
    
    if c = 1 then write('Наименьшее число во всей матрице равно ',g);
    
    g:=z[1,j];
    
    if c = 2
      then
        for j:=1 to a do
          if g > z[d,j] then g:=z[d,j];
    
    if c = 2 then write('Наименьшее число в столбце №',d,' равно ',g);
    
    g:=z[i,1];
    
    if c = 3
      then
        for i:=1 to b do
          if g > z[i,d] then g:=z[i,d];
    
    if c = 3 then write('Наименьшее число в строке №',d,' равно ',g);
    
    end;
    
    BEGIN
    
    repeat
    writeln('Введите количество столбиков и строк ');
    read(a,b);
    masZ(a,b);
    masO(a,b);
    write('Хотите продолжить бахать массивы ? Если да нажмите любое число Если нет и вам надоело нажмите 0 ');
    read(d);
    clrscr;
    until d=0;
    
    writeln('Хороший выбор ! Короче, Меченый, я тебя спас и в благородство играть не буду ... Ладно ладно без этого Короче если хочешь найти минимальное или максимальное значение в массиве в столбике или конкретном столбце тогда жми 0 энтер ');
    read(e);
    
    if e = 0
      then
        begin
          write('Максимальное - 1 Минимальное - (-1)');
          read(f);
        end;
    if f = 1
      then
        begin
          write('Наибольшее число во всей матрице - 1 Наибольшее число в столбце - 2 Наибольшее число в строке - 3 ');
          read();
        end;
    if f = -1
      then
        begin
          write('Наименьшее число во всей матрице - 1 Наименьшее число в столбце - 2 Наименьшее число в строке - 3 ');
          read();
        end;
        begin
          write('');
        end;
    
    END.
    
  • Аватар 永遠の雨 - 11 ч., 10 мин. назад:
    var
    m: array [1..100] of byte;
    j,n,x: word;
    begin
    read (n) ;
    for j:=1 to n do
    begin
    write ('m[',j,']=');
    readln (m [j]);
    end;
    x:=0;
    for j:=1 to n do
    	if m [j] = 0
    		then x:=1;
    
    	if x = 0
    		then writeln ('NO')
    		else writeln ('YES');
    
    END.
    
  • Аватар LukasTrickster - 10 ч., 38 мин. назад:
    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,f,e:word;
      z:array [1..Q,1..Q] of word;
    
    procedure MasZ (x,y: byte); //Подпрограмма для заполнения матрицы случайными числами от 0 до 9
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            z[i,j]:=random(10);
          end;
    
    end;
    
    procedure MasO (x,y: byte); //Подпрограмма для вызова матрицы
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            gotoxy(i*4,j*3);
            writeln(z[i,j]);
          end;
    
    end;
    
    procedure MasOO; //Подпрограмма для вызова матрицы
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to a do
        for j:= 1 to b do
          begin
            gotoxy(i*4,j*3);
            writeln(z[i,j]);
          end;
    
    end;
    
    procedure MaxXY; //Подпрограмма для определения максимального значения матрицы или отдельных столбцов матрицы (2х)
    
    var
      i,j,g:word;
    
    begin
    
    // Максимальные
    
    g:=z[1,1];
    
    if e = 1
      then
        for i:=1 to a do
          for j:=1 to b do
            if g < z[i,j] then g:=z[i,j];
    
    if e = 1 then write('Наибольшее число во всей матрице равно ',g);
    
    g:=z[1,j];
    
    if e = 1
      then
        for j:=1 to a do
          if g < z[d,j] then g:=z[d,j];
    
    if e = 1 then write('Наибольшее число в столбце №',d,' равно ',g);
    
    g:=z[i,1];
    
    if e = 1
      then
        for i:=1 to b do
          if g < z[i,d] then g:=z[i,d];
    
    if e = 1 then write('Наибольшее число в строке №',d,' равно ',g);
    
    end;
    
    procedure MinXY; //Подпрограмма для определения минимального значения матрицы или отдельных столбцов матрицы (2х)
    
    // Минимальные
    
    var
      i,j,g:word;
    
    begin
    
    g:=z[1,1];
    
    if e = 2
      then
        for i:=1 to a do
          for j:=1 to b do
            if g > z[i,j] then g:=z[i,j];
    
    if e = 2 then write('Наименьшее число во всей матрице равно ',g);
    
    g:=z[1,j];
    
    if e = 2
      then
        for j:=1 to a do
          if g > z[d,j] then g:=z[d,j];
    
    if e = 2 then write('Наименьшее число в столбце №',d,' равно ',g);
    
    g:=z[i,1];
    
    if e = 2
      then
        for i:=1 to b do
          if g > z[i,d] then g:=z[i,d];
    
    if e = 2 then write('Наименьшее число в строке №',d,' равно ',g);
    
    end;
    
    BEGIN
    
    repeat
    writeln('Введите количество столбиков и строк ');
    read(a,b);
    masZ(a,b);
    masO(a,b);
    write('Хотите продолжить бахать массивы ? Если да нажмите любое число Если нет и вам надоело нажмите 0 ');
    read(d);
    clrscr;
    until d=0;
    
    writeln('Менюшка');
    writeln('Максимальные значения в матрице - 1');
    writeln('Минимальные значения в матрице - 2');
    writeln('');
    read(e);
    
    if e = 1
      then
        begin
          read();
          clrscr;
          masOO;
          maxXY;
        end;
    
    if e = 2
      then
        begin
          clrscr;
          masOO;
          minXY;
        end;
    
    END.
    
  • Аватар LukasTrickster - 4 ч., 34 мин. назад:

    Код работает защиты от дурака нет
    выводы: 1 – комментарии это важно 2 – больше никаких переменных типа а,б,с … отныне только кричащие переменные 3 – код должен быть понятен не только тебе иначе помощи не будет :)

    uses crt;
    
    const
      Q=1000;
    
    var
      a,b,c,d,f,e,h,k:word;
      z:array [1..Q,1..Q] of word;
    
    procedure MasZ (x,y: byte); //Подпрограмма для заполнения матрицы случайными числами от 0 до 9
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            z[i,j]:=random(10);
          end;
    
    end;
    
    procedure MasO (x,y: byte); //Подпрограмма для вызова матрицы
    
    var
      i,j:word;
    
    begin
    
    randomize;
    
      for i:= 1 to x do
        for j:= 1 to y do
          begin
            gotoxy(i*4,j*3);
            writeln(z[i,j]);
          end;
    
    end;
    
    procedure MaxXY; //Подпрограмма для определения максимального значения матрицы или отдельных столбцов матрицы (2х)
    
    var
      i,j,g:word;
    
    begin
    
    // Максимальные
    
    g:=z[1,1];
    
    if e = 1
      then
        for i:=1 to a do
          for j:=1 to b do
            if g < z[i,j] then g:=z[i,j];
    
    if e = 1 then writeln('Наибольшее число во всей матрице равно ',g);
    
    g:=z[d,1];
    
    if e = 1
      then
        for j:=1 to a do
          if g < z[d,j] then g:=z[d,j];
    
    if e = 1 then writeln('Наибольшее число в столбце №',d,' равно ',g);
    
    g:=z[1,h];
    
    if e = 1
      then
        for i:=1 to b do
          if g < z[i,h] then g:=z[i,h];
    
    if e = 1 then writeln('Наибольшее число в строке №',h,' равно ',g);
    
    end;
    
    procedure MinXY; //Подпрограмма для определения минимального значения матрицы или отдельных столбцов матрицы (2х)
    
    // Минимальные
    
    var
      i,j,g:word;
    
    begin
    
    g:=z[1,1];
    
    if e = 2
      then
        for i:=1 to a do
          for j:=1 to b do
            if g > z[i,j] then g:=z[i,j];
    
    if e = 2 then writeln('Наименьшее число во всей матрице равно ',g);
    
    g:=z[d,1];
    
    if e = 2
      then
        for j:=1 to a do
          if g > z[d,j] then g:=z[d,j];
    
    if e = 2 then writeln('Наименьшее число в столбце №',d,' равно ',g);
    
    g:=z[1,h];
    
    if e = 2
      then
        for i:=1 to b do
          if g > z[i,h] then g:=z[i,h];
    
    if e = 2 then writeln('Наименьшее число в строке №',h,' равно ',g);
    
    end;
    
    BEGIN
    
    repeat
    writeln('Введите желаемое количество столбиков и строк ');
    read(a,b);
    masZ(a,b);
    masO(a,b);
    writeln('1 - продолжить ');
    writeln('Любое другое число = повторение этой операции');
    read(k);
    clrscr;
    until k=1;
    
    writeln('Менюшка');
    writeln('Максимальные значения в матрице - 1');
    writeln('Минимальные значения в матрице - 2');
    writeln('');
    read(e);
    
    if e = 1
      then
        begin
          repeat
          clrscr;
          masO(a,b);
          writeln('Номер желаемого cтолбца');
          read(d);
          writeln('Номер желаемой строки');
          read(h);
          maxXY;
          writeln('1 - продолжить');
          writeln('Любое другое число = повторение этой операции');
          read(k);
          until k=1;
        end;
    
    if e = 2
      then
        begin
          repeat
          clrscr;
          masO(a,b);
          writeln('Номер желаемого cтолбца');
          read(d);
          writeln('Номер желаемой строки');
          read(h);
          minXY;
          writeln('1 - продолжить');
          writeln('Любое другое число = повторение этой операции');
          read(k);
          until k=1;
        end;
    
    END.