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

Выпуск № 407
от 22.06.2007, 14:05

Вопрос № 91.641

Даны действительные числа x1, y1, x2, y2, …, x10, y10. Найти периметр десятиугольника, вершины которого имеют соответственно координаты (x1, y1), (x2, y2), …, (x10, y10). (Определить функцию вычисления расстояния между двумя точками, заданными своими координатами).

Отправлен: 16.06.2007, 17:17 Вопрос задал: Туев Артём Николаевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Устинов С.Е. Здравствуйте, Туев Артём Николаевич! Код программы в приложении. Для вычисления расстояния между точками A(x1,y1) и B(x2,y2) нужно воспользоваться геометрической формулой: AB=√( (x2-x1)2+(y2-y1)2). Удачи! Приложение: const n=10; var fig:array['x'..'y',1..n] of real; i:integer; p:real; function rasst(t1,t2:integer):real; begin rasst:=sqrt( sqr(fig['x',t2] - fig['x',t1])+sqr(fig['y',t2] - fig['y',t1]) ); end; begin for i:=1 to n do begin writeln('Vvedite koordinaty ',i,'-oy vershini'); readln(fig['x',i],fig['y',i]); end; p:=0; for i:=1 to n-1 do p:=p+rasst(i,i+1); p:=p+rasst(1,n); writeln('Perimetr=',p:9:4); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 16.06.2007, 17:35 Оценка за ответ: 5

Отвечает: Louken Здравствуйте, Туев Артём Николаевич! Код смотрите в приложении. На выбор предлагается два способа заполнения массива координатами десятиугольника: 1) правильный десятиугольник; 2) десятиугольник с произвольными вершинами (он закоментирован); Выбирайте какой из способов Вам больше всего подойдет. Удачи. Приложение: program z1; uses Crt; function Distance(x1,y1,x2,y2: real): real; begin Distance:=sqrt(sqr(x2-x1)+sqr(y2-y1)); end; const k = 10; var i: integer; m: array[1..k,1..2] of real; p: real; begin ClrScr; Randomize; for i:=1 to k do begin m[i,1]:=cos(2*Pi/k*i)*10; m[i,2]:=sin(2*Pi/k*i)*10; { m[i,1]:=Random(20); m[i,2]:=Random(20);} Writeln('Tochka ¹',i:2,' s koordanatami (',m[i,1]:6:2,', ',m[i,2]:6:2,')'); end; p:=0; for i:=1 to k-1 do p:=p+Distance(m[i,1], m[i,2], m[i+1,1], m[i+1,2]); p:=p+Distance(m[1,1], m[1,2], m[k,1], m[k,2]); Writeln; Writeln('Perimetr = ',p:0:4); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 16.06.2007, 18:31 Оценка за ответ: 5

Вопрос № 91.659

Помогите: Пусть дан файл целых чисел. Выберите наибольшее из них, принадлежащее интервалу [a,b].Концы интервала a,b вводяться с клавиатуры.

Отправлен: 16.06.2007, 19:15 Вопрос задал: Артем Фурдыга (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Устинов С.Е. Здравствуйте, Артем Фурдыга! Решение задания в приложении. test.dat замените на имя данного Вам файла чисел. Удачи! Приложение: var f:file of integer; t,m,a,b:integer; begin writeln('Vvedite A,B:'); readln(a,b); assign(f,'test.dat'); reset(f); m:=a-1; while not(eof(f)) do begin read(f,t); if (t > =a) and (t < =b) and (t > m) then m:=t; end; if t=a-1 then writeln('Iz etogo intervala chisel net.') else writeln('Max=',m); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 16.06.2007, 19:39 Оценка за ответ: 5 Комментарий оценки: спасибо

Отвечает: Louken Здравствуйте, Артем Фурдыга! Код в приложении. Незабудьте создать файл 1.txt. Программа выдает искомое число, или же если оно не найдено, то выдает соответствующее сообщение. Приложение: program v91659; uses Crt; var f: text; a,b,max,n: integer; q: boolean; begin ClrScr; Write('Vvedite chislo a = '); Readln(a); Write('Vvedite chislo b = '); Readln(b); Assign(f, '1.txt'); Reset(f); max:=Low(max); {Или же, что одно и тоже: max:=-32768;} q:=false; While not Eof(f) do begin Read(f, n); if (n>=a) and (n<=b) and (n>max) then begin max:=n; q:=true; end; end; Close(f); if q then Writeln(max) else Writeln('Ne naideno ni odnogo chisla'); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 16.06.2007, 19:40 Оценка за ответ: 5 Комментарий оценки: спасибо

Отвечает: Gh0stik Здравствуйте, Артем Фурдыга! Для решение данной задачи можно воспользоваться вот таким кодом: var f:file of integer; a,b,i,t,mx:integer; fst:boolean; begin fst:=true; write('a=');readln(a); write('(a < b) b=');readln(b); {определяем границы интервала} assign(f,'integer.dat'); rewrite(f); { генерируем файл произвольным образом, при необходимости можете заминить своим блоком ввода данных, либо вообще исключить из программы} randomize; for i:=1 to 100 do begin t:=random(1000); write(f,t); end; reset(f); {непосредственно нахождение наибольшего из интервала} while not eof(f) do begin read(f,t); if (t >= a) and (t <= b) then if fst then begin mx:=t; fst:=false; end else if t>mx then mx:=t; end; if not fst then writeln('mx=',mx) else writeln('No maximum!!!'); {вывод результата} close(f); end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 16.06.2007, 19:40 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.660

Дан файл, содержащий текст на руском языке. Определить, сколько раз встречаеться в нем самое длинное слово.

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

Отвечает: Градов Юрий Михайлович Здравствуйте, Артем Фурдыга! Воспользуйтесь вот этим методом: Приложение: type WordInfo = Record Word: string; count: integer; end; var F: Text; Mass: array[1..1000] of string; i,j,n,max,p: integer; wi: WordInfo; s: string; begin ClrScr; Assign(F,'text.txt'); Reset(F); n:=0; While not Eof(F) do begin Inc(n); Readln(F,Mass[n]); Mass[n]:=Mass[n]+' '; end; Close(F); for i:=1 to n do begin s:=''; max:=0; for j:=1 to Length(Mass[i]) do begin if Mass[i][j]<>' ' then begin s:=s+Mass[i][j]; Inc(max); end else begin if max>wi.count then begin wi.Word:=s; wi.count:=max; end; s:=''; max:=0; end; end; end; max:=0; for i:=1 to n do begin s:=Mass[i]; While Pos(wi.Word,s)<>0 do begin p:=Pos(wi.Word,s); if p<>0 then begin Inc(max); for j:=p to p+Length(wi.Word) do s[j]:=' '; end; end; end; Writeln('Slovo :'); Writeln(wi.word); Write(' s max dlinoy ',wi.count); Write(' povtoryaetsya ',max); Write(' raz'); ReadKey; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 17.06.2007, 00:54 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.667

помогите: Имееться текстовый файл. Все четные строки этого файла записать во второй файл, а нечетные- в третий.рорядок следования строк сохранить.

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

Отвечает: Nazar__D Здравствуйте, Артем Фурдыга! Вот код программы. Помог, чем мог... :) Приложение: program abc; var f1, f2, f3: text; ch: char; i: integer; begin assign (f1, 'file1.txt'); assign (f2, 'file2.txt'); assign (f3, 'file3.txt'); reset(f1); rewrite(f2); rewrite(f3); i:=1; while not eof(f1) do begin{Проверка на конец файла} while not eoln(f1) do begin{Проверка на конец строки} read(f1, ch); if odd(i){Проверка на непарность} then write(f3, ch) else write(f2, ch); end; readln(f1); if odd(i) then writeln(f3){Переход на новою строку в файле} else writeln(f2);{Переход на новою строку в файле} i:=i+1; end; close(f1); close(f2); close(f3); readln; end. --------- Я - українець!

Ответ отправил: Nazar__D (статус: 2-ой класс) Ответ отправлен: 16.06.2007, 21:30

Отвечает: Градов Юрий Михайлович Здравствуйте, Артем Фурдыга! Посмотрите в приложении, может устроит. В папке с проектом должен быть файл Text.txt. Его можно создать в блокноте или копировать и переименовать проводником из любого текстового файла. Если Вам необходима процедура создания файла, пишите. [Сделана правка ответа, после исправления кода экспертом в мини-форуме.] [Edited by Gh0stik] Приложение: var F,F1,F2: Text; n: integer; s: string; begin Assign(F,'Test.text'); Reset(F); Assign(F1,'nechet.txt'); Rewrite(F1); Assign(F2,'chet.txt'); Rewrite(F2); n:=0; While not Eof(F) do begin Inc(n); Readln(F,s); if n mod 2 =0 then Writeln(F2,s) else Writeln(F1,s); end; Close(F); Close(F1); Close(F2); end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 16.06.2007, 21:38 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.668

помогите: пусть дан текст. Распечатайте те буквы, которые встречаются в каждом слове текста только один раз.

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

Отвечает: Градов Юрий Михайлович Здравствуйте, Артем Фурдыга! Посмотрите, пожалуйста, это решение: [Сделана правка ответа, после исправления кода экспертом в мини-форуме.] [Edited by Gh0stik] Приложение: var F: Text; i: integer; s,st: string; ws: set of Char; begin Assign(F,'Text1.txt'); Reset(F); While not Eof(f) do begin Readln(F,s); st:=''; for i:=1 to Length(s) do begin if not (s[i] in ws) and (s[i]<>' ') then begin if s[i]<>' ' then ws:=ws+[s[i]]; st:=st+s[i]; end else begin Write(st); st:=''; end; end; Writeln; end; Close(F); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 16.06.2007, 22:01

Вопрос № 91.669

Помогите: Пусть даны два файла целых чисел. Определить, равны ли они.

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

Отвечает: Устинов С.Е. Здравствуйте, Артем Фурдыга! Программа в приложении. Имена файлов с целыми числами замените на необходимые Вам. Для сравнения файлов придется сравнивать их соответствующие элементы, и если хоть одна пара элементов не совпадает - значит файлы разные. Удачи! Приложение: var f1,f2:file of integer; t1,t2:integer; ravn:boolean; begin assign(f1,'file1.int'); assign(f2,'file2.int'); reset(f1); reset(f2); ravn:=true; while (not(eof(f1))) and (not(eof(f2))) do begin read(f1,t1); read(f2,t2); if not(t1=t2) then ravn:=false; end; close(f1); close(f2); if (ravn) and (eof(f1)) and (eof(f2)) then writeln('ravny') else writeln('ne ravny'); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 16.06.2007, 21:59 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.695

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

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

Отвечает: Louken Здравствуйте, Артем Фурдыга! Решение в приложении: Приложение: program z1; uses Crt; var f,fv: text; n,k: integer; r: real; begin ClrScr; Writeln('Begin'); Assign(f, '1.txt'); Reset(f); Assign(fv, '2.txt'); ReWrite(fv); r:=0; k:=0; While not Eof(f) do begin Read(f, n); Inc(k); r:=r+n; if (k=5) or Eof(f) then begin r:=r/k; Write(fv, r:10:4); r:=0; k:=0; end; end; Close(f); Close(fv); Writeln('The End'); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 12:38 Оценка за ответ: 5 Комментарий оценки: не подскажешь что за ошибка path not found

Отвечает: Устинов С.Е. Здравствуйте, Артем Фурдыга! Смотрите решение в приложении. Не забудьте создать входящий файл file.int. Для создания можно, например в цикле пока не введете ноль сохранять введенные числа в файл: rewrite(f1); repeat readln(i); if i<>0 then write(f1,i); until i=0; close(f1); Если Вас устраивает такой вариант создания файла - вставьте эти строки в программу. Удачи! Приложение: var f1:file of integer; f2:file of real; i,t,s:integer; r:real; begin assign(f1,'file.int'); {тут впишете строки создания файла} assign(f2,'file.out'); reset(f1); rewrite(f2); i:=0; s:=0; while not(eof(f1)) do begin read(f1,t); s:=s+t; inc(i); if (i=5) or (eof(f1)) then begin r:=s/i; s:=0; i:=0; write(f2,r); writeln(r); end; end; close(f1); close(f2); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 12:54 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.697

Помогите: Заменитие каждый элемент массива средним арифметическим всех предшествующих ему элементов.

Отправлен: 17.06.2007, 05:37 Вопрос задал: Артем Фурдыга (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Устинов С.Е. Здравствуйте, Артем Фурдыга! Предложу такой вариант: вначале вводим два элемента массива, а остальные n-2 элемента считаются по правилу, указанному в задании (если не вводить первые два элемента, то можно ставить все элементы равными нулю, если ввести только первый - все элементы равны первому). Хотя и в случае ввода первых k элементов все последующие будут равны среднему этих k элементов - вобще странная какая-то задача. const n=10; var s:array[1..n] of real; i:integer; t:real; begin writeln('Vvedite dva pervyh chisla'); readln(s[1],s[2]); t:=s[1]+s[2]; for i:=3 to n do begin s[i]:=t/(i-1); t:=t+s[i]; end; writeln('Resultat:'); for i:=1 to n do writeln(s[i]:6:3); readln; end. Удачи! --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 13:06 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.698

Помогите: Пусть даны два файлацелых чисел f1 и f2. Найдите в файле f2число, самое близкое по величине к минимальному значения файла f1.

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

Отвечает: Denisss Здравствуйте, Артем Фурдыга! См. пример в приложении. Самое близкое по величине к минимальному - это то, которое имеет наименьшую разницу по модулю. Соответственно, поиск производится в 2 этапа: 1. Поиск минимального значения в первом файле 2. Поиск наиболее близкого значения. При этом, если во втором файле было обнаружено значение, равное минимальному значению, то поиск прекращается, т.к. это и есть самое близкое значение. Удачи! Приложение: program q91698; uses Crt; var i, min, delta, mindelta, n: Integer; File1, File2: File of Integer; begin {Очистка экрана} ClrScr; {Открытие файлов} Assign(File1, 'file1.int'); Reset(File1); Assign(File2, 'file2.int'); Reset(File2); {Инициализация} Read(File1, i); min:= i; {Чтение файла1} while not eof(File1) do begin Read(File1, i); {Поиск минимального значения} if (i < min) then min:= i; end; Close(File1); Read(File2, n); mindelta:= abs(min - n); while not eof(File2) do begin Read(File2, i); delta:= abs(min - i); if (delta = 0) then begin {Если обнаружили число, равное минимальному, то дальнейший поиск бесполезен, т.к. более близкого числа, чем само число нету} mindelta:= 0; n:= min; Break; end else if (delta < mindelta) then begin mindelta:= delta; n:= i; end; end; Close(File2); {Вывод результата} writeln('Minimal''noe chislo v faile №1 = ', min); writeln('Samoe blizkoe k nemu chislo iz faila №2 = ', n); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 12:25

Вопрос № 91.699

Помогите: Пусть дан текст. Подсчитайте общее колическво входжений английских букв в текст.

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

Отвечает: Denisss Здравствуйте, Артем Фурдыга! См. пример в приложении. EngLet - список латинских символов. Удачи! Приложение: program q91699; uses Crt; var Str1: String; i, n: Integer; const EngLet: Set of Char = ['a'..'z', 'A'..'Z']; begin {Очистка экрана} ClrScr; {Ввод строки} WriteLn('Vvedite predlozhenie:'); ReadLn(Str1); {Инициализация} n:= 0; {Перебор строки, подсчет количества латинских (английских) символов} for i:= 1 to Length(Str1) do if (Str1[i] in EngLet) then Inc(n); {Вывод результата} writeln('V predlozhenii ', n, ' latinskih bukv.'); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 11:47 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.707

Здравствуйте, помогите пожалуйста решить задачу: Составьте программу вывода номеров позиций, на которых в слове S стоят согласные буквы.

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

Отвечает: Устинов С.Е. Здравствуйте, Graf_monte! Смотрите код в приложении. Проверяются прописные и строчные латинские буквы, если нужно также для русских - измените соответственно множество m. Удачи! Приложение: var s:string; i:integer; m:Set of char; begin writeln('Vvedite text'); readln(s); m:=['A'..'Z']-['A','E','U','I','O']; writeln('Otvet:'); for i:=1 to length(s) do if upcase(s[i]) in m then writeln(i); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 12:34 Оценка за ответ: 5 Комментарий оценки: Спасибо, огрооооомное!!!

Вопрос № 91.708

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

Отправлен: 17.06.2007, 09:57 Вопрос задал: Graf_monte (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Устинов С.Е. Здравствуйте, Graf_monte! Смотрите код в приложении. Создаются множества прописных и строчных латинских символов, далее каждый символ текста проверяется на вхождение в одно из множеств. Если входит в какое-то из множеств - соответствующий счетчик увеличиваем на 1. Далее просто сравниваем счетчики. Удачи! Приложение: var s:string; k1,k2,i:integer; m1,m2:Set of char; begin writeln('Vvedite text'); readln(s); m1:=['A'..'Z']; m2:=['a'..'z']; k1:=0; k2:=0; for i:=1 to length(s) do begin if s[i] in m1 then inc(k1) else if s[i] in m2 then inc(k2); end; if k1 < k2 then writeln('Strochnyh bolshe') else if k2 < k1 then writeln('Propisnyh bolshe') else writeln('Odinakovo strochnyh i propisnyh'); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 12:05 Оценка за ответ: 3 Комментарий оценки: к сожалению всегда выводит ответ что их одинаково.

Вопрос № 91.709

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

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

Отвечает: Устинов С.Е. Здравствуйте, Graf_monte! Посмотрите пример из приложения - делал когда-то на втором курсе :) Работает также для действительных чисел (в качестве разделителя - точка). Удачи! Приложение: program qqq; var i,u,u1,l:integer; t,str:string; s,k:real; otw,minus:boolean; j:char; label 1,3; begin write('Vvedite stroku:'); readln(str);otw:=false;minus:=false; l:=length(str); s:=1; 1: while str<>'' do begin val(str,k,u); case u of 1: begin str:=copy(str,2,length(str)-1);goto 1;end; 0: begin s:=s*k;goto 3;end; else begin val(copy(str,1,u-1),k,u1); str:=copy(str,u,length(str)-u+1); s:=s*k; goto 1; end; end; end; 3: writeln('Proizvedenie vseh chisel stroki=',s:9:2); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 11:56 Оценка за ответ: 4

Вопрос № 91.710

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

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

Отвечает: Denisss Здравствуйте, Graf_monte! См. пример в приложении. Файлу целых чисел я дал в примере имя 'test.int'. В примере поиск максимального значения производится одновременно с подсчетом количества его вхождения в файл. Удачи! Приложение: program q91710; uses Crt; var i, max, n: Integer; MyFile: File of Integer; const FileName: String = 'test.int'; begin {Очистка экрана} ClrScr; {Открытие файла} Assign(MyFile, FileName); Reset(MyFile); {Инициализация} Read(MyFile, i); max:= i; n:= 1; {Чтение файла, поиск максимального значения и подсчет его вхождений в файл} while not eof(MyFile) do begin Read(MyFile, i); {Поиск максимального значения} if (i > max) then begin max:= i; {Если нашли новое значение, то счетчик сбрасываем} n:= 1; end else if (i = max) then inc(n); end; Close(MyFile); {Вывод результата} writeln('Maximal''noe chislo = ', max); writeln('Ono obnaruzheno v faile ', n, ' raz(a).'); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 11:25

Вопрос № 91.711

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

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

Отвечает: Louken Здравствуйте, Graf_monte! Решение в приложении: Приложение: program z1; uses Crt; var f1,f2: text; min,max,n: integer; q: boolean; begin ClrScr; Assign(f1, '1.txt'); Reset(f1); min:=High(min); While not Eof(f1) do begin Read(f1, n); if (n<min) then min:=n; end; Close(f1); Assign(f2, '2.txt'); Reset(f2); max:=Low(max); While not Eof(f2) do begin Read(f2, n); if (n>max) then max:=n; end; Close(f2); Writeln('Min znachenie 1-ogo fayla = ',min); Writeln('Max znachenie 2-ogo fayla = ',max); Write('Bolshe li min znach 1-ogo fayla chem max znach 2-ogo?: '); if min>max then Writeln('Da') else Writeln('Net'); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 11:38

Вопрос № 91.712

Здравствуйте, помогите пожалуйста решить задачу: В строке заменить все двоеточия точками с запятой и подсчитать количество замен.

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

Отвечает: Coupler Здравствуйте, Graf_monte! Решение задачи в приложении. Приложение: program q91712; var s: string; i, k: integer; begin writeln('Vvedite stroku'); readln(s); k := 0; for i := 1 to length(s) do begin if s[i] = ':' then begin s[i] := ';'; inc(k); end; end; writeln(s); writeln('kolichestvo zamen ',k); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 17.06.2007, 11:07 Оценка за ответ: 5 Комментарий оценки: спасибо!!!

Отвечает: Louken Здравствуйте, Graf_monte! Опять привожу решение с помощью функции Pos: Приложение: program z1; uses Crt; var i,k: integer; s: string; begin ClrScr; Writeln('Vvedite stroku'); Readln(s); k:=0; i:=Pos(':',s); While i<>0 do begin s[i]:=';'; Inc(k); i:=Pos(':',s); end; Writeln('Resultat:'); Writeln(s); Writeln('Kolichestvo zamen: ',k); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 11:25 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное!!!!!! Все прекрасно работает

Вопрос № 91.713

Здравствуйте, помогите пожалуйста решить задачу: Определить, сколько раз в строке встречается заданное слово.

Отправлен: 17.06.2007, 10:08 Вопрос задал: Graf_monte (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Denisss Здравствуйте, Graf_monte! См. пример в приложении. Принцип такой: Если нашли слово в строке, то удаляем его из строки и увеличиваем значение n на 1. Делаем это до тех пор, пока можно найти нужное слово. Удачи! Приложение: program q91713; uses Crt; var Str1, Str2: String; i, j, n: Integer; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Vvedite stroku:'); ReadLn(Str1); writeln; writeln('Vvedite slovo:'); ReadLn(Str2); {Инициализация} n:= 0; i:= Length(Str2); {Поиск строки Str2 в строке Str1} j:= Pos(Str2, Str1); while (j > 0) do begin inc(n); Delete(Str1, j, i); j:= Pos(Str2, Str1); end; {Вывод результата} writeln('Naideno ', n, ' slov.'); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 11:10 Оценка за ответ: 5 Комментарий оценки: спасибо!!!

Отвечает: Louken Здравствуйте, Graf_monte! Насколько я понимаю, словом является подстрока из строки, если она отделяется от других хотябы одним пробелом или прижата к началу или концу. Насколько я правильно разобрался в ответе Denisss это правило не работает. Приложение: program z; uses Crt; var s,sd,s1,ss : string; k : integer; begin ClrScr; Writeln('Vvedite slovo: '); Readln(ss); Writeln('Vvedite stroku: '); Readln(s); sd:=''; k:=0; {Udalyaem lishnie probeli} While Pos(' ',s)>0 do Delete(s,Pos(' ',s),1); if s[1]=' ' then Delete(s,1,1); if s[Length(s)]=' ' then Delete(s,Length(s),1); While s<>'' do begin if Pos(' ',s)>0 then begin s1:=Copy(s,1,Pos(' ',s)-1); Delete(s,1,Pos(' ',s)); end else begin s1:=s; s:=''; end; if s1=ss then Inc(k); end; Writeln(k); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 11:52

Отвечает: Кайгородов Сергей Александрович Здравствуйте, Graf_monte! Попробуйте эту функцию. function CountWord(const SetWord: string; Text: string): Integer; begin if (Length(SetWord) = 0) or (Length(Text) = 0) or (Pos(SetWord, Text) = 0) then Result := 0 else Result := (Length(Text) - Length(StringReplace(Text, SetWord, '', [rfReplaceAll]))) div Length(SetWord); end;

Ответ отправил: Кайгородов Сергей Александрович (статус: 1-ый класс) Ответ отправлен: 17.06.2007, 12:46 Оценка за ответ: 3

Вопрос № 91.714

Здравствуйте, помогите пожалуйста решить задачу: В строке имеется точка с запятой. Подсчитать количество символов до точки с запятой и после нее.

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

Отвечает: Coupler Здравствуйте, Graf_monte! Решение задачи в приложении. Приложение: program q91714; var s: string; p, front, after: integer; begin writeln('Vvedite stroku'); readln(s); p := pos(';', s); front := p - 1; after := length(s) - p; writeln('do tochki s zapyatoi ', front, ' simvolov'); writeln('posletochki s zapyatoi ', after, ' simvolov'); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 17.06.2007, 10:59 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное!!!

Вопрос № 91.715

Здравствуйте, помогите пожалуйста решить задачу: В строке удалить символы двоеточия и подсчитать количество удаленных символов.

Отправлен: 17.06.2007, 10:11 Вопрос задал: Graf_monte (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Denisss Здравствуйте, Graf_monte! См. пример в приложении. Удачи! Приложение: program q91715; uses Crt; var Str1, Str2: String; i, n: Integer; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Vvedite stroku:'); readln(Str1); {Инициализация} Str2:= ''; n:= 0; writeln; WriteLn('Resultat:'); {Перебор всех символов строки и вывод полученной строки без двоеточий} for i:= 1 to Length(Str1) do if not (Str1[i] = ':') then begin Str2:= Str2 + Str1[i]; write(Str1[i]); end else Inc(n); {Вывод количества удаленных двоеточий} writeln; WriteLn('Kolichwstvo udalennyh dvoetochiy: ', n); {Ожидание нажатия любой клавиши пользователем} writeln; writeln('Press any key to continue...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 10:24 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!!

Отвечает: Coupler Здравствуйте, Graf_monte! Предлагаю немного иное, чем у эксперта Denisss, решение - символы удаляются прямо в строке, т.е. дополнительная строка не нужна. Приложение: program q91715; var s: string; i, k: integer; begin writeln('Vvedite stroku'); readln(s); i := 1; k := 0; while i <= length(s) do if s[i] = ':' then begin delete(s, i, 1); inc(k); end else inc(i); writeln(s); writeln('kolichestvo udalennyh simvolov ', k); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 17.06.2007, 10:52

Отвечает: Louken Здравствуйте, Graf_monte! В моем варианте поиск производиться с помощью функции Pos/ Код в приложении: Приложение: program z1; uses Crt; var i,k: integer; s: string; begin ClrScr; Writeln('Vvedite stroku'); Readln(s); k:=0; i:=Pos(':',s); While i<>0 do begin Delete(s,i,1); Inc(k); i:=Pos(':',s); end; Writeln('Resultat:'); Writeln(s); Writeln('Kolichestvo udalennih simvolov: ',k); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 11:20 Оценка за ответ: 5 Комментарий оценки: спасибо

Вопрос № 91.716

Здравствуйте, помогите пожалуйста решить задачу: В записке слова зашифрованы - каждое из них записано наоборот. Расшифровать сообщение.

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

Отвечает: Denisss Здравствуйте, Graf_monte! См. пример в приложении. Если я правильно Вас понял, то задача состоит в том, чтобы записать наоборот каждое слово, но не всю строку целиком. Удачи! Приложение: program q91716; uses Crt; var Str1, Str2, Str3: String; i, j: Integer; const sPrep: Set of Char = [' ', ',', '.', '!', '"', '?', '/', '', '<', '>', '[', '{', '}', ']', '(', ')', '''']; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Vvedite stroku:'); ReadLn(Str1); {Инициализация} Str2:= ''; Str3:= ''; {Перебор строки по символам} for i:= 1 to Length(Str1) do begin {Если встретили символ окончания слова} if (Str1[i] in sPrep) then begin {Запоминаем слово, но наоборот} for j:= Length(Str3) downto 1 do Str2:= Str2 + Str3[j]; {Добавляем соответствующий символ} Str2:= Str2 + Str1[i]; Str3:= ''; end else Str3:= Str3 + Str1[i]; end; if (Str3 <> '') then for j:= Length(Str3) downto 1 do Str2:= Str2 + Str3[j]; {Вывод результата} WriteLn('Resultat:'); WriteLn(Str2); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 10:59 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное!!!!

Вопрос № 91.717

Здравствуйте, помогите пожалуйста решить задачу: Дано слово. Если его длина нечетная, то удалить среднюю букву, в противном случае - две средние буквы.

Отправлен: 17.06.2007, 10:16 Вопрос задал: Graf_monte (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Coupler Здравствуйте, Graf_monte! Решение задачи в приложении. Приложение: program q91717; var s: string; begin writeln ('Vvedite stroku'); readln (s); if length (s) mod 2 = 1 then delete (s,length(s) div 2 + 1,1) else delete (s,length(s) div 2,2); writeln (s); readln; end.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 17.06.2007, 10:41 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!

Отвечает: Gh0stik Здравствуйте, Graf_monte! На самом деле задача решается в ОДНУ строку, вот код - как говориться "мал да удал"!!! var s:string; begin readln(s); delete(s,(length(s) div 2)+(length(s) mod 2),2-(length(s) mod 2)); writeln(s); end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 17.06.2007, 13:50 Оценка за ответ: 5 Комментарий оценки: Все гениальное просто, огромное спасибо!!!! и спасибо за разъяснение.

Вопрос № 91.719

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

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

Отвечает: Denisss Здравствуйте, Graf_monte! См. пример в приложении. Поскольку у Вас слова отделяются только пробелами, то я не стал делать проверки на другие символы (такие, как точка, запятая или др. знаки препинания). Удачи! Приложение: program q91719; uses Crt; {Фукнция проверки длины строки на четность} function ChetLen(const Str: String): Boolean; begin ChetLen:= ((Length(Str) and 1) = 0); end; var Str1, Str2, Str3: String; i: Integer; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Vvedite stroku:'); ReadLn(Str1); {Инициализация} Str2:= ''; Str3:= ''; {Перебор строки по символам} for i:= 1 to Length(Str1) do begin {Если символ - пробел} if (Str1[i] = ' ') then begin {Если длина строки четная, то записываем} if ChetLen(Str3) then Str2:= Str2 + Str3 + ' '; Str3:= ''; end else Str3:= Str3 + Str1[i]; end; if ChetLen(Str3) then Str2:= Str2 + Str3; {Вывод результата} WriteLn('Resultat:'); WriteLn(Str2); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 10:45 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!

Отвечает: Louken Здравствуйте, Graf_monte! Решение в приложении: Приложение: program z; uses Crt; var s,sd,s1 : string; k : integer; begin ClrScr; Writeln('Vvedite stroku: '); Readln(s); sd:=''; k:=0; {Udalyaem lishnie probeli} While Pos(' ',s)>0 do Delete(s,Pos(' ',s),1); if s[1]=' ' then Delete(s,1,1); if s[Length(s)]=' ' then Delete(s,Length(s),1); While s<>'' do begin if Pos(' ',s)>0 then begin s1:=Copy(s,1,Pos(' ',s)-1); Delete(s,1,Pos(' ',s)); end else begin s1:=s; s:=''; end; if Length(s1) mod 2=0 then begin if sd<>'' then sd:=sd+' '; sd:=sd+s1; end; end; Writeln(sd); Readln; end.

Ответ отправил: Louken (статус: 7-ой класс) Ответ отправлен: 17.06.2007, 11:59 Оценка за ответ: 5 Комментарий оценки: Спасибо, все правильно.

Вопрос № 91.720

Здравствуйте, помогите пожалуйста решить задачу: Дана строка символов. Удалить из нее все кратные рядом стоящие одинаковые символы, оставив по одному: ПППОООГОДДДААА -> ПОГОДА.

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

Отвечает: Tribak Здравствуйте, Graf_monte! Вот код: program www; uses crt; var i:integer; s,d:string; c:char; begin readln(s); c:=s[1]; d:=''; d:=d+c; for i:=2 to length(s) do begin if c<>s[i] then begin c:=s[i]; d:=d+c; end end; writeln(d); readln; end.

Ответ отправил: Tribak (статус: 2-ой класс) Ответ отправлен: 17.06.2007, 10:46 Оценка за ответ: 5 Комментарий оценки: Спасибо, Вы мне очень помогли!!!

Отвечает: Устинов С.Е. Здравствуйте, Graf_monte! Можно вот таким образом: var s:string; i:integer; begin writeln('Vvedite stroku'); readln(s); i:=1; while i < length(s) do begin while (i < length(s)) and (s[i]=s[i+1]) do delete(s,i,1); inc(i); end; writeln(s); readln; end. Удачи! --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 11:35

Отвечает: Gh0stik Здравствуйте, Graf_monte! Вот еще один способ решения Вашей задачи: var s,sb:string; i:integer; begin writeln('Input:');readln(s); i:=1; while i begin if s[i]=s[i+1] then begin sb:=s[i]+s[i+1]; while pos(sb,s)<>0 do delete(s,pos(sb,s),1); end; inc(i); end; writeln(s); end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 17.06.2007, 14:41 Оценка за ответ: 4 Комментарий оценки: спасибо!

Вопрос № 91.721

Здравствуйте, помогите пожалуйста решить задачу: Дан файл, содержащий текст на русском языке. Выяснить, чего в нем больше: русских букв или цифр.

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

Отвечает: Intelx86 доброе время суток! var f:file of char; c:char; chars:longint; filename:string; begin assign(f,filename); reset(f); while not eof(f) do begin read(f,c); if c in ['0'..'9']then inc(chars); end; if chars>filesize(f) then write('Цыфр больше') else write('Букв больше'); close(f); end.

Ответ отправил: Intelx86 (статус: Посетитель) Ответ отправлен: 17.06.2007, 10:47

Отвечает: Градов Юрий Михайлович Здравствуйте, Graf_monte! В приложении ниже фрагмент листинга Вашей задачи: Приложение: var F: Text; dg,wd,i: integer; ds: Set of Char=['1'..'0']; ws: Set of Char=['а'..'я','А'..'Я']; s: string; begin Assign(F,'text.txt'); Reset(F); dg:=0; wd:=0; While not Eof(F) do begin Readln(F,s); for i:=1 to Length(s) do begin if s[i] in ds then Inc(dg); if s[i] in ws then Inc(wd); end; end; Writeln('Tsifr: ',dg); Writeln('Bookv: ',wd); if dg>wd then Writeln('V faile bolshe tsifr') else if dg<wd then Writeln('V faile bolshe bookv') else if dg=wd then Writeln('Odinakovoe kol-vo'); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 17.06.2007, 11:19 Оценка за ответ: 5 Комментарий оценки: Спасибо за решение!

Вопрос № 91.729

помогите решить: Пусть вводиться последовательность символов длинной не более4. если все вводимые символы - цифры, то выполните преобразование данной последовательности в целое цисло.

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

Отвечает: Troyan Здравствуйте, Артем Фурдыга! Var S: String; x, err: Integer; begin Readln(s); Val(S, x, err); If Er=0 then Writeln('Число: ', x) else Writeln('Нельзя перевести!'); end; --------- Цени законы своего сердца, иди на обгон! Будь человеком, не запачкай свою совесть!

Ответ отправил: Troyan (статус: Студент) Ответ отправлен: 17.06.2007, 11:20 Оценка за ответ: 5 Комментарий оценки: спаисбо огромное.

Отвечает: Кайгородов Сергей Александрович Здравствуйте, Артем Фурдыга! Ответ не относится к теме рассылки, поскольку в Pascal нет функции StrToInt. Ответ удален и помещен для обсуждения в ветку форума "О деятельности экспертов и работе портала/Удаленные ответы для обсуждения". -~= Gh0stik =~-

Ответ отправил: Кайгородов Сергей Александрович (статус: 1-ый класс) Ответ отправлен: 17.06.2007, 12:03 Оценка за ответ: 4 Комментарий оценки: cпасибо я ее уже решил

Вопрос № 91.734

Помогите решить задачи к сессиии! Проверьте условие (А в степени Т)в степени Т = А, где А-исходная матрица (n x m), степень Т обозначает транспонирование. Используйте процедуру транспонирования. Пусть дан текст, состоящий из строчных латинских букв и цифр. Определить, каких букв - гласных или согласных - больше в этом тексте.

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

Отвечает: Устинов С.Е. Здравствуйте, Eisenheim! Решение второй задачи смотрите в приложении. А по поводу первой могу посоветовать - прочитайте, что такое транспонированная матрица и Вы сами все поймете - напишу лишь цикл из процедуры транспонирования: (матрицу A[n,m] транспонируем в AT(m,n)) for i:=1 to n do for j:=1 to m do AT[j,i]:=A[i,j]; Вот и все - таким образом получим транспонированную матрицу для данной матрицы A. Удачи! Приложение: var s:string; k1,k2,i:integer; m1,m2:Set of char; begin writeln('Vvedite text'); readln(s); m1:=['a','e','u','i','o']; m2:=['a'..'z']-m1; k1:=0; k2:=0; for i:=1 to length(s) do begin if s[i] in m1 then inc(k1) else if s[i] in m2 then inc(k2); end; if k1 > k2 then writeln('Glasnyh bolshe') else if k2 > k1 then writeln('Soglasnyh bolshe') else writeln('Odinakovo glasnyh i soglasnyh'); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 12:15 Оценка за ответ: 5 Комментарий оценки: Большое спасибо за вторую задачу! А с первой попытаюсь дальше разобраться сам!

Вопрос № 91.736

Уважаемые эксперты! Завтра экзамен по программированию, не могу сама решить пару задач, помогите с решением... Напечатайте заданный текст из 100 символов и удалите из него повторные вхождения каждого символа. Написать программу, которая сформирует новую строку, перевернув введенное слово или фразу.

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

Отвечает: Устинов С.Е. Здравствуйте, Paranoya! Смотрите решение Ваших задач в приложении. Во втором задании буду считать что нужно просто прочитать текст "задом наперед". Удачи! Приложение: Задача №1 var s:string; i:integer; begin writeln('Vvedite stroku'); readln(s); i:=1; while i<=length(s) do begin while (i<=length(s)) and (pos(s[i],s)<i) do delete(s,i,1); inc(i); end; writeln(s); readln; end. Задача №2 var s1,s2:string; i:integer; begin writeln('vvedite stroku'); readln(s1); s2:=''; for i:=length(s1) downto 1 do s2:=s2+s1[i]; s1:=s2; writeln('Perevernutaya stroka:'); writeln(s1); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 17.06.2007, 12:26 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!!! Хочу чтобы все эксперты были бы такими умными как данный1

Отвечает: Denisss Здравствуйте, Paranoya! Предлагаю несколько другое решение первой задачи (см. приложение). Оно проще, чем у первого эксперта и быстрее. Но требует чуть больше памяти на реализацию (для второй строки Str2 и для переменной, хранящей все встречавшиеся символы Chars). Вторую задачу Вам уже решили (я бы решил аналогично), потому ее решения я не привожу. Удачи! Приложение: program q91719_1; uses Crt; var Str1, Str2: String; i: Integer; Chars: Set of Char; begin {Очистка экрана} ClrScr; {Ввод строки} writeln('Vvedite stroku:'); ReadLn(Str1); {Инициализация} Chars:= []; Str2:= ''; {Перебор строки по символам} for i:= 1 to Length(Str1) do begin {Если такого символа еще не встречалось} if not (Str1[i] in Chars) then begin Str2:= Str2 + Str1[i]; Chars:= Chars + [Str1[i]]; end; end; {Вывод результата} WriteLn; WriteLn('Resultat:'); WriteLn(Str2); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 17.06.2007, 12:40

Отвечает: Кайгородов Сергей Александрович Здравствуйте, Paranoya! Пожалуйста, вот вам функция, которая убирает вхождения символов из полученной строки и возвращает строку без повторяющихся символов. function DelSymbol(sIn: string): string; var s: string; i, j: integer; begin s := sIn; for i := 0 to Length(s) do for j := i + 1 to Length(s) do if s[j] = s[i] then Delete(s, j, 1); Result := s; end; И функция, которая переворачивает слово или предложение. function Reversy(sIn: string): string; var s, ts: string; i: integer; begin ts := ''; i := Length(sIn); while i > 0 do begin ts := ts + sIn[i]; i := i - 1; end; result := ts; end;

Ответ отправил: Кайгородов Сергей Александрович (статус: 1-ый класс) Ответ отправлен: 17.06.2007, 12:42 Оценка за ответ: 5 Комментарий оценки: Спасибо за такие короткие, но выполняющие задачу функции!

Отвечает: Градов Юрий Михайлович Здравствуйте, Pahar! Посмотрите как в приложении, должно подойти: Приложение: var st,newst: string; i: integer; Sc: Set of Char; Label Nach; begin nach: ClrScr; Writeln('Vvedite stroku iz 100 simvolov'); Read(st); if Length(st)<>100 then begin Writeln('Stroka ne sootvetstvuet usloviyu'); Readln; st:=''; Goto nach; end else begin //можно до 100 т.к. сделана проверка длины строки newst:=''; for i:=1 to Length(st) do begin if Not(st[i] in Sc) then begin newst:=newst+st[i]; Sc:=Sc+[st[i]]; end; end; end; Writeln('Novaya stroka: ',newst); Readln; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 17.06.2007, 13:04

Вопрос № 91.738

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

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

Отвечает: Градов Юрий Михайлович Здравствуйте, Pahar! Можно решить задачу так, как указано в фрагменте листинга: Приложение: var S: string; SetGl: Set of Char =['e','u','i','a','o','у', 'е','ы','а','о','э','я', 'и','ь','ю']; sum,i: integer; function LowerCase(s: string): string; var i: integer; begin result := s; for i := 1 to length(result) do if (result[i] in ['A'..'Z', 'А'..'Я']) then result[i] := chr(ord(result[i]) + 32); end; begin Write('Vvedite stroku: '); Read(S); S:=LowerCase(S); sum:=0; for i:=1 to Length(s) do begin if S[i] in SetGl then sum:=sum+i; end; Write('Summa nomerov mest s glasnoy bukvoy v slove =',sum); Read; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 17.06.2007, 15:07 Оценка за ответ: 5 Комментарий оценки: 11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111

Отвечает: Louken Здравствуйте, Pahar! Решение смотри в приложении: Приложение: program z; uses Crt; const gl: set of char = ['a','e','i','o','u','A','E','I','O','U, 'а','А', 'е','Е', 'ё','Ё', 'и','И', 'о','О', 'у','У', 'ы','Ы', 'э','Э', 'ю','Ю', 'я','Я']; var s: string; i,sum: integer; begin ClrScr; Writeln('Vvedite slovo'); Readln(s); sum:=0; for i:=1 to Length(s) do begin if s[i] in gl then sum:=sum+i; end; Writeln('Summa = ',sum); Readln; end.

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

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