Здравствуйте уважаемые эксперты прошу решить задачу на тему "Файлы. Типизированные файлы":
Записать в файл прямого доступа N действительных чисел. Найти наибольшее из значений модулей компонентов с нечетными
(Пожалуйста с обьяснением кода и если можно использовать где то процедуру) Заранее благодарен.

Отправлен: 21.12.2009, 23:46
Вопрос задал: igoruu, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; var f:file of real;{типизированный файл вещественных чисел} a,mx:real;{числа} i:integer;{счетчик} begin clrscr; assign(f,\'file\');{связываем переменную с файлом, фал в папке с программой} rewrite(f);{открываем для записи} i:=0; writeln(\'Введите в файл ,не менее 2х действительных чисел, окончание ввода 0:\'); repeat write(\'a=\'); readln(a);{читаем числа} i:=i+1; write(f,a);{вводим в файл} until (a=0)and(i>1); clrscr; writeln(\'Содержание файла:\'); reset(f);{открываем файл для чтения} read(f,mx);{читаем первое число} write(mx:6:2);{выводим на экран} mx:=abs(mx);{его модуль пока будет максимумом} i:=1; while not eof(f) do{пока не конец файла} begin read(f,a);{читаем числа} write(a:6:2);{выводим на экран} i:=i+1;{считаем} if(i mod 2=1)and(abs(a)>mx) then mx:=abs(a);{если номер нечетный и модуль больше макс., то это пока макс.} end; close(f);{закрываем файл} writeln; write(\'Макcимальный модуль числа с нечетным номером=\',mx:0:2); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 23.12.2009, 18:32

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258077 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте уажаемые эксперты, помогите решить задачку на тему"«Файлы. Текстовые файлы»:
Даны файл, содержащий текст на русском языке, и некоторая буква. Подсчитать, сколько слов начинается с указанной буквы. (с обьяснением кода пожалуйста и с использование процедуры если можно)

Отправлен: 22.12.2009, 00:01
Вопрос задал: igoruu, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
Исходные данные: Йцуке фывап ячсми ааааа. Енгшщ пролд абббб итьбю енгшщ. Вапро аввввв, цукенг смить - ролдж аитьб аггггг. Программа. Вариант попроще: function CountLetters(letter:char;s:string):integer; var n,p:integer; begin if s[1]=letter then n:=1 else n:=0; p:=pos(\' \',s); while (p>0) and (p<length(s)) do begin if s[p+1]=letter then inc(n); delete(s,p,1); p:=pos(\' \',s); end; CountLetters:=n; end; var f:text; letter:char; n:integer; s:string; begin letter:=\'а\'; assign(f,\'175501.dat\'); reset(f); n:=0; while not eof(f) do begin readln(f,s); n:=n+CountLetters(letter,s); end; writeln(\'Буква \',letter,\' встречается \',n,\' раз\'); readln; end. Вариант посложнее: function CountLetters(letter:char;s:string):integer; var n,p:integer; begin n:=0; repeat p:=pos(\' \',s); if s[p+1]=letter then inc(n); delete(s,p,1); until p=0; CountLetters:=n; end; var f:text; letter:char; n:integer; s:string; begin letter:=\'а\'; assign(f,\'175501.dat\'); reset(f); n:=0; while not eof(f) do begin readln(f,s); n:=n+CountLetters(letter,s); end; writeln(\'Буква \',letter,\' встречается \',n,\' раз\'); readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 26.12.2009, 12:46

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258139 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте Уважаемые экспртыпомогите решить задачку на тему " «Подпрограммы. Рекурсивные процедуры и функции»(значит надо сделать используя процедурки или рекрусивные функции )
Дана символьная строка, представляющая собой запись натурального числа в p-ичной системе счисления (2<=p<=9 ).Составить программу для перевода этого числа в десятичную систему счисления.
Прошу еще (Обьясните пожалуйса сам код програаммы)

Отправлен: 22.12.2009, 00:46
Вопрос задал: igoruu, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
function GetDecimal(number:string;base:shortint;baseN:longint):longint; { Сама рекурсивная функция. На входе получает некоторый остаток числа, основание и основание, возведённое в степень (равную позции последнего знака в исходном числе) } var l:shortint; begin l:=length(number); {Длина полученного остатка. Если равна нулю, ...} if l=0 {... то возвращается ноль и рекурсия прекращается.} then GetDecimal:=0 {Иначе обрабатывается последний знак: берётся ASCII-код, вычитается код цифры ноль (48) -- получается число, соответствующее цифре. Умножается на основание в степени.} else GetDecimal:=baseN*(ord(number[l])-48) {Плюс результат рекурсивного вызова для оставшейся части числа -- с первого символа до предпоследнего. Также передаётся основание и основание в следующей степени } + GetDecimal(copy(number,1,l-1),base,base*baseN); end; var s:string; base:shortint; result:integer; begin {Исходные данные} s:=\'1234\'; base:=8; {s:=\'1101\'; base:=2;} {Вызов рекурсиии. Третьим аргументом обязательно должна быть 1, т.е. основание в нулевой степени} result:=GetDecimal(s,base,1); writeln(\'Po osnvaniyu \',base,\': \',s); writeln(\'Po osnvaniyu 10: \',result); readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 26.12.2009, 12:40

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258138 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Добрый день уважаемые эксперты прошу помогите решить задачку:
Найти все равновеликие прямоугольные треугольники, катеты которых выражены целыми числами a и b, а площадь равна S. (a и b принадлежат интервалу от 1 до 20, а S вводится с клавиатуры).(пожалуйса обьясните код заранее благодарен)

Отправлен: 22.12.2009, 01:46
Вопрос задал: igoruu, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
uses crt; var s,a,b,k:integer; begin clrscr; write(\'S=\');readln(s); k:=0; writeln(\'A\':5,\'B\':5,\'S\':5); writeln(\'----------------\'); for a:=1 to 20 do for b:=1 to 20 do if (a*b = 2*s)and(a<=b) then {если произведение катетов= двойной площади и первый катет не больше второго (чтоб не было повторов)} begin k:=:=k+1;{считаем} writeln(a:5,b:5,s:5);{выводим} if k mod 20=0 then readln{если пар больше 20, то делаем задержку} end; if k=0 then write(\'Треугольников с такой площадью нет!\'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 11:22

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258019 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lamed, Студент :
Здравствуйте, igoruu.

1. Треугольники со сторонами a,b и b,a считаются равными.
2. Пусть s2=2*s -удвоенная площадь треугольника. Тогда
  задача формулируется так:
  I этап. найти все пары (a,b) положительных целых делителей числа S2, таких, что a<=b
  и a*b=s2
и a,b in [min..max];
  II этап.  Уточнение границ.
  Левая. Минимально возможная длина a из условий amin>=2*s/bmax
  Правая. Поскольку a<=b, то рассматриваем делители только a*a<=s,

Приложение:
{ ∙ Вопрос № 175505 Найти все равновеликие прямоугольные треугольники, катеты которых выражены целыми числами a и b, а площадь равна S. (a и b принадлежат интервалу от 1 до 20, а S вводится с клавиатуры). } program p175505; var a,b,s: integer; { стороны и площадь } s2: integer; { удвоеннная плошадь } min, max: integer; { заданные границы } amin : integer; i: integer; { счетчик треугольников } begin { ввод } repeat write(\'min=\'); readln(min); write(\'max=\'); readln(max); until (min > 0) and (max > min); { альтернативный вариант ввода } (* min := 1; max := 20; *) { ввод S } repeat write(\'s=\'); readln(s); until (s > 0); i:= 0; { счетчик треугольников } s2 := 2*s; if (s2>=min*min) and (s2<=max*max) then begin { корректируем левую границу } amin := s2 div max; if min>amin then amin := min; a:= amin; while (a*a <= s2) do begin if s2 mod a = 0 then begin inc(i); b:= s2 div a; writeln(\'треугольник[\',i,\']=>\', a, \',\',b); end; inc(a); end; end; if i=0 then writeln (\'нет треугольников\'); readln; end.

Ответ отправил: lamed, Студент
Ответ отправлен: 22.12.2009, 11:47

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258020 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте уважаемые эксперты прошу вашей помощи в решении задачки на тему:Задачи на длинную арифметику»:
Вычислить 7^123. (семь в сто двацать третьей степени) (обьяснением кода если не сложно) заранее благодарен

Отправлен: 22.12.2009, 02:16
Вопрос задал: igoruu, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const base = 7; {основание} st = 123; {степень} var s,tt : string; c : char; i,j,k,a,b,len : integer; begin clrscr; s := \'7\'; {начальная строка} for i:=1 to st-1 do{от1 до 122} begin tt := s;{запоминаем строку} len := length(tt);{длина запомненной строки 1,2,3..} s := \'\';{сбрасываем строку} k := 0; for j:=1 to len do begin a := (ord(tt[j])-48)*base + k; {умножаем столбиком каждый раз новое число} b := a mod 10; {последняя цифра} k := a div 10; {перенос} s := s + chr(b+48);{новая строка без последнего переноса} end; if k <> 0 then s := s + chr(k+48);{добавляем в конец последний перенос} end; len := length(s); {переворачиваем строку} for i:=1 to len div 2 do begin c := s[len-i+1]; s[len-i+1] := s[i]; s[i] := c; end; writeln(s); readln; end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 10:34

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258018 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здавствуйте уважаемые эксперты. Помогите пожалуйста с решением задачи...
1. Уплотнить заданную матрицу, удаляя из нее строки и столбцы, заполненные нулями (оформить в виде процедуры).
2. Найти номер первой из строк, содержащих хотя бы один положительный элемент (оформить в виде функции).
Вычислить все корни уравнения на заданном отрезке с заданной точностью. На экран выдать значения корней и значения функции в точке корня, представить графики левой и правой частей уравнения, отметить на графике по-ложение корней.
ctgx=1/x-x/2 на отрезке [0.5, 20] с точностью 10-5.
Притом я хотел бы узнать, это можно все реализовать в виде одной программы?

Заранее огромное спасибо, задание к сессии, а я к сожеленью не владею pascal и неккому больше обратиться. Буду признателен за помощь

Отправлен: 22.12.2009, 02:46
Вопрос задал: Кирилл Васильевич, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
№1. uses crt; type matrix=array [1..50,1..50] of integer;{тип матрицы} procedure Udal(var n,m:integer;var a:matrix);{процедура уплотнения} var i,j,k,t,p:integer; begin {Udalenie stroki s 0} i:=1; while i<=n do{смотрим все строки} begin k:=0; for j:=1 to m do{в строке} if a[i,j]=0 then k:=k+1;{считаем ноли} if k=m then{если все} begin for t:=1 to m do{все елементы строк} for p:=i to n-1 do{от данной до предпоследней} a[p,t]:=a[p+1,t];{сдвигаем на 1 вверх, строка удаляется} n:=n-1;{уменьшаем количество строк} end else i:=i+1;{если не все ноли, пропускаем строку} end; {Udalenie stolbca s 0} j:=1; while j<=m do{все столбцы} begin k:=0; for i:=1 to n do{по столбцу вниз} if a[i,j]=0 then k:=k+1;{считаем ноли} if k=n then{если все} begin for t:=1 to n do{все элементы столбцов} for p:=j to m-1 do{от данного до предпоследнего} a[t,p]:=a[t,p+1];{сдвигаем на 1 влево} m:=m-1;{уменьшаем количество столбцов} end else j:=j+1;{иначе пропускаем} end; end; var n,m,i,j:integer; a:matrix; begin clrscr; write(\'Количество строк n=\');readln(n); write(\'Количество столбцов m=\');readln(m); Writeln(\'Введите \',n*m,\' элементов матрицы:\'); For i:=1 to n do For j:=1 to m do read(a[i,j]);{можно вводить элементы по строкам, потом Enter } readln;{считываем элементы} clrscr;{очищаем экран} Writeln(\'Исходная матрица:\'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; Udal(n,m,a);{вызываем процедуру уплотнения} writeln(\'Результат:\'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; readln end. №2. uses crt; type matrix=array [1..50,1..50] of integer; function Perv(n,m:integer; a:matrix; var f:byte):integer; {функция определения первой строки с положительным элементом} var i,j,k:integer; begin f:=0;{пока таких строк нет} for i:=1 to n do{идем по строкам} begin k:=0;{пока положительных нет} for j:=1 to m do{смотрим строку} if a[i,j]>0 then{если нашли положительный} begin f:=1;{фиксируем} Perv:=i;{присваиваем значение функции} exit;{прекращаем поиск} end; end; end; var n,m,i,j,p:integer; f:byte; a:matrix; begin clrscr; write(\'Количество строк n=\');readln(n); write(\'Количество столбцов m=\');readln(m); Writeln(\'Введите \',n*m,\' элементов матрицы:\'); For i:=1 to n do For j:=1 to m do read(a[i,j]); readln; clrscr; Writeln(\'Исходная матрица:\'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; p:=Perv(n,m,a,f);{присваиваем переменной значение функции} if f=0 then write(\'В матрице нет положительных элементов!\') {если значение вспомогательного параметра=0} else write(\'Номер первой строки с положительным элементом=\',p); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 09:22

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258017 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Уважаемые Эксперты!прошу вас помощи в решении задачи
Составьте программу, которая создает файл, состоящий из 10 значений типа integer. Прочитайте файл и вычислите сумму его элементов, Тип record не используйте.

Отправлен: 22.12.2009, 04:01
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const n=10; var f:file of integer;{типизированный файл целых чисел} i,s,a:integer; begin clrscr; assign(f,\'file\');{связываем переменную с файлом на диске} rewrite(f);{открываем для записи} writeln(\'Введите в файл \',n,\' целых чисел:\'); for i:=1 to n do begin write(\'a=\'); readln(a);{читаем числа} write(f,a);{записываем в файл} end; clrscr; writeln(\'Содержимое файла:\'); reset(f);{открываем файл для чтения} s:=0; while not eof(f) do{пока не конец файла} begin read(f,a);{читаем числа} write(a,\' \');{выводим на экран} s:=s+a;{суммируем} end; close(f);{закрываем файл} writeln; write(\'Сумма=\',s); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 07:20

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258016 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Уважаемые эксперты,помогите решить задачу
Напишите программу печати таблицы перевода расстояний из дюймов в сантиметры (1 дюйм = 2,5 см) для значений длин от 1 до 40 дюймов.

Отправлен: 22.12.2009, 11:16
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
var i: integer; r: Real; begin for i := 1 to 40 begin r := i * 2.5; WriteLn(r, \' сантиметров = \', i, \'Дюймов\'); end; end;

Ответ отправил: Колесников Иван Владимирович, 4-й класс
Ответ отправлен: 22.12.2009, 18:57

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258036 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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

Отправлен: 22.12.2009, 12:31
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
Исходные данные: 123,Kirov-Moskva,10:20,10:30 321,Moskva-Vladivostok,02:00,02:25 213,St.Peterburg-Astrahan,01:50,02:15 Программа: var f:text; s,Nomer,Nazvanie,VremiaPrib,VremiaOtpr:string; i,ChasPrib,MinPrib,ChasOtpr,MinOtpr,err, Chas,Min:integer; c:char; function Vremia(vr:string;var ch,min:integer):integer; {функция выделяет из строки со временем часы и минуты. возвращает коды ошибок полученные из val; ноль, если всё хорошо } var err1,err2:integer; begin val(copy(vr,1,2),ch,err1); val(copy(vr,4,2),min,err2); Vremia:=err1+err2; end; begin {считывание времени} writeln(\'Vvedite vremia (chas:min)\'); readln(s); if Vremia(s,Chas,Min)>0 then writeln(\'Neverni zadano vremia\') else begin assign(f,\'data.txt\'); reset(f); {Открыть файл данных и читать до конца} while not eof(f) do begin readln(f,s); { Очередная запись целиком прочитывается в строку s } i:=pos(\',\',s); { Ищется позиция первой запятой } Nomer:=copy(s,1,i-1); {Все, что до нее -- номер} delete(s,1,i); {Номер вместе с запятой удаляется } i:=pos(\',\',s); {и т.д.} Nazvanie:=copy(s,1,i-1); delete(s,1,i); i:=pos(\',\',s); VremiaPrib:=copy(s,1,i-1); delete(s,1,i); VremiaOtpr:=s; err:=Vremia(VremiaPrib,ChasPrib,MinPrib); err:=err+Vremia(VremiaOtpr,ChasOtpr,MinOtpr); {Строки со временем распознаются в числа с часами и минутами} if err=0 then if ( (Chas>ChasPrib) or ((Chas=ChasPrib) and (Min>=MinPrib)) {Условие: если заданный час больше часа прибытия или они равны, а заданные минуты больше минут прибытия } ) and ( (Chas<ChasOtpr) or ((Chas=ChasOtpr) and (Min<MinOtpr)) ) {Аналогично для отправления} then begin writeln(Nomer,\' \',Nazvanie); {Вывод} end; end; close(f); end; readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 27.12.2009, 22:40

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258191 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Дорогие эксперты,помогите в решении задачи
Дан текстовый файл. Дописать в его конце следующие данные: количество строк, количество символов в файле.

Отправлен: 22.12.2009, 13:31
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

В файле 175518.txt строк: 2, символов: 18
В файле 175518.txt строк: 2, символов: 18
В файле 175518.txt строк: 2, символов: 59
В
файле 175518.txt строк: 3, символов: 100
В файле 175518.txt строк: 5, символов: 142

Приложение:
CONST FileName = \'175518.txt\'; VAR t: text; s: String; lines_count, chars_count: integer; BEGIN Assign(t, FileName); {$I-} Reset(t); {$I+} if IOResult <> 0 then begin WriteLn(\'Не могу открыть файл \', FileName); Halt(1) end; lines_count := 0; chars_count := 0; While NOT EOF(t) do begin ReadLn(t, s); inc(lines_count); {Не считаем символами символы перехода на другую строку а пробелы - считаем} inc(chars_count, length(s)); end; WriteLn(\'В файле \', FileName,\' строк: \', lines_count,\', символов: \', chars_count); Close(t); Append(t); WriteLn(t,\'В файле \', FileName,\' строк: \', lines_count,\', символов: \', chars_count); Flush(t); Close(t); END. Прикрепленный файл: загрузить »

-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 22.12.2009, 17:26

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258030 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Уважаемые эксперты,помогите решить задачу
Переведите римское число CCXCIV в десятичное современное изображение (C – 100)/

Отправлен: 22.12.2009, 13:31
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

program rome_arabic;
uses crt;
const
  {римские цифры}
  RomeDigits : String='IVXLCDM';
  {числа - соответствующие римским цифрам}
  ArabicNumbers:array
[1..7] of Integer =
  (1, 5, 10, 50, 100, 500, 1000);

{Функция определения правильности ввода арабского числа}
function IsArabic(S : String) : Boolean;
var I, T, C : Integer;
begin
     IsArabic := True;
     For  I := 1 to Length(S) do
     if not(S[I] in ['0' .. '9']) then
    begin
         IsArabic := False;
    exit;
 end;
 val(S, T, C);
 if (C <> 0) or (T < 1) then
 begin
  IsArabic 
 := False;
  exit;
 end;
end;

{Функция перевода арабского числа в римское}
function ArabicToRome (S : String) : String;
var
    I,N,C : Integer;
    Res : String;
begin
     val(S, N, C);
     Res: = '';
     I := 7; {Проверяем от больших чисел к меньшим}
    while N > 0 do
     begin
          {находим следующее число - из которого будем формировать римскую цифру}
          while ArabicNumbers[I] > N do I := I - 1;
          Res := Res + RomeDigits[I];

         N := N - ArabicNumbers[I];
    end;
    ArabicToRome := Res;
end;

{Функция определения правильности ввода римского числа}
function IsRome(S : String) : Boolean;
var 
    I : Integer;
begin
     IsRome := True;
     if S = '' then
      begin
            IsRome := False;
      exit;
end;

For I := 1 to Length(S) do
if not (S[I] in ['I', 'V', 'X', 'L', &#
 39;C', 'D', 'M']) then
 begin
  IsRome := False;
  break;
 end;
end;

{Функция перевода римского числа в арабское}
function RomeToArabic (S : String) : Snteger;
var
   B : Array[1 .. 100] of Integer;
   I, J : Integer;
   Res : Integer;
begin
     For I :=1 to Length(S) do
      begin
           if S[I] = 'I' then B[I] := 1;
           if S[I] = 'V' then B[I] := 5;
           if S[I] = 'X' then B[I] := 10;

          if S[I] = 'L' then B[I] := 50;
           if S[I] = 'C' then B[I] := 100;
           if S[I] = 'D' then B[I] := 500;
           if S[I] = 'M' then B[I] := 1000;
      end;
 Res := B[1];{массив локальная переменная и
 сравнение первого элемента с нулевым искажает число,
 почему-то считает, что B[0] = 1 и автоматом вычитает 2}

 For I := 2 to Length(S) do
  begin
       Res := Res + B[I];
       if
  B[ I - 1] < B[I] then Res := Res - 2*b[I - 1] {вот здесь}
 end;
 RomeToArabic := Res;
end;
{Основная программа}
var
  Arabic : String; {арабское число}
  Rome : String; {римское число}
  Ask : Char; {режим перевода чисел}
begin
    clrscr;
    writeln('Программа переводит римское число в арабское или арабское в римское');
    repeat
    clrscr;
    writeln('Выберите режим перевода: ');
    writeln('1 - римское число в арабское');
 
  writeln('2 - арабское число в римское');
    writeln('другое - выход');
    ask := readkey;
    case ask of
    '1' : begin {Римское в арабское}
               write('Введите римское число: ');
               readln(Rome);
               if IsRome(Rome) then
               writeln('Арабское число = ',RomeToArabic(Rome))
               else writeln('В римской записи числа допущены ошибки! Перевод не во
 зможен! ');
               writeln('Press Enter...');
               readln
          end;

   '2' : be
gin {арабское в римское}
               write('Введите арабское число: ');
               readln(Arabic);
               if IsArabic(Arabic) then
               writeln('Римская запись = ',ArabicToRome(Arabic))
               else writeln('В арабской записи числа допущены ошибки! Перевод не возможен!');
               writeln('Press Enter... ');
               readln
         end;
         else exit;
   end;
  until not(Ask in ['1','2']);
end.

Ответ отправил: Мироненко Николай Николаевич, Студент
Ответ отправлен: 22.12.2009, 21:06

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258047 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Уважаемые эксперты,это снова я,мне ваша помощь очень нужна,помогите решить=)
Составьте программу вычисления степени числа а с натуральным показателем n. (Записать варианты программы с разными видами циклов While, repeat, for)

Отправлен: 22.12.2009, 14:31
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

uses crt;

var
   A, N, I : Integer;
       Res : Extended;
BEGIN
clrscr;
 write('Введите число A: ');
  read(A);

write('Введите показатель степени N: ');
  read(N);

 Res := 1;
 
 For I := 1 to N do
  begin
    Res := Res * A; {считаем степень}
  end;

 write(A,'^',N,' = ',Res : 3 : 1); {вывод результата}
readkey;
END.

uses crt;

var
   A, N, I : Integer;
       Res : Extended;
BEGIN
clrscr;
 write('Введите число A: ');
  read(A);
 write('Введите показатель степени N: ');
  read(N);

 Res := 1;

 while I < N do {пока I < N}
  begin
    Res := Res * A; {считаем степень}
    Inc(I); {инкремент счётчика}
  end;

 write(A,'^',N,' = ',Res : 3 : 1); {вывод результата}
readkey;
END.

uses crt;

var
   A, N, I : Integer;
       Res : Extended;
BEGIN
clrscr;
 write('Введите число A: ');
  read(A);
 write('В
 ведите показатель степени N: ');
  read(N);

 Res := 1;

 repeat {повторять}
  begin
    Res := Res * A; {считаем степень}
    Inc(I); {инкремент счётчика}
  end;
 until I = N; {пока I не будет ровняться N}

 write(A,'^',N,' = ',Res : 3 : 1); {вывод результата}
readkey;
END.

Ответ отправил: Мироненко Николай Николаевич, Студент
Ответ отправлен: 22.12.2009, 20:37

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258045 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Помогите пожалуйста юному программисту решить непонятную задачу.
4)Дан файл компоненты которого являются действительными числами. Найти наименьший из значений компонент с четными номерами.
Заранее большое спасибо.

Отправлен: 22.12.2009, 19:16
Вопрос задал: Эдуардик, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; var f:file of real;{типизированный файл действительных чисел} a,mn:real; i:integer; begin clrscr; assign(f,\'file\');{связываем переменную с файлом} rewrite(f);{открываем файл для записи} i:=0; writeln(\'Введите в файл ,не менее 2х действительных чисел, окончание ввода 0:\'); repeat write(\'a=\'); readln(a); i:=i+1; write(f,a);{вводим числа в файл} until (a=0)and(i>1);{если введен ноль и более одного числа, прекращаем ввод} clrscr;{очищаем экран} writeln(\'Содержание файла:\'); reset(f);{открываем файл для чтения} read(f,a);{читаем первое число} write(a:6:2); read(f,mn);{читаем второе, пока это минимум} write(mn:6:2); i:=2;{2 числа прочитано} while not eof(f) do{пока не прочитан весь файл} begin read(f,a);{читаем числа} write(a:6:2);{выводим на экран} i:=i+1;{считаем} if(i mod 2=0)and(a<mn) then mn:=a;{если четный номер, проверяем на меньшее} end; close(f);{закрываем файл} writeln; write(\'Минимальный с четным номером=\',mn:0:2); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 20:32

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258044 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Помогите пожалуйста юному программисту решить непонятную задачу.
Даны действительные числа X,Y,Z. Получить min2(x+y+z/2, xyz)+1
Заранее огромное спасибо.

Отправлен: 22.12.2009, 19:46
Вопрос задал: Димон Голов, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; function Min(x,y:real):real;{функция нахождения минимального из двух} begin if x<y then Min:=x else Min:=y;{выбираем что меньше} end; var x,y,z,c1,c2,m:real; begin clrscr; write(\'x=\');readln(x);{вводим три числа} write(\'y=\');readln(y); write(\'z=\');readln(z); c1:=x+y+z/2;{вычислим первое выражение} writeln(\'x+y+z/2=\',c1:0:2); c2:=x*y*z;{второе выражение} writeln(\'xyz=\',c2:0:2); m:=Min(c1,c2);{выберем минимальное} writeln(\'Min=\',m:0:2); write(\'m^2+1=\',m*m+1:0:2);{посчитаем результат} readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 22.12.2009, 20:10

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258043 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Помогите пожалуйста юному программисту решить непонятную задачу.
Вывести на печать строку: «Жизнь прекрасна и удивительна» полученную путем замены слов в фразе: «Жизнь чудесна и удивительна».
Заранее огромное спасибо.

Отправлен: 22.12.2009, 21:01
Вопрос задал: карина Булыгина, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{Решение задачи для этого частного случая с помощью функции определения положения ПОДстроки в строке POS} VAR s: String; BEGIN s:= \'Жизнь чудесна и удивительна\'; {удаляем "чудесна"} Delete(s, POS(\'чудесна\', s), length(\'чудесна \')); {Вставим другое слово} Insert(\'прекрасна \', s, POS(\'и \', s)); WriteLn(s); END.
-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 22.12.2009, 21:21

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258050 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Помогите сделать матрицу, пожалуста
Ввести матрицу m*n(9*4) и вывести на печать i,j-ый элемент, i(7)-ю строку или j(2)-ый столбец.
№ m n i j
8 9 4 7 2

Отправлен: 22.12.2009, 21:01
Вопрос задал: Темик, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
const m=9; n=4; type matr=array[1..m,1..n] of real; var a:matr; i,j:integer; begin randomize; for i:=1 to m do for j:=1 to n do a[i,j]:=random; writeln(\'Element i=7 j=2:\'); writeln(a[7,2]:0:3); writeln(\'Stroka i=7:\'); for j:=1 to n do write(a[7,j]:0:3,\' \'); writeln; writeln(\'Stolbets j=2:\'); for i:=1 to m do writeln(a[i,2]:0:3); writeln; readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 25.12.2009, 18:46

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258122 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »