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

Выпуск № 583
от 24.02.2008, 08:05

Вопрос № 123.629

2.1. Составить программу, позволяющую в тексте, введенном с клавиатуры, расставить запятые между словами: Бейсик Фортран Паскаль Си. Вывести результат на экран 2.2 Ввести с клавиатуры текст, содержащей не более 50 символов, внутри которого должны быть цифры. Подсчитать количество цифр, входящих в данную строку. Переписать их в новую переменную. Вновь образованное число увеличить на 10. Вывести на экран исходную строку, количество цифр, входящих в данную строку, вновь образованное число, результат вычислений. 3. Написать программу с использованием переменных типа запись с полями, указанными в задании 5. Вывести информацию о указанном в условии товаре.

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

Отвечает: Шемет Станіслав Васильович Здравствуйте, Дудус Владимир Викторович! Var S,ss:string; i:integer; begin Readln(s); for i:=1 to length(s) do if s[i]<> #32 then ss:=ss+s[i] else Begin if ss<>'' then ss:=ss+', '; Write(ss); ss:=''; end; if ss<>'' then Writeln(ss); REadln; end. Var s,ss:string[50]; l:longint; i:integer; Count:byte; begin Readln(s); ss:=''; for i:=1 to length(s) do if s[i] in ['0'..'9'] then begin inc(count); ss:=ss+s[i]; end; Val(ss,l,i); l:=l+10; Writeln(s); Writeln(count); Writeln(l); Readln; end; --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 4-ый класс) Ответ отправлен: 18.02.2008, 10:26

Отвечает: Артём1983 Здравствуйте, Дудус Владимир Викторович! Смотрите код программ в приложении. Не ответил только на третьй вопрос так как не знаю название полей. Приложение: {123629_1} uses crt; var s:string; i:integer; begin clrscr; write('введите строку = '); readln(s); for i:=1to length(s)do begin if s[i]=' ' then begin delete(s,i,1); insert(',',s,i); end; end; writeln(s); readln; end. {123629_2} uses crt; type numbers = set of '0'..'9'; var i,k,common,tmp:longint; n:numbers; s:string[50]; code,z:integer; begin clrscr; n:=['0'..'9']; k:=1; z:=0; write('введите предложение = '); readln(s); for i:=length(s)downto 1do begin if s[i]in n then begin val(s[i],tmp,code); common:=common+tmp*k; k:=k*10; inc(z); end; end; writeln('строка ----------- ',s); writeln('количество чисел - ',z); writeln('число ------------ ',common); writeln('число + 10 ------- ',common+10); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 18.02.2008, 18:51

Вопрос № 123.669

Здравствуйте! Помогите мне, пожалуйста, решить задачи на Паскале: 1) Дан двумерный массив. Поменять местами первую и последнюю строки данного массива. 2) Дана строка. Вывести на экран первое слово данной строки. Мне преподаватель дал эти задачи и сказал, чтобы я их решил, а сам ничего объяснять не хочет, как я его ни просил об этом. Сам я первый раз вижу такие задачи. Люди добрые, помогите, пожалуйста, мне их решить, буду ОЧЕНЬ благодарен! Заранее спасибо за помощь!

Отправлен: 18.02.2008, 13:35 Вопрос задал: Красильников И.П. (статус: 10-ый класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Красильников И.П.! Программы в приложении. Удачи! Приложение: program q123669; const n=8; var a:array[1..n,1..n]of integer; b,c:integer; e:set of char; f:string; begin {задача I } randomize; {формируем матрицу} for b:=1 to n do begin for c:=1 to n do begin a[b,c]:=random(99); write(a[b,c]:3); end; writeln; end; {переставляем} for b:=1 to n do begin c:=a[1,b]; a[1,b]:=a[n,b]; a[n,b]:=c; end; {выводим результат} writeln; writeln; for b:=1 to n do begin for c:=1 to n do write(a[b,c]:3); writeln; end; {эадача II } e:=['A'..'Z','a'..'z','А'..'п','р'..'я']; {вводим строку} write('Enter :'); readln(f); {первый элемент} b:=1; {пропускаем пробелы и т.д. в начале строки} while not(f[b]in e)do begin inc(b); end; {выводим первое слово} while f[b]in e do begin write(f[b]); inc(b); end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Boriss Здравствуйте, Красильников И.П.! В приложении решения этих простых задач с краткими комментариями. Если что не понятно будет - спрашивайте в минифоруме Приложение: {======== Первая ==============} {Самое лучшее и простое решение - объявить новый тип переменной = строка. Если этого не делать - будет чуть-чуть посложнее} const cols = 15; rows = 5; TYPE TRow = array[1..cols] of Integer; {Это и есть объявление} VAR Ar: array [1..rows] of TRow; {Теперь массив - это одномерный массив новых переменных = строк} buf: TRow; {Нужен будет для обмены} i, j: Integer; BEGIN WriteLn; {Заполнение случайными числами} for i:=1 to rows do for j:=1 to cols do Ar[i, j]:= random(200); {Показ} for i:=1 to rows do begin for j:=1 to cols do Write(Ar[i, j]:5); WriteLn end; WriteLn; {Меняем местами как простые переменные} buf := Ar[1]; Ar[1] := Ar[rows]; Ar[rows] := buf; {Показ} for i:=1 to rows do begin for j:=1 to cols do Write(Ar[i, j]:5); WriteLn end; END. {========== Вторая ============} {Тоже лучшее решение, если объявить множество допустимых символов} CONST S : String = ' первое asfhk ASD все, что угодно'; {Это исходная строка - заполните своей или с помощью ReadLn(s); введите с клавиатуры} chars: Set of char = ['A'..'z', 'А'..'п','р'..'я']; {так объявляется множество символов. Там, где многоточия - все подряд. В русских буквах есть разрыв между п и р} VAR i: Integer; BEGIN i:=1; while (not (s[i] in chars)) and (i <= Length(s)) do i:=i+1; {Пропускаем символы, которые не являются буквами} while (s[i] in chars) and (i<=Length(s)) do begin write(s[i]); i:=i+1 end; WriteLn; END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск Факультет Электронной Техники WWW: Программирование на Паскале ---- Ответ отправлен: 18.02.2008, 14:50 Оценка за ответ: 5 Комментарий оценки: ОГРОМНОЕ спасибо за помощь! У меня остался один маленький вопросик: я не совсем понял, как написана эта строка: i:=1; while (not (s[i] in chars)) and (i <= Length(s)) do i:=i+1; {Пропускаем символы, которые не являются буквами} Что значит "(not (s[i] in chars)) and (i <= Length(s)) do i:=i+1", почему именно так, расскажите, пожалуйста, поподробнее ?

Отвечает: Шемет Станіслав Васильович Здравствуйте, Красильников И.П.! const n=10; m=10; Var M:array[1..n,1..m] of integer; I,j:integer; s,ss:string; Procedure One; Begin for j:=1 to n do begin i:=m[j,1]; m[j,1]:=m[j,m]; m[j,m]:=i; end; end; Procedure Two; begin readln(s); for i:=1 to length(s) do if s[i]<>#32 then ss:=ss+s[i] else Writeln(ss); Readln; end; begin one; two; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 4-ый класс) Ответ отправлен: 18.02.2008, 15:19 Оценка за ответ: 5 Комментарий оценки: Благодарю!

Отвечает: Артём1983 Здравствуйте, Красильников И.П.! Смотрите код программ в приложении. Приложение: {123669_1} uses crt; const r = 10; type vector = array[1..r] of integer; matrix = array[1..r] of vector; var m:matrix; i,j:integer; swp:vector; begin clrscr; randomize; for i:=1to r do begin for j:=1to r do begin m[i,j]:=1+random(10); if j=r then writeln(m[i,j]:3) else write(m[i,j]:3); end; end; swp:=m[1]; m[1]:=m[r]; m[r]:=swp; writeln('==============================='); for i:=1to r do begin for j:=1to r do begin if j=r then writeln(m[i,j]:3) else write(m[i,j]:3); end; end; readln; end. {123669_2} uses crt; var first_word,s:string; i:integer; begin clrscr; write('введите строку = '); readln(s); for i:=1to length(s)do begin if s[i]=' ' then break; first_word:=first_word+s[i]; end; write(first_word); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 18.02.2008, 20:02 Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 123.693

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

Отправлен: 18.02.2008, 16:36 Вопрос задал: Дебелов Владимир Валентинович (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Дебелов Владимир Валентинович! Программа в приложении. Удачи! Приложение: uses crt; const N = 10; type mas=array [1..N] of integer; var a:mas; procedure vvod; var i:integer; begin WriteLn('Vvedite ',N,' chisel:'); for i := 1 to N do ReadLn(a[i]); WriteLn; end; procedure readmasfromfile(filename:string); var i:integer; f : text; begin Assign(f,filename); Reset(f); for i := 1 to N do ReadLn(f, a[i]); Close(f); end; procedure writemastofile(filename:string); var i:integer; f : text; begin Assign(f,filename); ReWrite(f); for i := 1 to N do writeLn(f, a[i]); Close(f); end; procedure writemas; var i:integer; begin for i:=1 to N do writeLn(a[i]); end; function findmin(k:integer):integer; var i, min : integer; begin min := k; for i := k+1 to N do if a[i] < a[min] then min := i; findmin := min; end; procedure change(var a,b:integer); var t : integer; begin t := a; a := b; b := t; end; procedure sort; var i:integer; begin for i := 1 to N -1 do change(a[findmin(i)],a[i]); end; var filename : string; begin clrscr; writeln; vvod; WriteLn('Vvedite imya fajla:'); ReadLn(filename); writemastofile(filename); Readln; readmasfromfile(filename); sort; writemas; ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 18.02.2008, 17:37 Оценка за ответ: 5 Комментарий оценки: спасибо вам большое только вот я сам писал програмку к одной задачке и у меня ошибка вроде в таком месте где не должно бы было быть вы не поможете мне её исправить ? program primer102; var x,c,d,b,q:real; procedure fpr (x,c,d,b:real;var z:real); begin z:=(exp(x)*abs(c-d))/ln(b); end; begin writeln (\\\\\\\'ўўҐбвЁ x,c,d,b\\\\\\\'); readln(x,c,d,b); z:= fpr(x,c,d,b); writeln(\\\\\\\'z\\\\\\\', z:7:3); end. текст задачи 2) Вычислить значение функции, исходные данные ввести с клавиатуры. Написать программу, в которой задача вычисления функции оформлена через: а) FUNCTION ; б)PROCEDURE ; Q= (экспонента^x * модуль(c-d)) / ln(b)

Отвечает: Артём1983 Здравствуйте, Дебелов Владимир Валентинович! Смотрите код программы в приложении. Приложение: {123693} uses crt; const n=10; var f:text; counter,i,tmp:integer; a:array[1..n]of integer; begin clrscr; assign(f,'number.txt'); rewrite(f); for i:=1to n do begin write('введите число номер ',i,' = '); readln(tmp); writeln(f,tmp); end; close(f); reset(f); for i:=1to n do begin readln(f,tmp); a[i]:=tmp; end; close(f); while counter<n-1 do begin counter:=0; for i:=1to n-1 do begin if a[i]>a[i+1] then begin tmp:=a[i]; a[i]:=a[i+1]; a[i+1]:=tmp; end else inc(counter); end; end; for i:=1to n do write(a[i]:3); readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 9-ый класс) Ответ отправлен: 18.02.2008, 20:00 Оценка за ответ: 5 Комментарий оценки: спасибо вам большое только вот я сам писал програмку к одной задачке и у меня ошибка вроде в таком месте где не должно бы было быть вы не поможете мне её исправить ? program primer102; var x,c,d,b,q:real; procedure fpr (x,c,d,b:real;var z:real); begin z:=(exp(x)*abs(c-d))/ln(b); end; begin writeln (\'ўўҐбвЁ x,c,d,b\'); readln(x,c,d,b); z:= fpr(x,c,d,b); writeln(\'z\', z:7:3); end. текст задачи 2) Вычислить значение функции, исходные данные ввести с клавиатуры. Написать программу, в которой задача вычисления функции оформлена через: а) FUNCTION ; б)PROCEDURE ; Q= (экспонента^x * модуль(c-d)) / ln(b)

Отвечает: Шемет Станіслав Васильович Здравствуйте, Дебелов Владимир Валентинович! const n=100(*Максимальное количество елементов в файле*); Var m:array[1..n] of integer; X,i,j:integer; b:boolean; f:text; begin assign(f,'d:1.txt'); Rewrite(f); Readln(x); for i:=1 to x do begin readln(j); Writeln(f,j); end; i:=1; Reset(f); Repeat Readln(f,j); m[i]:=j; inc(i); until eof(f); close(f); if x<=n then Repeat b:=true; for i:=1 to x-1 do if m[i]<m[i+1] then begin j:=m[i]; m[i]:=m[i+1]; m[i+1]:=j; b:=false; end; until b; for i:=1 to x do write(m[i],' ',); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 4-ый класс) Ответ отправлен: 18.02.2008, 21:20 Оценка за ответ: 5 Комментарий оценки: спасибо большое програма классная я вот сам одну писал а где то ошибку сделал и ни как не пойму, не могли бы посмотреть? program primer102; var x,c,d,b,q:real; procedure fpr (x,c,d,b:real;var z:real); begin z:=(exp(x)*abs(c-d))/ln(b); end; begin writeln (\'ўўҐбвЁ x,c,d,b\'); readln(x,c,d,b); z:= fpr(x,c,d,b); writeln(\'z\', z:7:3); end.

Вопрос № 123.753

Помогите пожалуйста решить задачи по паскалю! 1)В равнобедренном прямоугольном треугольнике известна высота h опущенная на гипотенузу.Найти стороны треугольника. 2)Даны три числа.Возвести в квадрат те из них, значения которых неотрицательны. 3)Составить программу для вычисления площади одной из трех фигур - квадрата, круга или равно стороннего треугольника по значению X интерпретируемому как сторона квадрата,радиус окружности или сторона треугольника. 4)Составить таблицу стоимости порций сыра весом 50,100,150, ... ,1000 грамм.Стоимоть сыра - вводимая величина. 5)Определить имеются ли среди чисел cos(i3)sin(i4n). i=1.2, ... , n меньше 0.0001 6)Задан массив b1, b2, b3, ... bn. Все элементы, равные 7 заменить единицей и подсчитать количество таких элементов. 7)Осуществить центрирование массива: от каждого из заданных m чисел X1 X2 ... Xm отнять их среднее арифметическое и результаты разместить на месте исходных данных. 8)Дана матрица вещественных чисел размером N на M. Найти среднее арифметическое каждого из столбцев матрицы, имеющих четные номера. 9)В заданном тексте удалить часть текста, заключеную в скобки (вместе со скобками). 10)Дан текст.Выяснить,является ли этот текст идентификатором.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Сухарев Дмитрий Владимирович! В приложении первая, вторая, третья, четвертая и девятая задачи. Удачи! Приложение: =========================================== Первая задача =========================================== var h : integer; begin WriteLn('Vvedite h:'); ReadLn(h); WriteLn('Gipotenuza: ',2*h); WriteLn('Storony: ', h*sqrt(2)); ReadLn; end. =========================================== Вторая задача =========================================== var a,b,c : real; begin WriteLn('Vvedite a:'); ReadLn(a); WriteLn('Vvedite b:'); ReadLn(b); WriteLn('Vvedite c:'); ReadLn(c); WriteLn; if a > 0 then WriteLn('a^2=' a*a); if b > 0 then WriteLn('b^2=' b*b); if c > 0 then WriteLn('c^2=' c*c); ReadLn; end. =========================================== Третья задача =========================================== var x : real; begin WriteLn('Vvedite X:'); ReadLn(x); WriteLn('S kvadrata: ', x*x:5:2); WriteLn('S kruga: ', pi*x*x/2:5:2); WriteLN('S ravnostoronnego treugolnika: ', sqrt(3)/4*sqr(x):5:2); readln; end. =========================================== Четвертая задача =========================================== var i : integer; cost : real; begin WriteLn('Vvedite cenu (za 1 kg):'); ReadLn(cost); for i := 1 to 20 do WriteLn(i*50,' gramm - ',i*50*cost/1000:5:2); ReadLn; end. =========================================== Девятая задача =========================================== var s : string; begin WriteLn('Input:'); ReadLn(s); delete(s, pos('(',s), pos(')',s)-pos('(',s)+1); WriteLn(s); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 18.02.2008, 23:06

Отвечает: Шемет Станіслав Васильович !!! Здравствуйте, Сухарев Дмитрий Владимирович! Программы в приложении. 1. Ответ переведен на русский язык. 2. Половина задач решена неверно. 3. Код перемещен в приложение (занимал два экрана). ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 19.02.2008, 22:36 Приложение: Var H:real; begin Readln(h); Writeln(h*sqrt(3)/2); !!!! рассчитывается какая-то странная величина, причем одна. Хотя у треугольника надо считать две: сторону и гипотенузу. readln; end. var A,b,c:integer; begin Readln(a,b,c); if a>= 0 then a:=a*a; if B>=0 then b:=b*b; if c>=0 then c:=c*c; Writeln(a,' ',b,' ',c); Readln; end. VAr x:integer; i,j,z:real; Procedure one; begin readln(i,j); Writeln('Площадь квадрата ', i*j); end; Procedure two; begin readln(j); Writeln('Площадь круга ',pi*j*j); !!!! неверная формула. Площадь круга = PI*j*j/2 end; Procedure Three; begin readln(j); writeln ('Площадь треугольника: ',j*j*sqrt(3)/4); end; Begin Readln(x); Case x of 1:one; 2:two; 3:three; end; end. const n=50; Var y:real; x:integer; begin x:=0; write('Стоимость сыра'); readln(y); repeat inc(x,n); Writeln(x,' грамм ',' = ',x*y); until x>=1000; readln; end. const n=34; Var M:array[1..n] of integer; count:integer; begin count:=0; Randomize; for i:=1 to n do m[i]:=random(12345); for i:=1 to n do if m[i]=7 then begin m[i]:=1; inc(count); end; Writeln(count); readln; end. const n=25; m=25; var J,i:intger; Ser:integer; begin i:=n div 2; For i:=i downto 1 do begin ser:=0; for j:=1 to m do ser:=m[i,j]+ser; !!!! M - и константа и необъявленный (!) массив Writeln(ser / m); end; readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 4-ый класс) Ответ отправлен: 19.02.2008, 00:04

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