Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 109 ∙ повысить рейтинг >>

Botsman Статус: 7-й класс Рейтинг: 80 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 70 ∙ повысить рейтинг >>

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

Выпуск № 815
от 21.02.2009, 19:35

Вопрос № 160513: Даны три множества x1, x2, x3, содержащие целые числа из диапазона 1 .. 100. Известно, что мощность каждого из этих множеств равна 10. Сформировать новое множество y = x1 + x2 -x3, из которого выделить подмножество нечетных чисел. На экран вывести ис...

Вопрос № 160.513

Даны три множества x1, x2, x3, содержащие целые числа из диапазона 1 .. 100. Известно, что мощность каждого из этих множеств равна 10. Сформировать новое множество y = x1 + x2 -x3, из которого выделить подмножество нечетных чисел. На экран вывести исходные и полученное множество.

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа с комментариями. Приложение: program Pascal_160513; const CMax=100;{Ограничение диапазона сверху} type TRange=1..CMax; {Диапазон по условию} TRangeSet=set of TRange; {Тип наших множеств} var x1,x2,x3,y,z:TRangeSet; {Объявляем множества} i:Integer; {Процедура выводит содержимое множества на экран} procedure PrintSet(Msg:String;S:TRangeSet); var i,cnt:Integer; begin cnt:=0; WriteLn(Msg); Write('{'); for i := 1 to CMax do if i in S then begin Write(i,','); Inc(cnt); end; if cnt>0 then Write(#8); WriteLn('}'); end; begin Randomize; {Заполняем множества случайными числами от 1 до 100} for i := 1 to 10 do begin x1:=x1+[Random(CMax)+1]; x2:=x2+[Random(CMax)+1]; x3:=x3+[Random(CMax)+1]; end; {Печатаем их} PrintSet('x1:',x1); PrintSet('x2:',x2); PrintSet('x3:',x3); y:=x1+x2-x3; {Действие по условию} PrintSet('y:',y); {Печатаем y} {Перебираем по нечетным и заносим их в множество z} i:=1; while i<=CMax do begin if i in y then z:=z+[i]; Inc(i,2); end; {Печатаем z} PrintSet('subset of odd numbers:',z); ReadLn; end.

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 15.02.2009, 14:36 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243677 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!!! Все работает!!! Благодарю вас!!!

Вопрос № 160.514

Даны файлы f1, f2, f3, f4, f5, компоненты которых являются действительными числами. Организовать обмен компонентами между файлами в соответствии со следующей схемой:

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Программа получилась довольно длинной из за обработки ошибок ввода/вывода. Пример вывода: Код: Source Files File:file1 40.892 -18.293 45.506 -44.848 41.710 16.566 -21.764 33.929 25.989 -36.335 10.908 26.434 -49.450 -21.823 49.732 -9.550 12.969 -33.677 -7.510 File:file2 16.516 3.800 -10.583 9.794 29.717 27.351 -30.193 -0.560 -11.017 41.667 45.279 -33.916 17.748 8.812 25.640 31.197 -39.458 12.352 8.281 File:file3 -44.553 13.378 File:file4 22.409 -6.630 40.612 -28.458 -12.486 37.564 -18.214 12.702 41.147 1.849 -31.530 -4.236 21.365 10.954 -28.446 -13.619 -12.553 -8.569 49.553 -19.086 File:file5 -33.431 16.938 16.834 -7.667 -46.245 24.674 44.150 20.043 -12.297 -29.854 43.808 48.088 18.015 -21.326 4.007 0.444 -45.519 Result Files File:file1 -33.431 16.938 16.834 -7.667 -46.245 24.674 44.150 20.043 -12.297 -29.854 43.808 48.088 18.015 -21.326 4.007 0.444 -45.519 File:file2 22.409 -6.630 40.612 -28.458 -12.486 37.564 -18.214 12.702 41.147 1.849 -31.530 -4.236 21.365 10.954 -28.446 -13.619 -12.553 -8.569 49.553 -19.086 File:file3 40.892 -18.293 45.506 -44.848 41.710 16.566 -21.764 33.929 25.989 -36.335 10.908 26.434 -49.450 -21.823 49.732 -9.550 12.969 -33.677 -7.510 File:file4 16.516 3.800 -10.583 9.794 29.717 27.351 -30.193 -0.560 -11.017 41.667 45.279 -33.916 17.748 8.812 25.640 31.197 -39.458 12.352 8.281 File:file5 -44.553 13.378 Приложение: {$I-} program Pascal_160514; const CFiles=5;{Количество файлов} type TFileDbl=file of Double; {Вещественный тип для элементов файла} {Функция создает файл с заданным количеством элементов} function CreateF(var F:TFileDbl;ItemCount:Word):Boolean; var d:Double; begin Rewrite(F); CreateF:=true; if IOResult<>0 then CreateF:=false else begin while ItemCount>0 do begin d:=Random*100-50; Write(F,d); if IOResult<>0 then begin CreateF:=false; Exit; end; Dec(ItemCount); end; Close(F); end; end; {Функция выводит содержимое файла на экран} function PrintF(Msg:String;var F:TFileDbl):Boolean; var d:Double; begin PrintF:=true; Reset(F); if IOResult<>0 then PrintF:=false else begin WriteLn(Msg); while not eof(F) do begin Read(F,d); if IOResult<>0 then begin PrintF:=false; Exit; end; Write(d:7:3,' '); end; WriteLn; Close(F); end; end; {Функция копирует один файл в другой} function CopyF(var F1,F2:TFileDbl):Boolean; var d:Double; begin CopyF:=true; Reset(F1); if IOResult<>0 then CopyF:=false else begin Rewrite(F2); if IOResult<>0 then CopyF:=false else begin while not Eof(F1) do begin Read(F1,d); if IOResult<>0 then begin CopyF:=false; Exit; end; Write(F2,d); if IOResult<>0 then begin CopyF:=false; Exit; end; end; Close(F2); end; Close(F1); end; end; var f,tmpf:array[1..CFiles]of TFileDbl; {Файловые массивы} fnames:array[1..CFiles]of String; {Имена файлов} i,toF:Integer; s:String; begin Randomize; {Создаем файлы и заполняем их случайными значениями} for i := 1 to CFiles do begin {Генерируем имя файла} Str(i,s); fnames[i]:='file'+s; Assign(f[i],fnames[i]); {Создаем файл.Количество элементов тоже выбираем случайно} if not CreateF(f[i],Random(25)+1) then begin WriteLn('Cannot create file:',fnames[i]); ReadLn; Exit; end; end; {Выводим содержимое файлов} WriteLn('Source Files'); for i := 1 to CFiles do if not PrintF('File:'+fnames[i],f[i]) then begin WriteLn('Cannot print file:',fnames[i]); ReadLn; Exit; end; {Создаем временные копии файлов} for i := 1 to CFiles do begin Assign(tmpf[i],fnames[i]+'_tmp'); if not CopyF(f[i],tmpf[i]) then begin WriteLn('Cannot copy file ',fnames[i],' to file ',fnames[i]+'_tmp'); ReadLn; Exit; end; end; for i := 1 to CFiles do begin {Хитро вычисляем индекс следующего файла назначения} if i in [1,2,3] then toF:=i+2 else toF:=6-i; {Копируем из временной копии в нужный нам файл} if not CopyF(tmpf[i],f[toF]) then begin WriteLn('Cannot copy file ',fnames[i],'_tmp to file ',fnames[toF]); ReadLn; Exit; end; Erase(tmpF[i]); {Удаляем временный файл} end; {Выводим файлы} WriteLn('Result Files'); for i := 1 to CFiles do if not PrintF('File:'+fnames[i],f[i]) then begin WriteLn('Cannot print file:',fnames[i]); ReadLn; Exit; end; ReadLn; end.

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 15.02.2009, 15:52 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243682 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Благодарю! Все работает! Огромное спасибо!

Вопрос № 160.515

Дан файл f, компоненты которого являются целыми числами. Никакая из компонентов файла f не равна нулю. Числа в файле идут в следующем порядке: десять положительных, десять отрицательных, десять положительных, десять отрицательных и т. д. Переписать компоненты файла f в файл g так, чтобы в файле g числа шли в следующем порядке: пять положительных, пять отрицательных, пять положительных, пять отрицательных и т. д.

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! Код программы с пояснениями в приложении. Если что-то не понятно - пишите в личку. С уважением, Дмитрий. Приложение: {$I-} program z160515; uses crt; type IntFile = file of Integer; {процедура обработки ошибок} procedure Error(msg:String); begin WriteLn(msg); ReadLn; Halt(0); end; {заполнение исходного файла} Function Fill(var f:IntFile; kol:Word):boolean; var i:Word; tmp:Integer; begin fill:=true; Rewrite(f); IF IOResult<>0 then begin fill:=false; Exit; end; For i:= 1 to kol do begin {пишем 10 положительных, 10 отрицательных и т.д.} case (i mod 20) of 1..10: tmp:=Random(100)+1; 0,11..19: tmp:=Random(100)-100; end; Write(tmp,' ');{выводим на экран то что пишем в файл} Write(f,tmp); IF IOResult<>0 then begin fill:=false; Exit; end; IF (i mod 20) = 0 then WriteLn;{переход на след. строку на экране} end; end; var sInput,sOutput:String; i,k,kol:Word; fIn,fOut:IntFile; nums: array[1..20] of Integer; begin clrscr; {ввод данных} Write('Enter name of input file: '); ReadLn(sInput); {ввод количества чисел в исходном файле} Repeat Write('Enter number of numbers in file (must be divisible by 20): '); ReadLn(kol); Until (kol mod 20)=0;{проверяем чтобы оно было кратно 20} Write('Enter name of output file: '); ReadLn(sOutput); {заполнение входного файла} Assign(fIn,sInput); WriteLn('Input file:'); IF not Fill(fIn,kol) then Error('Cannot create file: '+sInput); Close(fIn); Reset(fIn); IF IOResult<>0 then Error('Cannot open file: '+sInput); {создание файла с ответом} Assign(fOut,sOutput); Rewrite(fOut); IF IOResult<>0 then Error('Cannot create file: '+sOutput); {основная часть} WriteLn; WriteLn('Output file:'); While not EOF(fIn) do begin {читаем из исходного файла по 20 элементов} For i:= 1 to 20 do begin Read(fIn,nums[i]); IF IOResult<>0 then Error('Cannot read file: '+sInput); end; {пишем в ответ по 5 (1..5,11..15,6..10,16..20)} For i:= 1 to 20 do begin case i of 1..5,16..20: k:= i; 6..10: k:= i+5; 11..15: k:= i-5; end; Write(nums[k],' ');{выводим на экран то что пишем в файл} Write(fOut,nums[k]); IF IOResult<>0 then Error('Cannot write file: '+sOutput); end; WriteLn;{переход на след. строку на экране} end; Close(fIn); Close(fOut); WriteLn('Complete'); ReadLn; end.

Ответ отправил: Шевченко Дмитрий (статус: Студент) Ответ отправлен: 15.02.2009, 21:01 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243707 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо! Все работает =)) Я вам очень благодарен !

Вопрос № 160.516

Дан символьный файл f. Группы символов, разделенные пробелами (одним или несколькими) и не содержащие пробелов внутри себя, будем называть словами. Удалить из файла все однобуквенные слова и лишние пробелы. Результат записать в файл g.

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

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! В данной программе разбиваем строки на слова согласно установленным в задании правилам и добавляем все эти слова в новую строку через пробел, за исключением односимвольных слов. Приложение: program Ex1; var s,s1,s2:string; F,g : Text; i,j:integer; Begin Assign(F,'in.txt'); ReSet(F); Assign(G, 'out.txt'); ReWrite(G); while not eof(f) do begin readln(f,s); s1:=''; s2:=''; for i:=1 to length(s) do if s[i]<>' ' then s2:=s2+s[i] else begin if length(s2)>1 then if length(s1)>0 then s1:=s1+' '+s2 else s1:=s2; s2:=''; end; if length(s2)>1 then if length(s1)>0 then s1:=s1+' '+s2 else s1:=s2; writeln(g,s1); end; Close(G); Close(F); End.

Ответ отправил: Andersen (статус: 6-й класс) Ответ отправлен: 15.02.2009, 22:40 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243711 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо! Все работает! Благодарю Вас!

Вопрос № 160.517

Дан файл f, компоненты которого являются действительными числами. Найти сумму квадратов компонент файла f.

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

Отвечает: Micren Здравствуйте, Иванов Виктор Олегович! Пример работы программы: Код: Items in file: -13.328 14.416 -37.358 31.379 38.623 45.192 17.613 41.685 17.314 23.977 -14.261 -8.902 -2.750 32.837 0.067 33.497 -33.938 -23.880 -11.724 11.938 Sum of squares: 1.37148326819838E+0004 Приложение: {$I-} program Pascal_160517; type TFileDbl=file of Double; {Вещественный тип для элементов файла} {Функция создает файл с заданным количеством элементов} function CreateF(var F:TFileDbl;ItemCount:Word):Boolean; var d:Double; begin Rewrite(F); CreateF:=true; if IOResult<>0 then CreateF:=false else begin while ItemCount>0 do begin d:=Random*100-50; Write(F,d); if IOResult<>0 then begin CreateF:=false; Exit; end; Dec(ItemCount); end; Close(F); end; end; {Функция выводит содержимое файла на экран} function PrintF(Msg:String;var F:TFileDbl):Boolean; var d:Double; begin PrintF:=true; Reset(F); if IOResult<>0 then PrintF:=false else begin WriteLn(Msg); while not eof(F) do begin Read(F,d); if IOResult<>0 then begin PrintF:=false; Exit; end; Write(d:7:3,' '); end; WriteLn; Close(F); end; end; label err; var F:TFileDbl; Sum2,d:Double; begin Randomize; Assign(F,'file'); {Заполняем файл случайными значениями в случайном количестве 1..25} if CreateF(F,Random(25)+1) then begin {Выводим на экран компоненты файла} if PrintF('Items in file:',F) then begin Reset(F); {Открываем файл} if IOResult=0 then begin Sum2:=0; {Обнуляем сумму} {Читаем пока не конец файла} while not Eof(F) do begin Read(F,d); if IOResult<>0 then begin WriteLn('Read file error'); goto err; end; Sum2:=Sum2+d*d; end; WriteLn('Sum of squares:',Sum2); err: Close(F); end else WriteLn('Cannot open file'); end else WriteLn('Cannot print file'); end else WriteLn('Cannot create file'); ReadLn; end.

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 15.02.2009, 16:15 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243684 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо! Все работает!

Вопрос № 160.530

Здравствуйте, уважаемые эксперты! На сегодня такие задачи: 1. При печати документа можно выбрать страницы, которые будут отправлены на принтер. Пусть заданы номера страниц в порядке возрастания. Напишите программу, которая перечисляет номера страниц через запятую, при этом страницы, идущие подряд, замените на диапазон, указывая первую и последнюю страницу через дефис. Входные данные: 1 3 4 5 6 11 12 15 Выходные данные: 1, 1-6, 11-12, 15 Я написал такую программу, но проблема со считыванием данных: сначала вводится кол-во страниц, а потом сами страницы. Как это исправить? 2. Вводятся два числа N и K. Распечатайте числа из диапазона от 1 до N включительно такие, что их сумма цифр делится на K. Входные данные: 13 3 Выходные данные: 3 6 9 12 У меня код с ошибкой: почему-то программа выводит все числа, кроме 1. Прошу найти ошибку в моём коде. 3. Вычислите значение выражения, в котором заданы два натуральных числа, разделённые знаком сложения, вычитания, умножения или деления. Входные данные: 372-392 Выходные данные: -20 Прошу написать процедуру считывания данных: распознавание чисел и знака между ними. 4. Переведите число (223011323)4 из четвертичной системы счисления в шестнадцатеричную. У меня получилось 2В17В. Правильно? За ответы заранее благодарен, Артём. Приложение: 1. Var n, i, j: Integer; x: Array[1..100] Of Integer; flag: Boolean; Procedure ReadData; Begin ReadLn(n); For i := 1 To n Do Begin Read(x[i]); End; x[n+1] := 0; End; Begin ReadData; flag := FALSE; For i := 1 To n Do Begin If ((x[i+1] - x[i] <> 1) And (Not(flag))) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; End; If ((x[i+1] - x[i] = 1) And (Not(flag))) Then Begin Write(x[i], '-'); flag := TRUE; End; If ((x[i+1] - x[i] <> 1) And (flag)) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; flag := FALSE; End; End; WriteLn; ReadLn; End. 2. Uses CRT; Var n, k, i: Integer; Function CipherSum(i: Integer): Integer; Var res: Integer; Begin res := 0; While (n > 0) Do Begin Inc(res, n Mod 10); n := n Div 10; End; CipherSum := res; End; Begin ClrScr; ReadLn(n, k); For i := 1 To n Do Begin If (CipherSum(i) Mod k = 0) Then Begin Write(i, ' '); End; End; WriteLn; ReadLn; End.

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

Отвечает: Andersen Здравствуйте, Хощенко Артём Владимирович! 1. Произведена замена функции. сам текст программы слишком громозкий, можно было-бы сделать значительно короче, но работает. коротко о функции : разбиваем строку на участки цифр подряд, каждый участок переводим в целое число,добавляем в массив и увеличиваем счетчик числа участков. 2. здесь решение сделано коротко и просто, коментарии излишни 3. Разделяем строку на s1,s2,s3 (первое число,символ,второе число) числа преобразуем из текстового в числовой формат и для каждого символа выбираем операцию разделение происходит перебором по порядку всех символов : пока число добавляем в слово1 затем если не число - это символ иначе - слово2 4. число преобразовано правильно. алгоритм если длина строки нечетная - добавляем спереди 0 далее берем по 2 числа и пребразовываем их в числа. сумма = число1*4+число2 преобразуем сумму в шеснадцетеричное число и добавляем полученный симв ол в результирующую строку P.S. Лучше разбивать вопросы на несколько, чтобы увеличить скорость ответа экспертов. Приложение: 1. Var n, i, j: Integer; x: Array[0..100] Of Integer; flag: Boolean; Procedure ReadData; var s,s1,s2:string; Begin for i:=0 to 100 do x[i]:=0; n:=0; readln(s); s1:=''; for i:=1 to length(s) do begin s2:=s[i]; if (s2>='0') and (s2<='9') then s1:=s1+s2 else if s1<>'' then begin n:=n+1; val(s1,x[n],j); s1:=''; end; end; if s1<>'' then begin n:=n+1; val(s1,x[n],j); s1:=''; end; end; Begin ReadData; flag := FALSE; For i := 1 To n Do Begin If ((x[i+1] - x[i] <> 1) And (Not(flag))) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; End; If ((x[i+1] - x[i] = 1) And (Not(flag))) Then Begin Write(x[i], '-'); flag := TRUE; End; If ((x[i+1] - x[i] <> 1) And (flag)) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; flag := FALSE; End; End; WriteLn; ReadLn; End. 2. Uses CRT; Var n, k, i: Integer; Begin ClrScr; ReadLn(n, k); For i := 1 To (n div k) Do write(i*k,' '); WriteLn; ReadLn; End. 3. var s,s1,s2,s3:string; i,j,k:integer; Begin readln(s); k:=1; s1:=''; s2:=''; s3:=''; for i:=1 to length(s) do begin if (k=1) and (s[i]<='9') and (s[i]>='0') then s1:=s1+s[i] else begin k:=2; if (s[i]<='9') and (s[i]>='0') then s3:=s3+s[i] else s2:=s[i]; end; end; val(s1,i,k); val(s3,j,k); if s2='+' then writeln(i+j); if s2='-' then writeln(i-j); if s2='/' then writeln(i/j); if s2='*' then writeln(i*j); readln; End. 4. var i,j,k:integer; s,s1:string; begin readln(s); s1:=''; i:=length(s); if (i and 1)=1 then s:='0'+s; i:=length(s); for j:=1 to (i div 2) do begin k:=4*(ord(s[j*2-1])-48)+(ord(s[j*2])-48); if k<10 then s1:=s1+chr(k+48) else s1:=s1+chr(k+55); end; writeln(s1); readln; end.

Ответ отправил: Andersen (статус: 6-й класс) Ответ отправлен: 15.02.2009, 21:52 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243708 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Вопрос № 160.618

Уважаемые эксперты! помогите пожалуйста решить 2 задачи с использованием модуля. 1. Ввести произвольную последовательность из 20 символов и выяснить, сколько среди них точек, сколько среди них пробелов и сколько среди них букв Ш. 2. Дан массив действительных чисел. среди них есть равные. найти первый максимальный элемент массива и заменить его нулем. ЗАРАНЕЕ БЛАГОДАРЕН!!!

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

Отвечает: Andersen Здравствуйте, Ильин Дмитрий! в задаче 1 выносим метод определения количества символов в строке(путем перебора всех символов строки в задаче 2 само решение тоже в модуле unit2 приравниваем точку максиумума( положение и значение) к первой позиции и далее находим значения с превосходящим значением(его делаем точкой максиума) и так перебрав все элемены по порядку. затем присваиваем позиции точки максиума значение 0 Приложение: 1. ex1.pas uses unit1; var s:string; begin readln(s); writeln('В данной строке',chet(s,' '),' символов "пробел"'); writeln('В данной строке',chet(s,','),' символов ,'); writeln('В данной строке',chet(s,'Ш'),' символов Ш'); readln; end. unit1.pas unit unit1; interface function chet(s,ss:string):integer; implementation function chet(s,ss:string):integer; var i,j:integer; begin j:=0; for i:=1 to length(s) do if s[i]=ss then j:=j+1; chet:=j; end; end. 2. ex2.pas program ex2; uses unit2; var A,B:AAA; i:integer; begin for i:=1 to 20 do A[i]:=180*random-90; writeln(' Ishodnye Konechnye'); NoFirstMax(a,b); for i:=1 to 20 do writeln(A[i]:12:8,' ',B[i]:12:8); readln; end. unit2.pas unit unit2; interface type AAA=array[0..20] of real; procedure NoFirstMax(a:AAA;var b:AAA); implementation procedure NoFirstMax(a:AAA;var b:AAA); var m:real; i,j:integer; begin m:=a[1]; j:=1; for i:=1 to 20 do begin b[i]:=a[i]; if a[i]>m then begin j:=i; m:=a[i]; end; end; b[j]:=0; end; end.

Ответ отправил: Andersen (статус: 6-й класс) Ответ отправлен: 16.02.2009, 15:46 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243778 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: большое спасибо!!!

Вопрос № 160.648

Уважаемые эксперты, такая вот задача! Дана матрица P(3*5), содержащая положительные, отрицательные, элементы и нули. Вычислить сумму модулей отрицательных элементов, произведение положительных, и число нулей

Отправлен: 16.02.2009, 18:36 Вопрос задал: Slavko Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шевченко Дмитрий Здравствуйте, Slavko! В приложении 2 варианта программы: В первом произведение сохраняется в переменную типа Word (максимальное значение 65545), поэтому программа может работать только с небольшими числами. Во втором варианте произведение сохраняется в строку, поэтому можно использовать довольно большие числа. Но, из-за необходимости перемножения строк, этот вариант сложнее. С уважением, Дмитрий. Приложение: {===ПЕРВЫЙ ВАРИАНТ===} program z160648; const K = 3;{кол-во строк} L = 5;{кол-во столбцов} type elem = Integer;{тип елементов массива} tmas = array[1..L] of elem; mas = array[1..K] of tmas; procedure vivod(m:mas);{вывод массива} var i,j:byte; begin For j:= 1 to K do begin For i:= 1 to L do Write(m[j][i],' '); WriteLn; end; end; var m: mas; i,j: byte; sum,kol,proizv: Word; polozhit,otrizat: boolean; begin {Если надо вводить массив вручную:} { For j := 1 to K do For i := 1 to L do begin Write('Enter m[',j,',',i,']: '); ReadLn(m[j][i]); end; vivod(m);} {Если произвольно заполнить:} Randomize; For j := 1 to K do For i := 1 to L do m[j][i]:=Random(5) - 2;{заполняем числами от -2 до +2} vivod(m); {основная часть:} sum:=0; kol:=0; proizv:=1; polozhit:=false; otrizat:=false; For j := 1 to K do{перебираем все элементы массива} For i := 1 to L do IF m[j][i] < 0 then{если меньше нуля - } begin sum:=sum+abs(m[j][i]);{считаем сумму модулей} otrizat:=true;{запоминаем что у нас есть отрицательные элементы} end Else IF m[j][i] > 0 then{если больше нуля - } begin proizv:=proizv*m[j][i];{считаем произведение положительных} polozhit:=true;{запоминаем что у нас есть положительные элементы} end Else inc(kol); {выводим ответ:} IF otrizat then WriteLn('Summa modulei otrizatelnih elementov: ',sum) Else WriteLn('V massive net otrizatelnih elementov'); IF polozhit then WriteLn('proizvedenie polozhitelnih elementov: ',proizv) Else WriteLn('V massive net polozhitelnih elementov'); WriteLn('Koli4estvo nulei: ',kol); ReadLn; end. {===ВТОРОЙ ВАРИАНТ===} program z160648; type stroka = String[255]; miniStroka = String[3]; Function summ(a,b:stroka):stroka; var zifraA,zifraB,perehod,Summa,i:byte; sSumma,posled:miniStroka; res:Stroka; begin res:=''; perehod:=0; {уравниваем числа по длинне} While length(a)<length(b) do a:='0'+a; While length(b)<length(a) do b:='0'+b; a:='0'+a; b:='0'+b; For i:= length(a) downto 1 do{перебираем числа с конца} begin val(copy(a,i,1),zifraA);{складываем текущие символы} val(copy(b,i,1),zifraB); Summa:=zifraA+zifraB+perehod; IF Summa >= 10 then{если сумма получилась больше чем 10, то} begin str(Summa mod 10,posled); res:=posled+res;{пишем в ответ последнюю цифру и} perehod:=Summa div 10;{запоминаем сколько перешло в следующий разряд} end Else{если меньше - } begin str(Summa,posled); res:=posled+res;{пишем в ответ сумму} perehod:=0; end; end; While copy(res,1,1) = '0' do delete(res,1,1); IF res = '' then res:='0'; Summ:=res; end; Function umnozh_na_zifru(a:stroka; zifra:miniStroka):Stroka; var res,sProizv:stroka; symb:miniStroka; i,k,nSymb,nZifra:byte; begin res:=''; For i:= length(a) downto 1 do{перебираем число с конца} begin symb:=copy(a,i,1); val(symb,nSymb); val(zifra,nZifra); str(nSymb*nZifra,sProizv);{умножаем текущий символ на цифру} For k:= 1 to length(a)-i do{приписываем порядок} sProizv:=sProizv+'0'; res:=summ(res,sProizv);{складываем с результатом} end; umnozh_na_zifru:=res; end; Function proizv(a,b:stroka):Stroka; var res,sProizv:stroka; i,k:byte; begin IF length(b)>length(a) then{берём минимальное число} begin res:=b; b:=a; a:=res; end; res:=''; For i:= length(b) downto 1 do{перебираем его с конца} begin sProizv:=umnozh_na_zifru(a,copy(b,i,1));{умножаем большее число на текущую цифру меньшего} For k:= 1 to length(b)-i do sProizv:=sProizv+'0';{приписываем порядок} res:=summ(res,sProizv);{прибавляем к результату} end; proizv:=res; end; const K = 3;{кол-во строк} L = 5;{кол-во столбцов} type elem = Integer;{тип елементов массива} tmas = array[1..L] of elem; mas = array[1..K] of tmas; procedure vivod(m:mas);{вывод массива} var i,j:byte; begin For j:= 1 to K do begin For i:= 1 to L do Write(m[j][i],' '); WriteLn; end; end; var m: mas; i,j: byte; sum,kol: Word; polozhit,otrizat: boolean; proizved,tmp: Stroka; begin {Если надо вводить массив вручную:} { For j := 1 to K do For i := 1 to L do begin Write('Enter m[',j,',',i,']: '); ReadLn(m[j][i]); end; vivod(m);} {Если произвольно заполнить:} Randomize; For j := 1 to K do For i := 1 to L do m[j][i]:=Random(101) - 50;{заполняем числами от -5 до +5} vivod(m); {основная часть:} sum:=0; kol:=0; proizved:='1'; polozhit:=false; otrizat:=false; For j := 1 to K do{перебираем все элементы массива} For i := 1 to L do IF m[j][i] < 0 then{если меньше нуля - } begin sum:=sum+abs(m[j][i]);{считаем сумму модулей} otrizat:=true;{запоминаем что у нас есть отрицательные элементы} end Else IF m[j][i] > 0 then{если больше нуля - } begin Str(m[j][i],tmp); proizved:=proizv(proizved,tmp);{считаем произведение положительных} polozhit:=true;{запоминаем что у нас есть положительные элементы} end Else inc(kol); {выводим ответ:} IF otrizat then WriteLn('Summa modulei otrizatelnih elementov: ',sum) Else WriteLn('V massive net otrizatelnih elementov'); IF polozhit then WriteLn('proizvedenie polozhitelnih elementov: ',proizved) Else WriteLn('V massive net polozhitelnih elementov'); WriteLn('Koli4estvo nulei: ',kol); ReadLn; end.

Ответ отправил: Шевченко Дмитрий (статус: Студент) Ответ отправлен: 16.02.2009, 19:39 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 243801 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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