Отправлен: 26.05.2009, 11:21
Вопрос задал: Alex12, Посетитель
Всего ответов: 1
Страница вопроса >>

Var
  a: array [1..100] of real;
  n: integer;

  procedure Input(var a: array of real; var n: integer);
    var i:integer;
  begin
    writeln ('Введите число вещественных чисел N:');
    readln (n);

   writeln ('Введите любую последовательность чисел:');
    for i:=1 to n do
    readln (a[i]);
  end;

  function Main(a: array of real): real;
    var f0, f1, f2: integer;
        s: real;
  begin
    f0:= 1; f1:= 1; f2:= 1;
    s:= 0;
    while (f2<=n) do
       begin
          s:= s+a[f2];
          f2:= f0+f1;
          f0:= f1; f1:= f2;
       end;
    Main:=s;
  end;

  procedure OutPut(s: re
 al);
  begin
    writeln ('Ответ : ', s:5:5);
    readln;
  end;

begin
  Input(a,n);
  OutPut(Main(a));
end.

Ответ отправил: Тимошенко Дмитрий, Студент
Ответ отправлен: 27.05.2009, 07:18

Оценка ответа: 5
Комментарий к оценке:
Спасибо!

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

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

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

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

Добрый день уважаемые эксперты!
Прошу у вас помочь мне в решении задачи по Паскалю!
Буду вам очень признателен!

Даны целые числа а1,...,an, b1,...,bm, k. Если в последовательности а1,...,an нет ни одного члена со значением k, то первый по порядку член этой последовательности, не меньший всех остальных членов, заменить н азначение k. По такому же правилу преобразовать последовательность b1,...,bm применительно к значению 10. (с помощью функций)

Отправлен: 26.05.2009, 15:47
Вопрос задал: Андреев Дмитрий Фёдорович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; type mas=array[1..100] of integer;{тип массива} procedure Vvod(var m:mas; var x:byte;c:char);{ввод данных в массив} var i:byte; begin writeln('Массив ',c); write('Введите размер массива: '); readln(x); for i:=1 to x do m[i]:=random(20); end; procedure Vyvod(var m:mas;x:byte;s:string);{вывод массива на экран} var i:byte; begin writeln(s); for i:=1 to x do write(m[i],' '); writeln; end; function Max(m:mas;x:byte):integer;{поиск максимального значения в массиве} var i:byte; mx:integer; begin mx:=m[1]; for i:=2 to x do if m[i]>mx then mx:=m[i]; Max:=mx; end; function Poisk(m:mas;x:byte;k:integer):boolean; {определение, есть ли в массиве элемент, раный к} var i:byte; begin Poisk:=true; for i:=1 to x do if m[i]=k then begin Poisk:=false; break; end; end; procedure Zamena(var m:mas;x:byte;k:integer);{замена элемента} var i:byte; begin for i:=1 to x do if m[i]>=Max(m,x)then begin m[i]:=k; break; end end; var n,m:byte; a,b:mas; k:integer; begin clrscr; randomize; Vvod(a,n,'A'); vvod(b,m,'B'); clrscr; Vyvod(a,n,'Исходный массив А:'); write('K=');readln(k); if Poisk(a,n,k)then begin Zamena(a,n,k); Vyvod(a,n,'Измененный массив А:'); end else writeln('В последовательности есть элемент=',k); readln; Vyvod(b,m,'Исходный массив B:'); if Poisk(b,m,10)then begin Zamena(b,m,10); Vyvod(b,m,'Измененный массив B:'); end else writeln('В последовательности есть элемент=10'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 27.05.2009, 11:05

Оценка ответа: 5
Комментарий к оценке:
спасибо

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

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

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

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

Добрых времени суток, есть задача которую нужно решить.

Задача:
Вычислить z=e^{|x max|} - e^{|y max|}÷√|x max×y max|

где x max - наибольший элемент массива X(20); y max - наибольший элемент массива Y(15);
Для вычисления наибольшего элемента массива использовать function.

Отправлен: 26.05.2009, 15:50
Вопрос задал: stanislavkaa91, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; type {тип массива} mas=array[1..20]of real; {функция нахождения макс в массиве} function Max(m:mas;n:byte):real; var i:byte; mx:real; begin mx:=m[1]; for i:=2 to n do if m[i]>mx then mx:=m[i]; Max:=mx; end; var x,y:mas; z:real; i:byte; begin clrscr; randomize; writeln('Массив X:'); for i:=1 to 20 do begin x[i]:=10*random-4; write(x[i]:5:2); end; writeln; writeln('Массив Y:'); for i:=1 to 15 do begin y[i]:=10*random-4; write(y[i]:5:2); end; writeln; {формула, как она написана у Вас} z:=exp(abs(Max(x,20)))-exp(abs(Max(y,15)))/sqrt(abs(Max(x,20)*Max(y,15))); {формула, если вдруг пропущены скобки (exp(abs(Max(x,20)))-exp(abs(Max(y,15))))} {z:=(exp(abs(Max(x,20)))-exp(abs(Max(y,15))))/sqrt(abs(Max(x,20)*Max(y,15)));} write('Z=',z:0:2); readln end.

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

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

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

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

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

Здравствуйте эксперты! И сново я нуждаюсь в вашей помощи...
Помогите в решении задачки!

Даны натуральное число n, целые числа а1,а2,...,an. Рассмотреть отрезки последовательности а1,а2,...,an (подпоследовательности идущих подряд членов), состоящих из степеней пятерки.(задачу выполнить с помощью функции)

В приложении имеется код в Турбо С!

Отправлен: 26.05.2009, 15:53
Вопрос задал: Андреев Дмитрий Фёдорович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; function Pow_5(x:integer):boolean; {определение, является ли число степенью числа 5} var p:integer; begin p:=1; while p<x do p:=p*5; if p=x then Pow_5:=true else Pow_5:=false; end; var a:array[1..100] of integer; n,i,j,k:integer; begin clrscr; write('n='); readln(n); writeln('Введите ',n,' элементов последовательности:'); for i:=1 to n do begin write('a[',i,']='); readln(a[i]); end; clrscr; writeln('Последовательность:'); for i:=1 to n do write(a[i],' '); writeln; writeln('Последовательности:'); i:=1;k:=0;{начало последовательности, подпоследовательностей нет} while i<=n do{идем до конца последовательности} begin if Pow_5(a[i]) then{если степень 5, 1,5,25....} begin k:=1;{фиксируем} j:=i;{начинаем смотреть с этого места дальше} while Pow_5(a[j])do{пока степени} begin write(a[j],' ');{выводим} j:=j+1;{увеличиваем счетчик} end; writeln;{на новую строку} i:=j+1;{переходим на число за подпоследовательностью} end else i:=i+1;{если не степень, дальше} end; if k=0 then write('Заданных подпоследовательностей нет!'); readln end.

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

Оценка ответа: 5
Комментарий к оценке:
спасибо

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

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

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

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

Здравствуйте, есть задача, надеюсь вы мне поможите её решить:

Задача: Получить файл q, образованный из файла f сдвигом его компонент на две позиции вправо.

Отправлен: 26.05.2009, 16:27
Вопрос задал: nimzzz, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; var f,g:file of integer; a,i:integer; begin clrscr; assign(f,'file1'); rewrite(f); assign(g,'file2'); rewrite(g); writeln('Введите целые числа в файл f, окончание ввода 0:'); repeat write('a='); readln(a); write(f,a); until a=0; clrscr; writeln('Содержание файла f:'); reset(f); while not eof(f) do begin read(f,a); write(a,' '); end; writeln; close(f); reset(f); {последние 2 числа читаем и записываем в фвйл g} for i:=2 downto 1 do begin seek(f,filesize(f)-i); read(f,a); write(g,a); end; {все числа с перврго без 2х последних читаем и записывем в файл g} for i:=0 to filesize(f)-3 do begin seek(f,i); read(f,a); write(g,a); end; writeln('Содержание файла g:'); reset(g); while not eof(g) do begin read(g,a); write(a,' '); end; close(f); close(g); readln end.

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

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

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

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

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

1. Элемент матрицы называется локальным минимумом, если он строго меньше всех имеющихся у него соседей. Подсчитать количество локальных минимумов заданной матрицы размером 10 на 10 ( оформить в виде процедуры ).

2. Найти сумму модулей эл-тов, расположенных выше главной диагонали (оформить в виде функции).

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

{Функция получения суммы нужных элементов}
function GetSum: integer;
var
  Sum: integer;

begin

 sum := 0;
  {в этом цикле суммируем все элемнты которые находятся выше главной диагонали}
  for i := 1  to N - 1 do
    for j := i + 1 to N do
      {abs() - возвращает модуль аргумента}
      sum := sum + abs(a[i, j]);
  GetSum := sum;
end;

for i := 1  to N - 1 do
    for j := i + 1 to N do
       {a[i, j] - нужный элемент}

Приложение:
const {Размерность матрицы} N = 5; var {Матрица} a: array [1..N, 1..N] of integer; {Счетчики для цикла For} i, j: integer; {Процедура заполнения и вывода матрицы} procedure Fill; begin WriteLn('Исходная матрица: '); {Инициируем генаратор случайных чисел} randomize; {В цикле заполняем матрицу случайными числами и выводим} for i := 1 to N do begin for j := 1 to N do begin a[i, j] := random(20) - 10; Write(a[i, j]:4); end; WriteLn; end; end; {Функция получения суммы нужных элементов} function GetSum: integer; var Sum: integer; begin sum := 0; {в этом цикле суммируем все элемнты которые находятся выше главной диагонали} for i := 1 to N - 1 do for j := i + 1 to N do {abs() - возвращает модуль аргумента} sum := sum + abs(a[i, j]); GetSum := sum; end; begin {Основной код программы} Fill; Write('Ответ: ', GetSum); ReadLn; end.

Ответ отправил: Абельхарисов Руслан/Marked One, Практикант
Ответ отправлен: 26.05.2009, 22:08

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

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

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

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

Приложение:
uses Crt; const n=10; type Tmatrix=array[1..n,1..n]of integer; var a:Tmatrix; {процедура генерации массива} procedure CreateMatrix(var z:Tmatrix); var i,j:integer; begin for i:=1 to n do begin for j:=1 to n do begin z[i,j]:=random(50); write(z[i,j]:3); end; writeln; end; end; {процедура поиска локальных минимумов} procedure SearchMinimum(z:Tmatrix); var i,j,x,y,k,l:integer; w:boolean; begin y:=0; for i:=1 to n do begin for j:=1 to n do begin w:=true; TextColor(7); for x:=0 to 8 do begin k:=i-1+x mod 3; l:=j-1+x div 3; if ((i<>k)or(j<>l))and{исключаем проверку одно и тогоже числа} (1<=k)and(k<=n)and{исключаем выход за пределы массива} (1<=l)and(l<=n)and{исключаем выход за пределы массива} (z[k,l]<=z[i,j])then{проверяем неравенство} w:=false; end; if w then TextColor(15);{меняем цвет} inc(y,ord(w));{считаем минимумы} write(z[i,j]:3);{выводим элемент} end; writeln; end; TextColor(7); writeln('Local Mimimum:=', y:4); end; begin {создаем матрицу} CreateMatrix(a); writeln; {выводим результат} SearchMinimum(a); ReadKey; end. Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 29.05.2009, 13:47

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

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

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

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

Уважаемые знатаки!) Помогите решить задачу по информатике на языке Турбо Паскаль.
Написать программу движения снежинок(не менее 10 штук, сверху вниз).Движение должно быть хаотичным

Отправлен: 26.05.2009, 23:53
Вопрос задал: Timyselani, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses Graph,Crt; const n=10;{количество} angle=360;{} SnowSize=19;{} d_X=50;{полуось элипса} d_Y=15;{полуось элипса} d_A=10;{коэфициэнт приращения элипса} var Coordinate:array[1..n,1..3]of integer; x,y,z:integer; SnowPtr:pointer; begin {инициализируем графику} x:=detect; InitGraph(x,y,''); x:=GraphREsult; {проверяем ошибку инициализации графики} if x=0 then begin {сбрасываем генератор случайных чисел} randomize; {заполняем маиссив с координатами} for z:=1 to n do begin Coordinate[z,1]:=d_X+random(GetMaxX-2*d_X);{ X - по горизонтали} Coordinate[z,2]:=random(GetMaxY-SnowSize-d_Y);{ Y - по вертикали} Coordinate[z,3]:=d_A*random(angle div d_A);{ Z - начальный угол элипса} end; {чистим экран} ClearDevice; {рисуем снежинку} for z:=1 to SnowSize do begin PutPixel(1+SnowSize div 2,z,15); PutPixel(z,1+SnowSize div 2,15); PutPixel(z,z,15); PutPixel(z,SnowSize-z+1,15); end; {получаем изображение снежинки} GetMem(SnowPtr,ImageSize(1,1,SnowSize,SnowSize)); GetImage(1,1,SnowSize,SnowSize,SnowPtr^); repeat {читим экран} ClearDevice; for z:=1 to n do begin {считаем координаты вывода, если убрать +5-random(10) то снежинки будут спускатся раскачиваясь как маятник} x:=round(abs(d_X*cos(Coordinate[z,3]*2*pi/360)))+Coordinate[z,1]+5-random(10); y:=round(abs(d_Y*sin(Coordinate[z,3]*2*pi/360)))+Coordinate[z,2]; {увеличиваем вертикальную координату. снижаем снежинку} if (Coordinate[z,3] mod (2*d_A))=0 then Coordinate[z,2]:=(Coordinate[z,2]+5)mod(GetMaxY-SnowSize-d_Y); {увеличиваем угол} Coordinate[z,3]:=(Coordinate[z,3]+2)mod angle; {выводим снежинку} PutImage(x,y,SnowPtr^,CopyPut); end; {задержка} delay(30000); {пока не будет нажата клавиша повторить} until KeyPressed; {освобождаем память и закрываем графику} FreeMem(SnowPtr,ImageSize(1,1,SnowSize,SnowSize)); CloseGraph; end else begin {ошибка инициализации графики} write('InitGraph error',x); readKey; end; end. Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 28.05.2009, 18:28

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

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

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

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

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