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

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

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

Botsman Статус: Практикант Рейтинг: 205 ∙ повысить рейтинг >>

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

Тимошенко Дмитрий Статус: 7-й класс Рейтинг: 49 ∙ повысить рейтинг >>

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

Выпуск № 867
от 30.04.2009, 04:05

Вопрос № 165733: Помогите пожалуйста срочно! Найти слова в предложении, множество символов которые совпадает с множеством первого слова...

Вопрос № 165.733

Помогите пожалуйста срочно! Найти слова в предложении, множество символов которые совпадает с множеством первого слова

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

Отвечает: Botsman Здравствуйте, Денисов Алексей! Помогаю. Код - в приложении, комментарии внутри кода. Рад был помочь! Приложение: var mnozh_1:set of char;{множество символов первого слова} mnozh_i:set of char;{множество символов анализируемого слова} txt:string;{вводимый текст} slovo:string;{анализируемое слово} i:integer;{счетчик} BEGIN writeln('введите текст:'); readln(txt); {гарантируем наличие хотя бы одного разделителя слов} txt:=txt+' '; {выделяем первое слово} slovo:=copy(txt,1,pos(' ',txt)-1); writeln('первое слово: ',slovo); {и формируем множество его различных символов} mnozh_1:=[]; for i:=1 to length(slovo) do mnozh_1:=[slovo[i]]+mnozh_1; {анализируем остаток текста} writeln('Искомые слова:'); repeat {удаляем просмотренное слово} delete(txt,1,pos(' ',txt)); {выделяем и анализируем очередное слово} slovo:=copy(txt,1,pos(' ',txt)-1); mnozh_i:=[]; for i:=1 to length(slovo) do mnozh_i:=[slovo[i]]+mnozh_i; {если множества символов совпадает, печатаем текущее слово} if mnozh_i=mnozh_1 then writeln(slovo); {продолжаем, пока не просмотрим весь текст} until txt=''; readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

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

Вопрос № 165.744

Здравствуйте уважаемые эксперты помогите с задачей пожалста )) 1.2 1 ∫--------------- dx методом трапеций и симпсона 0.4 √х*х +3

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

Отвечает: Proce Здравствуйте, Лилечка Васина! Код программы в приложении. Удачи! Приложение: program z_165744; const a = 0.4;{нижний предел} b = 1.2;{верхний предел} n = 100;{точность} function f(x: real): real; begin f := 1/(x*sqrt(x)+3); end; function IntegralTrap(a, b: real): real; {метод трапеций} var h, k, s: real; i: Integer; begin h := (b - a)/N; s := (f(a) + f(b))/2; k := a; for i := 1 to N - 1 do begin k := k + h; s := s + f(k); end; s := s*h; IntegralTrap := s; end; function IntegralSimpson(a, b: real): real; {метод симпсона} var h, k, s: real; i: Integer; begin h := (b - a)/N; s := 0; k := a; for i := 1 to N - 1 do begin k := k + h; if i mod 2 = 0 then s := s + 2*f(k) else s := s + 4*f(k); end; s := (s + f(a) + f(b))*h/3; IntegralSimpson := s; end; begin writeln('Metodom Trapecij = ', IntegralTrap(a, b):0:5); writeln('Metodom Simpsona = ', IntegralSimpson(a, b):0:5); readln end.

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

Вопрос № 165.771

Уважаемы эксперты Напишите пожалуйста программу на паскале. Нужно ввести 8 чисел и вычислить среднее значение четных чисел.

Отправлен: 24.04.2009, 18:48 Вопрос задал: Баранов Сергей Алексеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Motoden Здравствуйте, Баранов Сергей Алексеевич! Если возникнут вопросы, пишите личное сообщение. Приложение: program m; var i,j:integer; summa,schetchik,chislo:integer; rezultat:real; begin summa:=0; chislo:=0; rezultat:=0; for i:=1 to 8 do begin writeln('Vvedite chislo:'); write('chislo[',i,']='); readln(chislo); if (chislo mod 2)=0 then{если остаток от деления числа на 2 равен 0, то число чётное} begin schetchik:=schetchik+1; summa:=summa+chislo; end; end; if schetchik=0 then{если не было ни одного чётного числа, то чтобы не возникло ошибки деления на ноль, выводим сообщение о том, что не было чётных чисел} writeln('Chetnix chisel net!') else begin rezultat:=summa/schetchik; write('srednee arifmeticheskoe=',rezultat:3:2);{выводим на экран полученное число с 3(если есть) знаками до запятой и 2 после} end; readln; end. --------- "это невозможно" - сказала причина, "это болезненно" - сказала гордость, "это безрассудно" - сказал опыт. "Попробуй!" - сказала мечта

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

Вопрос № 165.774

даны две действительные квадратные матрицы порядка N получить новую матрицу. Прибавление к элементам каждого столбца первой матрицы произведение элементов соответствующих столбцов второй матрицы. Помогите плз.

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

Отвечает: Proce Здравствуйте, Mika Baglanova! Код программы в приложении. Приложение: program z_165774; const N = 5; type TArray = array [1..N, 1..N] of real; var A, B, C: TArray; i, j: Integer; procedure InArray(var A: TArray); var i, j: Integer; begin for i := 1 to N do for j := 1 to N do A[i, j] := 9 - random(19) + 1/(100 - random(200)); end; procedure PrintArray(var A: TArray); var i, j: Integer; begin for i := 1 to N do begin for j := 1 to N do Write(A[i, j]:10:2); WriteLn end; writeln end; function Proizv(var A: TArray; k: Integer): Real; var i: Integer; p: Real; begin p := 1; for i := 1 to N do p := p * A[i, k]; Proizv := p; end; begin Randomize; InArray(A); InArray(B); PrintArray(A); PrintArray(B); for i := 1 to N do for j := 1 to N do C[i, j] := A[i, j] + Proizv(B, j); PrintArray(C); readln end.

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

Вопрос № 165.780

Здравствуйте! Возникли трудности в написании процедуры на динамические списки. "Описать процедуру, которая удаляет все элементы, у которых одинаковые "соседи" (первый и последний тоже считать соседями)". Прошу помочь в составлении данной процедуры. Спасибо! Приложение: Шапка к заданиям: ДИНАМИЧЕСКИЕ ПЕРЕМЕННЫЕ Каждому студенту сделать свой вариант задания, предусмотрев процедуры: ∙ создания динамического линейного списка, выбирая числа из текстового файла; ∙ вывода динамического линейного списка.

Отправлен: 24.04.2009, 21:54 Вопрос задал: A.J.Jackson (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 17)

Отвечает: Тимошенко Дмитрий Здравствуйте, Сапожников Константин Юрьевич! Программа в приложении. С уважением, Дмитрий Приложение: program dinamik_list; uses crt; type TPElement=^TElement; { Указатель на элемент списка } TElement=record i: integer; { Элемент списка } pred: TPElement; { Предыдущий элемент } sled: TPElement; { Следующий элемент } del: boolean; { Пометка удаления } end; var PSpisok: TPElement; { Указатель на список } fin: text; { Входной файл } { Процедура вывода списка на экран } procedure PrintList(List: TPElement); var TekElm: TPElement; begin TekElm:=List; if TekElm=nil then writeln('Список пуст') else begin repeat write(TekElm^.i,' -> '); TekElm:=TekElm^.sled; until TekElm=List; writeln('Начало списка'); end; end; { Добавление элемента в список - возвращает ссылку на новый элемент } function AddToList(var List: TPElement): TPElement; var tmp: TPElement; begin new(tmp); { Если список пустой то создаем первый элемент со ссылками на самого себя } if List=nil then begin tmp^.sled:=tmp; tmp^.pred:=tmp; List:=tmp; { Запомним новое начало списка } end else begin { Иначе добавляем } new(tmp); { Для нового элемента следующим будет первый } tmp^.sled:=List; { ... а предыдщим будет тот что был предыдушим для первого } tmp^.pred:=List^.pred; { Для предыдущего следующим станет новый элемент } List^.pred^.sled:=tmp; { Для первого предыдущим также станет новый элемент } List^.pred:=tmp; end; tmp^.del:=false; AddToList:=tmp; end; { Удаление элемента из списка - возвращает ссылку на след.элемент или nil } function DelFromList(Item: TPElement): TPElement; begin if Item^.sled=Item then begin { Остался один элемент } DelFromList:=nil; end else begin { Предыдущим элементом для следующего станет предыдущий для удаляемого } Item^.sled^.pred:=Item^.pred; { а следующим элементом для предыдщего станет следующий для удаляемого } Item^.pred^.sled:=Item^.sled; DelFromList:=Item^.sled; end; dispose(Item); end; { Обработка списка по заданию - удаление одинаковых соседей } procedure Obrabotka(var List: TPElement); var TekElm: TPElement; begin { Сначала поставим пометки на удаление } TekElm:=List; repeat if TekElm^.sled^.i=TekElm^.pred^.i then TekElm^.del:=true; { При выполнении условия - пометим на удаление } TekElm:=TekElm^.sled; until TekElm=List; { А теперь удалим помеченные элементы } TekElm:=List; repeat TekElm:=TekElm^.sled; if TekElm^.del then { Если удаляем начало списка - то надо запомнить новое начало } if TekElm=List then begin TekElm:=DelFromList(TekElm); List:=TekElm; end else TekElm:=DelFromList(TekElm); until TekElm=List; end; begin clrscr; { Открываем файл } assign(fin,'chisla.txt'); {$I-} reset(fin); if IOResult<>0 then begin writeln('Не могу открыть входной файл'); halt; end; {$I+} { Читаем и создаем список } PSpisok:=nil; while not(eof(fin)) do readln(fin,AddToList(PSpisok)^.i); { Выводим исходный список на экран } write('Исходный список: '); PrintList(PSpisok); { Обрабатываем список в соответствии с условиями } Obrabotka(PSpisok); { Выводим получившийся список на экран } writeln; write('Результат обработки: '); PrintList(PSpisok); readln; end.

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

Вопрос № 165.784

Здравствуйте уважаемые эксперты! Пожалуйста, помогите решить две задачки. Что-то сложная тема "запись". 1.Используя данное представление структуры данных, решить поставленную задачу. type dan=record pol:(муж,жен); rost:140..200 end; group=array[1..10] of dan; Написать программу, использующую логическую функцию rost(gr), проверяющую, есть ли в группе gr хотя бы три человека одного роста. 2.Для данной задачи описать структуру данных (типа запись или массив записей) и организовать соответствующую обработку данных согласно условию задачи. Пусть дан массив, содержащий сведения о претендентах на руку и сердце. Сведения могут содержать следующие данные: фамилию, имя, отчество, возраст, рост, зарплату, наличие квартиры и т.п. Сформулируйте несколько критериев, по которым претенденты будут отбираться. Напишите програм¬му, предназначенную для ввода данных о претендентах и печати сведений о наиболее подходящи х кандидатов в зависимости от того или иного критерия.

Отправлен: 25.04.2009, 00:01 Вопрос задал: Кирилов Михаил Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Proce Здравствуйте, Кирилов Михаил! Вот решение первой задачи. Приложение: program z_165784; type dan = record pol:(mug,gen); rost:140..200 end; group=array[1..10] of dan; var i: Integer; gr: group; s: String; function rost(gr: Group): Boolean; var i, j, count: Integer; begin i := 1; repeat count := 0; for j := i + 1 to 10 do if gr[i].rost = gr[j].rost then inc(count); inc(i); until (count >= 3) or (i > 10); rost := count >= 3 end; begin for i := 1 to 10 do begin writeLn('Vvedite pol:'); ReadLn(s); case s[i] of 'm': gr[i].pol := mug; 'g': gr[i].pol := gen; end; writeLn('Vvedite rost:'); ReadLn(gr[i].rost); end; if rost(gr) then WriteLn('V gruppe ectj tri cheloveka s odinakovim vozrastom') else WriteLn('V gruppe net trioh ludey s odinakovim vozrastom'); readln end.

Ответ отправил: Proce (статус: 4-й класс) Ответ отправлен: 25.04.2009, 20:43 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 248242 на номер 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