Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

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

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

lamed Статус: Бакалавр Рейтинг: 2412 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 2173 ∙ повысить рейтинг »

_Ayl_ Статус: Практикант Рейтинг: 1855 ∙ повысить рейтинг »

Вопрос № 178011: Уважаемые эксперты. Помогите написать программу на pascal abc. вот условие задания: type dan = record pol:(муж,жен); name:string; rost:140..200 end; group=array[1..10] of dan. Написать программу, использующую функцию higt(gr) для...

Уважаемые эксперты. Помогите написать программу на pascal abc. вот условие задания:
type dan = record
pol:(муж,жен);
name:string;
rost:140..200
end;
group=array[1..10] of dan.
Написать программу, использующую функцию higt(gr) для определения имени самого высокого мужчины из группы gr.

Отправлен: 24.04.2010, 18:33
Вопрос задал: Невалёный Виталий Владимирович, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
type dan = record pol: (male, female); name: string; rost: 140..200; end; group = array[1..10] of dan; PNames = ^TNames; TNames = record Name: String; Next: PNames; end; TNameList = record NameCount: Byte; First: PNames; Last : PNames; end; PNameList = ^TNameList; var gr: group; recCount: Byte; i: Byte; buf: String; nameList: PNameList; function higt(const gr: group): PNameList; var max: Byte; nameList: TNameList; p: PNames; begin max := 0; for i := 1 to recCount do if (gr[i].pol = male) and ((max = 0) or (gr[i].rost > gr[max].rost)) then max := i; nameList.NameCount := 0; if max > 0 then begin nameList.First := nil; nameList.Last := nil; for i := 1 to recCount do if (gr[i].rost = gr[max].rost) and (gr[i].pol = male) then begin Inc(nameList.NameCount); new(p); if nameList.First = nil then begin nameList.First := p; nameList.Last := p; nameList.First^.Name := gr[i].name; end else begin nameList.Last^.Next := p; nameList.Last := p; nameList.Last^.Name := gr[i].name; end; end; end; higt := @nameList; end; Begin repeat Writeln (\'How many records you want to create? (1..10)\'); Readln(recCount); until (recCount > 0) and (recCount < 11); for i := 1 to recCount do begin repeat Write(\'Rec. \' + IntToStr(i) + \': Enter sex (male(1) or female(2)): \'); Readln(buf); if (buf = \'male\') or (buf = \'1\') then gr[i].pol := male else if (buf = \'female\') or (buf = \'2\') then gr[i].pol := female; until (buf = \'male\') or (buf = \'1\') or (buf = \'female\') or (buf = \'2\'); Write(\'Rec. \' + IntToStr(i) + \': Enter name: \'); Readln(gr[i].name); repeat Write(\'Rec. \' + IntToStr(i) + \': Enter height (140..200): \'); Readln(buf); if (StrToInt(buf) > 139) and (StrToInt(buf) < 201) then gr[i].rost := StrToInt(buf); Until (StrToInt(buf) > 139) and (StrToInt(buf) < 201); end; nameList := higt(gr); case nameList^.NameCount of 0: Writeln(\'There is no men here\'); 1: Writeln(\'The highest man name is \' + nameList^.First^.Name); else begin Writeln(\'The highest men are \'); for i := 1 to nameList^.NameCount do begin Writeln(nameList^.First^.Name); nameList^.First := nameList^.First^.Next; end; end; end; End.

Ответ отправил: Алексей S, 4-й класс
Ответ отправлен: 25.04.2010, 19:43
Номер ответа: 261028

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261028 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Приложение:
CONST ar_max = 10; TYPE sex = (male, female); dan = record pol : sex; name: String; rost: 140..200; // - использовать диапазон не удобно здесь. Если нужно, то переделать // функцию придется - там, где идут сравнения end; TGroup = array[1..ar_max] of dan; function higt(gr: tGroup; fromNo: Integer): Integer; // Такой вид имеет на случай, если имеется несколько самых высоких // Работает так: просматривает весь массив, но возвращает номер // того, кто выше всех, но номер которого не меньше fromNo // если таких нет, то возвращает -1 var k, max: Integer; // k - переменная цикла, max - номер самого рослого begin result := -1; max := 1; // Находим самого рослого for k := 1 to ar_max do // элементы параметра "открытый массив" имеют номера от 0 до high(gr) if gr[k].rost > gr[max].rost then max := k; // Теперь определим, находится ли рослый после fromNo. Если да, но возвратим номер первого такого for k := fromNo to ar_max do if gr[k].rost = gr[max].rost then begin result := k; Exit; // немедленный выход из подпрограммы-функции end; end; VAR group: TGroup; i, count: Integer; buf: String; BEGIN count := 1; WriteLn(\'Введите данные о группе: \'); repeat WriteLn(count:2,\' из \',ar_max:2,\'): пол выберите: (мужской=1, женский=2) \'); repeat ReadLn(buf); until (buf[1] = \'1\') or (buf[1] = \'2\'); // На самом деле будет так: если введет первый символ \'1\', то пол мужской // Если на первом месте в введенной строке все что угодно, но не \'1\', // то женский if buf[1] = \'1\' then group[count].pol := male else group[count].pol := female; Write(\'Фамилия: \'); ReadLn(group[count].name); Write(\'Рост: \'); repeat ReadLn(buf); i := 0; if TryStrToInt(buf, i) and (i >= 140) and (i <= 200) then group[count].rost := i else WriteLn(\'Ошибка ввода. Попробуйте ввести рост еще раз\'); until (group[count].rost >= 140) and (group[count].rost <= 200); inc(count); until count > ar_max; WriteLn(\'Фамилия самого рослого:\'); i := 1; repeat i := higt(group, i); if (i > 0) and (group[i].pol = male) then begin Write(group[i].name,\', рост: \', group[i].rost); inc(i); end; until i < 0; END.
-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 25.04.2010, 19:56
Номер ответа: 261029

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261029 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

«Шифрование методом перестановки»
Цель занятия: ознакомление с шифрованием методом перестановки

Теоретический материал

Этот метод заключается в том, что символы шифруемого текста переставляются по определенным правилам внутри шифруемого блока символов. Рассмотрим некоторые раз¬новидности этого метода.
Рассмотрим метод шифрования, называемый одиночной перестановкой по ключу. Он отличается лишь тем, что колонки таблицы переставляются по ключевому слову, фразе или набору чисел длиной в строку таблицы. Использовав в виде ключа слово ЛУНАТИК, получим такую таблицу.

Л У Н А Т И К
4 7 5 1 6 2 3
Н О Н С Б Н Я
Е Е О Я О Е Т
Я С В Е Л П Н
С Т И Щ Е О Ы
Н А Т Е Е Н М
До перестановки

А И К Л Н Т У
1 2 3 4 5 6 7
С Н Я Н Н Б О
Я Е Т Е О О Е
Е П Н Я В Л С
Щ О Ы С И Е Т
Е Н М Н Т Е А
После перестановки

В верхней строке записан ключ, а номера под ключом определены по естественному порядку соответствующих букв ключа в алфавите. Если в ключе встретились бы одинаковые буквы, они бы нумеровались слева направо. Получается шифровка: СНЯНН БОЯЕТ ЕООЕЕ ПНЯВЛ СЩОЫС ИЕТЕН МНТЕА.
Для дополнительной скрытности можно повторно шифровать сообщение, которое уже было зашифровано. Этот способ известен под названием «двойная перестановка». Для этого размер второй таблицы подбирают так, чтобы длины ее строк и столбцов были другие, чем в первой таблице. Лучше всего, если они будут взаимно простыми. Кроме того, в первой таблице можно переставлять столбцы, а во второй строки. Наконец, можно заполнять таблицу зигзагом, змейкой, по спирали или каким-то другим способом. Такие способы заполнения таблицы если и не усиливают стойкость шифра, то делают процесс шифрования гораздо более занимательным.
Слабость шифрования простой перестановкой обуславливает¬ся тем, что при большой длине шифруемого текста в зашифрован¬ном тексте могут проявиться закономерности символов ключа. Для устранения этого недо статка можно менять ключ после за¬шифровки определенного числа знаков. При достаточно частой смене ключа стойкость шифрования можно существенно по¬высить. При этом, однако, усложняется организация процесса шифрования и расшифрования.
Кроме одиночных перестановок использовались еще двойные перестановки столбцов и строк таблицы с сообщением. При этом перестановки определялись отдельно для столбцов и отдельно для строк. В таблицу вписывался текст и переставлялись столбцы, а потом строки. При расшифровке порядок перестановок был обратный. Насколько просто выполнялось это шифрование, показывает следующий пример:
2 4 1 3
4 П Р И Е
1 З Ж А Ю
2 Ш Е С
3 Т О Г О
1 2 3 4
4 И П Е Р
1 А З Ю Ж
2 Е С Ш
3 Г Т О О
1 2 3 4
1 А З Ю Ж
2 Е С Ш
3 Г Т О О
4 И П Е Р


исходная таблица перестановка столбцов перестановка строк
Получается шифровка АЗЮЖЕ СШГТООИПЕР. Ключом к этому шифру служат номера столбцов 2431 и номер а строк 4123 исходной таблицы. Число вариантов двойной перестановки тоже велико: для таблицы 3x3 их 36, для 4x4 их 576, а для 5x5 их уже 14400. Однако двойная перестановка также очень слабый вид шифра, легко читаемый при любом размер таблицы шифрования.
Джероламо Кардано открыл класс шифров перестановок, названных решетками или трафаретами. Они представляют собой квадратные таблицы, где четверть ячеек прорезана так, что при четырех поворотах они покрывают весь квадрат. Вписывание в прорезанные ячейки текста и повороты решетки продолжаются до тех пор, пока весь квадрат не будет заполнен. Например, на рисунке ниже показан процесс шифровки решеткой 4x4.
П З Т
Р Ж Ш О
И А Е Г
Е Ю С О
0о 90о 180о 270о

З Т П
О Ж Ш Р
Е И Г А
Е С Ю О
Шифр

Черными квадратами обозначены непрозрачные ячейки. А повороты осуществляются по часовой стрелке на указанный ниж е угол:
В результате получается шифровка ЗТП ОЖШРЕИГАЕСЮЮ. Число подобных решеток быстро растет с их размером. Так решетка 2x2 еди нственна, решеток 4x4 уж 256, а решеток размером 6x6 свыше ста тысяч. Несмотря на кажущуюся сложность, шифры типа решеток довольно просто вскрываются и не могут использоваться в виде самостоятельного шифра. Однако они очень удобны и еще долго использовались в практике для усиления шифров замены.

Задание на лабораторную работу
1. Ознакомиться с примером шифрования методом одиночной перестановки, приведенным в методических указаниях.
2. Разработать программу, осуществляющую шифрование и расшифрование текста методом одиночной перестановки и поддерживающую ввод различных ключей. Зашифровать фразу своим личным ключом методом одиночной перестановки, сохраняя ключ и текст конфиденциальными для других студентов. Оформить результаты работы.
3. Ознакомиться с примером шифрования методом двойной перестановки, приведенным в методических указаниях.
4. Разработать программу, осуществляющую шифрование и расшифрование текста методом двойной перестановки, сохраняя ключ и текст конфиденциальными для других студентов. Оформить результаты работы.
5. Ознакомиться с примером шифрования методом решетки Кардано, приведенным в методических указаниях и придумать фразу для последующего зашифрования.
6. Разработать программу, осуществляющую шифрование и расшифрование методом решетки Кардано размером 6х6 и зашифровать фразу своим личным ключом, сохраняя ключ и текст конфиденциальными для других студентов. Оформить результаты работы.

Отправлен: 24.04.2010, 19:31
Вопрос задал: Андрей Куманюк, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{Разработать программу, осуществляющую шифрование и расшифрование методом решетки Кардано размером 6х6 } { http://www.cyberforum.ru/pascal/thread33245.html } { Исправлено: lamed } program p178014; const n = 6; type sType = string[n]; matrix = array[1 .. n] of sType; const mask: matrix = ( \'.x..x.\', \'.x.x..\', \'..x..x\', \'......\', \'...x..\', \'x.x...\' ); st: string = \'когдаумолкнутвсепесникоторыхянезнаю!\'; var encoded: matrix; masked: matrix; { Процедура поворота матрицы } procedure T(var res: matrix); var i, j: integer; mx: matrix; begin mx := res; for i := 1 to n do for j := 1 to n do res[j][n - i + 1] := mx[i][j]; end; { Зашифровка текста } procedure EncodeText(const s: string; const mask: matrix; var mx: matrix); var i, j, count: integer; masked: matrix; begin { Заполнение матрицы mx строками по N пробелов } for i := 1 to n do for j := 1 to n do mx[i] := mx[i] + #32; masked := mask; count := 1; while count <= length(s) do begin for i := 1 to n do for j := 1 to n do if masked[i][j] = \'x\' then begin mx[i][j] := s[count]; inc(count) end; T(masked); end; end; { Расшифровка текста } function DecodeText(const mask, encoded: matrix): string; var s: string; i, j, count: integer; masked: matrix; begin masked := mask; count := 0; s := \'\'; while length(s) < n*n do begin for i := 1 to n do for j := 1 to n do if masked[i][j] = \'x\' then s := s + encoded[i][j]; T(masked); end; DecodeText := s; end; var i: integer; begin EncodeText(st, mask, encoded); writeln(\'encoded text: \'); for i := 1 to n do begin writeln(encoded[i]); end; writeln(DecodeText(mask, encoded)); end.

Ответ отправил: lamed, Бакалавр
Ответ отправлен: 26.04.2010, 16:51
Номер ответа: 261051

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261051 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Доброе утро дорогие эксперты.
Помогите рещить задачи по множеству.
1. Дана строка состоящий из цифр. Вывести те цифры,которые стоят между скобками например 32432(3454353)4353. вывести нужно 3454353.
2.Написать программу,которая в заданно1 строке состоящей из слов,оделенных одним или несколькими пробелами,определяет номер слов содержащи1 цифры.

Отправлен: 25.04.2010, 09:31
Вопрос задал: Александ Двинятин, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program p178031a; { не проверяется правая скобка } { не проверяется наличие других символов между скобками } var s: string; i: integer; len : integer; begin write(\'s=\'); readln(s); len := length(s); i:= 1; { пропускаем символы до \'(\' } while (i<len-1) and (s[i]<>\'(\') do { должно быть как минимум два оставшихся символа \'(\' и \')\' } i:= i+1; if (s[i]<>\'(\') then writeln(\'нет скобок\') else begin i:= i+1; while (i<=len) and (s[i]<>\')\') do begin write(s[i]); { печатаем символы между скобками } i:= i+1; end; writeln; readln; end; end. program p178031b; { Программа в заданной строке, состоящей из слов, разделенных одним или несколькими пробелами,определяет номер слов содержащих только цифры. } var i: integer; s: string; { введенная строка } FirstWord: boolean; { первое слово } InDigits: boolean; { слово из цифр ? } InWord : boolean; { в слове ? } WordNo: integer; { номер слова } begin write(\'s=\'); readln(s); InWord := true; InDigits := true; FirstWord := true; for i:= 1 to length(s) do begin if InWord and (s[i] =\' \') then begin { это было слово } InWord := false; inc(WordNo,1); if InDigits then if FirstWord then { запятая идет только перед следующим словом } begin write(WordNo); FirstWord := false; end else write(\',\', WordNo); InDigits := true; end else if s[i] <> \' \' then { это начинается новое слово } begin InWord := true; if not (s[i] in [\'0\'..\'9\']) then inDigits := false; end; end; if InWord then { строка кончилась непробельным символом } begin inc(WordNo,1); if InDigits then { если слово только из цифр, печатать номер } if FirstWord then write(WordNo) else write(\',\', WordNo); end; writeln; readln; end.

Ответ отправил: lamed, Бакалавр
Ответ отправлен: 25.04.2010, 19:16
Номер ответа: 261025

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 261025 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »