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

Выпуск № 618
от 31.03.2008, 02:35

Вопрос № 128.969

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

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимомовна! Код в приложении.Текстовую часть типа "Направо пойдешь-коня потеряешь" сами заполните. Остальное вроде все ясно. Приложение: uses crt; var s:string; begin clrscr; write('vvedite napravlenie:'); readln(s); if s='rigth' then write('111') else if s='left'then write('222') else if s='noword' then write('235') else writeln('neverno'); readln end.

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

Вопрос № 128.970

С клавиатуры задается строка,требуется преобразовать эту строку так,чтобы в ней остались только буквы.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Лиманская Юлия Вадимовна! Программа в приложении. Удачи! Приложение: const letters = ['a'..'z','A'..'Z']; var s, s1 : string; i : integer; begin WriteLn('Vvedite stroku: '); ReadLn(s); WriteLn; s1 := ''; for i := 1 to length(s) do if s[i] in letters then s1 := s1 + s[i]; WriteLn(s1); ReadLn; end.

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

Отвечает: Coupler Здравствуйте, Лиманская Юлия Вадимовна! Программа в приложении. Приложение: var alpha: set of char; s:string; i:integer; begin alpha:= ['a'..'z', 'A'..'Z', 'а'..'я','А'..'Я']; writeln ('Vvedite stroku'); readln (s); i:=1; while (i<=length (s)) do if not(s[i] in alpha) then delete (s, i,1) else inc (i); writeln (s); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 25.03.2008, 11:35

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Код в приложении, вроде ничего сложного. Приложение: program q128970; uses crt; const c=['a'..'z','A'..'Z','А'..'п','р'..'ё']; var s,s1:string; i,j:integer; begin clrscr; Write('s: ');readln(s); for i:=length(s) downto 1 do {udal nenugn znaki} begin if not (s[i] in c) then delete(s,i,1); end; writeln(s); readln end.

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

Вопрос № 128.971

Подсчитать в предложении количество слов,начинающихся с прописной буквы.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Лиманская Юлия Вадимовна! Программа в приложении. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; const symbols = ',:;.!?'; { znaki prepinaniya } letters = ['A'..'Z']; var s, s1 : string; i, c : integer; begin WriteLn('Vvedite stroku:'); ReadLn(s); WriteLn; if trim(s) <> '' then begin { change all symbols to spaces } for i := 1 to length(s) do if (pos(copy(s,i,1),symbols)>0) then begin insert(' ',s,i); delete(s,i+1,1); end; {delete double spaces} s := Trim(s); While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); s := ' ' + s; c := 0; while pos(' ',s)>0 do begin if s[pos(' ',s)+1] in letters then inc(c); delete(s,pos(' ',s),1); end; WriteLn(c); end; ReadLn; end.

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

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Лиманская Юлия Вадимовна! Код в приложении, тоже все понятно. Неверное толкование термина "прописные буквы". Прописные - ято большие буквы. (см. тут) ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 25.03.2008, 20:52 Приложение: program q128971; uses crt; const c=['a'..'z','а'..'п','р'..'ё']; var s,s1:string; i,j:integer; begin clrscr; Write('s: ');readln(s); s:=' '+s; j:=0; for i:=2 to length(s) do if (s[i] in c)and(s[i-1]=' ') then begin j:=j+1; end; writeln('kol-vo slov=',j); readln end.

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

Отвечает: Кудинов Антон Павлович !!! Здравствуйте, Лиманская Юлия Вадимовна! Смотрите в примере 1) Не определена переменная result (integer) 2) Необходимо заменить if length(p>0) then if p[1] на if length(s)>0 then if s[1] 3) Прописные буквы - это большие (см. тут) ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 25.03.2008, 20:54 Приложение: function small_cap_word_count(s:string):integer; var p:integer; begin result:=0; repeat p:=pos(' ',s); if p=0 then exit; delete(s,1,p); if length(p>0) then if p[1] in ['a'..'z','а'..'я'] then inc(result); until p=0; end;

Ответ отправил: Кудинов Антон Павлович (статус: 3-ий класс) Ответ отправлен: 25.03.2008, 19:52

Вопрос № 129.016

Здравствуйте уважаемые эксперты. Помогите пожалуйста в решении вопроса № 129014 Задачка на системы счисления: даны два натуральных числа D и N (2<=n<=16) Организовать перевод целого десятичного числа D в N-ичную систему счисления. Решение неоюходимо на Basic или Pascal Заранее благодарю. Добавлен текст вопроса. ----- ∙ Отредактировал: Admiral (Профессор) ∙ Дата редактирования: 25.03.2008, 16:37

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Lommm! Программа в приложении. вопросы по ней задавайте в мини-форум. Удачи! Приложение: var d,n:word; s:string; begin write('D:');readln(d); repeat write('N:');readln(n); until (n>1)and(n<17); s:=''; while d>0 do begin s:=chr((d mod n)+48+7*ord((d mod n)>9))+s; d:=d div n; end; writeln(s); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 129.023

Помогите пожалуйста решить задачку. Организовать файл целых чисел из N компонент. Выполнить сортировку файла по возрастанию. Вывести содержимое файла до обработки, и после обработки.

Отправлен: 25.03.2008, 17:15 Вопрос задала: Ahmadullina Mila Raufovna (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Ahmadullina Mila Raufovna! Программа в приложении. В приложенном файле программа и файл-пример. Удачи! Приложение: uses crt; const N = 5; type mas=array [1..10] of integer; var a:mas; fname : string; procedure vvod; var i:integer; f : text; begin Assign(f, fname); Reset(f); for i:=1 to N do read(f, a[i]); Close(f); end; procedure vyvod; var i:integer; begin for i:=1 to N do write(a[i]:5); 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 savefile; var i:integer; f : text; begin Assign(f, fname); Reset(f); for i:=1 to N do WriteLn(f, a[i]); Close(f); end; procedure sort; var i:integer; begin for i := 1 to N-1 do change(a[findmin(i)],a[i]); end; begin randomize; clrscr; writeln; fname := 'example.txt'; vvod; vyvod; writeln; sort; vyvod; savefile; { save a[] to file} ReadLn; end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ahmadullina Mila Raufovna! Решение задачи в приложениии. Для хранения информации использовал типизированный файл. Приложение: uses crt; const n=10; var f:file of integer; a:array[1..n]of integer; i,j,z:integer; begin clrscr; randomize; Assign(f,'text1'); rewrite(f); for i:=1 to n do begin a[i]:=random(20)+1; write(f,a[i]); end; close(f); reset(f); writeln('File do obrabotki:'); while not eof(f) do begin read(f,a[i]); end; for i:=1 to n do write(a[i],' '); writeln; for i:=1 to n-1 do for j:=1 to n-1 do if a[j]>a[j+1] then begin z:=a[j];a[j]:=a[j+1];a[j+1]:=z; end; writeln; rewrite(f); for i:=1 to n do begin write(f,a[i]); end; close(f); reset(f); writeln('File posle obrabotki:'); while not eof(f)do begin read(f,a[i]); end; for i:=1 to n do write(a[i],' '); close(f); readln end.

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

Вопрос № 129.043

Уважаемые эксперты! Помогите решить задачу: В каждом парном слове предложения (на русском языке) поменять местами буквы "О" и "А", "К и "Л" соответственно.

Отправлен: 25.03.2008, 19:11 Вопрос задал: Щербаков Евгений Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Щербаков Евгений Николаевич! Программа в приложении. Удачи! Приложение: function Trim(const S: string): string; var I, L: Integer; res : string; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); if I > L then res := '' else begin while S[L] <= ' ' do Dec(L); Res := Copy(S, I, L - I + 1); end; Trim := res; end; Function CountWords(s : String) : Integer; var res : integer; begin res := 0; s := Trim(s); While pos(' ',s)>0 do begin s := copy(s, pos(' ',s)+1, Length(s) - pos(' ', s)); s := Trim(s); inc(res) end; CountWords := res+1; End; Function GetWord(s : String; i : Integer) : String; var s1 : string; k : integer; begin s1 := s; For k := 1 To i - 1 do s1 := copy(s1, pos(' ',s1)+1, Length(s1) - pos(' ', s1)); If pos(' ', s1) > 0 Then GetWord := copy(s1, 1, pos(' ',s1) - 1) Else GetWord := Trim(s1); End; function change(word:string;a,b:integer):string; var ch : char; begin ch := word[a]; word[a] := word[b]; word[b] := ch; change := word; end; const symbols = ',.:!?;'; { znaki prepinaniya } var s, s1, word : string; i : integer; begin WriteLn('Vvedite predlozhenie:'); ReadLn(s); { change all symbols to spaces } for i := 1 to length(s) do if (pos(copy(s,i,1),symbols)>0) then begin insert(' ',s,i); delete(s,i+1,1); end; While pos(' ', s) > 0 do delete(s, pos(' ',s), 1); s1 := ''; for i := 1 to countwords(s) do begin word := getword(s,i); { WriteLn('i=',i,' word= ',word);} if i mod 2 = 0 then begin if (pos('О', word)>0)and(pos('А',word)>0) then word := change(word,pos('О',word),pos('А',word)); if (pos('К', word)>0)and(pos('L',word)>0) then word := change(word,pos('К',word),pos('Л',word)); end; s1 := s1 + ' ' + word; end; Writeln(trim(s1)); ReadLn; end.

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

Вопрос № 129.067

1.Создать файл данных, каждая запись которого состоит из следующих полей: Поля записи Название книги Автор Год издания Кол. страниц 2. Считать из файла информацию, указанную преподавателем, или предложить свою версию для считывания информации.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, VanekP89! Что-то зачастили одинаковые задачи, но отвечать-то надо. По сравнению с предыдущими я изменил условия поиска. Код с комментариями в приложении. Орфография ----- ∙ Отредактировал: Виктор Пырлик (Профессионал) ∙ Дата редактирования: 26.03.2008, 03:49 Приложение: program knigi; uses crt; const n=5; type kniga=record {тип запись} avtor:string[20]; god:integer; str:integer; end; kn=array[1..n]of kniga; {массив записей} var sp:kn; i,j:integer; f:file of kniga; {типизированный файл запмсей} begin clrscr; for i:=1 to n do {вводим данные по условию} begin write('avtor: ');readln(sp[i].avtor); write('god: ');readln(sp[i].god); write('str: ');readln(sp[i].str); end; assign(f,'kniga.txt'); rewrite(f); for i:=1 to n do begin write(f,sp[i]); {записываем их в файл} end; close(f); reset(f); i:=1; while (not eof(f)) and(i<=n) do begin read(f,sp[i]); {считываем данные из файла в массив} inc(i); end; writeln; writeln('Spisok knig >100 str, fam avtora na A:');{выводим список книг в кот. >100 стр} for i:=1 to n do {и фамилия автора начинается на А} if (sp[i].avtor[1]='A')and(sp[i].str>100) then begin writeln(sp[i].avtor,' ',sp[i].god,' god ',sp[i].str,' str'); end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 25.03.2008, 22:44 Оценка за ответ: 5 Комментарий оценки: Спасоби огр!!!!! а насчет того что "зачастили" - наверно препод один и тот же!! но все равно спасибки)))

Вопрос № 129.081

Уважаеме эксперты, помогите решить ещё одну задачку. Вычислить значения переменных F и G, выявив предварительно подобные по схеме вычисления. F = b^(1+a) + b^(1+a+a^2) +b^(1+a^2+a^3) - a^(1+b) - a^(1+b+b^2) - a^(1+b^2+b^3) G = 2^3 + 2^7 + 2^13 Заранее спасибо!

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

Отвечает: Verena Здравствуйте, Dreamss! По сути задача сводится к определению функции, возвращающей число возведённое в степень (если, конечно, не задумываться о создании неуниверсальной функции, наиболее оптимально выполняющей действия, близкие к заданным в формуле). Буду считать, что речь идёт о целых числах и положительных степенях (вычисление дробной степени будет несколько иным, а вот для отрицательных степеней при необходимости легко внести изменения - результатом будет единица, делённая на число в модуле степени). Реализуем вот такую функцию: function Pow (a: integer; st: integer): longint; Касательно самой формулы: её можно вычислить "в лоб", т.е. просто прописав везде функцию Pow с необходимыми аргументами, или можно проанализировать преемственность степеней и сохранять промежуточные состояния. Например, для F этот вариант мог бы выглядеть так: b1 = b^(1+a); b2 = b1*b^(a^2); a1 = a^(1+b); a2 = a1*a^(b^2); F = b1 + b2+b^(1+a^2+a^3) - a1 - a2 - a^(1+b^2+b^3) А для G так: a1 = 2^3; a2 = a1*2^4; G = a1+a2+a2*2^6 Но это я оставляю на Ваше усмотрение. Реализация функции Pow и пример расчёта формул напрямую - в приложении. Удачи! Приложение: Var f, g: longint; a, b: integer; function Pow (a: integer; st: integer): longint; //Функция нахождения целой положительной степени целого числа Var i: integer; pw: longint; Begin pw:= a; if (st=0) then pw:=1; //Число в нулевой степени равно 1 for i:=1 to st do //В цикле до степени pw:= pw*a; //Домножаем на число Pow:= pw; //Возвращаем рещультат end; Begin readln (a, b); //Считываем данные f:= Pow (b, a+1) + Pow (b, 1+a+Pow(a, 2)) + Pow (b, 1+Pow(a, 2)+Pow(a, 3)); //Считаем по формулам f:= f- Pow (a, 1+b) - Pow (a, 1+b+Pow(b, 2)) - Pow (a, 1+Pow(b, 2)+Pow(b, 3)); g:= Pow (2, 3)+Pow (2, 7)+Pow (2, 13); writeln ('F = ', f); //Выводим результат writeln ('G = ', g); end; --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 26.03.2008, 01:09 Оценка за ответ: 5 Комментарий оценки: Большое спасибо, Verena! Очень помогли.

Вопрос № 129.082

Дано натуральное число k. Вывести на экран k-ю цифру последовательности Фибоначчи. Входящие даные Число k. Исходящие даные Единственная цифра, которая стоит на k-ой позиции последовательности. Ограничения: 1 <= K <= 907.

Отправлен: 25.03.2008, 23:34 Вопрос задал: ПАВЛО (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Пупорев Юрий Борисович Здравствуйте, ПАВЛО! Код программы с комментариями в приложении. Не советую проверять при к=907, или около этого. Результат ждать придется очень долго, сколько не знаю, т.к. не дождался. Очень медленно Паскаль считает числа Фибоначчи. Отредактировано по просьбе эксперта. Программа работает верно. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 26.03.2008, 19:38 Приложение: program NomFib; uses crt; var k,i,s,b,c,n,a:longint; function Fib(i:integer):longint; begin if i<=2 then Fib:=1{функция определения чисел Фибоначчи} else Fib:=Fib(i-2)+Fib(i-1); end; begin clrscr; write('k=');readln(k);{номер цифры} writeln(‘Rjad:’); s:=0;i:=0; while s<k do begin i:=i+1; b:=Fib(i);{числа Фибоначчи } c:=1; n:=10; while b div n<>0 do begin n:=n*10; c:=c+1; {считаем сколько цифр в числе} end; s:=s+c; {считаем сколько цифр всего} write(b); end; s:=s-c; {возвращаемся назад, ищем нужную цифру} n:=n div 10; while s<>k do begin a:=b div n mod 10; n:=n div 10; s:=s+1; end; writeln; write(‘Zadannaia cifra=’,a); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 26.03.2008, 14:11 Оценка за ответ: 2

Отвечает: Marked One Здравствуйте, ПАВЛО! Код в приложении. Я воспользовался формулой для нахождения любого члена последовательности Фибоначчи: (a1^n-a2^n)/корень из 5, где a1=(1+корень из 5)/2, a2=(1-корень из 5)/2. Удачи!!! Приложение: function stepen(a:real; n:integer):real; {Функция для вычисления степени числа} var i:integer; result:real; begin result:=1; for i:=1 to n do result:=result*a; stepen:=result; end; Var k:integer; a1, a2, kn:real; begin write('Введите K: '); ReadLn(K); If (k>=1 and k<=907) then begin a1:=(1+sqrt(5))/2; a2:=(1-sqrt(5))/2; kn:=(stepen(a1, k)-stepen(a2, k))/sqrt(5); Writeln('Рез-тат: ', kn:0:0); readln(k); end else WriteLn('Ошибка! 1>K>907'); end.

Ответ отправил: Marked One (статус: 9-ый класс) Ответ отправлен: 26.03.2008, 16:23

Отвечает: Louken Здравствуйте, ПАВЛО! Раз Вам еще не предложили работающего варианта, я немного модифицировал свою программу из мини-форума. Теперь она находит то, что Вам нужно: Приложение: program z; uses Crt; var m,c,t: array[1..100] of byte; k,k1,k2,kt,r,i,s: integer; begin ClrScr; Write('k = '); Readln(k); m[1]:=1; k1:=1; c[1]:=0; k2:=1; Dec(k); r:=1; While k>0 do begin t:=m; kt:=k1; for i:=1 to k2 do begin s:=m[i]+c[i]; m[i]:=s mod 10; m[i+1]:=m[i+1]+s div 10; end; k1:=k2; if m[k1+1]>0 then Inc(k1); c:=t; k2:=kt; if k-k1<1 then r:=k1-k+1; k:=k-k1; end; Write('Result: ', m[r]); Readln; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 26.03.2008, 18:48 Оценка за ответ: 5

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