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

Выпуск № 642
от 26.04.2008, 05:35

Вопрос № 133.068

Добрый день! Моя проблема заключается в чтении данных из файла и запись в файл, среда - turbo pascal 7.0. входной файл 1.txt содержит числовые данные, разделенные пробелами, например "10 5 34 12". И входной, и выходной файлы размещаются в каталоге программы...

Отправлен: 20.04.2008, 05:05 Вопрос задал: В.Ю.К. (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, В.Ю.К.! Для чтения из файлов используется стандартная процедура READ. Сейчас немножко объясню. Как Вы сказали, данные хранятся в текстовом файле. Объявим переменную, которая будет рабтать с файлом: var f: text; {/...../} begin {/...../} Чтобы получить доступ к файлу, файловую переменную и файл нужно "связать" (ассоциировать): Assign(f, '1.txt'); А потом открыть для чтения: Reset(f); Теперь файл в нашем рапоряжении. Читаем из него данные: read(f, a, b, c, d); После совершения ВСЕХ действий с файлом, его необходим закрыть: close(f); Переменные a, b, c, d типа INTEGER (хотя можно в данном случае REAL или, скажем, BYTE). Удачи! --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 20.04.2008, 07:46 Оценка за ответ: 5 Комментарий оценки: Спасибо, ваш ответ помог многое понять в процедуре простейшей работы с файлами!

Отвечает: Евчик Сергей Александрович Здравствуйте, В.Ю.К.! Чтение данных может осуществляться таким образом: Program z1; uses crt; var s:string; f:text; begin Assign(f,'1.txt'); {$I-} Reset(f);{Reset(f)-Открывает сушествующий файл и устанавливает указатель в начало файла} {$I+} if IoResult <> 0 then {Проверка на ошибку при открытии файла} Begin Writeln('ERROR'); ReadKey; Halt end else begin While not EOF(f) do {Пока не конец файла} begin Readln(f,s); {Считываем в переменную s строку из файла} {Тут нужные вам действия со строкой} end; close(f); end; readkey end. Запись данных осуществляться таким образом: Program z1; uses crt; var s:string; f:text; i:byte; begin randomize; Assign(f,'1.txt'); {$I-} ReWrite(f); {Зоздаем и открываем новый файл. Вместо ReWrite(f) можно использовать Append(f)-открывает существующий файл и устанавливает указатель в конец файла} {$I+} if IoResult <> 0 then Begin Writeln('ERROR'); ReadKey; Halt end else begin repeat i:=random(255); Write(f,i,' '); until i=100; {Записываем данные в файл пока i не станет = 100} { repeat i:=random(255); Write(f,i,' '); until i=100; Взяты для примера.} { Write(<файловая переменная>,<данные которые нужно записать в файл>)} close(f); end; readkey end. Приложение:

Ответ отправил: Евчик Сергей Александрович (статус: 4-ый класс) Ответ отправлен: 20.04.2008, 12:35 Оценка за ответ: 5 Комментарий оценки: Спасибо, в особенности за комментарии - иначе с некоторыми функциями пришлось бы побатрачиться...

Вопрос № 133.070

В данной действительной матрице размера 6*9 поменять местами строку , содержащую элемент с наибольшим значением , со строкой , содержащей элемент с наименьшим значением . Предполагается , что эти элементы единственны . Отсортировать матрицу по убыванию .Решить с помощью подпрограмм.Спасибо!(Использовать двумерные массивы)

Отправлен: 20.04.2008, 05:58 Вопрос задала: Лиманская Юлия Вадимовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Хотел отправить Вас к вопросу №131594, там аналогичная задача, но без процедур, поэтому решил уж все доделать сам. Чтобы макс и мин гарантированно не попали в одну строку и чтобы такие строки были единственными, матрицу надо набивать вручную. Поскольку по условию числа действительные, значит могут встречаться не только целые, но и дробные, поэтому применяем тип Real. Но вводить можно и только целые числа, чтоб быстрее, только вывод нужно форматировать как для вещественных чисел. При тестировании программы можно взять n и m поменьше. Сортировку матрицы я сделал с помощью линейного массива. Сначала матрицу разворачиваем в линейный массив, который легко сортировать, а затем, после сортировки, снова собираем массив в матрицу. Поскольку параметры матрицы у нас заданы константами, а преобразованиях участвует только сама матрица, которая объявлена как глобальная переменная, формальных параметров в процедурах нет. Код с пояснениями в приложении. Удачи! Приложение: 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; writeln('Vvedite ',n*m, 'element matricy:'); {вводим с клавиатуры элементы матрицы, затем представляем их в виде матрицы } for i:=1 to n do for j:=1 to m do read(a[i,j]); readln; clrscr; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4:1); writeln; end; readln; end; Procedure Perest; var i,j,imax,imin:integer; max,min,x:real; begin {находим максимальный и минималиный элементы, определяем номера их строк} max:=a[1,1];min:=a[1,1];imax:=1;imin:=1; for i:=1 to n do for j:=1 to m do if a[i,j]>max then begin max:=a[i,j]; imax:=i; end else if a[i,j]<min then begin min:=a[i,j]; imin:=i; end; writeln('max=',max:4:1,' imax=',imax); writeln('min=',min:4:1,' imin=',imin); readln; {меняем местами элементы строк с макс и мин} for j:=1 to m do begin x:=a[imin,j]; a[imin,j]:=a[imax,j]; a[imax,j]:=x; end; writeln('Perestanovka:'); {выводим результат на экран} for i:=1 to n do begin for j:=1 to m do begin write(a[i,j]:4:1); end; writeln; end; readln; 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('Sortironka:'); 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]:5:1); end; writeln; end; end; begin {начало основной программы с последовательным вызовом процедур} Vvod; Perest; Sort; readln; end.

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

Вопрос № 133.073

Сама не разобралась,помогите пожалуйста с решением: Дан двумерный массив, содержащий 5 строк и 7 столбцов. Элемен- тами массива являются целые числа. Упорядочить массив по невоз- растанию элементов первого столбца.

Отправлен: 20.04.2008, 07:24 Вопрос задала: Тимощенко Елизавета Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Тимощенко Елизавета Владимировна! Решение задачи в приложении. Просто идет обычная сортировка элементов первого столбца как линейного массива. Поскольку элементы в других столбцах связаны с элементами первого столбца через номер строки, то одновременно и они все тоже сортируются. Приложение: program matrica; uses crt; const n=5; m=7; var i,j,p,x:integer; a:array[1..n,1..m]of 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(20); write(a[i,j]:4); end; writeln; end; readln; {sortirovka po neubyvaniu v 1 stolbce} for i:=1 to n-1 do for p:=1 to n-1 do if a[p,1]<=a[p+1,1] then begin for j:=1 to m do begin x:=a[p,j];a[p,j]:=a[p+1,j];a[p+1,j]:=x; end; end; {vyvod obrabotannoj matrichy} writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to m do write(a[i,j]:4); writeln; end; readln; end. end.

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

Вопрос № 133.131

Дорогие эксперты, помогите пожалуйста решить задачу: Текстовый документ не обязателен, главное сама программа. Осуществить поиск всех вхождений данного слова в тексте из файла OBRAZEC.TXT. Выдать на экран сообщение "слова.....в тексте нет", или "слово..... стоит на....месте в....предложении". Результаты работы программы записать в файл REZULT.TXT.

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

Отвечает: Евчик Сергей Александрович Здравствуйте, Муратов Дмитрий Анатольевич! Я бы делал так: Program z1; uses crt; var s,s1:string; i,j,kol:integer; f:Text; begin clrscr; Write('Введите путь к файлу: '); readln(s); Assign(f,s); {$I-} Reset(f); {$I+} if IoResult<>0 then begin Writeln('Error'); readkey; Halt; end else begin i:=0; j:=0; Write('Введите слово для поиска: '); readln(s1) While not EOF(f) do begin inc(i); Readln(f,s); kol:=0; repeat j:=pos(s1,s); if (j<>0) then begin Writeln('Строка вхождения: ',i,'Позиция вхождения: ',j+kol*length(s1)); inc(kol); delete(s,j,length(s1)); end; until j=0; end; close(f); end; readkey; end.

Ответ отправил: Евчик Сергей Александрович (статус: 4-ый класс) Ответ отправлен: 20.04.2008, 13:09 Оценка за ответ: 5 Комментарий оценки: Просто отлично!!! Спасибо огромное. Просто я строки плохо знаю(((

Вопрос № 133.133

уважаемые эксперты помогите решить задачу. дано n различных натуральных чисел(n=5). напечатать все перестановки этих чисел

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

Отвечает: Костя Симанович Здравствуйте, Ильин Дмитрий! Если правильно понял задачу, ответ в приложении. В цикле записываем числа с 1 по 5, но вы можете изменить ввод и записать любые целые числа. Удачи. Приложение: program per; const n = 5; { количество элементов в перестановке} var a : array[1..n] of integer; i1 : integer; procedure generate (l,r : integer); var i,v : integer; begin if (l=r) then begin for i:=1 to n do write(a[i],' '); writeln; end else begin for i := l to r do begin v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]} generate(l+1,r); {вызов новой генерации} v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]} end; end; end; begin for i1 := 1 to N do {заполняем массив числами} A[i1]:=i1; {можно в ручную любыми} generate(1, n); readln; end.

Ответ отправил: Костя Симанович (статус: 3-ий класс) Ответ отправлен: 20.04.2008, 19:50

Вопрос № 133.176

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

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хмелев Андрей Борисович! В приложении программа, которая рисует график Y=X3 и показывает работу самого метода. Удачи! Приложение: program q96704; uses Graph,Crt; const x0=-3;{начало} x1= 3;{конец} e=0.0001;{точность} h=0.00001; var x,xA,xB:real; grDriver,grMode:integer; {сама функция} function myFN(x:real):real; begin myFN:=x*x*x; end; {считаем координату Y для графика} function myPointY(x:real):integer; begin myPointY:=200+round(int(20*(myFN(x1)/myFN(x0))*GetMaxY*myFN(x))/GetMaxY); end; {считаем координату X для графика} function myPointX(x:real):integer; begin myPointX:=round(int(GetMaxX*((x-x0)/(x1-x0)))); end; {вывод графика} procedure myFunctionOut; var i:integer; begin {ось Х} Line(0,200,GetMaxX,200); for i:=0 to GetMaxX do begin PutPixel(i,myPointY(x0+(x1-x0)*i/GetMaxX),13); end; end; begin {включаем графику} grDriver:=0; InitGraph(grDriver,grMode,''); {метод ньютона (касательных или с аппроксимацией производной (метод хорд))} myFunctionOut;{рисуем график функции} x:=x0; xA:=0; repeat Circle(myPointX(x),myPointY(x),1);{рисуем текущую точку} xA:=h*myFN(x)/(myFN(x+h)-myFN(x)); x:=x-xA; Delay(32000);{задержка работы} until abs(xA)<e; Circle(myPointX(x),myPointY(x),3); ReadKey; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.185

Здравствуйте эксперты помогите пожалуйста!!! В одномерном массиве, состоящем из n вещественных элементов, вычислить сумму модулей элементов массива, расположенных после минимального по модулю элемента. Заранее спасибо

Отправлен: 20.04.2008, 16:05 Вопрос задал: Lubimov Alexandr (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Lubimov Alexandr! Программа в приложении. Удачи! Приложение: const n=12; var a:array [1..n]of real; b:real; x,y:integer; begin {создаем случайно массив} randomize; for x:=1 to n do begin a[x]:=10-20*random; write(a[x]:20:10); end; writeln; {поиск минимального значения} y:=1; for x:=1 to n do if a[y]>a[x] then y:=x; {суммируем абсолютные значения} b:=0; for x:=y+1 to n do b:=b+abs(a[x]); {выводим результат} writeln(b:20:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 20.04.2008, 16:36 Оценка за ответ: 5 Комментарий оценки: БОЛЬШОЕ СПАСИБО!!! Все правильно, даже немного лишнего ;-)

Вопрос № 133.213

Здравствуйте, уважаемые эксперты! Требуется написать программу на паскале: посчитать сумму ряда S=1+1/2^2+1/3^2+1/4^2+1/5^2+... число членов ряда =50 Оформить программу как функцию и процедуру. Заранее благодарен.

Отправлен: 20.04.2008, 17:20 Вопрос задал: Лобанов Александр (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: SHERRY !!! Здравствуйте, Лобанов Александр! Код задачи в приложении. В ответе эксперта нужно заменить цикл на: for i:=1 to a do ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 24.04.2008, 20:49 Приложение: var s: real; procedure Go(a: integer); var i: integer; begin for i:=i to a do s := s + sqr(1/i); end; function Go2(a: integer): real; var i: integer; b: real; begin b:=0; for i:=i to a do b := b + sqr(1/i); Go2 := b; end; begin s:=0; Go(50); writeln('By procedure ', s:5:3); s:=0; writeln; writeln('By function ', Go2(50):5:3); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: Студент) Ответ отправлен: 20.04.2008, 17:29 Оценка за ответ: 3

Вопрос № 133.236

Уважаемые , эксперты!Помогите пожалуйста,мне решить задачи,буду очень благодарна вам. 1.Организовать символьный файл f из N компонент. После этого организовать файл g содержащий все компоненты файла f в обратном порядке. Вывести содержимое файлов на экран. 2.Организовать файл целых чисел из N компонент. Выполнить сортировку файла по убыванию. Вывести содержимое файла до обработки, и после обработки.

Отправлен: 20.04.2008, 19:09 Вопрос задала: Юлия правда (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Юлия правда! Первая задача в приложении. Задача решается с помощью оператора For. Есть две формы оператора, используется вторая: FOR пар_цик := нач_знач downto кон_значение do операторы Как видите эта форма отличается тем, что вместо TO - DOWNTO. Это значит что шаг наращивания равен: -1, а не +1 как в обычном цикле. Т.е. параметр цикла уменьшается на 1, до тех пор пока не будет равен конечному значению. Например: var i:integer; begin for i:=10 downto 1 do write(i, ' '); end. В этом примере при первом проходе будет выведено 10, при втором 9, при третьем 8 и т.д. Удачи!!! Приложение: uses crt; const {кол-во компонентов файла} N=50; var {f-иходный файл, g-конечный файл} f, g : text; {fs-N символов файла f, gs-N символов файла g} {'STRING[N]' - означает что максимальное и минимальное кол-во символов в строке равно N, если строке будет присвоено меньше или больше символов, то лишние обрежутся, а не достающие будут заменены на пробел} fs, gs : string[N]; {счетчик для цикла For} i : integer; begin {очищаем экран} ClrScr; {связываем ф.п. с файлом} assign(f, 'Data.txt'); {открываем для перезаписи} rewrite(f); {Получаем данные} Write('Введите содержимое исходного файла: '); readln(fs); {сохраняем в файл исходные данные} Write(f, fs); WriteLn('Исходный файл: ', fs); {обнуляем строку} gs:=''; {записываем исзодные данные наоборот} for i:=N downto 1 do gs:=gs+fs[i]; {закрываем файл} close(f); assign(g, 'Result.txt'); rewrite(g); {записываем в файл рез-тат} write(g, gs); {вывод} writeLn('Рез-тат: ', gs); {закрываем файл} flush(g); close(g); readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Юлия правда! Решение второй задачи c пояснениями в приложении. Поскольку нам сами файлы не нужны непосредственно для чтения, я использовал типизированные файлы. Приложение: uses crt; const n=20; var f:file of integer; {переменная, типизированный файл целых чисел} i,j,x:integer; a:array[1..n]of integer; begin clrscr; randomize; assign(f,'chisla.dat');{связываем переменную с именем} rewrite(f); {открываем файл для записи} for i:=1 to n do begin a[i]:=random(20); write(f,a[i]); {записываем в файл данные} end; close(f); {закрываем файл и открываем его для чтения} reset(f); writeln('Ishodny massiv:'); i:=1; While (not eof(f)) and (i<=n) do begin read(f,a[i]); write(a[i],' ');{записываем данные из файла в массив} i:=i+1; end; writeln; writeln; close(f); {закрываем файл} for i:=1 to n-1 do for j:=1 to n-1 do if a[j]<a[j+1] then {сортируем массив по убыванию} begin x:=a[j];a[j]:=a[j+1];a[j+1]:=x; end; rewrite(f); {открываем файл для перезаписи} for i:=1 to n do write(f,a[i]); {записываем в него отсортированный массив} close(f); {закрываем файл} writeln('Otsortirovanny fail:'); reset(f); {опять открываем его для чтения} i:=1; While (not eof(f)) and (i<=n) do begin write(a[i],' '); {выводим на экран} i:=i+1; end; close(f); {закрываем файл} readln end.

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

Вопрос № 133.250

Здравствуйте уважаемые профессионалы помогите мне пожалуйста! Вот такая задача: Написать программу, которая формирует два массива чисел, упорядочивает их по возрастанию, а затем формирует упорядоченный по возрастанию массив, составленный из всех элементов первых двух массивов (слияние упорядоченных массивов)

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

Отвечает: Verena Здравствуйте, Lubimov Alexandr! Такие вопросы уже задавались, например, 110449 (или по этой бесплатной ссылке на subscribe). Я немного изменила свой код оттуда, добавила формирование массивов через генератор случайных чисел и убрала проверку на неповторность чисел. Для слияния двух упорядоченных массивов применяется стандартный алгоритм, который также используется в сортировке слиянием, работает он примерно так: пишем в новый массив меньший элемент из текущих. Выглядеть это будет так: А В С 1 2 3 4 5 А В С 3 2 1 5 4 A B C 3 4 1 5 2 A B C 5 4 1 - - 2 - - 3 И т.д. То есть из массивов А и В выбирается минимальный элемент сверху (сначала) и записывается в С. Программа в приложении, думаю, из комментариев всё будет ясно. Удачи! Приложение: Type mas = array [1..100] of integer; Var i, n, m, k: integer; a, b, c: mas; procedure Sort (var a: mas; n: integer); {процедура сортировки (метод пузырька)} Var i, k, j: integer; begin for i:=2 to n do for j:=n downto i do if a[j]<a[j-1] then {если текущий элемент меньше предыдущего - меняем их местами} begin k:= a[j]; a[j]:=a[j-1]; a[j-1]:=k; end; end; procedure Merge (var a: mas; var b: mas; var c: mas; m, n: integer; var k: integer); {процедура слияния} Var i, j: integer; begin i:=1; j:=1; k:=1; {устанавливаем счётчики} while (i<=n) or (j<=m) do {пока не дошли до конца каждого из массивов} begin if (i<=n) and (j<=m) then {если оба массива ещё не закончились} begin if a[i]<b[j] then {то пишем в новый массив меньший из текущих элементов} begin c[k]:= a[i]; inc (i); {переходим к следующему элементу соответствующего массива} inc (k); {переходим к следующему элементу конечного массива} end else begin c[k]:= b[j]; inc (j); inc (k); end end else if j>m then {иначе один из массивов уже закончился} begin {и мы пишем из того, в котором ещё есть элементы} c[k]:= a[i]; inc (i); inc (k); end else begin c[k]:= b[j]; inc (j); inc (k); end; end; dec (k); {k показывает, сколько элементов в результирующем массиве - это выходной параметр (при завершении функции он на 1 больше, чем элементов в С} end; begin randomize; {инициализация генератора случайных чисел} n:= random (100); {формируем входные данные} for i:=1 to n do a[i]:= random (1000); m:= random (100); for i:=1 to m do b[i]:= random (1000); writeln ('Ishodniii massiv A: '); {выведем исходные массивы} for i:=1 to n do write (a[i], ' '); writeln; writeln ('Ishodniii massiv B: '); for i:=1 to m do write (b[i], ' '); writeln; Sort (a, n); {сортируем оба массива} Sort (b, m); Merge (a, b, c, m, n, k); {применяем процедуру слияния} writeln ('Rezultiruiutzii massiv C iz ', k, 'elementov: '); {выводим результат} for i:=1 to k do write (c[i], ' '); writeln; end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.04.2008, 22:08

Вопрос № 133.255

Здравствуйте уважаемые! Нужно решить следущие задачи в pascal ∙ Составить программу вычисления корней квадратного уравнения: AX(x в квадрате) + BX + C Значения коэффициентов A, B, C должны вводиться пользователем по запросу программы. Обеспечить возможность неоднократного решения задачи без повторной загрузки программы. ∙ Составить программу, позволяющую подсчитать сумму цифр пятизначного числа. Обеспечить возможность неоднократного решения задачи без повторной загрузки программы. Буду премного благодарна!

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

Отвечает: SHERRY Здравствуйте, Малинина Алиса! Вторая задача решена. Программа считает сумму цифр любого числа целого положительного числа. Приложение: var a, sum: integer; retry: byte; begin retry:=0; Repeat sum:=0; Writeln('Vvedite 4islo '); readln(a); repeat sum:=sum + (a mod 10); a:= a div 10; until a=0; writeln('Sum = ', sum); writeln('Retry? (1 - YES, 0 - NO)'); readln(retry); Until retry=0; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Малинина Алиса! Первая программа в приложении, выход их неё если А:=0. Удачи! Приложение: var a,b,c,d:real; begin repeat write('A:'); readln(a); write('B:');readln(b); write('C:');readln(c); d:=b*b-4*a*c; if (a<>0) then if d<0 then writeln('complex:') else writeln('X1:':5,((-b+sqrt(d))/(2*a)):20:10, 'X2:':5,((-b-sqrt(d))/(2*a)):20:10) else if b<>0 then writeln('X0:':5,-c/b:20:10); until a=0; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 133.256

Здравствуйте господа эксперты! нужно решить задачи: ∙ Составить программу, которая меняет местами максимальный и минимальный элементы главной диагонали двумерного массива. Вывести их на экран. ∙ Составить программу, которая сортирует четные строки двумерного массива по возрастанию, а нечетные строки по убыванию. Для каждой задачи составить алгоритм и привести листинг программы Огромное спасибо!!!!!!!!!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Малинина Алиса! Решение обеих задач в приложении. Комментарии и есть по сути алгоритм. Добавить только типа: начало программы, конец программы и все. Приложение: Задача 1. uses crt; const n=6; var a:array[1..n,1..n]of integer; i,j,max,min,imax,jmax,imin,jmin,x:integer; begin clrscr; {очищаем экран} randomize; {инициализируем генерацию случайных чисел} writeln('Ishodnaia matrica:'); for i:=1 to n do {заполняем матрицу случайными числами} begin {из диапазона [-3,6] и выводим ее на экран} for j:=1 to n do begin a[i,j]:=random(10)-3; write(a[i,j]:4); end; writeln; end; readln; {назначаем макс и мин a[1,1]} max:=a[1,1];min:=a[1,1];imax:=1;jmax:=1;imin:=1;jmin:=1; for i:=1 to n do for j:=1 to n do if (j=i)then {главная диагональ} begin if a[i,j]>max then begin max:=a[i,j]; {находим максимум} imax:=i; {номер его строки} jmax:=j; {номер его столбца} end else if a[i,j]<min then begin min:=a[i,j]; {аналогично минимум} imin:=i; jmin:=j; end; end; {выводим данные о макс и мин на экран} writeln('max el=',max,' str=',imax,' stb=',jmax); writeln('min el=',min,' str=',imin,' stb=',jmin); {меняем местами макс и мин} x:=a[imax,jmax]; a[imax,jmax]:=a[imin,jmin]; a[imin,jmin]:=x; writeln; {выводим результат на экран} writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to n do begin write(a[i,j]:4); end; writeln; end; readln; end. Задача 2. uses crt; const n=6; var a:array[1..n,1..n]of integer; i,j,k,x:integer; begin clrscr; randomize; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10)-3; write(a[i,j]:4); end; writeln; end; readln; {до сюда как в первой задаче} for i:=1 to n do begin if i mod 2=0 then {если строка четная} begin for j:=1 to n-1 do for k:=1 to n-1 do if a[i,k]>a[i,k+1] then begin x:=a[i,k]; {сортируем по возрастанию} a[i,k]:=a[i,k+1]; a[i,k+1]:=x; end; end else if i mod 2<>0 then {если нечетная} begin for j:=1 to n-1 do for k:=1 to n-1 do if a[i,k]<a[i,k+1] then begin x:=a[i,k]; {по убыванию} a[i,k]:=a[i,k+1]; a[i,k+1]:=x; end; end; end; {выводим результат на экран} writeln('Otsortirovannaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin write(a[i,j]:4); end; writeln; end; readln; end.

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

Вопрос № 133.257

И ещё раз доброго времени суток))) Пожалуйста, напишите 2 прогhfvvs на накопление суммы ряда через функцию и процедуру: 1) S=1/(1+1!) + 2/(1+2!) + 3/(1+3!) +..... n=50 2) Ln(2)=S=1 - 1/2 + 1/3 - 1/4 +...+ (-1)^(x+1) * 1/x Благодарю;)

Отправлен: 20.04.2008, 21:16 Вопрос задал: Лобанов Александр (статус: 1-ый класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY !!! Здравствуйте, Лобанов Александр! Решение первого примера в приложении. Через функцию оформил нахождение факториала, и процедуру - нахождение суммы ряда. Думаю разберётесь. Удачи! Тип Integer в Turbo Pascal имеет диапазон -32768..32767. 8! = 40320, т.е. уже при вычислении факториала 8-ми возникает переполнение в функции fakt. 50! > 3*1064. Ни один из стандартных целочисленных типов Turbo Pascal для факториала 50-ти не подходит. ----- ∙ Отредактировал: Denisss (Профессионал) ∙ Дата редактирования: 21.04.2008, 20:46 Приложение: var s: real; function fakt(n: integer): integer; var rez,i: integer; begin rez:=1; for i:=n DownTo 2 do rez:=rez*i; fakt:=rez; end; procedure Go(n: integer; var k: real); var i: integer; begin for i:=1 to n do k:=k+ i/(1 + fakt(i)); end; begin s:=0; Go(50, s); writeln(s:3:3); readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Лобанов Александр! Второая задача в приложении. При увеличении N увеличивается точность вычисления ряда. Удачи! Приложение: const n=30000; var a:real; procedure Z(var c:real); var d:integer; begin c:=0; for d:=1 to n do c:=c+(2*ord(odd(d))-1)/d; end; function B(e:integer):real; var f:integer; g:real; begin g:=0; for f:=1 to n do g:=g+(2*ord(odd(f))-1)/f; B:=g; end; begin Z(a); writeln('Procedure:',a:0:10); writeln('Function :',B(n):0:10); writeln('Control :',ln(2):0:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Coupler Здравствуйте, Лобанов Александр! Программа вычисления суммы 1 в приложении. Отмечу, что для этой задачи вовсе не нужно вычилять факториал каждый раз - подробности смотрите в комментариях. Приложение: program Project2; function calc (n:integer):extended; var s: extended; i:integer; temp:extended; begin temp:=1;{в temp хранится число, равное i!} n:=50; s:=0; for i:=1 to n do{50 слагаемых} begin s:=s+i/(1+temp); temp:=temp*(i+1);{умножаем temp на (i+1), тем самым получая (i+1)!} end; calc:=s; end; begin writeln(calc(50)); readln; end.

Ответ отправил: Coupler (статус: Специалист) Ответ отправлен: 21.04.2008, 14:26 Оценка за ответ: 5

Вопрос № 133.276

Доброго времени суток. Мне требуется помощь в написании программы, у мя получается замудреннои поэтому не работает. 1) в строковом массиве хранятся названия дней недели. выведите их в алфавитном порядке. 2) Даны матрица B[i,j] и число А. Сформировать матрицу С, элементы которой удовлетворяю условию С[i,j]=(B[i,j]-a)/(3+B[i,j])/ В векторе D, элементы которого есть сумма положительных элементов строк матрицы С, найти наибольший элемент. Вывести на экран веторк D и наибольший элемент Приложение: 1) program SortDriver; type DataItem = string[80]; DataArray = array [1..80] of DataItem; var test: dataarray; t, t2: integer; testfile: file of char; procedure QsString(var item: DataArray; count:integer); procedure qs(l, r: integer; var it:DataArray); var i,j:integer; x, y: DataItem; begin i := l; j := r; x := it[(l+r) div 2]; repeat while it[i] < x do i := i+1; while x < it[j] do j := j-1; if i<=j then begin y := it[i]; it[i] := it[j]; it[j] := y; i := i+1; j := j-1; end; until i>j; if l<j then qs(l, j, it); if l<r then qs(i, r, it); end; begin qs(1, count, item); end; begin Assign(testfile, 'c:mass.txt'); Reset(testfile); t := 1; while not Eof(testfile) do begin read(testfile, test[t]); t := t+1; end; t := t-2; QsString(test, t); for t2 := 1 to t do write(test[t2]); WriteLn; end. 2) program massiv; var b:array[1..10,1..5] of integer; c:array[1..10,1..5] of real; x:array[1..10] of real; i,j:byte; A,max:real; begin randomize; {ввод матрицы В} for i:=1 to 10 do for j:=1 to 5 do b[i,j]:=-2+random(9); a:=4; {формирование матрицы С} for i:=1 to 10 do for j:=1 to 5 do c[i,j]:=b[i,j]-a/(3+b[i,j]); {формирование вектора D} for i:=1 to 10 do for j:=1 to 5 do begin if c[i,j]>0 then x[i]:=x[i]+c[i,j]; end; {вывод вектора D} writeln('matrix d'); for i:=1 to 10 do begin write(x[i]); writeln; end; {поиск максимального значения} max:=x[1]; for i:=2 to 10 do if x[i]>max then max:=x[i]; writeln('max= ',max); readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, DaImeR! Решение обеих задач с пояснениями в приложении. Вы действительно много намудрили, я даже разбираться не стал, привожу свое решение. В первой задаче массив дней недели взял по их количеству, т .к. сортировать 80 повторяющихся названий никчему. Во второй задаче у Вас, извините тоже сумбур. Направление мысли верное, но реализация никуда. Продолжайте постигать Паскаль дальше. Удачи! Приложение: Задача 1. uses crt; const n=7; var dw:array[1..n]of string; {дни недели} i,j:integer; s:string; {буфер при сортировке} begin clrscr; writeln('Vvedite nazvania dnej nedeli:'); for i:=1 to n do begin readln(dw[i]); end; for i:=1 to n-1 do for j:=1 to n-1 do if dw[j]>dw[j+1] then {сортируем по убыванию, т.е. по алфавиту} begin s:=dw[j];dw[j]:=dw[j+1];dw[j+1]:=s; end; writeln; writeln('Po alfavitu:'); for i:=1 to n do write(dw[i],' '); readln end. Задача 2. uses crt; const n=5; m=6; var b,c:array[1..n,1..m]of real; d:array[1..n]of real; i,j,k:integer; a,sum,max:real; begin clrscr; randomize; write('a=');readln(a); {создаем исходную матрицу} writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin b[i,j]:=random(10)+random-4; write(b[i,j]:7:2); end; writeln; end; readln; {создаем матрицу С по условию} writeln('Matrica C:'); for i:=1 to n do begin for j:=1 to m do begin c[i,j]:=(b[i,j]-a)/(3+b[i,j]); write(c[i,j]:7:2); end; writeln; end; readln; {создаем вектор D и находим в нем максимум} max:=0; for i:=1 to n do begin sum:=0; for j:=1 to m do if c[i,j]>0 then begin sum:=sum+c[i,j]; end; d[i]:=sum; if d[i]>max then max:=d[i]; end; writeln('Vektor D:'); for i:=1 to n do write(d[i]:7:2); writeln; writeln('max=',max:5:2); readln; end.

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

Вопрос № 133.295

Помогите, сррочно нужно написать программу в Pascal: дан целочисленный файл D. Сформировать файл R, компоненты которого квадраты элементов файла D

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Stormy skY! Решение вашей задачи с комментаоиями в приложении. Для начала нужно создать текстовый файл, заполненный целыми числами, введенными через пробел. Присвоить этому файлу имя и сохранить, лучше в той же директории, что и программа. После выполнения программы в этой директории будет создан новый файл, с квадратами чисел и exe-файл. После этого вы можете менять данные в исходном файле, сохранять, а затем с помощью exe-файла вносить соответствующие изменения в новый файл. Приложение: 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.

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

© 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