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

Выпуск № 643
от 27.04.2008, 06:35

Вопрос № 133.305

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

Отправлен: 21.04.2008, 06:39 Вопрос задал: Kl1shny Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Kl1shny! Только что отправил ответ на вопрос №133295, где рассматривается решение аналогичной задачи. Зайдите туда и спишите, только вместо while not eof(D)do begin read(D,a); a:=sqr(a); write(R,a,' '); end; Напишите while not eof(D)do begin read(D,a); if sqr(trunc(sqrt(a)))=a {если квадрат целой части корня=числу, то корень целое число} then write(R,a,' '); end; Говорить, что корень натуральное число неправильно, т.к. у каждого положительного числа два действительных корня, положительный и отрицательный, который натуральным числои не является. См. минифорум ----- ∙ Отредактировал: Alexandre V. Tchamaev (*У правляющий) ∙ Дата редактирования: 21.04.2008, 09:58

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 21.04.2008, 08:03

Отвечает: Евчик Сергей Александрович Здравствуйте, Kl1shny! Код в приложении. Программа будет работать, если в файле все числа будут идти в столбик. Если у Вас числа идут не в столбик, то придется из считанной строки выбирать каждое число и проверять его функцией Proverka. Удачи. Приложение: Program z1; uses crt; var f,f1:text; i,cod:integer; way,s:string; Function Proverka (i:integer):boolean; begin if (sqr(trunc(sqrt(i))) = i) and (i>=0) then Proverka:=true else Proverka:=false; end; begin clrscr; Write('Введите путь к файлу: '); readln(way); Assign(f,way); {$I-} Reset(f); {$I+} If IoResult <> 0 then begin Writeln('ERROR'); ReadKey; Halt; end else begin Write('Введите путь к файлу для сохранения: '); readln(way); Assign(f1,way); {$I-} ReWrite(f1); {$I+} If IoResult <> 0 then begin Writeln('ERROR'); ReadKey; Halt; end else begin While not EOF(f) do begin Readln(f,s); val(s,i,cod); if cod=0 then if Proverka(i) = true then Writeln(f1,i) end; close(f); close(f1); end; readKey; end.

Ответ отправил: Евчик Сергей Александрович (статус: 4-ый класс) Ответ отправлен: 21.04.2008, 14:36

Вопрос № 133.356

Добрый день)...вот помогите плиз решить задачку... Текстовый фаил содержит натуральные числа. В другой фаил поместить только те числа, корень из которых натурально число

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

Отвечает: Лобанов Александр Здравствуйте, Китаев Кирилл Артурович! Данную программу уже писал ранее Пупорев Юрий Борисович См.приложение Приложение: uses crt; var D,R:text;{переменные - текстовые файлы} a:integer;{переменная для обработки чисел} begin clrscr; assign(D,'chisla.txt');{связываем переменную с нашим файлом} reset(D); {открываем его для чтения} assign(R,'chisla1.txt');{связываем переменную с новым файлом} rewrite(R); {открываем его для записи} while not eof(D)do begin read(D,a); {считываем числа из файла} a:=sqr(a); {возводим их в квадрат} write(R,a,' '); {записываем квадраты в новый файл} end; close(D); {закрываем файлы} close(R); writeln('Fail chisla1.txt sozdan!'); readln end.

Ответ отправил: Лобанов Александр (статус: 1-ый класс) Ответ отправлен: 21.04.2008, 14:13 Оценка за ответ: 4 Комментарий оценки: Благадарю за помощь.

Вопрос № 133.373

1. В двумерном массиве переставить местами элементы первого и по- следнего столбца. 2. Дана действительная матрица размера n*m. Найти сумму наиболь- ших и наименьших значений элементов в каждой из ее строк. От- сортировать матрицу по возрастанию.

Отправлен: 21.04.2008, 14:50 Вопрос задал: Боринов Святослав Николаевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Боринов Святослав Николаевич! Первая задача в приложении Удачи!!! Приложение: const m=5; //Кол-во строк n=10; //Кол-во столбцов var a : array [1..M, 1..N] of integer; //массив buf : array [1..M] of integer; //временный массив i, j:integer; //счетчики для циклов For begin WriteLn('Матрица: '); randomize; //заполняем матрицу случайными числами и выводим её for i:=1 to M do begin for j:=1 to N do begin a[i, j]:=random(101); write(a[i, j], ' '); end; writeln; end; for i:=1 to M do //для каждой строки begin buf[i]:=a[i, N]; //приравниваем тек. эл. массива BUF к эл. из последнего столбца матрицы a[i, N] := a[i, 1]; //приравниваем i-му эл. первого столбца i-ий эл. последнего столбца матрицы a[i, 1]:=buf[i]; //i-ий эл. := i-му ел. Buf end; Writeln('Результат:'); //Выводим результат for i:=1 to M do begin for j:=1 to N do write(a[i, j], ' '); writeln; end; readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 9-ый класс) Ответ отправлен: 21.04.2008, 20:48

Отвечает: Пупорев Юрий Борисович Здравствуйте, Боринов Святослав Николаевич! Решение второй задачи в приложении. Сортировка матрицы выполнена с использованием дополнительного линейного массива. Приложение: uses crt; const n=6; m=5; var mt:array[1..n,1..m]of real; {матрица} ms:array[1..n*m]of real; {массив для сортировки} i,j,k:integer; max,min,x:real; begin clrscr; randomize; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin mt[i,j]:=random(20)+random-9; write(mt[i,j]:7:2); end; writeln; end; readln; for i:=1 to n do begin {поиск макс и мин в строках} max:=mt[i,1];min:=mt[i,1]; for j:=1 to m do if mt[i,j]>max then begin max:=mt[i,j]; end else if mt[i,j]<min then begin min:=mt[i,j]; end; writeln('sum max+min v stroke ',i,'=',(max+min):5:2); end; readln; {разложение матрицы в линейный массив} k:=0; for i:=1 to n do for j:=1 to m do begin k:=k+1; ms[k]:=mt[i,j]; end; {сортировка массива по возрастанию} for i:=1 to k-1 do for j:=1 to k-1 do if ms[j]>ms[j+1]then begin x:=ms[j]; ms[j]:=ms[j+1]; ms[j+1]:=x; end; writeln('Sortironka:'); {вывод полученного массива на экран в виде матрицы} for i:=1 to n do begin for j:=1 to m do begin mt[i,j]:=ms[j+m*(i-1)]; write(mt[i,j]:7:2); end; writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 21.04.2008, 22:33

Вопрос № 133.374

здраствуйте! Помогите написать программы по теме символьный и строковый типы данных! 1) Написать программу,которая запрашивает день недели у пользователя. В зависимости от дня недели дается некий совет. 2)С клавиатуры задаются три строковых значения. Требуется проверить на вхождение первого значения в два остальные одновременно. 3)Подсчитать в предложении количество слов, содержащих цифры.

Отправлен: 21.04.2008, 14:59 Вопрос задала: Шичкина, Анна, Сергеевна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Шичкина, Анна, Сергеевна! По поводу первого вопроса. Можно запрашивать у пользователя номер дня недели, а потом использую оператор CASE вывести какую-нибудь надпись. Вот например: var ch: byte; {/////} begin {///} read(ch); case ch of 1: writeln('Понедельник - жень тяжёлый'); 2: writeln('Вторник! Бла-бла-бла...'); { и так далее } 7: writeln('Ура! Воскресенье!'); end; Удачи! --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 21.04.2008, 19:33 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Шичкина, Анна, Сергеевна! Решение второй и третьей задач в приложении. Приведены необходимые комментарии. Приложение: Задача 2. uses crt; var s1,s2,s3:string; begin clrscr; write('Vvedite podstroku:'); readln(s1); write('Vvedite stroku 1:'); readln(s2); write('Vvedite stroku 2:'); readln(s3); {если первое вхождение подстроки s1 в строки s2,s3>0 } if (pos(s1,s2)>0) and (pos(s1,s3)>0) then writeln('podstroka s1 vhodit v stroki s2 i s3') else writeln('podstroka s1 ne vhodit v stroki s2 i s3 odnovremenno'); readln end. Задача 3. uses crt; var s:string; s1:array[1..50]of string; i,j,k,g:integer; begin clrscr; write('Vvedite predlogenie:'); readln(s); j:=1; {от конца строки к началу ищем пробелы. От начала строки до пробела копируем символы в слова, которые собираем в массив. После копирования удаляем эту часть строки и все повторяем до последнего пробела. Последним элементом массива будет остаток строки от последнего пробела до конца} for i:=length(s) downto 1 do if s[i]=' 'then begin s1[j]:=copy(s,1,(pos(' ',s)-1)); delete(s,1,pos(' ',s)); j:=j+1; end; s1[j]:=s; {последнее слово} g:=0; {в каждом слове проверяем символы, не входят ли они во множество цифр. Если встречаем цифру, считаем это слово и выходим из цикла} for i:=1 to j do for k:=1 to length(s1[i]) do if s1[i][k] in ['0'..'9'] then {s1[i]-слово, [k]-символы в нем} begin g:=g+1; break; end; writeln('Kolichestvo takih slov=',g); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 21.04.2008, 23:23 Оценка за ответ: 5

Вопрос № 133.379

Дан текстовый файл, не содержащий запятых. Расставить запятые перед союзами “а” и “но” (если эти союзы не стоят в начале предложения).

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

Отвечает: -=Dr. Штопор=- Здравствуйте, QwertySX! Программа в приложении, всё просто. На всякий случай дополнительно проверяю на начало предложения (вдруг оно с маленькой буквы начнётся? ;) ), если входные данные всегда корректны, то if s[pos(' а',s)]<>'.' then и if s[pos(' но',s)]<>'.' then можно опустить. ____________________________ Tantum possumus, quantum scimus Приложение: program zpt; var s:string; BEGIN writeln('Введите строку'); readln(s); while pos(' а',s)<>0 do if s[pos(' а',s)]<>'.' then insert(',',s,pos(' а',s)); while pos(' но',s)<>0 do if s[pos(' но',s)]<>'.' then insert(',',s,pos(' но',s)); writeln(s); end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 8-ой класс) Ответ отправлен: 21.04.2008, 15:46 Оценка за ответ: 5

Вопрос № 133.382

Здравствуйте! Помогите мне, пожалуйста, решить задачу на Паскале. Задача: Вводим строку из букв и цифр. Необходимо распознать все цифры и сосчитать их сумму. У меня возникла одна проблема: как распознать цифры в строке. Помогите, пожалуйста. Спасибо! P.S. Если нужно, могу прислать свое решение, которое у меня не работает.

Отправлен: 21.04.2008, 16:04 Вопрос задал: BOOM (статус: 10-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Шемет Станислав Васильевич Здравствуйте, BOOM! Для того чтоб распознать цифры в строке не обходимо проверить код каждого символа для цифр ети кода будут в районе 48..57; Тоесть для вашей задачи нужно сделать цикл по всей строке и проверить значения кода для каждого символа и если этот код входит в заданий диапазон выполнить соответствующее мери. Кстати можно и немного подругому сделать єту задачу а имеено нужно зделать цикл по всей строки и проверить на вхождения символов строки в множество цифр символов, тоесть єту If ord(s[i]) in [48..57] then строку можно заменить такой: If s[i] in ['0'..'9'] then Приложение: Var S:string; Sum:word; I:word; Begin sum:=0; Readln(s); for i:=1 to length(s) do If ord(s[i]) in [48..57] then sum:=sum+ord(s[i])-48;(*Здесь смотрим что єто за цифра ето сам код символа минус 48 так как 0 равен коду 48*) Writeln(sum); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 6-ой класс) Ответ отправлен: 21.04.2008, 16:39 Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 133.401

Доброе время суток эксперты...Помогите пожалуйста решить задачки по одномерному массиву: 1) Дан одномерный массив из 10 элементов. Найти сумму элементов, стоящих на чётных местах и количество элементов кратных 5. 2) Сформируйте массив, содержащий 20 элементов, с помощью датчика случайных чисел. Получите новый массив, каждый элемент которого равен произведению соответствующего элемента исходного массива и его индекс. Выведите на экран исходные и полученные результаты. 3) Дан одномерный массив из 20 элементов. Найти в нём минимальный и максимальный элементы. Вывести на печать элементы, которые находятся в массиве между ними. 4)Создать массив из 20 элементов, вместо чётных чисел записать 0, подсчитать количество замен. Распечатать новый массив.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Danilka! Задачи №1, 2, 3 в приложении Удачи!!! Приложение: {№1} var a : array [1..10] of integer; //Массив //sum - сумма четных элементов, kratfive - кол-во элементов кратных пяти, i - счетчик для цикла For sum, kratfive, i : integer; begin sum:=0; //обнуляем сумму, если этого не сделать, то переменная будет содержать мусор и прогорамма выдаст не верный рез-тат kratfive:=0; randomize; //включаем генератор случайных чисел for i:=1 to 10 do //перебираем весь массив begin a[i]:=random(14)-7; //присваиваем тек. эл. случайное число из диапозона [-7; 6] write(a[i], ' '); //выводим через пробел end; for i:=1 to 10 do //для каждого элемента массива begin if not Odd(i) then //если тек. индекс четный, то прибавляем к сумме sum:=sum+a[i]; if (a[i] mod 5) = 0 then //если тек. эл. делится на 5 без остатка, то увеличиваем счетчик на 1 inc(KratFive); end; WriteLn; //начинаем новую строку Write('Сумма = ', sum, ' Кол-во кр. 5 = ', kratfive); //выводим рез-ты ReadLn; end. {№2} const N=20; //размер массивов var a : array [1..N] of integer; //исходный массив New : array [1..N] of integer; //конечный массив i : integer; //счетчик для цикла For begin randomize; Write('Исходный массив: '); for i:=1 to N do //заполняем массив begin a[i]:=random(30)-15; write(a[i], ' '); end; WriteLn; Write('Результат работы: '); for i:=1 to N do //заполняем новый массив begin new[i]:=a[i]*i; Write(New[i], ' '); end; readln; end. {№3} const N=20; var a : array [0..N] of integer; min, max, minx, maxx, i, st, en : integer; begin randomize; Write('Исходный массив: '); for i:=1 to N do //заполняем массив begin a[i]:=random(30)-15; write(a[i], ' '); end; WriteLn; min:=a[1]; max:=min; minx:=1; maxx:=minx; for i:= 1 to N do begin if a[i]>max then begin max:=a[i]; maxx:=i; end else if a[i]<min then begin min:=a[i]; minx:=i; end; end; if minx<maxx then begin en:=maxx; st:=minx; end else begin st:=maxx; en:=minx; end; WriteLn; for i:=st+1 to en-1 do write(a[i], ' '); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 9-ый класс) Ответ отправлен: 21.04.2008, 19:50

Отвечает: SHERRY Здравствуйте, Danilka! Четвёртая задача в приложении. Приложение: const N = 20; var ms: array [1..n] of integer; i, count: integer; begin randomize; count:=0; for i:=1 to N do begin ms[i]:=random(100); write(ms[i]:5); if not Odd(ms[i]) then begin ms[i]:=0; inc(count); end; end; writeln; writeln; for i:=1 to n do write(ms[i]:5); writeln; writeln('Vsego ', count, ' zamen'); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 21.04.2008, 21:17

Вопрос № 133.411

Здравствуйте! Помогите пожалуйста с несколькими задачами, без сдачи этого предмета не допускают на практику! 1)Найти значение функции cosx в интервале от п/3 до 2п/3 в 20 точках. 2)Вычислить У(система уравнений) - e√x(в смысле е в степени квадр. корня от х) – cos x если х > pi - x*x ln x если 1≤x≤2 3)В массиве из 10 целых чисел, заданных случайным образом из интервала от 1 до 100 вывести на экран порядковые номера нечетных элементов 4)В заданной строке символов, где между группами символов стоят пробелы найти длину самой короткой и самой длинной группы 5)Создать файл из 10 целых чисел. Найти минимальный элемент и его порядковый номер 6)Создать файл из 10 вещественных чисед. Переписать в другогй файл сначала положительный потом отрицательные числа

Отправлен: 21.04.2008, 18:57 Вопрос задал: Третьяков Алексей Михайлович (статус: 4-ый класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Лобанов Александр Здравствуйте, Третьяков Алексей Михайлович! Смотрите программу 4 5) в приложении Исправлено по просьбе автора. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 21.04.2008, 21:42 Приложение: uses crt; const n=10; var a:array [1..n] of integer; i,imin,min:integer; begin clrscr; for i:=1 to n do begin a[i]:=random(100)-10; write(a[i]:3); end; writeln; readln; min:=a[1]; for i:=1 to n do if a[i]<min then begin min:=a[i]; imin:=i; end; writeln ('min= ',min:3,' ','nomer min: ',imin); end.

Ответ отправил: Лобанов Александр (статус: 1-ый класс) Ответ отправлен: 21.04.2008, 20:06 Оценка за ответ: 3 Комментарий оценки: не нашел 5 но все равно спасибо

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Третьяков Алексей Михайлович! Задача номер 3 в приложении Удачи!!! Приложение: const N=10; //размер массива var a : array [1..N] of integer; //сам массив i : integer; //счетчик для For begin randomize; //Включаем генератор случайных чисел write('Массив: '); for i:=1 to N do //для каждого элемента массива begin a[i]:=random(101); //присваиваем сл. число write(a[i], ' '); //и выводим через пробел end; writeln; //новая строка for i:=1 to N do //для каждого эл. массива begin if Odd(a[i]) then //если тек. эл. нечетный, то выводим его порядковый номер writeln('Порядковый номер - ', i); end; readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 9-ый класс) Ответ отправлен: 21.04.2008, 20:29 Оценка за ответ: 5 Комментарий оценки: Очень понравился ответ код программы написан с пояснениями, большое спасибо

Отвечает: SHERRY Здравствуйте, Третьяков Алексей Михайлович! Задачи номер 5 и 6 в приложении. Примечание: нумерация чисел в файле начинается с нуля! Приложение: №5 const N = 10; var f: file of integer; a,i,index,min: integer; begin Assign(f, 'MyFile.bin'); Rewrite(f); randomize; for i:=1 to N do begin a:=random(10); write(f, a); end; Reset(f); min:=9999999; for i:=0 to FileSize(f)-1 do begin read(f, a); write(a:4); if a < min then begin min:=a; index:=i; end; end; writeln; writeln('Min = ', min, ' cituated at ', index, ' position'); readln; end. №6 const N = 10; var f, f1: file of real; i: integer; a: real; begin Assign(f, 'MyFile.bin'); Rewrite(f); Assign(f1, 'MyFile-2.bin'); Rewrite(f1); randomize; for i:=1 to N do begin a:=random(100) / 5 - 10; write(f, a); end; Reset(f); writeln('All elements: '); for i:=0 to FileSize(f)-1 do begin read(f, a); write(a:8:3); if a > 0 then write(f1, a); end; Reset(f); for i:=0 to FileSize(f)-1 do begin read(f, a); if a < 0 then write(f1, a); end; writeln; writeln('In new file: '); Reset(f1); for i:=0 to FileSize(f)-1 do begin read(f1, a); write(a:8:3); end; readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 21.04.2008, 21:06 Оценка за ответ: 5 Комментарий оценки: спасибо за быстрый и качественный ответ.

Отвечает: Пупорев Юрий Борисович Здравствуйте, Третьяков Алексей Михайлович! Решение задач №1,2 и 4 в приложении. В задаче 2 в выражении x*x ln x нет знака между x и ln, я поставил *. Если неверно, поправьте, код от этого не изменится. Приложение: Задача №1. uses crt; var x,dx,y:real; i:integer; begin clrscr; x:=pi/3; {начальное значение х} dx:=(2*pi-pi/3)/19; {делим интервал на 19 частей} writeln('Rezultat:'); for i:=1 to 20 do begin y:=cos(x); {считаем у в 20 точках} writeln('t# ',i:2,' x=',x:5:2,' y=',y:5:2); {вывод форматируем, под номер-2 позиции, под х и у по пять позиций и два знака после запятой} x:=x+dx; {наращиваем х} end; readln end. Задача №2. uses crt; var x,y:real; begin clrscr; Writeln('Vvedite x v intervale (1,2) or x>pi:'); repeat write('x='); readln(x); until ((x>1)and(x<2))or(x>pi); if x>pi then y:=exp(sqrt(x)) else if (x>1)and(x<2)then y:=x*x*ln(x); Write('y=',y:5:3); readln end. Задача №4. uses crt; var s:string; {заданная строка} s1:array[1..100]of integer; {массив длин слов} i,j,max,min:integer; begin clrscr; Writeln('Vvedite stroku:'); readln(s); j:=1;s1[j]:=0; for i:=1 to length(s) do begin if s[i]=' 'then j:=j+1 else {если пробел, то +1 слово} s1[j]:=s1[j]+1; {если нет, то +1 к длине текущего слова} end; {в массиве обычным способом находим макс и мин} max:=s1[1];min:=s1[1]; for i:=2 to j do begin if s1[i]>max then max:=s1[i] else if s1[i]<min then min:=s1[i]; end; writeln('Dlina samogo dlinnogo slova= ',max,' znak(a,ov)'); writeln('Dlina samogo korotkogo slova= ',min,' znak(a,ov)'); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 22.04.2008, 09:20 Оценка за ответ: 5

Вопрос № 133.423

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

Отправлен: 21.04.2008, 19:48 Вопрос задал: Igor lukashov (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Igor lukashov! Код с комментариями в приложении Удачи!!! Приложение: const M = 5; //Кол-во строк var s : string; //Сама строка i, j : integer; //Счетчики для циклов For begin for i:=1 to M do //Повторяем M раз begin Write('Введите строку №', i, ': '); //просим ввести следующюю строку ReadLn(s); for j:=1 to Length(s) do //для каждоко элемента строки if s[j]='!' then //если он равен !, s[j]:='.'; //то приравниваем '.' WriteLn('Результат: ', s); //Выводи рез-тат end; readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 9-ый класс) Ответ отправлен: 21.04.2008, 20:14 Оценка за ответ: 5 Комментарий оценки: Все супер!спасибо!!!)))

Вопрос № 133.440

Уважаемые эксперты!помогите решить задачу! Даны числа P и H. Суммировать вводимые числа >P и отдельно числа <H. Определить количество тех и других слагаемых. При вводе числа=Р или H закончить работу. Огромное вам спасибо!!!)))

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

Отвечает: SHERRY Здравствуйте, Igor lukashov! Код задачи в приложении. Удачи! Приложение: const P = 15; H = 60; var sum_P,sum_H,cou_P,cou_H, a: integer; begin sum_P:=0; sum_H:=0; cou_P:=0; cou_H:=0; Repeat readln(a); if a > P then begin sum_P := sum_P + a; inc(cou_P); end; if a < H then begin sum_H := sum_H + a; inc(cou_H); end; Until (a=P) or (a=H); writeln('Sum H = ', Sum_H, ', ', cou_H, ' slagaemih'); writeln('Sum P = ', Sum_P, ', ', cou_P, ' slagaemih'); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 21.04.2008, 21:49 Оценка за ответ: 5

Вопрос № 133.474

Уважаемые эксперты,я обращаюсь к вам в очередной раз за помощью. Не бросайте в беде,помогите,пожалуйста. Я Благодарен всем кто откликается...Хочется сказать вам в очередной раз СПАСИБО,есть еще добрые люди на свете. Задчки на одномерные массивы: 1) Дана последовательность действительных чисел a1,a2 ,..., an . Заменить все ее члены, большие данного Z, этим числом. Подсчитать количество замен. 2) В последовательности действительных чисел a1,a2, ,an есть только положительные и отрицательные элементы. Вычислить произведение отрицательных элементов P1 и произведение положительных элементов P2. Сравнить модуль P2 с модулем P1, указать, какое из произведений по модулю больше.

Отправлен: 21.04.2008, 22:55 Вопрос задал: Денисов Игорь Александрович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Лобанов Александр Здравствуйте, Денисов Игорь Александрович! Задача №1 в приложении Приложение: uses crt; const n=10; var a:array [1..n] of integer; Z,zam,i:integer; begin z:=20; clrscr; randomize; for i:=1 to n do begin a[i]:=random(100); write (a[i]:3); writeln; end; readln; for i:=1 to n do if a[i]>z then begin a[i]:=z; zam:=zam+1; end; writeln('Chislo zamen =', zam:3); readln; end.

Ответ отправил: Лобанов Александр (статус: 1-ый класс) Ответ отправлен: 21.04.2008, 23:16 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Денисов Игорь Александрович! Решение второй задачи в приложении. Приложение: uses crt; const n=10; var a:array[1..n]of real; p1,p2:real; i:integer; begin clrscr; p1:=1;p2:=1; for i:=1 to n do begin a[i]:=random(10)+random-4;{в такой записи не будет ноля} if a[i]<0 then p1:=p1*a[i] {перемножаем отрицательные} else if a[i]>0 then p2:=p2*a[i];{перемножаем положительные} write(a[i]:6:2); end; writeln; {для проверки выводим произведения на экран} writeln('p1=',p1:5:2,' p2=',p2:5:2);if abs(p1)>abs(p2) then writeln('Modul proizvedenia otricatelnyh bolshe.') else writeln('Modul proizvedenia pologitelnyh bolshe.'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 22.04.2008, 17:13 Оценка за ответ: 5

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