/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 581
от 22.02.2008, 07:05

Вопрос № 123.355

Уважаемы эксперты! Помогите, пожалуйста решить 2 задачи: 1. Дан массив. Удалить из него нули, а после чисел, которые оканчиваются на пятёрку вставить единицу. 2. Два натуральных числа называются «дружественными», если каждое из них равно сумме всех делителей (кроме его самого) другого (например, числа 220 и 284). Найти все пары «дружественных чисел», которые не больше заданного числа N. Заранее огоромное спасибо! Swallow.

Отправлен: 16.02.2008, 11:42 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Ласточка! Вторая программа в приложении. Про дружественные числа (в том числе список известных) можно прочитать в статье Дружественные числа. Удачи! Приложение: =========================================== Вторая программа =========================================== function sum_delitel(n:integer):integer; var i, res : integer; begin res := 1; {результат изначально равен 1, т.к. 1 - делитель всех чисел} for i := 2 to n-1 do { проверяем все числа, являются ли они делителями. n-1 т.к. не надо само число проверять } if n mod i = 0 then { если без остатка делится на проверяемое число } res := res + i; { то добавляем его к результату } sum_delitel := res; { результат функции - полученная сумма } end; var N, i, j : integer; begin WriteLn('Enter N, please:'); ReadLn(N); for i := 1 to N do { для каждого числа не превышающего введенное } for j := 1 to N do { проверяем все остальные числа } if i <> j then { чтобы не проверять пары типа 1, 1} if (sum_delitel(i) = j)and(sum_delitel(j)=i)and(j>i) then { если суммы делителей равны; условие j>i - чтобы выводить пару только один раз (чтобы не было 220,284 и 284,220)} WriteLn(i,' ',j); { выводим пару чисел } ReadLn; { считываем строку перед завершением программы } end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 16.02.2008, 12:09 Оценка за ответ: 5 Комментарий оценки: Николай Владимирович, огромное вам спасибо за решение второй задачи!! Ещё не проверяла, но думаю, должна работать правильно!

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ласточка! Первая программа в приложении. Удачи! Приложение: program q123355; const n=20; var a:array [1..2*n]of integer; i,j,x,y,z:integer; begin {формируем массив с помощью случайного генератора и выводим его} randomize; for i:=1 to n do begin a[i]:=random(20); write(a[i]:3); end; writeln; {запоминаем текущий размер массива} x:=n; {начинаем с первого элемента} i:=1; {проверяем весь массив} while i<=x do begin {предыдущий элемент} y:=1; {настраиваемся на цикл} j:=1; {если текущий элемент в цикле(i) равен 5} while ((a[i]mod 10)=5)and((i+j-1)<=x) do begin {запоминаем следующий елемент} z:=a[i+j]; {записываем предыдущий} a[i+j]:=y; {теперь следующий элемент становится предыдущим} y:=z; {переходи к следующему элементу} inc(j); end; {корректируем размер массива если цикл отработал} if j>1 then inc(x); {настраиваемся на цикл} j:=0; {если текущий элемент в цикле(i+j) равен 0} while (a[i+j]=0)and((i+j)<=x)do begin {запоминаем ноль} y:=a[i+j]; {записываем следующий элемент} a[i+j]:=a[i+j+1]; {записываем ноль} a[i+j+1]:=y; {переходим к следующему элементу} inc(j) end; {если цикл отработал то корректируем размер массиваи уменьшаем индекс i} if j>0 then begin dec(x); dec(i); end; {переходим к следующему элементу} inc(i); end; {выводим результат работы} for i:=1 to x do write(a[i]:3); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 16.02.2008, 19:48 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо за решение, Константин Николаевич!

Вопрос № 123.358

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

Отправлен: 16.02.2008, 11:44 Вопрос задала: BlackFlame (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 10)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, BlackFlame! Последовательность должна состоять из целых чисел иначе определить четность невозможно. Программа в приложении. Удачи! Приложение: const N = 10; var A : array[1..N] of integer; i : integer; summ : integer; begin WriteLn('Vvedite ',N,' chisel: '); for i := 1 to N do ReadLn(A[i]); i := 1; summ := 0; while A[i] mod 2 <> 0 do begin summ := summ + A[i]; inc(i); end; WriteLn('Summa pervysh ',i-1,' nechetnyh chisel: ',summ); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 16.02.2008, 12:16 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, BlackFlame! Программа в приложении. По программе: флаг J:=1, он таким и останется пока будут нечетные числа идти подряд, как только появится первое четное число ему присвоится значение J:=0, а дальше сколько его не умножай всеравно будет 0. ps:это пример как можно выполить Ваше задание, но следует помнить, что четность это характеристика целого числа Удачи! Приложение: program q123358; const {количество элементов в последовательности} n=10; var i,j:integer; a,b:real; begin {тут будет сумма} b:=0; {флаг нечетных чисел} j:=1; for i:=1 to n do begin {вводим число} write('Enter:'); readln(a); {если число нечетное, то получается 1х1=1, если хоть раз будет четное число, то j=1х0=0} j:=j*(round(int(a))mod 2); {суммируем с участием флага} b:=b+j*a; end; {выводим результат} writeln(b:10:5); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 16.02.2008, 15:03 Оценка за ответ: 5

Отвечает: Шемет Станіслав Васильович Здравствуйте, Иванова Мария Андреевна! const n=10; Var m:array[1..n] of integer;(*Здесь храниться оследовательность из N вещественных чисел*) Sum:integer; i:integer; begin i:=1; sum:=0; repeat sum:=sum+m[i]; inc(i); until (m[i+1] mod 2 =0 )or i>=n-1; Writeln(sum); readln; end. --------- Любовь может все.

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 16.02.2008, 20:36 Оценка за ответ: 4

Вопрос № 123.400

Уважаемы эксперты! Очень Вас прошу, помогите! Задача 1 Дано поле M на N клеток. Фигура стоит в ЛЕВОМ НИЖНЕМ углу. Существует ТОЛЬКО ЧЕТЫРЕ варианта ходов: 1) 2 клетки вверх и 1 вправо 2) 2 клетки вверх и 1 влево 3) 2 клетки вправо и 1 вверх 4) 2 клетки вправо и 1 вниз Сколько существует вариантов маршрутов добраться до ПРАВОГО ВЕРХНЕГО УГЛА. (Если поле один на один, то ответ 1. Если поле 3*3, то ответ 0. Если поле 2*3, то ответ 1) Задача 2 Дан прямоугольник M на N клеток. Нужно разделить его на квадраты(не обязательно равные). Причём количество квадратов должно быть минимальным. На сколько квадратов можно разделить прямоугольник (например для прямоугольника 2 на 3 ответ 3; для прямоугольника 5 на 6 ответ 5, ибо мы можем разделить на 2 квадрата 3на2 и 3 квадрата 2на2) Решать надо через двумерные массивы и желательно функцией. Очень вас прошу, помогите!

Отправлен: 16.02.2008, 16:09 Вопрос задал: Penny (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Penny! Вторая задача в приложении. В файл записывается текущее состояние прямоугольника. Вопросы по программе задавайте в мини-форуме. Удачи! Приложение: program q123400b; const a=50; var b:array[1..a,1..a]of integer; c,m,n,x,y,z:integer; {контроль} q:text; {функция поиска квадрата} function find(d:integer):boolean; var ch,cv,ih,iv,jh,jv,i,j:integer; begin {сбрасываем координаты} ih:=0; jh:=0; {ищем первый ноль по горизонтали} for i:=1 to n do for j:=1 to m do if (ih=0)and(b[i,j]=0)then begin {запоминаем коордитаты нуля} ih:=i; jh:=j; end; {сбрасываем координаты} iv:=0; jv:=0; {ищем первый ноль по вертикали} for j:=1 to m do for i:=1 to n do if (iv=0)and(b[i,j]=0)then begin {запоминаем координаты нуля} iv:=i; jv:=j; end; {проверяем результаты поиска} if(iv=0)and(ih=0)then begin {ничего не нашли} find:=false; end else begin {еще можно искать} find:=true; {выбираем минимальное из найденых значений по горизонтали} if(n-ih)>(m-jh)then ch:=m-jh else ch:=n-ih; {выбираем минимальное из найденых значений по вертикали} if(n-iv)>(m-jv)then cv:=m-jv else cv:=n-iv; {выбираем максимальное из найденых значений по вертикали или по горизонтали} if ch<cv then begin ih:=iv; jh:=jv; ch:=cv; end; {урезаем до текущей стороны квадрата} if ch>=d then ch:=d-1; {рисуем новый квадрат} for i:=ih to ih+ch do for j:=jh to jh+ch do b[i,j]:=1; {контроль:вывод текущего состояния прямоугольника в файл} for i:=1 to n do begin for j:=1 to m do write(q,b[i,j]); writeln(q); end; writeln(q); end; end; begin {вводим сторону N} repeat write('Enter N:');readln(n); until (n>0)and(n<=a); {вводим сторону М} repeat write('Enter M:');readln(m); until (m>0)and(m<=a); {N должна быть меньше M, если нет то меняем местами} if n>m then begin z:=n; n:=m; m:=z; end; {масимальное значение} c:=m*n; {минимальная сторона прямоугольника} z:=n; {контроль:открываем файл для записи} assign(q,'q123400.txt'); rewrite(q); {цикл поиска} repeat {контроль:выводим в файл сторону квадрата} writeln(q,'Z:=',z); {сбрасываем массив } for x:=1 to n do for y:=1 to m do b[x,y]:=0; {сброс счетчика кол-ва квадратов} y:=0; {ищем пока истина} while find(z)do begin {считаем кол-во квадратов} inc(y); end; {проверяем минимальное значение найденых квадратов} if c>y then c:=y; {уменьшаем сторону квадрата} dec(z); {продолжаем пока сторона квадрата больше 0} until z=0; {выводим результат} writeln('Result :',c); {контроль:закрываем файл} close(q); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 19.02.2008, 21:55

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.70 от 17.01.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru