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

Выпуск № 645
от 29.04.2008, 12:35

Вопрос № 133.774

Написал функцию для нахождение наибольшего общего делителя, но она работает только тогда когда n,m<1000000000 , а мне нужно, щтоби искало для чисел, которые менше 1000000000000. Моя функция в приложение. надеюсь на помоч. Приложение: FUNCTION NDC(M,N:extended):extended; BEGIN IF N=0 THEN NDC:=M ELSE IF M<N THEN NDC:=NDC(N,M) ELSE NDC:=NDC(TRUNC(N),TRUNC(M) MOD TRUNC(N)); END;

Отправлен: 23.04.2008, 15:01 Вопрос задал: ПАВЛО (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Denisss Здравствуйте, ПАВЛО! В приложении пример с функцией нахождения наибольшего общего делителя, использующий алгоритм Евклида. Как Вам уже и предлагали, желательно использовать 64-битный тип Comp (он позволяет вводить до 19 цифр). Ваша ошибка заключается в использовании функции Trunc, которая возвращает тип LongInt, позволяющий использовать только до 10-ти цифр (-2147483648..2147483647). Чтобы работать с числами типа Comp, необходимо обязательно включить директиву {$N+}. Успехов! Приложение: program nod; {$N+} {Функция возвращает наибольший общий делитель} function NDC(m, n: comp): comp; {Функция возвращает остаток деления двух чисел} function ost(m, n: comp): comp; var a: comp; begin a:= (m/n) - 1; m:= m - (n*a); if (m >= n) then m:= m - n; ost:= m; end; begin while ((m <> 0) and (n <> 0)) do if (m > n) then m:= ost(m, n) else n:= ost(n, m); NDC:= m + n; end; var m, n: comp; begin {Получаем числа m и n} readln(m, n); {Возвращаем результат} writeln(NDC(m,n):1:0); {Ожидаем нажатия любой кнопки} readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 23.04.2008, 20:10 Оценка за ответ: 5 Комментарий оценки: ДЯКУЮ.

Вопрос № 133.778

Задание 2. С клавиатуры задаётся строка. Требуется преобразовать строку так, чтобы цифры были продублированы.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Азаркина Полина Александровна! Программа в приложении. Удачи! Приложение: const z:set of char=['0'..'9']; var a:string[100]; b:string; i:integer; begin write('A:');readln(a); b:=a; i:=1; while i<=length(b) do begin if b[i] in z then begin a:=b[i]; insert(a,b,i); inc(i); end; inc(i); end; writeln('B:',b); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.782

Задание 1. создать программу которая может Вычислить выражение: y = t1 (a, ab, ac) - t2 (7, a+4, b) + t3 (2+b, 2-b, c), где функция t1 (x, y, z) – вычисляет сумму, t2 (x, y, z) – среднее арифметическое параметров, t3 (x, y, z) = 3x+2y+z. делать с помощью подпрограмм

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Азаркина Полина Александровна! Использован один из видов подпрограмм - function. Удачи! Приложение: var a,b,c:real; function t1(x,y,z:real):real; begin t1:=x+y+z; end; function t2(x,y,z:real):real; begin t2:=t1(x,y,z)/3; end; function t3(x,y,z:real):real; begin t3:=3*x+2*y+z; end; begin write('A:');readln(a); write('B:');readln(b); write('C:');readln(c); writeln('Y:=',(t1(a,a*b,a*c)-t2(7,a+4,b)+t3(2+b,2-b,c))); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.784

Задание 3*. Создать программу, обрабатывающую строки символов с помощью процедур и функций. создавать используя подпрограммы

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Азаркина Полина Александровна! В приложении программа которая, после каждого пробела в строке вставляет символ "#". Использован рекурсивный вызов, а также процедуры и функции работы со строками, из-за этого, количество переменных минимально. Удачи! Приложение: var a:string; procedure change(var b:string;c:integer); begin if c>0 then begin {удаляем пробел для поиска остальных} delete(b,c,1); {вызываем сами себя с новыми значениями} change(b,pos(' ',b)); {вставляем пробел и знак} insert(' #',b,c); end; end; begin {вводим строку} write('Enter string:'); readln(a); {вызываем функцию замены} change(a,pos(' ',a)); {выводим результат} write('Result:',a); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.788

составить программу: 1. Дан массив вещественных чисел, содержащий 15 элементов. Запи- сать в этот массив сначала все отрицательные числа, а затем все по- ложительные и нули, сохраняя порядок их следования. все делается используя подрограммы

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

Отвечает: SHERRY Здравствуйте, Азаркина Полина Александровна! Код задачи в приложении. Исправлено по просьбе автора ответа. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 24.04.2008, 10:47 Приложение: const n=15; Type Q = array [1..N] of integer; var ms: Q; i: integer; procedure CreateMS; {процедура генерирует массив} var i: integer; begin randomize; for i:=1 to n do ms[i]:=random(20)-10; end; procedure SortMS; {сортировка массива по Вашему методу} var i,j: integer; m1: Q; begin j:=1; for i:=1 to n do if ms[i]<0 then begin m1[j]:=ms[i]; inc(j); end; for i:=1 to n do if ms[i]>=0 then begin m1[j]:=ms[i]; inc(j); end; ms:=m1; end; begin CreateMS; writeln('Before sorting: '); for i:=1 to n do write(ms[i]:5); writeln; writeln('After sorting: '); SortMS; for i:=1 to n do write(ms[i]:5); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 7-ой класс) Ответ отправлен: 23.04.2008, 16:46 Оценка за ответ: 5

Вопрос № 133.794

составить программу с помощью подпрограмм, которая выполняет следующии действия: Дана действительная матрица 6 * 9. Найти среднее арифметическое наибольшего и наименьшего значения элементов матрицы. Отсор- тировать матрицу по убыванию

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азаркина Полина Александровна! Решение задачи в приложении. Вычисление среднего арифметического выполнено в виде функции, поскольку нам нужен только режультат вычислений без вывода промежуточных данных. Правильность результата легко проверить после сортировки матрицы, т.к. макс эл-т будет стоять первым, а мин – последним. Сортировку матрицы я сделал с помощью линейного массива. Сначала матрицу разворачиваем в линейный массив, который легко сортировать, а затем, после сортировки, снова собираем массив в матрицу. Поскольку параметры матрицы у нас заданы константами, а в преобразованиях участвует только сама матрица, которая объявлена как глобальная переменная, формальных параметров в процедурах нет. В функции входной параметр – матрица, на выходе число вещественного типа, в нашем случае значение ср.арифм. Приложение: uses crt; const n=6; m=9; type Tmatr=array[1..n,1..m]of real; Tmas=array[1..n*m]of real; var a:Tmatr; Procedure Vvod; var i,j:integer; begin clrscr; randomize; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10)+random; write(a[i,j]:6:2); end; writeln; end; readln; end; Function SrAr(a:Tmatr):real; var i,j:integer; max,min,x:real; begin {находим максимальный и минималиный элементы} max:=a[1,1];min:=a[1,1]; for i:=1 to n do for j:=1 to m do if a[i,j]>max then begin max:=a[i,j]; end else if a[i,j]<min then begin min:=a[i,j]; end; SrAr:=(min+max)/2; {среднее арифметическое} end; Procedure Sort; var i,j,k:integer; b:Tmas; x:real; begin {разворачиваем матрицу в линейный массив} k:=0; for i:=1 to n do for j:=1 to m do begin k:=k+1; b[k]:=a[i,j]; end; {сортируем его по убыванию методом «пузырька»} for i:=1 to k-1 do for j:=1 to k-1 do if b[j]<b[j+1]then begin x:=b[j]; b[j]:=b[j+1]; b[j+1]:=x; end; {выводим результат на экран} writeln('Sortirovka:'); for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=b[j+m*(i-1)]; write(a[i,j]:6:2); end; writeln; end; end; {начало основной программы с последовательным вызовом подпрограмм} begin Vvod; writeln('Srednee arifmeticheskoe max+min=',SrAr(a):5:2); readln; Sort; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 24.04.2008, 08:36

Вопрос № 133.847

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

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

Отвечает: Евчик Сергей Александрович Здравствуйте, Igor lukashov! Извините пожалуйста! Вот ваша задача: Исправлено по просьбе автора ответа. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 23.04.2008, 22:10 Приложение: Program z1; uses crt; const glas = ['а','е','и','о','у','э','ю','я','А','Е','И','О','У','Э','Ю','Я']; var s:string; i,j:integer; c:char; a:array[1..100] of string; begin clrscr; i:=0; Writeln('Будете вводить данные'); readln(c); While ( c in ['Y','y','Д','д']) or (i=100) do begin inc(i); Writeln('Введите ',i,' ю строку'); readln(s); for j:=1 to length(s) do begin if not(s[j] in glas) then a[i]:=a[i]+s[j] end; Writeln('Вводить еще информацию? '); readln(c); end; for j:=1 to i do if a[j]<>'' then Writeln(a[j]); readln end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 23.04.2008, 21:14 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное!!!)))

Вопрос № 133.848

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

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

Отвечает: Евчик Сергей Александрович Здравствуйте, SaHek! Решение вашей задачи находится в приложении Приложение: Program z1; uses crt; var i,j,n,m,max,min,max_pos,min_pos,buf:integer; a:array[1..100,1..100] of integer; {Для примера я взял матрицу 100x100} begin randomize; Writeln('Введите n и m'); readln(n,m); max:=0; min:=100; for i:=1 to n do for j:=1 to m do begin a[i,j]:=random(100); {Генерация случайного значения ячеек} if a[i,j]>max then begin max:=a[i,j]; max_pos:=i; end; if a[i,j]<min then begin min:=a[i,j]; min_pos:=i; end; {Заполнили и нашли max и min элементы} end; for i:=1 to m do begin buf:=a[max_pos,i]; a[max_pos,i]:=a[min_pos,i] a[min_pos,i]:=buf end; {Поменяли местами строки. Для смены нам понадобилась переменная buf в которую мы временно скидывали значение ячейки} end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 23.04.2008, 21:05 Оценка за ответ: 5

Вопрос № 133.850

помогите плиз решить задачку Написать программу, которая проверяет, является ли простым введенное пользователем положительное целое число. и если не трудно напишите комментарии :) очень прошу

Отправлен: 23.04.2008, 20:28 Вопрос задал: SaHek (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Евчик Сергей Александрович !!! Здравствуйте, SaHek! Простое число - число имеющее два делителя: 1 и само число. Зная это можно решить вашу задачу методом укзанным в приложении. Вот про определение Вы не забыли, только привели к сожалению неполное определение простого числа. В следствии этого программа выдаст ответ простое для числа 1 - что НЕ правильно! ----- ∙ Отредактировал: Gh0stik (Академик) ∙ Дата редактирования: 23.04.2008, 22:52 Приложение: Program z1; uses crt; var i:integer; {Функция проверяет простое число или нет. Если Число не простое функция возвращает false} function Proverka (j:integer):boolean; var k:integer; q:boolean; begin q:=true; for k:=2 to j-1 do if j mod k = 0 then q:=false; {Если остаток от деления на k = 0 то q:=false} {Т.О. функция делит ваше число на все из диапозона [2;j-1]} Proverka:=q; end; begin repeat clrscr; Write('Введите целое число > 0: '); readln(i); until i>0 {Не позволяем ввести отрицательное число} if Proverka(i) = true then Writeln('Число простое');} readln end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 23.04.2008, 20:52 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, SaHek! Программа(с использованием рекурсии) в приложении. Удачи! Приложение: var a:integer; function B(c,d:integer):boolean; begin if d=1 {достигли 1 значит истина} then B:=true {проверяем текущий делитель} else B:=B(c,d-1) and ((c mod d)>0); end; begin {вводим число} repeat write('A:'); readln(a); until a>1; {выводим результат} write(B(a,a-1)); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Gh0stik Здравствуйте, SaHek! К сожалению предыдущие эксперты забыли, что их подходы займут УЙМУ времени для проверки числа, как только значение числа перевалит за миллиард. Хотя достаточно обратится к теории чисел и данная проблема частично решается. Смотрите код ниже. function prime(x:longint):boolean; var sq,n:longint;    res:boolean; begin    res:=false;    if odd(x) and (x>1) then {если число нечетно, то продолжаем проверку}    begin      sq:=trunc(sqrt(x)); n:=3; {определяем границы проверки делителей}      while n<=sq do      begin        if x mod n=0 then break; {если число имеет делитель, значит оно не простое}  &nb sp;     inc(n,2);      end;    if (n>sq) then res:=true; {если перебрали всевозможные делители из интервала, то число простое}    end;    prime:=res or (x=2); {если значение переменной res=true либо испытуемое число равно 2, то число простое} end; var z:longint; begin    readln(z);    if prime(z) then writeln('Простое') else writeln('Не является простым'); end. Good Luck! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 23.04.2008, 21:34 Оценка за ответ: 5 Комментарий оценки: спс огромное

Отвечает: Шемет Станислав Васильевич !!! Здравствуйте, SaHek! Программа в приложение Удачи Не забывайте, что число ОДИН - НЕ простое. также рекомендую ознакомиться с замечаниями в мини-форуме. ----- ∙ Отредактировал: Gh0stik (Академик) ∙ Дата редактирования: 23.04.2008, 22:53 Приложение: Var I,j,x:word; b:boolean; Begin B:=true; Readln(x); j:=x div 2;(*Чтоб число делилось ровно без остатка на другое одно число должно бить больше другого как минимум в два раза*) For j:=j downto 2 do(*Делаем цикл от исходное чило поделенное на 2 , до двух *) If x mod j=0 then(*Если остача от деления равна 0 то число не простое*) Begin b:=false; break; end; If b then Writeln('Простое число') else Writeln('Не простое число'); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 6-ой класс) Ответ отправлен: 23.04.2008, 22:36 Оценка за ответ: 5

Вопрос № 133.858

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

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Igor lukashov! Cмотрите приложение. Удачи! Приложение: var a,b,c,d:integer; begin b:=0; c:=0; repeat inc(c); write('Enter number:'); readln(a); if (a>0)and((c mod 4)>0)then begin inc(d); inc(b,a); end; until a<0; writeln('сумма:',b:5,'всего:',c:6,'суммированных:',d:6); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 23.04.2008, 22:29 Оценка за ответ: 5 Комментарий оценки: Все классно!)

Отвечает: Шемет Станислав Васильевич Здравствуйте, Igor lukashov! Программа в приложение Удачи!!! Приложение: Var I,Sum,X:integer; Begin i:=0; Repeat(*Цикл*) Readln(x); if x>=0 then(*Если введенное число больше либо равно нулю то выполняем дальше условия задачи*) Begin inc(i); if i mod 4 <> 0 then(*Если остача от деления номера чила не равно 0 то суммируем числа, то-есть проверяем ли каждое ли четвертое это число *) sum:=sum+x; end; until x<0; Writeln('Сумма: ',sum); Writeln('Количество чисел: ',i); Readln; end. --------- Любовь это прекрасно!!!

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

Отвечает: Евчик Сергей Александрович Здравствуйте, Igor lukashov! Решение вашей задачи в приложении. Приложение: Program z1; uses crt; var i,j,k,m:integer; begin clrscr; Writeln('Введите число: '); readln(i); k:=0; j:=1; While (i>0) do begin if (j mod 4 <> 0) then begin k:=k+i; inc(j); inc(m); end else inc(j); Writeln('Введите число: '); readln(i); end; Writeln('Сумма равна = ',k,' Кол-во введенных = ',j-1,' Кол-во просуммированных = ',m); readln end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 23.04.2008, 22:45 Оценка за ответ: 5 Комментарий оценки: Спасибо вам громадное!)все просто супер!)

Вопрос № 133.884

ПОмогите ПЛИЗЗЗЗЗЗ Задание 1. Вычислить выражение: y = p1 (a, b-1, a + c) + p2 (a+b, 3c, a) + p3 (a, c, 2b), где функция p1 (x, y, z) – вычисляет сумму положитель- ных параметров, p2 (x, y, z) – вычисляет выражение 4x+5y-2z, p3 (x, y, z) – вычисляет произведение x, y и z. Задание 2. Создайте процедуру, печатающую слова введенной строки на отдельных строках. Постройте блок-схему процедуры. Обоснуйте выбор механизма передачи пара- метров. Задание 3*. Создать программу, обрабатывающую строку символов с помощью процедур и функций.

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

Отвечает: Костя Симанович Здравствуйте, Fatum! Задача 1. var a,b,c:real; function p1(x,y,z:real):real; {если все отриц, функ. возвращает 0} var p : real; begin p := 0; if x >= 0 then p := p + x; if y >= 0 then p := p + y; if z >= 0 then p := p + z; p1 := p; end; function p2(x,y,z:real):real; begin p2:= 4*x + 5*y - 2*z; end; function p3(x,y,z:real):real; begin p3:=x*y*z; end; begin write('A:');readln(a); write('B:');readln(b); write('C:');readln(c); writeln('Y:=',(p1(a,b-1,a+c)+p2(a+b,3*c,a)+p3(a,c,2*b))); readln; end. В приложении задача 2. задача с коментариями если не нарисуете блок-схему напишите скину по почте. по 3 задаче не совсем понятно, что Вам надо. В решении 2 задачи используются некоторые стандартные процедуры и функции: length(s) вычисление длинны строки copy копирование подстроки в массив (или подстроку) delete удаление из строки подстроки. Удачи. Приложение: задача 2. program stroki; uses crt; type s1 = array[1..100] of string; procedure wiwod(str : s1; a : integer); var i : integer; begin for i := 1 to a do {просто выводим слова из массива } writeln(str[i]); {в отдельные строчки} end; var s :string; {строка} ss : s1; {массив} j, i :integer; begin clrscr; write('s: '); {вводим строку} readln(s); {length(s)- длина строки} j:=1; for i := length(s) downto 1 do {по пробелам отделяем слова, копируем их в массив и удаляем из строки} if s[i]=' 'then begin ss[j]:=copy(s,1,(pos(' ',s)-1)); delete(s,1,pos(' ',s)); j:=j+1; {количество слов} end; ss[j]:= s; {последнее слово строки} wiwod(ss, j); {передаём массив со словами в процедуру} readln; end.

Ответ отправил: Костя Симанович (статус: 3-ий класс) Ответ отправлен: 24.04.2008, 09:50 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Fatum! Вторую задачу можно решить намного проще и не используя массивов. Смотрите код в приложении. Блок-схему отправил по внутренней почте, можно сказать наугад. Если не получите, а схема нужна, пишите куда отправить. Приложение: uses crt; var s:string; Procedure Enter(var s:string); var i:integer; begin i:=1; while i<=length(s)do begin {вставляем после пробела символ конца строки #10 и символ перехода на новую строку #13} if s[i]=' 'then begin insert(#10+#13,s,i+1); delete(s,i,1); {удаляем пробел} end; inc(i); end; writeln(s); readln end; begin {начало основной программы} clrscr; write('s= ');readln(s); Enter(s); {вызов процедуры} end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 24.04.2008, 11:02 Оценка за ответ: 5

Вопрос № 133.888

уважаемые эксперты и их помощники, прошу вас помочь мне с решением следующих задач: 1 Полторы кошки за полтора часа съедают полторы мышки. Сколько мышек схъедят х кошек за у часов. 2 Составить программу, определяющую результат гадания - "любит - не любит", взяв за исходное данное количество липестков n. 3 Для каждой введённой цифры от 0 до 9 вывести соответствующее ей название на английском языке. 4 Составить алгоритм решения ребуса МУХА+МУХА= СЛОН (различные буквы обозначают различные цифры - старшая - не 0) 5 даны целые числа а1, а2, ..., аn. Вывести на печать только те числа, для которых an>=i. 6 Задана квадратная матрица, получить транспорированную матрицу. 7 Дана строка, содержащая текст, заканчивающаяся точкой. Вывести на экран слова, содержащие 3 буквы. 8 Известны марки машин, изготавливаемых в данной стране и импортируемых зарубеж. Даны некоторые n стран. Определить для каждой из марок, какие из них были: доставлены во все страны доставлены в некоторые из стран не доставленные ни в одну страну 9 изобразить пятиконечную звезду.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Мирякубов Григорий Алексеевич! Задачи №№ 6 и 7 в приложении. Приложение: №6. uses crt; const n=6; var a,b:array[1..n,1..n]of integer; i,j:integer; begin clrscr; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*i+j; write(a[i,j]:4); end; writeln; end; readln; writeln('Transponirovannaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin {меняем местами строки и столбцы} b[i,j]:=a[j,i]; write(b[i,j]:4); end; writeln; end; readln; end. №7. program zad7; uses crt; var s:string; s1:array[1..100] of string; i,j:integer; begin clrscr; writeln('Ishodnaia stroka:'); readln(s); j:=1; for i:=1 to length(s) do begin {если пробел считаем слова от 2} if s[i]=' 'then j:=j+1 else {если нет, копируем буквы в слова из массива} s1[j]:=s1[j]+copy(s,i,1); end; writeln; writeln('Slova iz 3 bukv:'); for i:=1 to j do {если в слове 3 буквы, выводим на экран} if length(s1[i])=3 then begin writeln(s1[i]); end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 24.04.2008, 12:36 Оценка за ответ: 5 Комментарий оценки: спасибо

Отвечает: Зенченко Константин Николаевич Здравствуйте, Мирякубов Григорий Алексеевич! Четвертая задача в приложении. Перебирает все возможные варианты, в данном случае их 33. Удачи! Приложение: var a,b,c,d:string; e:array[0..10]of integer; f:boolean; i,j,p,n,m:integer; {процедура для вывода значений} procedure outData(s:string); begin for i:=length(c) downto 1 do if i<=length(s)then write(e[pos(s[i],d)]) else write(' '); writeln; end; {функция для ввода задания} function inpData(z:char):string; var s,o:string; begin {вводим строку} write('Enter ',z,':'); readln(s); {переворачиваем строку, после этого со всеми числами можно можно работать одинаково} o:=''; for i:=1 to length(s)do o:=s[i]+o; inpData:=o; end; begin{вводим строки} a:=inpData('A'); b:=inpData('B'); c:=inpData('C'); d:='';{в этой строке будет хранится все буквы задания} for i:=1 to length(c)do begin if (pos(a[i],d)=0)and(i<=length(a)) then d:=d+a[i]; if (pos(b[i],d)=0)and(i<=length(b)) then d:=d+b[i]; if pos(c[i],d)=0 then d:=d+c[i]; end; {т.к. цифр только 10(0:9) проверяем правильность ввода задания} if (length(d)>0)and(length(d)<11)then begin {счетчик кол-ва вариантов} n:=0; for i:=0 to 10 do e[i]:=i mod 10; {начинаем перебор} repeat {проверяем есть ли совпадающие цифры, если есть, сбрасываем флаг и ничего не делаем} f:=true; for i:=1 to length(d)-1 do for j:=i+1 to length(d) do if e[i]=e[j] then f:=false; {если все цифры разные начинаем работу} if f then begin {перенос с предыдущего разряда} p:=0; for i:=1 to length(c)do begin {суммируем с учетом переноса с предыдущего разряда} p:=p+e[pos(a[i],d)]+e[pos(b[i],d)]; {если числа не равны сбрасываем флаг} if (p mod 10) <> e[pos(c[i],d)] then f:=false; {определяем перенос на следующий разряд} p:=p div 10; end; end; {если флаг ещё не сброшен решение найдено, выводим результат и увеличивем счетчик} if f then begin outData(a); outData(b); outData(c); writeln; inc(n); end; {хитрый цикл перебора всех значений} j:=1; repeat inc(e[j]); p:=e[j]div 10; e[j]:=e[j] mod 10; j:=j+p; until (p=0)or(j>length(d)); until j>length(d); end else writeln('error:неверное кол-во букв'); writeln('вариантов:',n); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 24.04.2008, 21:39 Оценка за ответ: 5 Комментарий оценки: спасиб

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Мирякубов Григорий Алексеевич! Задача №3 в приложении Удачи!!! Приложение: const num : array [0..9] of string = ('zero', 'one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine'); var i : integer; begin Write('Введите цифру: '); ReadLn(i); if (i<=9) and (i>=0) then WriteLn(num[i]) else writeln('Нету такой цифры!'); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: 9-ый класс) Ответ отправлен: 25.04.2008, 21:30 Оценка за ответ: 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