Здравствуйте.
Уважаемые эксперты нужна помощь в решении задач :
1.Даны три числа. Написать фрагмент программы, подсчитывающий количество четных чисел
2.Используя цикл repeat, напишите программу, которая требует ввод пароля, например, числа 111, и, если пароль правильный, заполняет все строки эк¬рана сообщением «Молодец!!!». Если после пятой попытки пароль неверен, выйти из программы.
Спасибо.

Отправлен: 06.01.2010, 23:08
Вопрос задал: aller719, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
1. Вот программа полностью. uses crt; var a,b,c:integer; k:byte; begin clrscr; writeln(\'Введите 3 целых числа:\'); readln(a,b,c); k:=ord((a mod 2=0))+ord((b mod 2=0))+ord((c mod 2=0));{если условие выполняется, значение ord=1, если нет ord=0} write(\'Количество четных чисел=\',k); readln end. Вам видимо нужен фрагмент k:=ord((a mod 2=0))+ord((b mod 2=0))+ord((c mod 2=0)); 2. uses crt; const p=\'111\';{пароль} var s:string;{вводимая строка} k,i,j:byte;{счетчики циклов} begin clrscr; k:=0;{ноль попыток} repeat write(\'Введите пароль: \'); readln(s);{читаем введенный пароль} if s=p then{если совпал} begin for i:=1 to 24 do{в 24 строки выводим сообщение} writeln(\'Молодец!!!\'); write(\'Молодец!!!\');{в 25-ю строку, иначе там будет стоять курсор} readln {for i:=1 to 25 do{если нужно по всему экрану, правда будет через строку, т.к. курсор не входит} begin for j:=1 to 8 do write(\'Молодец!!!\'); writeln; end; readln;} end else k:=k+1;{если не угадали, увеличиваем счетчик попыток} until(s=p)or(k=5);{если угадали или 5 попыток, заканчиваем} end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 10:35

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258434 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Нужна помощь в решении задачи.
Создайте матрицу из 15 строк и 15 столбцов. Вычислите произведение сум¬мы элементов главной диагонали на сумму элементов L-й строки.
Спасибо.

Отправлен: 06.01.2010, 23:09
Вопрос задал: aller719, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
Program p1; var data:array [1..15,1..15] of real; L:integer; {номер строки} i,j:integer; S1,S2:real; {суммы элементов главной диагонали и L-ной строки} begin write(\'L=\'); readln(L); {ввод L} if (L>15) or (L<1) then begin writeln(\'Nevernoe L\');readln; exit end; {проверка на правильность введенного L} randomize; for i:=1 to 15 do {создание массива из случайных чисел} for j:=1 to 15 do data[i,j]:=random(100); {вывод на экран получившегося массива} for i:=1 to 15 do begin for j:=1 to 15 do write(data[i,j]:3:0); writeln; end; {вычисление суммы элементов главной диагонали} S1:=0; for i:=1 to 15 do S1:=S1+data[i,i]; {вычисление суммы элементов L-ной строки} S2:=0; for i:=1 to 15 do S2:=S2+data[L,i]; writeln(S1*S2:0:0); {вывод на экран произведения сумм} readln; end.

Ответ отправил: Vassea, Профессионал
Ответ отправлен: 07.01.2010, 09:47

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258430 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
вот мой вариант програмки

Приложение:
program q; var a:array[1..15,1..15]of integer; i,j,sumd,suml,rez:integer; begin //ввод и вывод матрицы randomize; for i:=1 to 15 do for j:=1 to 15 do a[i,j]:=random(100); for i:=1 to 15 do begin writeln; for j:=1 to 15 do write(a[i,j]:4); end; writeln; //алгоритм for i:=1 to 15 do sumd:=sumd+a[i,i]; write(\'введите номер строки \'); readln(i); for j:=1 to 15 do suml:=suml+a[i,j]; rez:=sumd*suml; writeln(\'результат \', rez); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 20:56

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258560 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Нужна помощь в решении задачи.
Вычислите сумму элементов двухмерного массива, индексы которых состав¬ляют в сумме заданное число К
Спасибо.

Отправлен: 06.01.2010, 23:10
Вопрос задал: aller719, Посетитель
Всего ответов: 3
Страница вопроса »

Приложение:
Program p1; var data:array [1..10, 1..10] of integer; K:integer; S:integer; {сумма элементов} i,j:integer; begin {ввод К и проверка его правильности} write(\'K=\'); readln(K); if (K>20) or (K<2) then begin write(\'Net takih elementov\');readln; exit; end; {создание массива} randomize; for i:=1 to 10 do for j:=1 to 10 do data[i,j]:=random(100); {вывод массива на экран} for i:=1 to 10 do begin for j:=1 to 10 do write(data[i,j]:3); writeln; end; {вычисление суммы тех элементов, которые соответствуют условию задачи} S:=0; for i:=1 to 10 do for j:=1 to 10 do if i+j=K then S:=S+data[i,j]; writeln(S); {вывод полученнго значения на экран} readln; end.

Ответ отправил: Vassea, Профессионал
Ответ отправлен: 07.01.2010, 10:02

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258431 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lamed, Практикант :
Здравствуйте, aller719. Текст в приложении, Turbo Pascal. Вычисляем границы номеров строк.
Левая граница = max (1, k-cols). Правая граница = min(k-1, rows).
Например, для rows=cols=10, k=20 левая граница = 10. правая граница = 10. По номеру строки номер столбца определяется однозначно j=k-i.
Предложенный способ значительно уменьшает количество операций в цикле.
С уважением.

Приложение:
{ 175874. Вычислите сумму элементов двухмерного массива, индексы которых состав¬ляют в сумме заданное число К } Program p175874; Const rows = 10; cols = 10; base = 100; var data:array [1..rows, 1..cols] of integer; k:integer; s:integer; {сумма элементов} i,j:integer; function max(a,b: integer): integer; begin if a>b then max:= a else max := b; end; { max } function min(a,b: integer): integer; begin if a<b then min:= a else min := b; end; { min } begin { главная } {создание массива} randomize; for i:=1 to rows do for j:=1 to cols do data[i,j]:=random(base); {печать массива} for i:=1 to rows do begin for j:=1 to cols do write(data[i,j]:3); writeln; end; {если условие не выполнено или еще нет элементов, s=0} s:= 0; {ввод k} Write(\'k=\'); Readln(k); if (k in [2..rows+cols]) then {суммируем элементы, для которых i+j=k} begin for i:= max(1,k-cols) to min(k-1,rows) do s:= s + data[i,k-i]; end; writeln(\'s=\',s); readln; end.

Ответ отправил: lamed, Практикант
Ответ отправлен: 07.01.2010, 13:43

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258440 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
мой вариант ответа

Приложение:
program q; const n=5; var a:array[1..n,1..n]of integer; i,j,sum,k:integer; begin //ввод и вывод матрицы randomize; for i:=1 to n do for j:=1 to n do a[i,j]:=random(10); for i:=1 to n do begin writeln; for j:=1 to n do write(a[i,j]:4); end; writeln; //алгоритм write(\'задайте число \'); readln(k); for i:=1 to n do for j:=1 to n do if i+j=k then begin sum:=sum+a[i,j]; writeln(\'a[\',i,\',\',j,\']=\',a[i,j]); end; writeln(\'результат \', sum); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 21:20

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258561 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Нужна помощь в решении задачи.
Найдите длину наибольшего отрезка, соединяющего две точки с координа¬тами, заданными таблицей F(2, N)
Спасибо.

Отправлен: 06.01.2010, 23:11
Вопрос задал: aller719, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; function Rasst(x1,y1,x2,y2:real):real; begin Rasst:=sqrt(sqr(x1-x2)+sqr(y1-y2));{фомула определения расстояния между двумя точками, задаными координатами} end; var F:array[1..2,1..100] of real;{массив точек} mx:real;{максимальное расстояние} n,i,j,imx,jmx:integer;{размер массива, счетчики циклов, номера искомых точек} begin clrscr; randomize; write(\'Количество точек (нормально до 13) = \'); readln(n); for i:=1 to n do begin F[1,i]:=10*random-4;{случайные числа от -4 до 6} F[2,i]:=10*random-4; end; write(\'Нoмер точки \'); for i:=1 to n do write(i:5); writeln; write(\'координата Х\'); for i:=1 to n do write(F[1,i]:5:1); writeln; write(\'координата Y\'); for i:=1 to n do write(F[2,i]:5:1); writeln; writeln; mx:=Rasst(F[1,1],F[2,1],F[1,2],F[2,2]);{начальный максимум-расстояние между точками 1 и 2} imx:=1;jmx:=2;{номера} for i:=1 to n-1 do{от точки } for j:=i+1 to n do{до точек} if Rasst(F[1,i],F[2,i],F[1,j],F[2,j])>mx then{если больше предыдущего максимума} begin mx:=Rasst(F[1,i],F[2,i],F[1,j],F[2,j]);{это максимум} imx:=i;{первая точка} jmx:=j;{вторая точка} end; writeln(\'Длина наибольшего отрезка между точками a[\',imx,\'] a[\',jmx,\'] = \',Rasst(F[1,imx],F[2,imx],F[1,jmx],F[2,jmx]):0:2); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 10:07

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258433 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Нужна помощь в решении задачи.
Дан массив размерностью N*N, N - нечетное число. Вывес¬ти элементы массива, при обходе его по спирали, начиная с центра.
Спасибо.

Отправлен: 06.01.2010, 23:12
Вопрос задал: aller719, Посетитель
Всего ответов: 2
Страница вопроса »

program Pascal_175876;

const
     Center=3;
     N=Center*2-1;

type
    TType=Integer;
    TMatrix=array[1..N,1..N] of TType;

var
   Matrix:TMatrix;
   I,J,IDirection,JDirection,Count,DistanceLeft,Distance:Integer;

  IsInc:Boolean;

begin
{* Заполним матрицу числами по порядку и выведем ее *}
     Count:=0;
     WriteLn('Матрица в нормальном представлении:');
     for I:=1 to N do begin
         for J:=1 to N do begin
             Inc(Count);
             Matrix[I][J]:=Count;
             Write(Matrix[I][J]:4,' ');
         end;
         WriteLn;
     end;

     {* Начинаем обход с центра *}
 
     I:=Center; J:=Center;
     {* Направление изменения индекса *}
     IDirection:=0; JDirection:=0;
     {* Общее количество элементов *}
     Count:=N*N;
     {* Количество элементов в одном направлении *}
     Distance:=0; DistanceLeft:=0;
     WriteLn('Матрица по спирали:');
     while Count>0 do begin
        {* Если пришло время сменить направление движения *}
        if DistanceLeft=0 then begin
          {* Меняем направление *}
          if IDirection<>0
then begin
             JDirection:=IDirection;
             IDirection:=0;
          end else if JDirection<>0 then begin
              IDirection:=-JDirection;
              JDirection:=0;
          end else begin
              {* Здесь начальные настройки для этих параметров. *}
              IDirection:=0;
              JDirection:=-1;
              IsInc:=True;
          end;
          {* Если пришло время изменить к
 оличество элементов
             проходимых в одном направлении *}
          if IsInc then begin
             Inc(Distance);
          end;
          IsInc:= not IsInc;
          DistanceLeft:=Distance;
        end;

        Write(Matrix[i][j]:4,' ');
        {* Идем дальше *}
        I:=I+IDirection;
        J:=J+JDirection;

        Dec(DistanceLeft);
        Dec(Count);
        if Count mod N = 0 then begin
          WriteLn;
        end;

    end;
     ReadLn;
end.

/home/micren/projects/Pascal/Pascal_175876
Матрица в нормальном представлении:
   1    2    3    4    5 
   6    7    8    9   10 
  11   12   13   14   15 
  16  
  17   18   19   20 
  21   22   23   24   25 
Матрица по спирали:
  13   12   17   18   19 
  14    9    8    7    6 
  11   16   21   22   23 
  24   25   20   15   10 
   5    4    3    2    1

Ответ отправил: Micren, Профессионал
Ответ отправлен: 07.01.2010, 05:06

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258420 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
мой вариант задачи

Приложение:
program q; const n=5; var a:array[1..n,1..n]of integer; i,j,l,k:integer; begin //ввод и вывод матрицы randomize; for i:=1 to n do for j:=1 to n do a[i,j]:=random(100); for i:=1 to n do begin writeln; for j:=1 to n do write(a[i,j]:4); end; writeln; //алгоритм i:=n div 2+1; //центр матрицы j:=i; k:=1; //колличество ячеек в ряду write(a[i,j]:2); repeat i:=i+1; j:=j+1; k:=k+2; for l:=1 to k-1 do begin j:=j-1;write(a[i,j]:4); end; for l:=1 to k-1 do begin i:=i-1;write(a[i,j]:4); end; for l:=1 to k-1 do begin j:=j+1;write(a[i,j]:4); end; for l:=1 to k-1 do begin i:=i+1;write(a[i,j]:4); end; until k=n; end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 20:08

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258557 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Нужна помощь в решении задачи.
Для заданного целочисленного массива (N*N) найти макси¬мум среди сумм элементов диагоналей, параллельных глав¬ной диагонали.
Спасибо.

Отправлен: 06.01.2010, 23:15
Вопрос задал: aller719, Посетитель
Всего ответов: 1
Страница вопроса »

program Pascal_175877;

uses Math;

const
    N=5; { Размерность }

type
    TType=Integer;
    TMatrix=array[1..N,1..N] of TType;

{ Ищет максимум сумм диагоналей }
function FindMaxInDiag(Matrix:TMatrix):TType;
var

   I,J,Count:Integer;
    Max,Sum:TType;

    { Сумма на диагонали начало которой задано параметрами }
    function DiagSum(I,J:Integer):TType;
    var
        Sum:TType;
        Count:Integer;
    begin
        Sum:=0;
        { К-во элементов на диагонали }
        Count:=N-Math.Max(I,J)+1;
        { Считаем сумму }
        while Count>0 do begin
            Dec(Count);
            Sum:=Sum+Matr
 ix[I][J];
            Inc(I); Inc(J);
        end;
        DiagSum:=Sum;
    end;

begin
    { Зададим начальное значение для Max }
    Max:=Matrix[N][1];
    { Оставшееся количество диагоналей }
    Count:=2*(N-1);
    { Начало диагонали }
    I:=N-1; J:=1;
    while Count>0 do begin
        Dec(Count);
        Sum:=DiagSum(I,J);
        if Sum>Max then begin
            Max:=Sum;
        end;
        { Сместимся на следующую диагональ }
  
     if I>1 then begin
            Dec(I);
        end else begin
            Inc(J);
        end;
    end;
    FindMaxInDiag:=Max;
end;

var
    I,J:Integer;
    Matrix:TMatrix;

begin
    Randomize;
    WriteLn('Матрица:');
    { Заполним матрицу случайными числами }
    for I:=1 to N do begin
        for J:=1 to N do begin
            Matrix[I][J]:=Random(50);
            Write(Matrix[I][J]:3,' &
 #39;);
        end;
        WriteLn;
    end;

    WriteLn('Максимальная сумма среди диагоналей:',FindMaxInDiag(Matrix));
    ReadLn;
end.

/home/micren/projects/Pascal/Pascal_175877
Матрица:
 26  48  20  35  27 

41  31  21  38  19 
 31  29   3  21  32 
 30  39  34  42  35 
 32  33  28  11  25 
Максимальная сумма среди диагоналей:127

Ответ отправил: Micren, Профессионал
Ответ отправлен: 07.01.2010, 06:09

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258421 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты нужна помощь в решении задач:
1.Составить программу, которая уменьшает первое число в пять раз, если оно больше второго по абсолютной величине.
2.Создайте и произведите отладку программы, вычисляющей сумму квадратов чисел от 1 до введенного целого числа n.
Спасибо.

Отправлен: 06.01.2010, 23:17
Вопрос задал: aller719, Посетитель
Всего ответов: 4
Страница вопроса »

Приложение:
{Program 175878_1;} uses crt; var a,b:real; begin clrscr; Writeln (\'Введите первое число\'); readln(a); Writeln (\'Введите второе число\'); readln(b); if abs(a)>abs(b) then a:=a/5; Writeln (\'Первое число\', a:7:2); Writeln (\'Второе число\', b:7:2); Writeln (\'Нажмите Enter\'); readln; end. {Program 175878_2;} uses crt; var i,n:integer; begin clrscr; Writeln (\'Введите n\'); readln(n); for i:=1 to n do write(\' \',i*i); Writeln; Writeln(\'Нажмите Enter\'); readln; end.

Ответ отправил: WEKlabs, 2-й класс
Ответ отправлен: 07.01.2010, 09:31

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258428 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Пупорев Юрий Борисович, Специалист :
Здравствуйте, aller719!
Решение задач в приложении. Задачи настолько простые, что, право, не знаю что комментировать.

Приложение:
1. uses crt; var a,b:real; begin clrscr; writeln(\'Введите 2 числа:\'); readln(a,b); if abs(a)<=abs(b) then write(\'Первое число не больше второго по модулю!\') else begin a:=a/5; write(\'a=\',a:0:2); end; readln end. 2. uses crt; var n,i,s:longint; begin clrscr; repeat write(\'Введите натуральное число n=\'); readln(n); until n>0; s:=0; for i:=1 to n do s:=s+i*i; write(\'Сумма квадратов от 1 до \',n,\' = \',s); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 09:39

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258429 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Колесников Иван Владимирович, 5-й класс :
Здравствуйте, aller719!
Решения в приложении.

Приложение:
1) var x, y: integer; begin ReadLn(x, y); if Abs(x) > Abs(y) then x := x div 5; WriteLn(x); end. 2) var i, n: integer; begin ReadLn(n); for i := 1 to n do WriteLn(i * i); end;

Ответ отправил: Колесников Иван Владимирович, 5-й класс
Ответ отправлен: 07.01.2010, 10:55

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258435 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
мои варианты прграмм

Приложение:
1 program q; var a,b:real; begin write(\'введите число а \'); readln(a); write(\'введите число b \'); readln(b); if abs(a)>b then begin a:=a/5; write(\'a больше b по абсолютной величине a/5=\',a); end; end. 2 program q; var n,b,i, rez:integer; begin write(\'введите число n \'); readln(n); for i:=1 to n do begin b:=i; rez:=rez+sqr(b); end; write(\'сумма квадратов = \', rez); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 22:07

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258563 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты, нужна помощь в решении задачи:
Найти максимальный элемент массива, встречающийся бо¬лее одного раза.
Спасибо.

Отправлен: 06.01.2010, 23:18
Вопрос задал: aller719, Посетитель
Всего ответов: 3
Страница вопроса »

Приложение:
uses crt; const n=10; {длинна массива} var a:array[1..n]of integer; i,max,f:integer; begin randomize; {включаем генерато случайных чисел} clrscr; max:=0; f:=0; writeln(\'Исходный массив:\'); write(\'[ \'); for i:=1 to n do begin a[i]:=random(10)+2; {генерируем случайными числами в интервале} if a[i]>max then {идем по массиву пока не найдем макс элемент} max:=a[i]; {нашли макс} write(a[i],\' \') ; end; writeln(\']\'); for i:=1 to n do {повторяющийся максимальный элемент} begin if a[i]=max then f:=f+1; {если есть увеличиваем счетчик} end; if f>=2 then writeln(\'Максимальный элемент = \' ,max) else Writeln (\'Такого элемента нет\'); readkey; end.

Ответ отправил: Sky-er, 7-й класс
Ответ отправлен: 07.01.2010, 03:07

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258419 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Пупорев Юрий Борисович, Специалист :
Здравствуйте, aller719!
Решение задачи в приложении. Рассмотрено 2 способа решения, без сортировки массива и с сортировкой.

Приложение:
1. Первый способ, без сортировки массив. uses crt; const nmax=100;{максимальный размер массива} var a:array[1..nmax] of integer;{массив} n,i,k,imx,p:byte; mx,mn:integer; begin clrscr; randomize; repeat write(\'Размер массива n=\'); readln(n); until n in [1..nmax];{проверяем правильность ввода} writeln(\'Массив:\'); for i:=1 to n do begin a[i]:=random(10);{числа от 0 до 9, можно поменять} write(a[i],\' \'); end; writeln; writeln; {находим минимум} mn:=a[1]; for i:=1 to n do if a[i]<mn then mn:=a[i]; p:=0;{число попыток найти} repeat{цикл поиска первого макс > 1 раза} k:=0;{пока нет такого числа} {находим максимальный} mx:=a[1];imx:=1; for i:=1 to n do if a[i]>mx then begin mx:=a[i];{нашли макс} imx:=i;{его индекс} end; {ищем равный ему} for i:=1 to n do if (a[i]=mx)and(i<>imx)and(a[i]<>mn-1) then k:=1;{если есть равный и не совпадает индекс и это не замененный элемент, нашли} if k=0 then{если не нашли} begin a[imx]:=mn-1;{меняем макс элемент на число меньше минимума} p:=p+1;{считаем число попыток} end; until (k=1)or(p=n-1);{если нашли, или остался только 1 непроверенный элемент, заканчиваем} if k=0 then write(\'Все элементы по 1 разу\') else write(\'Первый максимальный более 1 раза=\',mx); readln end. 2. Второй способ с сортировкой по убыванию uses crt; const nmax=100; var a:array[1..nmax] of integer; n,i,j,k:byte; x:integer; begin clrscr; randomize; repeat write(\'Размер массива n=\'); readln(n); until n in [1..nmax]; writeln(\'Массив:\'); for i:=1 to n do begin a[i]:=random(10); write(a[i],\' \'); end; writeln; writeln; for i:=1 to n-1 do{сортируем массив по убыванию обменом} for j:=i+1 to n do if a[i]<a[j] then begin x:=a[i]; a[i]:=a[j]; a[j]:=x; end; k:=0;{пока нет} for i:=1 to n-1 do{от первого до предпоследнего смотрим} if a[i]=a[i+1] then{если рядом 2 одинаковых} begin k:=1;{фиксируем удачу} break;{выходим из цикла} end; if k=1 then writeln(\'Максимальное > 1 раза =\',a[i]) else writeln(\'Такого числа нет!\'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 09:26

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258427 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
вот мой вариант

Приложение:
program a; const n=10; var a:array[1..n]of real; maxi,i,b:integer; max,min:real; p:boolean; begin writeln(\'введите массив из \',n,\' элементов\'); for i:=1 to n do readln(a[i]); // min:=a[1]; // for i:=2 to n do if min>a[i] then min:=a[i]; max:=a[1]; b:=0; repeat p:=false; b:=b+1; max:=a[1]; maxi:=1; for i:=2 to n do if a[i]>max then begin max:=a[i]; maxi:=i; end; if maxi<>n then for i:=maxi+1 to n do if a[i]=max then p:=true; if p=false then a[maxi]:=min; until (b=n )or( p=true); if p=true then writeln(\'элемент a[\',maxi,\']=\',a[maxi],\'встречается более одного раза\') else writeln(\'в массиве нет искомых элементов\'); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 10:39

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258547 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты, нужна помощь в решении задачи:
Дана матрица D, имеющая N строк и N столбцов. Сформируйте два одно¬мерных массива. В один запишите четные, а в другой — нечетные элемен¬ты матрицы. Выведите на экран все массивы
Спасибо.

Отправлен: 06.01.2010, 23:20
Вопрос задал: aller719, Посетитель
Всего ответов: 3
Страница вопроса »

Приложение:
uses crt; const nmax=20;{максимальный размер двумерного массива - матрицы} var d:array[1..nmax,1..nmax] of integer;{матрица} a,b:array[1..nmax*nmax] of integer;{2 линейных массива} n,i,j,na,nb:integer;{размеры массивов и счетчики циклов} begin clrscr; randomize; repeat write(\'Размер матрицы D = \'); readln(n); until n in [1..nmax];{проверяем правильность ввода размера} writeln(\'Матрица D:\'); na:=0;{размеры массивов четных и нечетных пока = 0} nb:=0; for i:=1 to n do begin for j:=1 to n do begin d[i,j]:=random(50)+1;{заполним матрицу случайными числами от 1 до 50} if d[i,j] mod 2=0 then{если четное} begin na:=na+1;{увеличиваем размер соответствующего массива и заносим в него элемент матрицы} a[na]:=d[i,j]; end; if d[i,j] mod 2=1 then{то же с нечетными} begin nb:=nb+1; b[nb]:=d[i,j]; end; write(d[i,j]:4);{выводим матрицу построчно} end; writeln; end; writeln; writeln(\'Массив четных элементов А:\');{выводим 2 массива} for i:=1 to na do write(a[i],\' \'); writeln; writeln; writeln(\'Массив нечетных элементов В:\'); for i:=1 to nb do write(b[i],\' \'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 08:46

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258425 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает WEKlabs, 2-й класс :
Здравствуйте, aller719.
решение задачи в приложении

Приложение:
{Program 175881;} uses crt; const n=8;{размер массива} var d:array [1..n,1..n] of byte; dchet,dnechet:array [1..n*n] of byte; i,j,di,dj:integer; begin clrscr; randomize; for i:=1 to n do for j:=1 to n do d[i,j]:=random(100); {вывод исходного массива} for i:=1 to n do begin for j:=1 to n do write(d[i,j],\' \'); writeln; end; di:=1;{индекс четного массива} dj:=1;{индекс нечетного массива} for i:=1 to n do for j:=1 to n do begin if (d[i,j] mod 2)=0 then begin dchet[di]:=d[i,j]; di:=di+1; end else begin dnechet[dj]:=d[i,j]; dj:=dj+1; end end; Writeln (\'вывод четного массива, кол-во элементов: \', di-1); for i:=1 to di-1 do write(dchet[i],\' \'); Writeln; Writeln (\'вывод нечетного массива, кол-во элементов: \', dj-1); for i:=1 to dj-1 do write(dnechet[i],\' \'); Writeln; Writeln (\'Нажмите Enter\'); readln; end.

Ответ отправил: WEKlabs, 2-й класс
Ответ отправлен: 07.01.2010, 08:58

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258426 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aller719.
мой вариант

Приложение:
program q; const N=5;// размер матрицы NN=N*N; var d:array [1..N,1..N]of integer; d1:array [1..NN]of integer; d2:array [1..NN]of integer; i,j,i1,i2:integer; begin writeln(\'ввод массива из \',N,\' строк \',N,\' столбцов\'); for i:=1 to N do begin writeln(\'строка \' , i); for j:=1 to N do readln(d[i,j]); end; //алгоритм i1:=0; i2:=0; for i:=1 to N do for j:=1 to N do begin if d[i,j]mod 2=0 then begin i1:=i1+1; d1[i1]:=d[i,j]; end else begin i2:=i2+1; d2[i2]:=d[i,j]; end end; // вывод массива for i:=1 to i1 do write(d1[i],\' \'); writeln; for i:=1 to i2 do write(d2[i],\' \'); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 11.01.2010, 09:15

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258545 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты, нужна помощь в решении задачи:
Найдите наибольшее и наименьшее значения функции у - Зх2 + х - 4, если в заданном интервале [a, b] x изменяется с шагом 0,1.
Спасибо.

Отправлен: 06.01.2010, 23:21
Вопрос задал: aller719, Посетитель
Всего ответов: 2
Страница вопроса »

Ответ отправил: WEKlabs, 2-й класс
Ответ отправлен: 07.01.2010, 08:05

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258423 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Пупорев Юрий Борисович, Специалист :
Здравствуйте, aller719!
Решение задачи в приложении.

Приложение:
uses crt; function F(x:real):real;{наша функция, чтобы не писать ее каждый раз в программе} begin F:=3*x*x+x-4; end; var x,a,b,y,h,min,max,xmn,xmx:real; begin clrscr; repeat writeln(\'Введите интервал табуляции\'); readln(a,b); until b>a;{проверяем правильность ввода интервала} h:=0.1; max:=F(a);{за макс и мин принимаем значение функции в первой точке} min:=F(a); xmx:=a;{также значение аргумента} xmn:=a; x:=a; while x<b do{пока не достигли конца интервала} begin if F(x)>max then begin max:=F(x);{ищем максимум} xmx:=x;{и его аргумент} end; if F(x)<min then begin min:=F(x);{ищем минимум} xmn:=x;{и его аргумент} end; x:=x+h;{наращиваем аргумент} end; writeln(\'Максимальное значение=\',max:0:2,\' при х=\',xmx:0:1); writeln(\'Минимальное значение =\',min:0:2,\' при х=\',xmn:0:1); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 08:14

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258424 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты, нужна помощь в решении задачи:
Используя цикл repeat, напишите программу-фильтр, которая вводит лю¬бые символы, но комментирует только буквы русского алфавита. Заверше¬ние работы программы — по нажатию буквы «Я».
Спасибо.

Отправлен: 06.01.2010, 23:22
Вопрос задал: aller719, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; var c:char; begin clrscr; writeln(\'Вводите символы, окончание ввода - Я\'); repeat write(\'Символ \'); readln(c); if c in [\'А\'..\'п\',\'р\'..\'ё\']{буквы русского алфавита, в таблице символов разбиты на 2 части} then writeln(\' - Это буква \',c);{выводим комментарий} c:=readkey;{ожидаем нажатия клавиши} until c=\'Я\';{если нажата Я, программа завершается} end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 07.01.2010, 07:58

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258422 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте.
Уважаемые эксперты, нужна помощь в решении задачи:
Используя цикл while, напишите программу определения идеального веса для взрослых людей по формуле: Идеальный вес = рост - 100. Выход из цикла — значение роста 200.
Спасибо.

Отправлен: 06.01.2010, 23:22
Вопрос задал: aller719, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
Program 175883; uses crt; var v,r,k:integer ; begin clrscr; k:=100; while r<>200 do begin Write (\'Введите ваш рост \'); readln(r); v:= r-k; Writeln (\'Ваш идеальный вес =\', v); end; end.

Ответ отправил: Sky-er, 7-й класс
Ответ отправлен: 07.01.2010, 01:23

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258418 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Колесников Иван Владимирович, 5-й класс :
Здравствуйте, aller719!
Решение в приложении. А вообщето такие задачи лучше решать с помошью repeat.

Приложение:
var n: integer; begin n := 0; while n < 200 do begin ReadLn(n); if n < 200 then WriteLn(n - 100); end; end.

Ответ отправил: Колесников Иван Владимирович, 5-й класс
Ответ отправлен: 07.01.2010, 11:01

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258436 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »