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

Выпуск № 597
от 09.03.2008, 15:05

Вопрос № 125.818

Вот тут задачки. С клавиатуры вводятся четыре числа - длины стороно конверта и открытки.Определите, можно ли не сгибая положить открытку в конверт. вот эта задача в приложении. И пожалуйста, прошу. Решите эти две задачи обязательно. В первой можно использовать условный оператор, логические операции, никаких функций, типы данных Boolean и Integer, никаких массивов. Во второй можно также пользоваться циклами. 1. Даны координаты четырёх точек A, B, C, D на координатной прямой. Не применяя циклов, определите длину пересечения отрезков АВ и CD. Если отрезки не пересекаются, выведети ноль. 2. С клавиатуры вводится натуральное число n. Написать программу, которая рисует равнобедренный треугольник из звёздочек с бедром и основанием, равным n. Приложение: Var a, b, x, y: Integer; Begin Write('Длины сторон коверта: '); Read(a, b); Write('Длины сторон открытки: '); Read(x, y); If (a+b > x+y) Then Begin WriteLn('Можно'); End Else Begin WriteLn('нельзя'); End; ReadLn; End.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Задачу №2. я вам выкладывал без массивов на мини-форуме, с массивами- в письме. По моему вам надо без массивов, поэтому смотрите в приложении. Приложение: Задача №2. uses crt; var n,i,j:integer; 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 begin gotoxy(j,i); write('*'); end else if (i=n)and(j mod 2=1) then begin gotoxy(j,i); write('*'); end; end; readln; 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-ий класс) Ответ отправлен: 03.03.2008, 18:28

Вопрос № 125.860

Уважаемые эксперты, помогите пожалуйста решить: 1) Даны натуральное число n, символы s1, …, sn. Определить число вхождений в последовательность s1, …, sn группы букв abc. 2) Из заданного предложения выбрать и напечатать те символы, которые встречаются в нем только один раз (в том порядке, в котором они встречаются в тексте). 3) Дан файл f, компоненты которого являются целыми числами. Записать в файл g все четные числа файла f, ав файл h – все нечетные. порядок следования чисел сохраняется. 4) Дан файл, содержащий сведения об ассортименте игрушек в магазине. Каждая запись содержит поля – название игрушки, цена, количество, возрастные границы, например, для детей от 2 до 5 лет. Написать программу, выдающую информацию следующего вида: - названия игрушек, которые подходят детям от 1 до 3 лет; -стоимость самой дорогой игрушки и ее наименование; -название игрушки, которая по стоимости не превышает Х руб. и подходит ребенку в возрасте от А до В лет. Значения Х, А, В вводятся по запросу с терминала. 5)Написать программу, которая вводит с клавиатуры радиус окружности, рисует окружность с заданными параметрами в центре экрана и последовательно уменьшает размер окружности до точки. Окружность рисовать красным цветом на черном фоне. >>>если можно то простыми операторами или хотябы понятными не сильно заумно а то и так не могу разобраться<<< ЗАРАНЕЕ БОЛЬШОЕ СПАСИБО

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Дебелов Владимир Валентинович! Задача № 1. Поскольку по условию нужно ввести N символов, то будем использовать массив символов, хотя эту задачу можно решить и с поиощью строки. Задача №2. Здесь вроде все просто. Как бы клонируем строку (s[i]и s[j]),затем считаем посимвольно количество одинаковых. Если оно(r)=1, значит символ встречается один раз.Копируем его в строку s1. Задача №3. Тоже вроде все понятно. Создаем текстовый файл, заполненный через пробелы целыми числами, присваиваем ему имя и сохраняем. Затем считываем его в массив, далее из массива если четный-в один файл, если нет – в другой. Задача №4. Решать не стал, довольно длинная, путанная и простыми, понятными простому человеку словами мне ее не написать, комментариев будет больше, чем текста. Задача №5. Работа с в графическом режиме своеобразна и объяснять нужно каждое слово, поэтому найдите или скачайте из инета учебник, где рассматривается работа в графическом режиме и внимательно прочитайте, иначе ничего не поймете. Суть решения: Задаем R, x,y в центре экрана. В цикле рисуем окружность красным цветом, потом по ней черным(стираем). Затем через задержку в 100 млсек уменьшаем радиус на 1 пиксель и все повторяем. Останавливаемся при R=1, т.е. точка, как в условии. Приложение: Задача №1. program q125860_1; uses crt; var n,i,k:integer; a:array[1..100]of char; begin clrscr; write('n=');readln(n); for i:=1 to n do begin write('a[',i,']='); readln(a[i]); end; clrscr; for i:=1 to n do write(a[i],' '); writeln; k:=0; for i:=1 to n do if (a[i]='a')and(a[i+1]='b')and(a[i+2]='c') then k:=k+1; write('k=',k); readln end. Задача №2. program q125860_2; uses crt; var a,i,j,r:integer; s,st:string; begin clrscr; write('stroka: ');readln(s); a:=length(s);st:=''; for i:=1 to a do begin r:=0; for j:=1 to a do if (s[i]=s[j]) then begin r:=r+1; end; if r=1 then st:=st+copy(s,i,1); end; writeln('st: ',st); readln end. Задача №3. program q125860_3; uses crt; var f,g,h:text; a:array[1..100]of integer; n,i:integer; begin clrscr; assign(f,'fq860_3.txt'); reset(f); assign(g,'fq860_31.txt'); rewrite(g); assign(h,'fq860_32.txt'); rewrite(h); n:=1; while not eof(f)do begin read(f,a[n]); n:=n+1; end; close(f); for i:=1 to n-1 do begin if a[i] mod 2=0 then write(g,a[i],' ') else if a[i] mod 2=1then write(h,a[i],' '); end; close(g); close(h); end. Задача №5. program q125860_5; uses crt,graph; var a,i,x,y,r,gd,gm:integer; begin clrscr; write('R=');readln(R); InitGraph(gd,gm,'d pgi'); x:=GetMaxX div 2;y:=GetMaxY div 2; SetbkColor(0); repeat SetColor(0); Circle(x,y,R); R:=R-1; SetColor(4); Circle(x,y,R); delay(100); until r=1; readln; RestoreCrtMode; {выход в текстовый режим} end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 04.03.2008, 12:46 Оценка за ответ: 5 Комментарий оценки: ОЙ,спасибо большое!!!!!! спасибо сто написали пояснения так гораздо проще понять всё это. Последнюю задачу я вообще незнал как делать так как я не представлял что оказывается можно рисовать в такой программе как паскаль.

Вопрос № 125.903

Здадача: Удалить часть строки, заключенной в скобки(вместе со скобками). Задача должна быть решена с применением строковых процедур и функций. Приложение: Задача должна быть решена с применением строковых процедур и функций.

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

Отвечает: Костя Симанович Здравствуйте, Попов Александр Олегович! В данном решении сначала ищется вхождение открывающейся скобки, запоминаем её номер, потом ищем закрывающуюся скобку. Запоминаем её номер. далее в копируем все символы до первой скобки и прибавляем все символы после второй скобки. Решение в приложении. Добавил проверку на открытие и закрытие скобок. Приложение: program stroki; var stroka : string; // водимая строка pod : string; // подстрока a, a1 : integer; // номер искомого элемента l : integer; // длина строки begin writeln('Введиде строку'); readln(stroka); l := length(stroka); a := pos('(', stroka); if a = 0 then writeln('Открывающихся скобок нет. Удалить элемент невозможно') else begin a1 := pos(')', stroka); if a1 = 0 then writeln('Открывающихся скобок нет. Удалить элемент невозможно') else begin if a < a1 then begin pod := copy(stroka, 1, a-1); pod := pod + copy(stroka, a1+1, l); writeln('Строка после обработки'); writeln; writeln(pod); end else writeln('Закрывающаяся скобка стоит раньше открывающейся.'); end; end; readln; end.

Ответ отправил: Костя Симанович (статус: 1-ый класс) Ответ отправлен: 04.03.2008, 13:42 Оценка за ответ: 3

Отвечает: Пупорев Юрий Борисович Здравствуйте, Попов Александр Олегович! Если нужно удалить только один раз, например первые скобки, то можно решить как в первом варианте. Если нужно удалить все символы в строке, заключенные в скобки, тогда нужно решать как во втором варианте. Смотрите решение в приложении. Приложение: program q125903_1; uses crt; var s:string; i,a,b:integer; begin clrscr; write('s:');readln(s); a:=pos('(',s);b:=pos(')',s); if a<b then delete(s,a,(b-a+1)); writeln(s); readln end. program q125903_2; uses crt; var s,s1:string; i:integer; begin clrscr; write('s:');readln(s); s1:=''; for i:=1 to length(s) do begin s1:=s1+copy(s,1,pos('(',s)-1); delete(s,1,pos(')',s)); end; writeln(s1); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 3-ий класс) Ответ отправлен: 04.03.2008, 14:08 Оценка за ответ: 4 Комментарий оценки: воспользовался ответом другова эксперта

Отвечает: Попов Владимир Иванович Здравствуйте, Попов Александр Олегович! Задачка решается с применением таких строковых функций : length(s) - определения длины рядка и delete(s,p,n) - удаления части рядка s, начиная с позиции p, на n символов. Поиск первого удаляемого символа '(' организован в виде цикла с параметром по длине рядка. Исходник в приложении. Удачи. Приложение: program q125903; uses crt; var s:string; i,L,k1,k2:byte; ch:char; begin clrscr; writeln; repeat write(' Input you string row : '); readln(s); L:=length(s); for i:=1 to L do begin if s[i]='(' then k1:=i; if s[i]=')' then k2:=i; end; delete(s,k1,k2-k1+2); writeln(' Your modify row is : ',s); writeln; write(' Again ? (y/n) ---> '); ch:=readkey; until ch='n'; end. --------- Physics forever !

Ответ отправил: Попов Владимир Иванович (статус: 3-ий класс) Ответ отправлен: 04.03.2008, 19:15 Оценка за ответ: 5 Комментарий оценки: Огромное спосибо! все работает!!!!

Вопрос № 125.905

Уважаемые эксперты помогите написать программу для нахождения в тексте всех английских слов , содержащих наименьшее кол-во гласных букв.

Отправлен: 04.03.2008, 12:46 Вопрос задал: Maniak8989 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Verena Здравствуйте, Maniak8989! Для решения задачи понадобится два обхода строки: сначала вычислим минимальное число гласных среди всех слов, а потом выберем все слова с этим числом гласных. Для подсчёта числа гласных в слове я использую функцию, сами гласные хранятся в множестве (set of char), благодаря чему их наличие можно проверять оператором in. Я перечислила только маленькие гласные буквы, Вы можете при делании добавить и заглавные. Код в приложении. Приложение: Const glb: set of char = ['a', 'e', 'o', 'i', 'y', 'u']; {Объявляем костанту - множество гласных букв} Var str: string; i, l, k, mink, nw, kw: integer; function KolGlBukv (word: string): integer; {Функция подсчёта гласных букв в слове} var k, i: integer; begin k:=0; {Обнуляем счётчик} for i:=1 to length (word) do {Идём по слову посимвольно} if (word[i] in glb) then inc (k); {Если текущий символ принадлежит искомому множеству - наращиваем счётчик} KolGlBukv:= k; {Возвращаем полученное значение} end; begin i:= 1; k:= 0; {Устанавливаем счётчики} readln (str); {Считываем строку} l:= length (str); {Запоминаем её длину} mink:= l; {Максимально возможное число гласных букв - длина строки} {Ищем минимальную длину} while (i<=l) do {Пока не конец строки} begin while (i<=l) and (str[i]=' ') do inc (i); {Пропускаем пробел(ы)} nw:= i; {Запоминаем номер символа начала слова} while (i<=l) and (str[i]<>' ') do inc (i); {Прокручиваем слово} kw:= i; {Запоминаем его конец} k:= KolGlBukv (copy (str, nw, kw-nw)); {Передаём вырезанное функцией copy слово в функцию} if (k<mink) then mink:= k; {Если полученная длина меньше текущей минимальной - запоминаем новую} end; i:= 1; {Переопределяем счётчик} while (i<=l) do {Пока не конец строки} begin {Аналогично вырезаем слово} while (i<=l) and (str[i]=' ') do inc (i); nw:= i; while (i<=l) and (str[i]<>' ') do inc (i); kw:= i; {Если количество гласных в слове равно минимальному - выводим его на экран} if KolGlBukv (copy (str, nw, kw-nw))=mink then writeln (copy (str, nw, kw-nw)); end; end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 04.03.2008, 15:36 Оценка за ответ: 5

Вопрос № 125.923

Здравствуйте, Уважаемые Эксперты! Помогите, пожалуйста, сделать 2 задачи. 1. определить , какая из букв “е” или “о” встречается в предложении чаще. 2. Вводится строка текста из N символов слова разделены одним пробелом. Найти количество слов, которых первая и последняя буквы одинаковые

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

Отвечает: Verena Здравствуйте, MUSIC! Решение Ваших задач в приложении (первой идёт задача 2). Из комментариев, думаю, всё будет ясно. Приложение: {#Задача 2} Var str: string; i, l, k, nw: integer; begin i:= 1; k:= 0; {Устанавливаем счётчики} readln (str); {Считываем строку} l:= length (str); {Запоминаем её длину} while (i<=l) do {Пока не конец строки} begin if (str[i]=' ') then inc (i); {Пропускаем пробел} nw:= i; {Запоминаем номер символа начала слова} while (i<=l) and (str[i]<>' ') do inc (i); {Прокручиваем слово} if (str[nw]=str[i-1]) then inc (k); {Если символы совпадают - наращиваем счётчик} end; writeln (k); end. {#Задача 1} Var str: string; i, ke, ko: integer; begin i:= 1; ke:= 0; ko:= 0; {Устанавливаем счётчики} readln (str); {Считываем строку} for i:=1 to length(str) do begin if str[i]='e' then inc (ke) {Наращиваем соответствующий счётчик} else if (str[i]='o') inc (ko); end; if ke>ko then writeln ('Bolshe ''e''') {Выбираем результат в зависимости от значений счётчика} else if ke<ko then writeln ('Bolshe ''o''') else writeln ('Odinakovo'); end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 04.03.2008, 15:52 Оценка за ответ: 5 Комментарий оценки: Спасибо выручили)

© 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