Программирование циклов в Паскале

Типовые задачи на отработку техники программирования циклов

БОНУСНЫЙ ТУР!

Вот несколько бонусных задач (учитывается факт участия в решении/обсуждении, решение и качество решения;
никак не комментированный или неряшливо оформленный код мною не комментируется и не оценивается)
==================================================================================

Задача1. Даны натуральные M и N. Найти наименьший нетривиальный (т.е., если возможно, не равный 1) их общий делитель.

Задача2. Дано натуральное N заранее неизвестной десятичной разрядности. Проверить представляет ли десятичная запись этого числа "счастливый билет". Т.е. равна ли сумма первых половины цифр записи числа сумме цифр второй половины. Например, программа должна сказать ДА на числе 256094.

Задача3. Дано натуральное N. Проверить представляет ли оно целую степень числа 2. Например, на числе 64 программа должна сказать ДА.

Задача1. Даны натуральные M и

Задача1. Даны натуральные M и N. Найти наименьший нетривиальный (т.е., если возможно, не равный 1) их общий делитель.

  1. program netr_del;
  2. var m,s,n: integer;
  3. begin
  4.  read(m,n);
  5.   s:=2;
  6.   while ((n mod s) <> 0) AND ((m mod s) <> 0) do begin
  7.   inc(s);
  8.   end;
  9.  writeln(s)
  10. end.

Дано натуральное N. Проверить

Дано натуральное N. Проверить представляет ли оно целую степень числа 2. Например, на числе 64 программа должна сказать ДА.

  1. program stepen;
  2. var n: integer;
  3.  begin
  4.  read(n);
  5.  while n>2 do
  6.   n:= n div 2;
  7.   if n=2 then writeln('da')
  8.   else writeln('net');
  9.   Readln;
  10. end.

Замечание

тип integer не удовлетворяет условию задач, слудует использовать тип word.

Задача3. Дано натуральное N.

Задача3. Дано натуральное N. Проверить представляет ли оно целую степень числа 2. Например, на числе 64 программа должна сказать ДА.

  1. program stepen;
  2. var n: integer;
  3. begin
  4.   read(n);
  5.   while ((n mod 2) = 0) do
  6.   begin
  7.   n:=n div 2;
  8.   if (n=1) then writeln('da')
  9.   end
  10.   if (n<>1) then writeln('NET')
  11. end.

Изменил задачу у меня там ошибка была=)

Вот мое решение задачи №3.

  1. program N3;
  2. var n,i: word;
  3. begin
  4.   read(n);
  5.   i:=n;
  6.   while (i mod 2) = 0 do begin
  7.    i:=i div 2;
  8.   end;
  9.     if (i=1) then writeln('Да')
  10.     else writeln('Нет')
  11. end.

Задача №1.

  1. Program NaimObchDel;
  2. Var x,y: Integer;
  3. Begin
  4. Readln(x,y);
  5.   If x>y Then x:=x Mod y Else
  6.      y:=y Mod x;
  7.     If (x<>0) and (y=0) And (x-y<>1) Then
  8.      Writeln('НОД=', x-y) else write('наим. нетревиального общ.делителя нет');
  9. Readln;
  10. End.

задача

задача №1

  1. var
  2.  m,n,i,j,r:integer;
  3. begin
  4.   write('vvedite chisla M i N ');
  5.   readln(m,n);
  6.   j:=m;
  7.   if n>m then
  8.     j:=n;
  9.   for i:=2 to j do
  10.     if ((n mod i)=0) and ((m mod i)=0) then
  11.        r:=i;
  12.   if r<>0 then
  13.      writeln('Obhii delitel ',r)
  14.   else
  15.      writeln('Obhix delitelei net')
  16. end.
  17. <\pre>

задача№3

  1. program zadacha3;
  2.    var n: word;
  3. begin
  4.    read(n);
  5.    if (n mod 2)=0 then writeln('yes')
  6.    else writeln('no')
  7. end.

Трофимчук не умничай там все

Трофимчук не умничай , лучше покажи как ты сам сделал, и не тебе судить ребят.

задача 2

  1. program Zadacha2;
  2. var  i,n,c,k,ch,dec,ch1,ch2,s1,s2: Integer;
  3. begin
  4.   write ('vvedite chislo is chetnogo kol-va znakov ');  //вводим номер билета (он состоит из четного кол-ва цифр)
  5.   read (ch);
  6.   k:=1;   //счетчик
  7.   c:=ch;
  8.   while c >10 do begin    //выясняем количество разрядов числа
  9.     c:=c div 10;
  10.     k:=k+1;
  11.   end;
  12.   n:=k div 2;
  13.   dec:=1;
  14.   for i:=1 to n do begin
  15.     dec:=dec*10;
  16.   end;
  17.   ch1:=ch div dec;          //делим число напополам
  18.   ch2:=ch mod dec;
  19.   s1:=0;
  20.   s2:=0;
  21.   for i:=1 to n do begin        //вычисляем суммы левой и правой части в общем виде
  22.     s1:=s1+(ch1 mod 10);
  23.     s2:=s2+(ch2 mod 10);
  24.     ch1:=ch1 div 10;
  25.     ch2:=ch2 div 10;
  26.   end;
  27.   while s1>=10 do begin               //приводим обе суммы к цифрам
  28.     s1:=(s1 div 10)+(s1 mod 10)
  29.   end;
  30.   while s2>=10 do begin
  31.     s2:=(s2 div 10)+(s2 mod 10)
  32.   end;
  33.   if s1=s2 then write ('chastlivii bilet')        //сравнение итоговых результатов и вывод заключения
  34.             else write ('neschastlivii bilet');
  35.  
  36. end.

Получился очень громоздкий код, выложил в таком виде. Уверен что можно проще, пока не додумался как.

Задача 2.

Немного пораскинув мозгами и несколько раз перечитав лекции, у меня вроде бы получилось оптимизировать вторую задачу.
(Задача2. Дано натуральное N заранее неизвестной десятичной разрядности. Проверить представляет ли десятичная запись этого числа "счастливый билет". Т.е. равна ли сумма первых половины цифр записи числа сумме цифр второй половины. Например, программа должна сказать ДА на числе 256094.)

  1. program happy;
  2. var n,n1,n2,i:Longint;
  3. begin
  4.  readln(n);n1:=0;n2:=0;
  5.  for i:=1 to 6 do
  6.   begin
  7.    if i<=3 then n1:=n1+n mod 10
  8.        else n2:=n2+ n mod 10;
  9.    n:=n div 10;
  10.   end;
  11.   if n1=n2 then writeln('da ')
  12.      else writeln('Usual');
  13. end.

у меня получилось для билета, который содержит в себе 6 цифр :)

Универсальное решение

  1. Program Happy;
  2.  
  3. var n, n1, n2, k, t, i: integer;
  4.  
  5. begin
  6.   write('n=');
  7.   readln(n);
  8.  
  9.   t := n;
  10.   k := 0;
  11.   n1 := 0;
  12.   n2 := 0;
  13.  
  14.   while t > 0 do begin
  15.     inc(k);
  16.     t := t div 10;
  17.   end;
  18.  
  19.   if odd(k) then
  20.     write('Нельзя определить')
  21.  
  22.   else begin
  23.  
  24.     for i := 1 to k do begin
  25.       if i <= k/2 then
  26.         n1 := n1 + n mod 10
  27.       else
  28.         n2 := n2 + n mod 10;
  29.      
  30.       n := n div 10;
  31.     end;
  32.    
  33.     if n1 = n2 then
  34.       write('Happy')
  35.     else
  36.       write('Unhappy');
  37.  
  38.   end;
  39. end.

Димы

У вас в суммах билета получится несостыковка, если я правильно понял. К примеру 123456 билет, суммы будут n1=6, n2=15. То есть билет то счастливый, но алгоритм не приведет суммы до конца к цифре. Могу ошибаться

зачем все в одну программу пихать, это же разные задачи)

Что Вы курите, Кирилл?

Не понял про "не стоит пихать"
И как вдруг число 123456 оказалось счастливым, сумма первой половины цифр не равна сумме второй половины

хм

1+2+3=6
4+5+6=9+6=15, 1+5=6

По крайней мере я всю жизнь приводил суммы билетов к цифре и расчитывал оттуда счастливый ли он (совпадают ли).
В принципе сам себе усложнил задачу:) Зато у меня больше счастливых билетов:)

Неожиданная интерпретация

Неожиданная интерпретация критерия "счастливости" билета, Кирилл. Да и занятная, возьму на заметку!

Итоги решений

По задаче 1.
Барышников Дима (Вс, 23/10/2011 - 15:28) – решение неверное.
Нозадзе Роман (Вс, 23/10/2011 - 20:38) — решение неверное. Нужен цикл, и НОД здесь непричём.
Смольняков Саша (Вс, 23/10/2011 - 20:50)– решение неверное.

По задаче 3.
Барышников Дима (Вс, 23/10/2011 - 15:50) – решение неверное
Барышников Дима ( Вс, 23/10/2011 - 16:15 ) – поправил, но остался небольшой изъян
Нозадзе Роман (Вс, 23/10/2011 - 18:18) — ЗАДАЧА ЗАКРЫТА!
Воропаева Екатерина (Вс, 23/10/2011 - 20:56)– неверно. Нужен цикл.

По задаче 2.
Общее замечание. Я не исключал и нечётного числа цифр!

Гущин Кирилл (Вс, 23/10/2011 - 21:54) – строки 27-32 в общем случае сомнительны, но если их убрать, верно.
Барышников Дима – верно, но частный случай.
Студенцов Дима - верно. Как и у Кирилла работает с произвольной (но почему-то только чётной!) длиной. Содержит некорректную для целых операцию вещественной арифметики. Уже традиционно, плохие имена переменных и любовь к слову "универсальное".

Внимание! Задачи можно ещё обсуждать!

задача 1

  1. program zadacha1;
  2.   var m,n: integer;
  3. begin
  4.   write ('vvedite chisla');
  5.   readln (m,n);
  6.   while m<>n do begin
  7.      if m>n then m:=m-n
  8.      else n:=n-m;
  9.   end;
  10.   Write ('NOD - ',m);
  11. end.

Если не ошибаюсь так называемый алгоритм Евклида. Комментировать тут даже как то нечего...

И что?

Действительно, алгоритм Евклида. Ну и ...
Какое он имеет отношение к задаче1?

я может что то не так понял?

Задача1. Даны натуральные M и N. Найти наименьший нетривиальный (т.е., если возможно, не равный 1) их общий делитель.

Алгоритм Евклида имеено это и делает вроде... К примеру m=25, n=15
m=25-15=10 (m=10, n=15)
n=15-10=5 (m=10, n= 5)
m=10-5=5=n...
5 наименьший общий делитель 15 и 25. Вроде все верно

все понял:(

Евклида наибольший находит...

Задача 1, попытка 2

  1. program Zadacha1;
  2.   var a,b,max,min,i,nod: integer;
  3. begin
  4.   write ('vvedite chisla');
  5.   read (a,b);
  6.   nod:=1;
  7.   if a>=b then max:=a else max:=b;
  8.   for i:=2 to max do begin
  9.      if  (a mod i=0) and (b mod i=0) then nod:=i;
  10.   end;
  11.   write ('NOD= ',nod);
  12. end.

А если так?

ЕЩЁ ТРИ ЗАДАЧИ...

Задача4. Дано натуральное N. Проверить, представляют ли цифры 8-ричной его записи строго монотонную (т.е. убывающую или возрастающую) последовательность.

Задача5. Дано натуральное N>1. Вывести его разложение в произведение простых сомножителей в той форме, которая указана жирным шрифтом в следующем примере. Дано: N=140, Ответ: 140 = 2*2*5*7

Задача6. На лекции рассмотрена формула Ньютона и программа вычисления по ней корня квадратного из X с заданной точностью eps. В общем случае, для вычисления корня N-й степени (N>=2), эта формула выглядит так: new=(X/(old^(N-1)) + (N-1)*old))/N . Написать и отладить программу, которая реализует этот общий случай. Вводиться должны X, N, eps.

Снова нет.

Втр, 25/10/2011 - 19:07 — Гущин Кирилл
И опять не ясно, при чём тут NOD ...

Задача №5.

  1. program mnozhetel;
  2. var n,i:Integer;
  3. begin
  4.   ReadLn(n);
  5.   Write (n,' = 1');
  6.   i:=2;
  7.   while n > 1 do
  8.   begin
  9.     if n mod i = 0 then
  10.     begin
  11.       Write (' * ', i);
  12.       n:= n div i;
  13.     end else Inc(i);
  14.   end;
  15.   ReadLn;
  16. end.

Задача 5

  1. program Zadacha5;
  2.   var n,i:integer;
  3. begin
  4.  read (n);
  5.  write ('n=');
  6.  for i:=2 to n do begin
  7.     while n mod i=0 do begin //пока остаток от деления  n на i равен 0 мы выводим на экран i*
  8.       write (i,'*');      // и целочисленно делим n на i, тем самым получая на экране наглядное
  9.       n:=n div i;        // разложение числа по простым сомножителям
  10.     end;
  11.   end;
  12. write ('1'); //в конце выводим единичку чтобы не висел пустой знак *
  13. end.

Задача1. Даны натуральные M и N. Найти наименьший нетривиальный

  1. program zadacha1;
  2. var m,n,max,f: integer;
  3. begin
  4. write ('vvedite chisla');
  5. read (m,n);
  6. f:=0;
  7. if (n<=m) then max:=n
  8. else max:=m;
  9. for i:=max downto 2 do begin
  10. if (n mod i=0) and (m mod i=0) then
  11. f:=i;
  12. end;
  13. if (f<>0) then write (‘nod=’,f)
  14. else write ('delitelei net');
  15. end.

Задача4. Дано натуральное N.

Задача4. Дано натуральное N. Проверить, представляют ли цифры 8-ричной его записи строго монотонную (т.е. убывающую или возрастающую) последовательность.

  1. var
  2.  y,i,n,j:integer;
  3. begin
  4. readln(n);
  5. y:=0;
  6. i:=1;
  7. while n>0 do begin
  8.    y:=(n mod 8)*i+ y;
  9.    i:=i*10;
  10.    n:=n div 8;
  11. end;
  12. if (y mod 10)>((y mod 100)div 10) then
  13.    while y>10   do   begin
  14.      if  (y mod 10)<=((y mod 100)div 10) then   begin
  15.         j:=1;
  16.      break;
  17.      end;
  18.    y:=y div 10;
  19.    end
  20. else
  21.   if (y mod 10)<((y mod 100)div 10) then
  22.     while y>10   do   begin
  23.       if  (y mod 10)>=((y mod 100)div 10) then   begin
  24.         j:=1;
  25.       break;
  26.       end;
  27.     y:=y div 10;
  28.     end
  29.   else
  30.   j:=1;
  31. if j=1 then
  32. writeln('no')
  33. else
  34.  writeln('yes')
  35. end.

Кому не лень протестируйте.

Задача6. Написать и

Задача6. Написать и отладить программу, которая реализует этот общий случай для вычисления корня N-й степени (N>=2). Вводиться должны X, N, eps. формула : new=(X/(old*(N-1)) + (N-1)*old))/N

  1. program zd6;
  2.        var x, new, old, eps, n:real;
  3. begin
  4.         readln (x,eps,n);                       ' вводятся x-переменная, exp-точность, n-степень извлекаемого корня'
  5.         new:=x/n;                                          'вычисляем y0  начальное значение'            
  6.  repeat
  7.         old:=new;                                            'присваикаем к переменной old вычисленное значение y0 '
  8.         new:=(X/(old*(n-1)) + (n-1)*old)/n;            'вычисляем по формуле'
  9.   until abs(new-old)<eps                                 'модуль разности сравниваем с eps'
  10.      writeln(new,eps,n);                                         'вывод  полученого числа - new, точность - eps,  и степень корня  n'
  11.      readln;
  12. end.

Молодец, Юля!

Молодец, Юля! Посрамила мужиков, закрыла-таки задачу 1 (хотя можно бы решить и оптимальней).
А Дима, Роман, Александр, Кирилл били, били - не добили, так и сбежали не разобравшись в своих ошибках ...
Вот только, Юля, код нужно научиться правильно вставлять в комменты. На этом сайте я не раз это показывал.

Задачу 5 тоже можно закрыть. Здесь правы и Роман, и Кирилл (у Романа несколько эффективней по времени (ПОЧЕМУ?), да и вывод поэстетичней).

У Александра в решении задачи 4 предлагаю покопаться, а Сергею рекомендую внимательней почитать условие задачи 6, да и взять за правило проверять решения на компьютере.

В любом случае, Благодарю участников за активность!

потскажите где копаться, а то

потскажите где копаться, а то чтот не чего не найду. В первом цикле число переводится в 8 систему, А потом проверяется в какую сторону идет последовательность на основе последних 2 чисел. И в итоге мы проверяем есть ли все же эта последовательность монотонной.

Спасибо!

Спасибо большое! Я обязательно научусь!!!!

Александр...

... и не только. Можно короче!

Задача №1

  1. Program delitel;
  2.        var m,n,k,min:Integer;
  3. begin
  4.         read(m,n);
  5.          k:=2;
  6.         while (n mod k)<>0 do begin
  7.         Inc(k);
  8.         n:=min;
  9.         else
  10.          while(m mod k)<>0 do begin
  11.          Inc(k);
  12.          m:=min;
  13.          end;
  14.          end;
  15. end.

Мне жаль, Оксана, но совсем

Мне жаль, Оксана, но совсем не то ...
Ошибки уже на уровне синтаксиса. Я бы очень советовал перед публикацией проверять свой код на компьютере. Удачи!

Задача №2

  1. program HappyTicket;
  2.  
  3. var
  4.   n, a: longint;
  5.   lev, prav, length, i: byte;
  6.  
  7. begin
  8.   a := 0;
  9.   length := 0;
  10.   lev := 0;
  11.   prav := 0;
  12.   read(n);
  13.   a := n;
  14.   while a <> 0 do begin
  15.     a := a div 10;
  16.     inc(length)
  17.   end;
  18.   for i := 1 to length div 2 do begin
  19.     prav := prav + n mod 10;
  20.     n := n div 10
  21.   end;
  22.   if odd(length) then n := n div 10;
  23.   for i := 1 to length div 2 do begin
  24.     lev := lev + n mod 10;
  25.     n := n div 10
  26.   end;
  27.   if lev = prav then write('YES') else write('NO')
  28. end.

Моя программа обрабатывает и случай, когда длина билета нечетна. Однако при этом не совсем понятно, как поступить с серединной цифрой. Ее можно разделить на два и прибавить к сумме цифр левой и правой частей, просто прибавить к сумме цифр левой и правой частей или отбросить. Так как во всех трех случаях для одного и того же билета нечетной длины сумма цифр левой и правой части остается одной и той же, поэтому обработка их в программе приведена к общему случаю, реализованному отбрасыванием серединной цифры.

Задачи №1 и №3

Так как задачи 1 и 3 уже закрыты, я публикую их в одном сообщении с единственной целью: получить внимание тех, кто сможет найти ошибки в моем коде, если они есть, или поможет мне оптимизировать его.

Задача №1:

  1. program MinDivisor;
  2.  
  3. var
  4.   a, b, mindel, i: word;
  5.  
  6. begin
  7.   mindel := 1;
  8.   read(a, b);
  9.   for i := 2 to min(a, b) do begin
  10.     if (a mod i) = 0 then if (b mod i) = 0 then begin
  11.         mindel := i;
  12.         break
  13.       end
  14.   end;
  15.   write(mindel)
  16. end.

Задача №3:

  1. program PowerOfTwo;
  2.  
  3. var
  4.   n: longint;
  5.  
  6. begin
  7.   read(n);
  8.   while n <> 1 do begin
  9.     if (n mod 2) = 1 then break;
  10.     n := n div 2
  11.   end;
  12.   if n = 1 then write('YES') else write('NO')
  13. end.

Решения принимаются, Данил.

Решения принимаются, Данил. Замечание: функция min(a,b) не может быть использована.

Задача №4

  1. program OctalSequence;
  2.  
  3. var
  4.   n, old, new: word;
  5.   flag: boolean;
  6.  
  7. begin
  8.   flag := true;
  9.   read(n);
  10.   if n > 7 then begin
  11.     old := n mod 8;
  12.     new := (n div 8) mod 8;
  13.     n := n div 16;
  14.     if old > new then begin
  15.       while n <> 0 do begin
  16.         old := new;
  17.         new := n mod 8;
  18.         n := n div 8;
  19.         if old <= new then begin
  20.           flag := false;
  21.           break
  22.         end;
  23.       end;
  24.       if flag = true then write('YES') else write('NO')
  25.     end
  26.     else if old < new then begin
  27.       while n <> 0 do begin
  28.         old := new;
  29.         new := n mod 8;
  30.         n := n div 8;
  31.         if old >= new then begin
  32.           flag := false;
  33.           break
  34.         end
  35.       end;
  36.       if flag = true then write('YES') else write('NO')
  37.     end
  38.     else write('NO')
  39.   end
  40.   else write('NO')
  41. end.

Данное решение оказалось достаточно тяжеловесным и запутанным, однако сложность и многообразие ветвлений в программе, как мне кажется, оправдывается выбором наиболее оптимального алгоритма для обоих возможных вариантов, а также возможностью обработки исключений. Но к сожалению, данная программа не может отбросить исключения на уровне основного алгоритма, поэтому я вынужден был использовать результаты простейшего исследования восьмеричных чисел и сделать дополнительное условие.
Также программа иллюстрирует пример того, что операции преобразования разрядов в иную систему счисления и их сравнения можно провести в одном цикле, несколько различающемся для искомых последовательностей разного типа.
Правильность работы программы проверена на большом количестве примеров, и теперь, как я надеюсь, мне остается лишь выполнить ее качественную оптимизацию. Рассчитываю на комментарии и внимание участников форума.

Валерий Шахамболетович,домашняя задача №2 где найти НОК (m,n)

Program NOK;

var n, m, r: word;

begin

readln(n);

readln(m);

r := n * m;

while n <> m do
if n > m then
n := n - m
else
m := m - n;

r := r div n;

writeln('НОК: ', r);

end.

ну и ещё с массивом, где найти max и min

Program min_and_max;

var min, max, a, n, i: integer;

begin
write('n=');
readln(n);

readln(a);
min := a;
max := a;

for i := 2 to n do begin
readln(a);

if a < min then min := a;
if a > max then max := a;
end;

writeln('min=', min);
writeln('max=', max);

end.

Задачи №5 и №6

Задача №5:

  1. program PrimeFactors;
  2.  
  3. var
  4.   n, p: word;
  5.  
  6. begin
  7.   p := 2;
  8.   read(n);
  9.   write(n, ' = 1');
  10.   while n <> 1 do
  11.     if (n mod p) = 0 then begin
  12.       write(' * ', p);
  13.       n := n div p
  14.     end else inc(p)
  15. end.

Задача №6:

  1. program NthRoot;
  2.  
  3. var
  4.   x, new, old, oldst, eps: real;
  5.   n, i: byte;
  6.  
  7. begin
  8.   read(x, n, eps);
  9.   new := x / 2;
  10.   repeat
  11.     oldst := 1;
  12.     old := new;
  13.     for i := 1 to n - 1 do oldst := oldst * old;
  14.     new := (x / oldst + old * (n - 1)) / n;
  15.   until(abs(new - old)) < eps;
  16.   writeln(new:4:2)
  17. end.

здравстуйте Валерий Шахамболетович

здравстуйте Валерий Шахамболетович я немножко опоздал на счёт решениий но решил некоторые зададие
2 задание на вычисление наименьшего кратного делителя

rogram ZaDaNiE2;
var
m,n,i,j: integer;
begin
readln(m,n);
if m>n then j:=2*m
else j:=n*2;
for i:=j to n*m do
if ((i mod n)= 0) and ((i mod m)= 0)then begin
n:=i;
break;
end;
writeln(n);
end.

и ещё одна задача намассив

и ещё одна задача намассив знаков длины N<50 проверить является ли он полиндромом
program ZaDaNiE3;
var
mas: array [0..50] of char;
sim: char;
i,j:integer;
begin
write('Vvodite simvoli a posle vvedite "."');
sim:='1';
i:=1;
repeat
read(mas[i]);
sim:=mas[i];
i:=I+1;
until sim='.';
i:=I-2;
sim:='0';
for j:=1 to (i div 2 ) do
if mas[j]<>mas[i-j] then sim:='1';
if sim='1' then writeln ('no')
else writeln ('yes')
end.

Задача 4 (из темы, не ДЗ)

Задача4. Дано натуральное N. Проверить, представляют ли цифры 8-ричной его записи строго монотонную (т.е. убывающую или возрастающую) последовательность.
Решение:

  1. Program CheckPosl;
  2.  
  3. var dec, oct, noct: integer;
  4. f1, f2: boolean;
  5.  
  6. begin
  7.   readln(dec);
  8.   f1 := true;
  9.   f2 := true;
  10.  
  11.   while (f1 or f2) and (dec > 10) do begin
  12.     oct := dec mod 8;
  13.     dec := dec div 8;
  14.     noct := dec mod 8;
  15.    
  16.     if oct < noct then
  17.       f1 := false
  18.    else
  19.       if oct > noct then
  20.         f2 := false;
  21.   end;
  22.  
  23.   if (f1 or f2) then
  24.     write('YES')
  25.   else
  26.     write('NO');
  27.  
  28. end.

Возможно я не понял условия и решение соответственно неправильное

Таня!

Таня!А где собственно массив??? =)
P.S.Валерий Шахамболетович я скинул задания вам на почту =)

Задача4, Данил. Громоздко,

Задача4, Данил. Громоздко, эффективность под сомнением. Не комментирую.
Не стоит рассчитывать на комментарии других, выплёскивая абсолютно недокументированный код ...

Я бы написал как-то так:

  1. Program Monoton;
  2.    Var a,b,N: Word;
  3.          delta: Integer;
  4. begin
  5.    read(N);
  6.    delta:=1; a:=1; b:=0; //инициализация для случая  однозначного N
  7.    If N>7 Then Begin // N более чем 1-значное 8-ричное
  8.       b:=N mod 8; // последняя цифра
  9.       N:= N div 8; // отбросим её
  10.       a:= N mod 8; // предпоследняя цифра
  11.       delta:= a - b; // отриц., полож. или 0  
  12.       repeat
  13.          b:=a; //сдвигаем влево b
  14.          a:=N mod 8; //... и a
  15.          N:= N div 8; // отбрасываем последнюю цифру
  16.          If delt*(a-b) <=0 then break //нарушение монотонности
  17.       until (N=0);
  18.     End;//of If
  19.       If delt*(a-b) >0 Then Writeln('Yes') else Writeln('No')
  20. End.

Домашняя задача №2.Найти НОК.Ну вот пожалуй и на сайт выложу :)

  1. Program A2;
  2. var m,n:integer;
  3. function NOD(a,b:integer):integer;
  4. Begin
  5.      While (a<>0) and (b<>0) do
  6.      if a>=b then
  7.      a:=a mod b
  8.      else
  9.      b:=b mod a;
  10.      NOD:=a+b;
  11.      end;
  12. function NOK(a,b:integer):integer;
  13. Begin
  14.      NOK:=a*b div NOD(a,b);
  15.      end;
  16. Begin
  17.      Writeln('Введите m и n');
  18.      Readl(m,n);
  19.      Writeln('НОК=', NOK(a,b);
  20. end.

Домашняя задача №4.Найти наименьший и наибольший элемент массива

  1. Program A4;
  2. const n=50;
  3. var   i,max,min:integer;
  4.       a:array[1..n] of integer;
  5. Begin
  6.       for i:=1 to n do read(a[i]);
  7.       max:=a[1];
  8.       min:=a[1];
  9.       for i:=2 to n do begin
  10.           if a[i]>max then begin
  11.           max:=a[i];
  12.           end;
  13.           if a[i]<min then begin
  14.           min:=a[i];
  15.           end;
  16.       end;
  17.       writeln('Наименьший элемент:',min,    'Наибольший элемент:',max);
  18. end.