Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 107 ∙ повысить рейтинг >>

Botsman Статус: 7-й класс Рейтинг: 90 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 70 ∙ повысить рейтинг >>

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

Выпуск № 819
от 26.02.2009, 09:05

Вопрос № 160955: Здравствуйте! Помогите, пожалуйста, написать программы (с комментариями): 1. Задача Джозефуса. Данная задача представляет собой своего рода считалку. Формальное описание алгоритма этой считалки. Для этого элементы "становятся в круг", вв...

Вопрос № 160.955

Здравствуйте! Помогите, пожалуйста, написать программы (с комментариями): 1. Задача Джозефуса. Данная задача представляет собой своего рода считалку. Формальное описание алгоритма этой считалки. Для этого элементы "становятся в круг", вводится некоторое число k. Необходимо, начиная с первого, отсчитать k-й элемент списка и удалить его. Далее отсчет начинается с k+1 элемента и опять удаляется k-ый элемент. Так продолжается до тех пор, пока в списке не останется один элемент. Необходимо выдать содержимое последнего оставшегося элемента (например, строку). Для решения использовать кольцевой список. 2. Дана последовательность из не менее чем двух различных натуральных чисел. Напечатать в обратном порядке все числа между наибольшим и наименьшим числами этой последовательности. Использовать двумерный список.

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

Отвечает: Denisss Здравствуйте, Student_! Примеры находятся в приложении. В первом примере нужно ввести два числа: n (размерность списка) и k. Во второй задаче я не стал реализовывать проверку первого элемента, если пользователь нечестно себя проявит, то может ввести число, не являющееся натуральным. Ввод последовательности во второй задаче заканчивается после ввода пользователем любого ненатурального числа (например, нуля). Поиск максимального и минимального значений элементов производится во время ввода. Если я правильно понял, то под "обратным порядком" подразумевается порядок, обратный порядку ввода натуральных чисел. Поскольку нужно выводить "числа между наибольшим и наименьшим" значениями списка, то сами эти значения не выводятся. Честно говоря, термин "двумерный список" мне встречается впервые, да и Google мне не подсказал что это за зверь. Поэтому пришлось предположить, что это "двусвязный список", т. е. список, каждый элемент которого имеет указатель на следующий и предыдущий элементы. Удачи! Приложение: ======================== Задача №1 ======================== program Q160955_1; type { Элемент кольцевого списка } PCNode = ^TCNode; TCNode = record data: Integer; next: PCNode; end; var cirList, next: PCNode; i, k: Byte; tmp: Integer; begin { Создаем список } GetMem(cirList, sizeof(TCNode)); cirList^.next:= cirList; { Первый элемент } cirList^.data:= 1; { Получаем n - количество элементов } write('n = '); readln(k); { Заполняем список } for i:= 2 to k do begin next:= cirList^.next; GetMem(cirList^.next, sizeof(TCNode)); cirList:= cirList^.next; cirList^.next:= next; cirList^.data:= i; end; { Вводим k } repeat write('k = '); readln(k); until(k > 0); { Пока в списке не останется } { всего один элемент } while (cirList <> cirList^.next) do begin { Отсчитываем k-1 элемент } for i:= 2 to k do cirList:= cirList^.next; { Следующий элемент - k-й } next:= cirList^.next; cirList^.next:= next^.next; { Удаляем k-й элемент } FreeMem(next, sizeof(TCNode)); end; { Выводим номер оставшегося элемента } writeln('result = ', cirList^.data); { Удаляем последний элемент } FreeMem(cirList, sizeof(TCNode)); { Ждем, пока пользователь не } { нажмет [Enter] } Readln; end. ======================== Задача №2 ======================== program Q160955_2; type { Элемент двунаправленного } { связного списка } PDLNode = ^TDLNode; TDLNode = record data: Integer; prev: PDLNode; next: PDLNOde; end; var dList, lFirst, lLast, next, prev: PDLNode; i: Byte; iMin, iMax, inp: Integer; begin { Создаем список } GetMem(dList, sizeof(TDLNode)); dList^.next:= nil; dList^.prev:= nil; { Вводим число последовательности } write('1: '); readln(inp); { Инициализация } i:= 2; iMin:= inp; iMax:= inp; dList^.data:= inp; lFirst:= dList; lLast:= dList; { Ввод последовательности } while (True) do begin write(i, ': '); readln(inp); { Если inp не натуральное число, } { завершаем ввод } if (inp < 1) then Break; { Создаем новый элемент списка } GetMem(dList^.next, sizeof(TDLNode)); dList^.next^.prev:= dList; dList:= dList^.next; dList^.next:= nil; dList^.data:= inp; { Проверяем на максимум } if (inp > iMax) then begin { Если максимум был в начале } if (iMax = lFirst^.data) then { Переносим минимум в начало } lFirst:= lLast; lLast:= dList; iMax:= inp; end { Проверяем на минимум } else if (inp < iMin) then begin { Если минимум был в начале } if (iMin = lFirst^.data) then { Переносим максимум в начало } lFirst:= lLast; lLast:= dList; iMin:= inp; end; Inc(i); end; writeln('result:'); { Проверка на всякий случай... } if (lFirst <> lLast) then { Перебираем элементы в } { обратном направлении } while (lFirst <> lLast^.prev) do begin lLast:= lLast^.prev; writeln(lLast^.data); end; { Удаляем список из памяти } while (dList <> nil) do begin lLast:= dList^.prev; FreeMem(dList, sizeof(TDLNode)); dList:= lLast; end; { Ожидаем, пока пользователь } { не нажмет [Enter] } Readln; end. --------- Все должно быть сделано настолько просто, насколько это возможно. Но не проще. (с) А.Эйнштейн

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 2412904 ---- Ответ отправлен: 20.02.2009, 17:42 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244140 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.964

Помогите пожалуйста на Паскаль! В массив С записать индексы положительных элементов исходного массива M(A). Предусмотреть случай, когда в массиве нет положительных элементов.

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

Отвечает: Minin Здравствуйте, Rutra! В программе заполняем массив М случайным образом перебирая элементы выносим их индексы в массив С если массив С пуст выдаем сооьветствующее сообщение. Приложение: var M:array [1..20]of integer; C:array [1..20]of integer; n,nc,i:integer; begin nc:=0; randomize; n:=random(10)+10; for i:=1 to n do M[i]:=random(198)-99; writeln('Ishodnyj massiv'); for i:=1 to n do write(M[i]:4); writeln; for i:=1 to n do if M[i]>0 then begin nc:=nc+1; C[nc]:=i; end; if nc>0 then begin writeln('Indexy'); for i:=1 to nc do write(C[i]:3); end else writeln('Net polojitelnyh elementov'); readln; end.

Ответ отправил: Minin (статус: 1-й класс) Ответ отправлен: 20.02.2009, 12:23 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244119 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Вопрос № 160.965

Помогите пожалуйста. Одномерные массивы. Дан список фирм и их уставной фонд. Найти сумму фондов, попадающих в интервал от В1 до В2

Отправлен: 20.02.2009, 10:46 Вопрос задал: Rutra Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Rutra! Поскольку Вы не уверены в правильности условия, привожу 2 варианта решения: с использованием одного линейного массива записей, и с использованием двух отдельных линейных массивов - фирм и фондов. Приложение: 1) Один линейный массив записей. uses crt; const nmax=100;{максимальное количество фирм} type TFirma=record {тип запись с полями по условию} nam:string[20];{название} usf:word;{уставной фонд} end; var sp:array[1..nmax] of TFirma;{массив записей, список фирм с фондами} n,b1,b2,i:word;{количество, нижний и верхний размеры фондов, счетчик цикла} sum:longint;{сумма} k:byte;{фиксатор} begin clrscr; repeat write('Kolichestvo firm n='); readln(n); until (n>0)and(n<=nmax);{проверяем правильность ввода} repeat write('b1=');readln(b1); write('b2=');readln(b2); until (b1>0)and(b2>b1);{правильность ввода} writeln('Vvedite dannye o ',n,' firmah:'); for i:=1 to n do {наполняем список данными} begin writeln('Firma ',i); write('Nazvanie: ');readln(sp[i].nam); write('Ustavnoj fond: ');readln(sp[i].usf); end; clrscr; {очищаем экран} writeln('Spisok firm s ustavnym fondom >',b1,' i <',b2); sum:=0;k:=0; for i:=1 to n do if (sp[i].usf>b1)and(sp[i].usf<b2)then{если фонд попадает в диапазон} begin writeln(sp[i].nam,' ',sp[i].usf);{выводим} sum:=sum+sp[i].usf;{считаем сумму} k:=1;{фиксируем, что есть такие} end; write('Summa=',sum); if k=0 then write('Takih firm net!');{если нет} readln end. 2) два линейных массива: фирм и их фондов. uses crt; const nmax=100; var frm:array[1..nmax] of string[20];{массив названий фирм} fnd:array[1..nmax] of longint;{массив их уставных фондов} n,b1,b2,i:word; sum:longint; k:byte; begin {дальше все тоже, только 2 отдельных массива} clrscr; repeat write('Kolichestvo firm n='); readln(n); until (n>0)and(n<=nmax); repeat write('b1=');readln(b1); write('b2=');readln(b2); until (b1>0)and(b2>b1); writeln('Vvedite dannye o ',n,' firmah:'); for i:=1 to n do begin write('Firma ',i,': '); readln(frm[i]); write('Fond ',i,': ');readln(fnd[i]); end; clrscr; writeln('Spisok firm s ustavnym fondom >',b1,' i <',b2); sum:=0;k:=0; for i:=1 to n do if (fnd[i]>b1)and(fnd[i]<b2)then begin writeln(frm[i],' ',fnd[i]); sum:=sum+fnd[i]; k:=1; end; write('Summa=',sum); if k=0 then write('Takih firm net!'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.02.2009, 17:26 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244183 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Супер!

Вопрос № 160.978

1. Разработать программу для выполнения указанных операций с матрицами;(а) Разработать программу для вычисления следующих матриц; (б) Составить блок-схему задачи (*для всех вариантов). а) умножение матрицы на число, сложение матриц ; б) 25B+8C+9A ;

Отправлен: 20.02.2009, 12:43 Вопрос задал: Кондрашов Вадим Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Кондрашов Вадим Александрович! Решение задачи в приложении. Приложение: uses crt; const n=5; {размеры матрицы} m=6; type Tmatr=array[1..n,1..m] of real;{тип матрицы} procedure Vvod(var mt:Tmatr);{присвоение значений элементам матрицы} var i,j:byte; begin for i:=1 to n do for j:=1 to m do mt[i,j]:=10*random;{псевдослучайные числа в диапазоне(0,10)} end; procedure Vyvod(var mt:Tmatr;s:string);{вывод матриц на экран} var i,j:byte; begin writeln('Matrica ',s,':'); for i:=1 to n do begin for j:=1 to m do write(mt[i,j]:6:1); writeln; end; end; procedure UmMatCh(var mt:Tmatr; b:integer);{умножение матрицы на число} var i,j:byte; begin for i:=1 to n do for j:=1 to m do mt[i,j]:=mt[i,j]*b;{все элементы умножаются на число} end; procedure SumMatr(m1:Tmatr;var mt:Tmatr);{сумма матриц} var i,j:byte; begin for i:=1 to n do for j:=1 to m do mt[i,j]:=mt[i,j]+m1[i,j];{соответствующие элементы складываются} end; var a,b,c:Tmatr;{раздел переменных – 3 маирицы} begin {основная программа, по очереди вызываются нужные процедуры} clrscr; randomize; Vvod(b); Vyvod(b,'B'); UmMatCh(b,25); Vyvod(b,'25*B'); readln; Vvod(c); Vyvod(c,'C'); UmMatCh(c,8); Vyvod(c,'8*C'); readln; Vvod(a); Vyvod(a,'A'); UmMatCh(a,9); Vyvod(a,'9*A'); readln; SumMatr(c,b); SumMatr(a,b); Vyvod(b,'25B+8C+9A'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.02.2009, 13:57 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244172 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.979

решите пожалуйста задачу 1. Решить при помощи численных методов уравнение (найти действительные корни) указанным методом, составить блок-схему. х⁴-4х+1=0 метод Ньютона; бисекции;

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Кондрашов Вадим Александрович! Код программы, вычисляющей корень обоими методами в приложении. Теория методов и коды программ с детальными пояснениями в огромном количестве в интернете. Приложение: uses crt; function F(x:real):real; begin F:=x*x*x*x-4*x+1; {заданная функция} end; function F1(x:real):real; begin F1:=4*x*x*x-4;{ее первая производная} end; function Bisec(a,b,e:real):real;{метод бисекции, или дихотомии} var x,c:real; begin repeat c:=(a+b)/2; if F(a)*F(c)<0 then b:=c else a:=c; until b-a<e; Bisec:=(a+b)/2; end; function Newton(x1,e:real):real;{метод Ньютона, или касательных} var x2:real; begin repeat x2:=x1; x1:=x1-F(x1)/F1(x1); until abs(x2-x1)>e; Newton:=x1; end; var x0,x1,x2,eps:real; begin clrscr; repeat write('Vvedite nachalnoe priblizenie x1=');{слева от корня} readln(x1); write('Vvedite nachalnoe priblizenie x0=');{близко к корню} readln(x0); write('Vvedite nachalnoe priblizenie x2=');{справа от корня} readln(x2); until (x0>x1)and(x2>x0); write('Vvedite tochnost eps='); readln(eps); writeln('Xnewton=',Newton(x0,eps):0:5); writeln('Xbisec=',Bisec(x1,x2,eps):0:5); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.02.2009, 16:15 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244177 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 160.990

Здравствуйте, уважаемые эксперты! 1. Напишите программу, которая выводит все перестановки целых чисел из N элементов. 3 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 2. При печати документа можно выбрать страницы, которые будут отправлены на принтер. Пусть заданы номера страниц в порядке возрастания. Напишите программу, которая перечисляет номера страниц через запятую, при этом страницы, идущие подряд, замените на диапазон, указывая первую и последнюю страницу через дефис. Входные данные: 1 3 4 5 6 11 12 15 Выходные данные: 1, 1-6, 11-12, 15 Прошу исправить ошибки. Приложение: 2. Var n, i, j: Integer; x: Array[0..100] Of Integer; flag: Boolean; Procedure ReadData; var s,s1,s2:string; Begin for i:=0 to 100 do x[i]:=0; n:=0; readln(s); s1:=''; for i:=1 to length(s) do begin s2:=s[i]; if (s2>='0') and (s2<='9') then s1:=s1+s2 else if s1<>'' then begin n:=n+1; val(s1,x[n],j); s1:=''; end; end; if s1<>'' then begin n:=n+1; val(s1,x[n],j); s1:=''; end; end; Begin ReadData; flag := FALSE; For i := 1 To n Do Begin If ((x[i+1] - x[i] <> 1) And (Not(flag))) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; End; If ((x[i+1] - x[i] = 1) And (Not(flag))) Then Begin Write(x[i], '-'); flag := TRUE; End; If ((x[i+1] - x[i] <> 1) And (flag)) Then Begin If (i <> n) Then Begin Write(x[i], ', '); End; If (i = n) Then Begin Write(x[i]); End; flag := FALSE; End; End; WriteLn; ReadLn; End.

Отправлен: 20.02.2009, 13:45 Вопрос задал: Хощенко Артём Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Решение первой и второй задач в приложении. Приложение: { генерация перестановок } uses crt; const n = 5; { количество элементов в перестановке} var a:array[1..n] of integer;{массив элементов перестановки} j:integer;{счетчик} kol : longint;{количество перестановок} procedure generate (l,r:integer;var k:longint); {рекурсивная процедура генерации перестановок, входные параметры-границы перестановок, выходной-количество их} var i,v:integer; {счетчик цикла и буфер при обмене} begin if (l=r) then {если дошли до конца} begin for i:=1 to n do write(a[i],' '); {выводим на экран очередную перестановку} writeln; k:=k+1;{считаем} if k mod 20 = 0 then readln;{для удобства просмотра делаем задержки после каждых 20 перестановок} end else {если еще не дошли} begin for i := l to r do {от данного положения начала (L) до конца} begin v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[l]} {обмениваем текущий первый элемент с очередным} generate(l+1,r,k); {вызов новой генерации}{увеличиваем на 1 начало перестановки} v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[l]} {снова меняем} end; end; end; begin clrscr; for j := 1 to n do {заполняем первоначальный массив} a[j]:=j;{или порядковыми номерами(обычно) или как Вам нравится} generate( 1,n,kol); {генерация} writeln('kol=',kol);{вывод количества} readln end. {нумерация страниц Чтобы не заморачиваться с Вашим навороченным кодом, сделал по своему. Использовал девиз скульпторов, сначала создаю неправильную строку, потом от нее отсекаю все лишнее.} uses crt; const nmax=100; var a:array[1..nmax] of word; s,c:string; n,i,j,k:word; begin clrscr; repeat write('Vvedite kolichestvo stranic n='); readln(n); until (n>1)and(n<=nmax); repeat writeln('Vvedite ',n,' nomerov stranic po vozrastaniyu:'); for i:=1 to n do read(a[i]); readln; k:=0; for i:=2 to n do {проверяем правильность ввода} if a[i]<=a[i-1] then begin k:=1; break; end; if k=1 then writeln('Dopushena oshibka! Povtorite vvod.'); until k=0; str(a[1],c); {преобразуем в строку первое число} s:=c;{начальная строка} i:=2;{начинаем со второго} while i<=n do begin str(a[i],c);{преобразуем} if a[i]-a[i-1]<>1 then s:=s+', '+c;{если не по порядку, запятая +число} if (a[i]-a[i-1]=1)and(a[i+1]-a[i]<>1) then s:=s+'-'+c;{если по порядку, а следующее не по порядку, то дефис+число} if (a[i]-a[i-1]=1)and(a[i+1]-a[i]=1) then {если 3 по порядку, то} begin s:=s+'-';{пишем дефис} inc(i);{переходим к следующему} end else inc(i);{если не 3 попорядку, к следующему} end; for i:=length(s)downto 1 do {удаляем сочетания (,-)} if (s[i]='-')and(s[i+1]=',') then delete(s,i+1,2); while pos('--',s)>0 do {удаляем лишние дефисы} delete(s,pos('--',s),1); write(s); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.02.2009, 09:42 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244163 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Для задачи, которую Вы поставили для себя, Вы справились.

Вопрос № 161.047

Пожалуйста помогите найти ошибку. Программа должна выводить на экран самое короткое слово в тексте Приложение: program a1; uses crt; var str:string; slovo,slovomin:string; i:integer; begin clrscr; write('vvestu text: '); readln(str); i:=1; slovomin:=''; while i<=length(str) do begin if str[i]<>' ' then begin slovo:=''; while (str[i]<>' ') do begin slovo:=slovo+str[i]; if (i=length(str)) then break; i:=i+1; end; if slovomin = '' then slovomin := slovo; if length(slovo)<length(slovomin) then slovomin:=slovo; end; inc(i); end; write('slovo min : ',slovomin); readln; end.

Отправлен: 21.02.2009, 01:13 Вопрос задала: Orlova Svetlana Stanislavovna (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 9)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Orlova Svetlana Stanislavovna! Поскольку программа Ваша работает,то лишь немного ее усовершенствовал. Сейчас можно вводить практически любой текст, несколько пробелов подряд, основные разделители слов, можно добавить. Комментирую только то, что изменил. Прилагаю саму программу, возможно Вы неправильно ввели ее текст. Приложение: program a1; uses crt; const rz=['.',',',';',':','?','!'];{список разделителей} var str:string; slovo,slovomin:string; i:integer; begin clrscr; writeln('Vvedite text:'); readln(str); for i:=1 to length(str) do if str[i] in rz then str[i]:=' ';{заменим разделители на пробелы} while pos(' ',str)>0 do {если 2 пробела подряд, то 1 удаляем(между апострофами обязательно 2 пробела!, инче удалите все пробелы, и не будет слов)} delete(str,pos(' ',str),1); if str[length(str)]=' 'then{если в конце строки оказался пробел, удаляем его} delete(str,length(str),1); i:=1; slovomin:=''; while i<=length(str) do begin if str[i]<>' ' then begin slovo:=''; while (str[i]<>' ') do begin slovo:=slovo+str[i]; if (i=length(str)) then break; i:=i+1; end; if slovomin = '' then slovomin := slovo; if length(slovo)<length(slovomin) then slovomin:=slovo; end; inc(i); end; write('slovo min : ',slovomin); readln end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 21.02.2009, 12:26 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244166 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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