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

Выпуск № 528
от 26.12.2007, 21:05

Вопрос № 115.133

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

Отправлен: 20.12.2007, 22:37 Вопрос задал: ksana09 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Артём1983 Здравствуйте, ksana09! Смотрите коды программ в приложении. Приложение: {115133_1} uses crt; var s:string; begin clrscr; write('введите строку символов, используя скобки ='); readln(s); write(copy(s,pos('(',s)+1,pos(')',s)-pos('(',s)-1)); readln; end. {115133_2} uses crt; var s:string; letter:char; i,counter,t,first_i,last_i,j,max:integer; flag:boolean; begin clrscr; counter:=0; s:='миру мир ляля ляляляля ляляля'; letter:='л'; first_i:=0; for i:=1to length(s)do begin if s[i]=' ' then begin t:=counter; flag:=true; if t>=max then begin max:=t; last_i:=i; for j:=i-1 downto 0do begin if s[j]=' ' then begin first_i:=j; break; end; end; end; counter:=0; end else begin if s[i]=letter then counter:=counter+1; end end; writeln('строка =',s); writeln('буква =',letter); writeln(last_i); writeln('слово в котором чаще всего стречается буква "',letter,'" =',copy(s,first_i,last_i-first_i)); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 7-ой класс) Ответ отправлен: 21.12.2007, 22:14 Оценка за ответ: 5 Комментарий оценки: Спасибо Вам огромное!!!!Не знаю, чтобы без Вас делала!

Вопрос № 115.140

Дан массив, найти сумму положительных элементов массива

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

Отвечает: Миленин Александр Здравствуйте, Sheetsack! Код в приложении, массив заполняется случайными целыми цислами от -20 до 50. Приложение: var summ:integer; i:byte; arr: array [1..30] of integer; begin summ:=0; randomize; for i:=1 to 30 do begin arr[i]:=random(70)-20; write(arr[i]:2); if arr[i]>0 then summ:=summ+arr[i]; end; writeln; write('Summ=',summ); end.

Ответ отправил: Миленин Александр (статус: 9-ый класс) Ответ отправлен: 20.12.2007, 23:12

Отвечает: Djec Здравствуйте, Sheetsack! В приложении решение задачи с вводом исходных данных и обработкой исключительных ситуаций: Приложение: program q115140; const N_Max = 10; var A : Array [1..N_Max] of integer; i, sum, N : integer; begin WriteLn( 'Введите размерность массива N:' ); Write( 'N= ' ); ReadLn( N ); WriteLn( 'Введите ', N ,' элементов массива А:' ); for i := 1 to N do ReadLn( A[i] ); WriteLn( 'Исходный массив A:' ); for i := 1 to N do Write( A[i]:3 ); WriteLn; sum := 0; for i := 1 to N do if A[i] > 0 then sum := sum + A[i]; if sum = 0 then WriteLn( 'В массиве нет положительных элементов' ) else WriteLn( 'Сумма положительных равна ', sum ); ReadLn; end. --------- "Если ты что-то делаешь, делай это хорошо. если же ты не можешь или не хочешь делать хорошо, лчуше совсем не делай" © Л.Н.Толстой"

Ответ отправил: Djec (статус: 6-ой класс) Ответ отправлен: 20.12.2007, 23:25

Отвечает: Зиновьев Дмитрий Владимирович Здравствуйте, Sheetsack! var i: integer; sum: real; begin sum := 0; for i := Low(A) to HIGH(A) do if A[i] > 0 then sum := sum + A[i]; end;

Ответ отправил: Зиновьев Дмитрий Владимирович (статус: 9-ый класс) Ответ отправлен: 21.12.2007, 12:55 Оценка за ответ: 5

Отвечает: Артём1983 Здравствуйте, Sheetsack! Смотрите код программы в приложении. Приложение: {115140} uses crt; var a:array[1..10]of integer; i,summ:integer; begin clrscr; randomize; summ:=0; textcolor(white); for i:=1to 10do begin a[i]:=-10+random(21); if a[i]>0 then begin summ:=summ+a[i]; textcolor(green); write(a[i]:4); end else begin textcolor(white); write(a[i]:4); end; end; writeln; textcolor(white); write('сумма положительных элементов =',summ); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 7-ой класс) Ответ отправлен: 21.12.2007, 22:15

Вопрос № 115.143

Дан массив, найти сумму пяти первых элементов массива

Отправлен: 20.12.2007, 23:22 Вопрос задал: Sheetsack (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Djec Здравствуйте, Sheetsack! В приложении решение вашей задачи: Приложение: program q114885; const N_Max = 10; var A : Array [1..N_Max] of integer; i, sum, N : integer; begin WriteLn( 'Введите размерность массива N:' ); Write( 'N= ' ); ReadLn( N ); WriteLn( 'Введите ', N ,' элементов массива А:' ); for i := 1 to N do ReadLn( A[i] ); WriteLn( 'Исходный массив A:' ); for i := 1 to N do Write( A[i]:3 ); WriteLn; sum := 0; for i := 1 to N do if A[i] > 0 then sum := sum + A[i]; if sum = 0 then WriteLn( 'В массиве нет положительных элементов' ) else WriteLn( 'Сумма положительных равна ', sum ); ReadLn; end. --------- "Если ты что-то делаешь, делай это хорошо. если же ты не можешь или не хочешь делать хорошо, лчуше совсем не делай" © Л.Н.Толстой"

Ответ отправил: Djec (статус: 6-ой класс) Ответ отправлен: 20.12.2007, 23:29

Отвечает: Миленин Александр Здравствуйте, Sheetsack! В приложении код программы, константа n задаёт размерность массива, а сам массив заполняется случайными целыми числами от 0 до 100 Приложение: const n=30; var summ:integer; i:byte; arr: array [1..n] of integer; begin summ:=0; randomize; for i:=1 to n do begin arr[i]:=random(100); write(arr[i]:2); if i<=5 then summ:=summ+arr[i]; end; writeln; write('Summ=',summ); end.

Ответ отправил: Миленин Александр (статус: 9-ый класс) Ответ отправлен: 20.12.2007, 23:45

Отвечает: Зиновьев Дмитрий Владимирович Здравствуйте, Sheetsack! i, j, k: integer; sum: real; begin i := Low(a); // где a - ваш массив j := i + 5; k := High(a); if j > k then j := k; for k := i to j do sum := sum + a[k]; end;

Ответ отправил: Зиновьев Дмитрий Владимирович (статус: 9-ый класс) Ответ отправлен: 21.12.2007, 12:53

Отвечает: Артём1983 Здравствуйте, Sheetsack! Смотрите код программы в приложении. Приложение: {115143} uses crt; var a:array[1..10]of integer; i,summ:integer; begin clrscr; randomize; summ:=0; textcolor(white); for i:=1to 10do begin a[i]:=-10+random(21); write(a[i]:4); if i<=5 then summ:=summ+a[i]; end; writeln; write('сумма первых пяти элементов = ',summ); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 7-ой класс) Ответ отправлен: 21.12.2007, 22:16 Оценка за ответ: 5

Вопрос № 115.236

в массиве даны числа 0,1,2. Переставить их в порядке возрастания. разрешена только перестановка

Отправлен: 21.12.2007, 16:48 Вопрос задал: Кузнецов Николай Михайлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Boriss Здравствуйте, Кузнецов Николай Михайлович! Вот простейший вариант (по сути дела, реализуется метод пузырьковой сортировки). Можно и поумнее сделать Приложение: const N = 20; var ar: array[1..N] of Byte; i, k: Integer; temp: Byte; BEGIN for i:=1 to N do ar[i]:=Random(3); for i:=1 to N do Write(ar[i]:4); WriteLn; for i:=1 to N-1 do for k:=i+1 to N do if ar[k] < ar[i] then begin temp:=ar[k]; ar[k]:=ar[i]; ar[i]:=temp end; for i:=1 to N do Write(ar[i]:4); WriteLn; END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 22.12.2007, 14:28

Вопрос № 115.239

найти количество четных цифр целого положительного числа

Отправлен: 21.12.2007, 16:53 Вопрос задал: Кузнецов Николай Михайлович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Boriss Здравствуйте, Кузнецов Николай Михайлович! Это решается просто с помощью оператора MOD (вычисление остатка от целочисленного деления). Пример в приложении. А на уточняющие вопросы мои на вопросы Ваши ответьте в минифорумах. Действительно, не понятные задания Приложение: const num: Longint = 123456; count: Integer = 0; begin while num <> 0 do begin if NOT ODD(num mod 10) then inc(count); num := num div 10 end; WriteLn(count); end. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 21.12.2007, 17:09

Отвечает: Витек Здравствуйте, Кузнецов Николай Михайлович! var n,kol:integer; s:string; begin write('Ukagite chislo: '); readln(n); str(n,s); write('Kol-vo cifr v chisle = ',length(s)); end. --------- ohne fleis, keine preis

Ответ отправил: Витек (статус: 3-ий класс) Ответ отправлен: 25.12.2007, 10:08

Вопрос № 115.240

дана непустая последовательность слов из строчных русских букв. между словами запятая, за последним точка. напечатать в алфавитном глухие согласные которые не входят только в одно слово

Отправлен: 21.12.2007, 16:54 Вопрос задал: Кузнецов Николай Михайлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Boriss Здравствуйте, Кузнецов Николай Михайлович! Я такие штуки делаю через множества. Для них определена удобная функция in - принадлежность множеству. Вот в приложении я и определил множество letters, в который записал все символы, из которых может состоять слово (как видите, я расширил задачу - слово может состоять и из латинских букв) А дальше задача решается с помощью функции, которой передается анализируемая строка и положение в строке. Она анализирует строку и увеличивает положение. Не понятно ежели что, то пишите в минифоруме Приложение: const Letters: Set of Char = ['A'..'Z', 'a'..'z', 'А'..'п','р'..'я']; {Перечислим символы, из которых может состоять слово} function GetWord(source: String; var position: Integer): String; var buf: String; begin buf:=''; while (position <= length(source)) and (NOT (source[position] in letters)) do inc(position); while (position <= length(source)) and (source[position] in letters) do begin buf := buf + source[position]; inc(position) end; GetWord := buf end; const TestString: String = 'абвг,деж,зи.кл'; var i: Integer; BEGIN i:=1; while (i < length(TestString)) and (testString[i] <> '.') do begin WriteLn(GetWord(TestString, i)); end; END. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 22.12.2007, 13:59

Вопрос № 115.241

Даны a b и с. Имеет ли уравнение а хквадрат + bx + с=0 одинаковые действительные корни. Если нет, то выдать сообщение

Отправлен: 21.12.2007, 16:56 Вопрос задал: Кузнецов Николай Михайлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Boriss Здравствуйте, Кузнецов Николай Михайлович! Ну вот так можно. Пишите подробнее, в чем Ваши проблемы :)) Приложение: VAR a, b, c, det: Real; x1, x2: Real; BEGIN WriteLn('Введите значения коэффициентов a, b, c уравнения ax^2 + bx + c = 0'); ReadLn(a, b, c); det := b*b -4*a*c; if det < 0 then WriteLn('Действительных корней нет') else if det = 0 then WriteLn('Корни равны друг другу и равны ', b /(2*a):10:4) else begin det := SQRT(det); x1:=(b - det)/(2*a); x2:=(b+det)/(2*a); WriteLn('Корни уравнения ',x1:10:4, ' и ',x2:10:4) end; END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 22.12.2007, 09:48

Вопрос № 115.242

Найти корни а хквадрат + bx + с=0 для а b и с, вводимых с клавиатуры

Отправлен: 21.12.2007, 16:58 Вопрос задал: Кузнецов Николай Михайлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Pavl Здравствуйте, Кузнецов Николай Михайлович! Алгоритм решения такой: если a=0, то нет квадратного уравнения. Иначе, считаем дискриминант. Если он <0, то не будет действительных корней. Иначе, считаем корни. И всё. Программа в приложении. Приложение: program kvadrat; var a,b,c:real; d:real; x1,x2:real; begin writeln('Введите коэффициенты'); write('a = '); readln(a); write('b = '); readln(b); write('c = '); readln(c); if a<>0 then begin d:=b*b-4*a*c; if d>=0 then begin x1:=(-b-sqrt(d))/2/a; x2:=(-b+sqrt(d))/2/a; writeln('корни x1 = ',x1:0:3,' и x2 = ',x2:0:3); end else writeln('Действительных корней нет'); end else writeln('Нет квадратного уравнения'); end.

Ответ отправил: Pavl (статус: 2-ой класс) Ответ отправлен: 21.12.2007, 17:35

Вопрос № 115.244

Помоготе сделать программу вычисляющая синус (ряд Тейлора) с заданной точностью, например до 0.000001.

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

Отвечает: Coupler Здравствуйте, Семин Алексей Юрьевич! Как известно, синус раскладывается в ряд Тейлора так: (сумма от 0 до беск.) (-1)^n*x^(2n+1)/(2n+1)! Так как рад знакочередующийся, то остаток можем оценить как элемент, который меньше 0.000001 и все последующие за ним. То есть нужно вычислять и складывать члены ряда до тех пор, пока не найдем элемент, модуль которого меньше 0.000001. Сумма ряда - это и будет sin(x) с точностью 0.000001. По всем правилам сумма ряда должна выводиться с тем же числом знаков, что и точность (для этого ее округляют). Но эту работу я оставляю Вам :) Приложение: program Project2; var x, e, s, tmp: real; n, z: integer; begin writeln('Vvedite X'); readln(x); writeln('Vvedite e'); readln(e); s := x; tmp := x; z := -1; n := 1; while (abs(tmp) >= e) do begin tmp := tmp * x * x / (2 * n * (2 * n + 1)); s := s + z * tmp; z := z * (-1); n:=n+1; end; writeln(s:2:8); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 21.12.2007, 19:05 Оценка за ответ: 4

Вопрос № 115.256

Здравствуйте! У меня к Вам два вопроса: можно ли для созданных на Паскале программок делать графическую оболочку, графический интерфейс какой то, а не стандартное черное окно! Хотя бы без кнопок там разных, просто красивое цветное окно! И если можно то как!? И еще, если писать программку на паскале, которая будет выдавать текстовую инф., то как лучше это сделать? писать текстовый файл что ли?!? посоветуйте пожалуйста!!!

Отправлен: 21.12.2007, 18:25 Вопрос задал: Васько (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: SHERRY Здравствуйте, Васько! Для этого можно использовать среду разработки Borland Delphi. Там такое используется графический интерфейс приложения (хотя есть и консоль), и практически всё основано на языке дедушки Паскаля. --------- Наши программисты самые программистые программисты!..

Ответ отправил: SHERRY (статус: 5-ый класс) Ответ отправлен: 21.12.2007, 19:19 Оценка за ответ: 5 Комментарий оценки: СПАСИБО!!! Но если я только недавно начал изучать язык Паскаль, то мне несложно будет работать на Delphi!? процедуры и функии те же?

Отвечает: Shapoklak Здравствуйте, Васько! Высылаю Вам пример. Там синее окно и меню в виде списка пунктов (переход стрелками). Попробуйте переделать под свои нужны. Описание и исходные тексты - все в архиве. Выводит и на экран, и в текстовый файл, который потом можно просто в Блокноте открыть. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправила: Shapoklak (статус: Академик) Россия, Орск Организация: школа Адрес: www.school56orsk.narod.ru WWW: компьютерные фирмы г. Орска ICQ: 101137510 ---- Ответ отправлен: 22.12.2007, 22:58 Оценка за ответ: 5 Комментарий оценки: Спасибо! Но вы ответили на первый вопрос! Посмотрите второй!

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