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

Выпуск № 595
от 07.03.2008, 14:05

Вопрос № 125.548

вот задачка: с клавиатуры вводится целое число n. Напишите программу, которая рисует с помощью * рб треугольник с основанием и ребром, равным n. Уважаемые программисты, решение нужно срочно. Пользоваться можно только условным оператором, циклом For, логическими операциями.

Отправлен: 01.03.2008, 14:32 Вопрос задал: Хощенко Артём Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Решение задачи во вложении. Пустые места заполнены пробелами. Приложение: uses crt; var n,i,j:integer; a:array[1..50,1..50]of char; begin clrscr; write('n=');readln(n); for i:=1 to n do for j:=1 to 2*n-1 do begin if (j=n-i+1)or(j=n+i-1) then a[i,j]:='*' else if (i=n)and(j mod 2=1) then a[i,j]:='*' else a[i,j]:=' '; end; for i:=1 to n do begin for j:=1 to 2*n-1 do write(a[i,j]); writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 01.03.2008, 15:11

Вопрос № 125.569

Помогите решить следующие задачи: 1) Ввести из файла многозначное целое число и разделить его на 2 таким образом, чтобы суммы делителей каждого разделялись бы на минимальную величину. 2) Найти k-у простое число в арифметической прогрессии 11, 12, 31, 41, 51, 61, ... . Привести ответ для k = 1, 10, 100, 1000 и т. д. 3) Заданы 2 целых числа. Составить число, цифры котого являются простыми множителями каждого из заданных чисел. 4) Найти сумму целых чисел из интервала [n1:n2], у которых ровно 5 делителей. Каждое из этих чисел вывести на печать.

Отправлен: 01.03.2008, 17:13 Вопрос задал: Piotr-es (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Piotr-es! 3-я и 4-я задачи в приложении. Удачи! Приложение: var n,m,i:integer; a:longint; b,c:set of 0..9; {функция возвращает истину если делителей 5-ть} function F_1(x:integer):boolean; var y,z:integer; begin y:=0; {считаем кол-во делителей} for z:=1 to x do if (x mod z )=0 then inc(y); {проверяем условие и выводим их} if y=5 then for z:=1 to x do if (x mod z )=0 then write(z:5); {возвращаем значение} F_1:=y=5; end; begin {IV} {вводим данные} write('Enter N1:'); readln(n); write('Enter N2:'); readln(m); if n>m then begin i:=n; n:=m; m:=i; end; a:=0; {все делаем в цикле} while n<=m do begin {проверяем условие} if F_1(n) then begin a:=a+n; writeln('=':4,n:7); end; inc(n); end; writeln('Summa:=',a:10); {III} b:=[2,3,5,7]; {вводим число и определяем простые делители} c:=[]; write('Enter N1:'); readln(n); for i:=2 to 7 do if (i in b)and((n mod i)=0) then c:=c+[i]; {вводим число и определяем делители равные первому числу} b:=[]; write('Enter N2:'); readln(m); for i:=2 to 7 do if (i in c)and((m mod i)=0) then b:=b+[i]; {выводим результат} for i:=2 to 7 do if i in b then write(i:2); writeln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 125.593

Помогите, пожалуйста составить программу на Pascal по матричному превращению.В квадратной матрице Е поменять местами елементы главной и побочной диагоналей,предыдуще отсортировав побочную диагональ по убыванию елементов.

Отправлен: 01.03.2008, 19:38 Вопрос задал: Соловьёв Дмитрий Олександрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Соловьёв Дмитрий Олександрович! Решение длинное очень подробно, чтобы было понятно. Потом можно половину выкинуть, имею в виду вывод промежуточных результатов на экран(для контроля правильности работы программы). Код в Приложении. Приложение: uses crt; var E:array[1..20,1..20]of integer;//матрица a,b:array[1..20]of integer;//диагонали n,i,j,x:integer; begin clrscr; write('n=');readln(n); writeln('Ischodnaja matrica:'); randomize; for i:=1 to n do begin for j:=1 to n do begin E[i,j]:=random(20); write(E[i,j]:4); end; writeln; end; readln; writeln; writeln('Pobochnaja diagonal:');//выводим побочную диагональ for i:=1 to n do for j:=1 to n do if j=n-i+1 then a[i]:=E[i,j]; for i:=1 to n do write(a[i],' '); readln; writeln; writeln('Otsortirovannaja pobochnaja diagonal:');//сортируем for i:=1 to n-1 do for j:=1 to n-1 do if a[j]<a[j+1] then begin x:=a[j];a[j]:=a[j+1];a[j+1]:=x; end; for i:=1 to n do write(a[i],' '); readln; writeln; Writeln('Glavnaja diagonal:');//выводим главную диагональ for i:=1 to n do for j:=1 to n do if i=j then b[i]:=E[i,j]; for i:=1 to n do write(b[i],' '); readln; writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to n do //вставляем все на новые места begin if i=j then E[i,j]:=a[i] else if j=n-i+1 then E[i,j]:=b[i]; write(E[i,j]:4); end; writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 01.03.2008, 20:30

Вопрос № 125.607

Здраствуйте уважаемые эксперты, помогите пожалуйста решить проблему, нужно написать программу сложения, вычитания и умножения полиномов, используя указатели, Я начал писать программу, она в примере, покачто пробую реализовать сложение, вроде всё правильно зделал, но почемуто в результате сложения всегда коефицентов на один меньше. Наверное я чтото напутал с указателями, надеюсь Вы сможете мне помочь, Заранее Спасибо. С Уважением, Станислав. Приложение: program Bevarde2; TYPE shablonas = ^zapis; zapis = record chislo : integer; //число для обработки next : shablonas; //ukazatel na sledusceje cislo v spiske end; var x, poly2,poly1, y, rezult:shablonas; procedure spausdinam ( pirmas : shablonas ); //peciatac vse elementy spiska var x : shablonas; begin x:= pirmas; REPEAT WRITE( x^.chislo, ' '); x := x^.next; UNTIL x = NIL; writeln; end; //------------------------------------------------------------------------------- begin WriteLn('Vvedite pervyj polinom:'); while not eoln do //scityvaem so stroki koeficenty polinoma ( 6 1 2 3 == 6x^3+x^2+2x+3) begin New(x); read(x^.chislo); x^.next:=NIL; IF (poly1 = NIL) THEN begin poly1 := x; end ELSE begin //sozdajom i zapolniajem spisok koeficentami odnogo polinoma y^.next := x; end; If (poly1 = NIL) then begin Writeln('Nuzno vvesti xot odin element.'); //exit; end; y := x; end; spausdinam(pirmas); //peciatajem vvedionnyj polinom (dlia sebia dlia proverki) readln; Writeln('Vvedite vtoroj polinom: '); while not eoln do begin New(x); read(x^.chislo); x^.next:=NIL; IF (poly2 = NIL) THEN begin poly2 := x; end ELSE begin y^.next := x; end; If (poly2 = NIL) then begin Writeln('Nuzno vvesti xot odin element.'); //exit; end; y := x; end; spausdinam(poly2); //peciat polinoma vtorogo writeln('Sto delat?'); writeln('slozit - 1'); writeln('otniat- 2'); readln(c); writeln(c); if c=1 then begin { repeat New(x); x^.chislo:=poly1^.chislo+poly2^.chislo; //slazivaem koeficenty s odinakovymi stepeniami x^.next:=NIL; if (rezult=NIL) Then begin rezult:= x; end else begin y^.next:= x; end; y:=x; poly1:=poly1^.next; //perexod na sleduscij element spiska poly2:=poly2^.next; until ((poly1^.next = NIL) or (poly2^.next = NIL)); } while ((poly1^.next <> NIL) or (poly2^.next <> NIL)) do //v etom cikle navernoe ctoto nepravilno, t.k. v rezultate nexvataet elementa :( begin New(x); x^.skaicius:=poly1^.skaicius+poly2^.skaicius; x^.next:=NIL; if (rezult=NIL) Then begin rezult:= x; end else begin y^.next:= x; end; y:=x; poly1:=poly1^.next; poly2:=poly2^.next; end; spausdinam(rezult); end; readln; end.

Отправлен: 01.03.2008, 21:12 Вопрос задал: Станислав (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Станислав! Программа в приложении. Удачи! Приложение: program Bevarde2; TYPE shablonas = ^zapis; zapis = record chislo : integer;{//число для обработки} next : shablonas;{//ukazatel na sledusceje cislo v spiske} end; var x, poly2,poly1, y, rezult:shablonas; c:integer; procedure spausdinam ( pirmas : shablonas );{//peciatac vse elementy spiska} var x : shablonas; begin x:= pirmas; REPEAT WRITE( x^.chislo, ' '); x := x^.next; UNTIL x = NIL; writeln; end;{ //------------------------------------------------------------------------------- } begin WriteLn('Vvedite pervyj polinom:'); while not eoln do{//scityvaem so stroki koeficenty polinoma ( 6 1 2 3 == 6x^3+x^2+2x+3)} begin New(x); read(x^.chislo); x^.next:=NIL; IF (poly1 = NIL) THEN begin poly1 := x; end ELSE begin{//sozdajom i zapolniajem spisok koeficentami odnogo polinoma} y^.next := x; end; If (poly1 = NIL) then begin Writeln('Nuzno vvesti xot odin element.');{//exit;} end; y := x; end; readln; Writeln('Vvedite vtoroj polinom: '); while not eoln do begin New(x); read(x^.chislo); x^.next:=NIL; IF (poly2 = NIL) THEN begin poly2 := x; end ELSE begin y^.next := x; end; If (poly2 = NIL) then begin Writeln('Nuzno vvesti xot odin element.');{//exit;} end; y := x; end; writeln; spausdinam(poly1);{//peciatajem vvedionnyj polinom (dlia sebia dlia proverki)} spausdinam(poly2);{//peciat polinoma vtorogo} writeln('Sto delat?'); writeln('slozit - 1'); writeln('otniat - 2'); readln(c); writeln; if c=1 then begin while ((poly1 <> NIL) or (poly2 <> NIL)) do { } begin New(x); x^.chislo:=poly1^.chislo+poly2^.chislo; x^.next:=NIL; if (rezult=NIL) Then begin rezult:= x; end else begin y^.next:= x; end; y:=x; poly1:=poly1^.next; poly2:=poly2^.next; end; spausdinam(rezult); end; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 125.647

Здравствуйте, уважаемые эксперты. Такая вот задачка: Написать программу, выводящую на экран "электронные часы", которые работают в течение, например, трех минут или до тех пор, пока пользователь не нажмет любую клавишу. Вроде бы ничего сложного, но затрудняюсь ее решить. Компиляция идет нормально, а выполнение идет не так, как хотелось бы. Цифры за несколько секунд проскакивают, и программа завершается. Т.е. надо, чтобы все это дело длилось 3 минуты, а оно длится несколько секунд. Приложение: { Простые электронные часы } uses Crt; { используем процедуры и функции библиотеки Crt } var min,sec: integer; { минуты, секунды } begin ClrScr; { очистить экран } for min:=l to 3 do begin for sec:=l to 60 do begin Delay(lOOO); { задержка 1000 ms } GotoXY(l,l); { установить курсор в 1-ю колонку 1-й строки ) write(min,':',sec,' '); if KeyPressed ( если нажата клавиша } then Halt; { завершить программу } end; end; end.

Отправлен: 02.03.2008, 09:18 Вопрос задал: Чечин Георгий Александрович (статус: 3-ий класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Чечин Георгий Александрович! Программа в приложении. Если у Вас не работают все программы, использующие модуль crt и Вы используете Turbo Pascal 7, необходимо поправить модуль CRT (заменить старые файлы turbo.tpl и tpp.tpl на исправленные). В приложенном архиве все подробно описано и приложены нужные файлы. Удачи! Приложение: uses Crt; var min,sec: integer; begin ClrScr; for min:=1 to 3 do begin for sec:=1 to 60 do begin Delay(1000); GotoXY(1,1); write(min-1,':',sec,' '); if KeyPressed then Halt; end; end; end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 02.03.2008, 09:38 Оценка за ответ: 5 Комментарий оценки: Спасибо большое. Действительно очень хороший и нужный ответ.

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Чечин Георгий Александрович! У меня тоже быстро идут часы, видимо у нас задержка не в миллисекундах. Добился нормального времени через delay(60000). Поправил еще, чтобы больше на часы походило. См. приложение. Это далеко не 3 минуты. Задержка во внутреннем цикле составляет 60 сек. ----- ∙ Отредактировал: Виктор Пырлик (Профессионал) ∙ Дата редактирования: 03.03.2008, 07:36 Приложение: uses crt; var min,sec:integer; begin clrscr; for min:=0 to 2 do {2*60*60 = 7200 с = 120 мин. } begin for sec:=0 to 59 do begin delay(60000);{вы ждете 60 секунд} gotoxy(1,1); write('0',min,':','0',sec,' '); if sec>9 then begin gotoxy(1,1); write('0',min,':',sec,' '); end; if keypressed then halt; end; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 02.03.2008, 11:59 Оценка за ответ: 5 Комментарий оценки: Большое вам спасибо.

Отвечает: Евчик Сергей Александрович !!! Здравствуйте, Чечин Георгий Александрович! Дело в том что 1000 мс это почти ничего... Чтобя программа отсчитала 60 сек поставьте for i:=1 to 120 do{50*120 = 6000 с = 100 минут} begin Delay(50000);{это 50 секунд} ............ end; Думаю все получится 1000 мс = 1 с. Это стандартная величина для функций времени. ----- ∙ Отредактировал: Виктор Пырлик (Профессионал) ∙ Дата редактирования: 03.03.2008, 07:28

Ответ отправил: Евчик Сергей Александрович (статус: 2-ой класс) Ответ отправлен: 02.03.2008, 21:38 Оценка за ответ: 5 Комментарий оценки: Спасибо большое. Ваш ответ действительно помог.

Вопрос № 125.667

Уважаемые эксперты, помогите, пожалуйста решить задачи: 2. Составить программу, позволяющую в тексте, введенном с клавиатуры, расставить запятые между словами –май июнь июль . 3. Написать программу с использованием переменных типа запись с полями, указанными в задании 5. Вывести информацию о указанном в условии товаре. 4. Записать в файл N-чисел, введенных с клавиатуры. Считать из файла эти числа. Ввести с клавиатуры n-чисел в порядке возрастания. Вставить число в эту последовательность, не нарушая упорядоченности. 5.1. Создать файл данных, каждая запись которого состоит из следующих полей: Задание Поля записи Наименование Адрес магазина цена Кол-во проданных 5.2. Считать из файла информацию, указанную преподавателем, или предложить свою версию для считывания информации.

Отправлен: 02.03.2008, 13:44 Вопрос задал: Спиридонов Максим Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Спиридонов Максим Владимирович! Задача №2. Написал программу, насколько понял условие. Например вводим текст: Самые лучшие месяцы май июнь июль. Получаем: Самые лучшие месяцы май,июнь,июль. Задача №4. Тоже написал исходя из понимания условия. Решения в приложении. Приложение: program q125667_2; uses crt; var s:string;i:integer; begin clrscr; write('Text: ');readln(s); for i:=1 to length(s) do begin if i=pos('май',s) then insert(',',s,i+3); if i=pos('июнь',s) then insert(',',s,i+4); end; writeln(s); readln; end. program q125667_4; uses crt; var f:text; a:array[1..50]of integer; n,i,p,k:integer; begin clrscr; assign(f,'chisla.txt'); rewrite(f); write('n=');readln(n); for i:=1 to n do begin readln(a[i]); //заполняем файл числами write(f,a[i],' '); end; close(f); reset(f); //открываем файл для чтения clrscr; writeln('Chisla iz faila:'); i:=1; while not eof(f)do begin read(f,a[i]); //выводим числа на экран i:=i+1; end; for i:=1 to n do write(a[i],' '); readln; close(f); //закрываем файл, конец первой части write('p=');readln(p); writeln('Vvedite n chisel v poriadke vozrastania:'); for i:=1 to n do begin readln(a[i]); end; for i:=1 to n do if (p>=a[i])and(p<=a[i+1])then k:=i; for i:=n downto k+1 do a[i+1]:=a[i]; a[k+1]:=p; //вставляем число р в последовательность Writeln('Posledovatelnost so vstavkoj:'); for i:=1 to n+1 do write(a[i],' '); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 02.03.2008, 17:34

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