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

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

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

Шичко Игорь Статус: Практикант Рейтинг: 183 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 114 ∙ повысить рейтинг >>

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

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

Выпуск № 750
от 09.12.2008, 15:35

Вопрос № 152780: Помогите пожалуйста. Нужно зашифровать и расшифровать русскоязычное сообщение, содержащее пробелы и знаки препинания (длина алфавита 35) с помощью одноразовой системы шифрования. Ключом является большой фрагмент текста (не менее длины сообщения).<...

Вопрос № 152.780

Помогите пожалуйста. Нужно зашифровать и расшифровать русскоязычное сообщение, содержащее пробелы и знаки препинания (длина алфавита 35) с помощью одноразовой системы шифрования. Ключом является большой фрагмент текста (не менее длины сообщения). Заранее Спасибо.

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

Отвечает: Foxbox Здравствуйте, Фролов Сергей Анатольевич! В приложении приведён модуль, написанный для ObjectPascal. Адаптировать сможете (надеюсь) без труда. Алгоритм шифрации прост до безобразия. Есть текст и есть ключ. Ограничения на взаимные длины отсутствуют. Идет побайтное сложение кодов символов текста с кодом символа ключа. проще говоря: NewChar := chr(ord(TextChar) + ord(KeyChar)) Если получаемый код символа превышает размерность в 1 байт, то текущий код символа приводится к размерности 1 байта, но код следующего символа будет увеличен на 1. Алгоритм шифрования по ключу со смещением. Криптостойкость алгоритма невелика. В приложении 2 функции: function encodestring(s,k:string):string; кодирует текст и возвращает зашифрованный текст. s - исходный текст k - ключ function decodestring(s,k:string):string; декодирует текст и возвращает расшифрованный текст s - зашифрованный текст k - ключ Обращаю внимание. Зашифрованный текст може т содержать спецсимволы; перегоняя зашифрованный текст из переменной в переменную или вводя его с клавиатуры, можно потерять часть символов. Зашифрованный текст лучше сохранять в файлы и из файла его потом считывать побайтно. Приложение: unit EncodeDecode; interface function encodestring(s,k:string):string; function decodestring(s,k:string):string; implementation uses sysutils; function encodestring(s,k:string):string; var key:string; c:char; i,j,b,d:integer; mustinc:boolean; begin result:=''; mustinc:=false; if length(trim(k))>0 then begin j:=1; key:=trim(ansilowercase(k)); c:=key[1]; key[1]:=key[length(key)]; key[length(key)]:=c; for i:=1 to length(s) do begin b:=ord(s[i]); if mustinc then inc(b); d:=ord(key[j]); result:=result+chr((b+d)mod 256); if (((b+d)div 256)>0) then mustinc:=true else mustinc:=false; inc(j); if j>length(key) then j:=1; end; end else result:=s; end; function decodestring(s,k:string):string; var key:string; c:char; i,j,b,d:integer; mustdec:boolean; begin result:=''; mustdec:=false; if length(trim(k))>0 then begin j:=1; key:=trim(ansilowercase(k)); c:=key[1]; key[1]:=key[length(key)]; key[length(key)]:=c; for i:=1 to length(s) do begin b:=ord(s[i]); d:=ord(key[j]); b:=(b-d); if mustdec then dec(b); if b<0 then begin mustdec:=true; b:=b+256 end else mustdec:=false; result:=result+chr(b); inc(j); if j>length(key) then j:=1; end; end else result:=s; end; end.

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

Вопрос № 152.784

Добрый день уважаемые эксперты мне очень нужна ваша помощь, помогите пожалуйста решить несколько задач, за ранее благодарю. №1 В матрице A(M,N), M<=50, N<=30 найти максимальный вектор-строку. Вектор (2,3,4,5) > вектора (2,3,1,5), посколько третья компонента 4 больше третьей компоненты 1. №2 Составить программу нахождения НОД и НОК двух чисел a и b. №3 Ввести строку длинной до 30 символов, заменить в ней двойных символов на одиночные, пробелов - на знак почёркивания, сочетание '**' на многоточие '...'.

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

Отвечает: 6a3uJI Здравствуйте, Кирова Анастасия Викторовна! 2) НОД и НОК двух чисел (параметры): function NOD(x,y:integer):integer; Begin If x<>0 then NOD:=NOD(y mod x,x) else NOD:=y; End; function NOK(x,y:integer):integer; Begin NOK:=(x div NOD (x,y))*y; end; 3) label ex; var s,s1:string[30]; i,j:integer; ch:char; begin write('Enter string: '); readln(s); i:=1; s1:=''; ex: while i<=length(s) do begin if s[i]=' ' then begin s1:=s1+'_'; i:=i+1; goto ex; end; if s[i]=s[i+1] then begin if s[i]='*' then s1:=s1+'...' else s1:=s1+s[i]; i:=i+2; goto ex; end; s1:=s1+s[i]; i:=i+1; end; writeln(s1); end.

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

Вопрос № 152.786

Уважаемые эксперты, помогите, пожалуйста! Задача такая: Ввести с клавиатуры и вывести на экран многочлен используя указатели, причем привести подобные слагаемые и расставить по степеням. Сигнлом окончания ввода является 0 0. ЗАДАЧУ НУЖНО РЕШИТЬ УСПОЛЬЗУЯ УКАЗАТЕЛИ! Например: Вводим с клавиатуры 4 2 0 -1 5 2 1 1 0 0 т.е. мы ввели 4x^2 + 0x^-1 + 5x^2 + 1x^1 Вывести на экран 9x^2+1x^1 или (9x^2 + x)

Отправлен: 03.12.2008, 16:23 Вопрос задала: Miracle (статус: 1-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Miracle! Программа в приложении. Удачи! Приложение: type TList=^rList; rList=record x,y:integer;{} z:TList;{указатель на следующий элемент} end; var a,b,c:TList; d,e:integer; begin a:=nil; repeat b:=a; {вводим коэфициэнт и степень} write('Ax:');readln(e); write('x^:');readln(d); if (e<>0)or(d<>0)then begin {начинаем поиск степени в списке} c:=nil; while (b<>nil)and(b^.y<>d) do b:=b^.z; if b<>nil then begin b^.x:=b^.x+e;{нашли суммируем} end else begin{ненашли} new(c);{создаем новый элемент} c^.x:=e;{запоминаем коэфициэнт} c^.y:=d;{запоминаем степень} end; if c<>nil then{если новый элемент создавался} begin if (c^.y>a^.y)or(a=nil) then{проверяем больше ли он первого элемента в списке} begin c^.z:=a; a:=c; end else begin{вставляем в список после всех элементов степень которых больше введенного} b:=a; while (b^.z^.y>c^.y)and(b^.z<>nil) do b:=b^.z; c^.z:=b^.z; b^.z:=c; end; end; end; until (e=0)and(d=0); writeln; b:=a; {вывод результата и освобождение занимаемой памяти} c:=a; while b<>nil do begin a:=b; if (c=nil)and(b^.x>0)then write('+'); if a^.x <> 0 then begin write(a^.x,'x^',a^.y); c:=nil; end; b:=b^.z; dispose(a); end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 152.790

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

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

Отвечает: Foxbox Здравствуйте, Harlamenkov Alexandr Nikolaevich! Похоже, Вы с "Фролов Сергей Анатольевич" учитесь вместе... Посмотрите ответ на вопрос № 152780. Возможно, Вы найдёте для себя что-то полезное... ссылка в приложении Редактирование - длинная ссылка (ссылка нашего портала, не там взятая) -------- ∙ Отредактировал: Shapoklak, Академик ∙ Дата редактирования: 03.12.2008, 18:11 (время московское) Приложение: http://rusfaq.ru/info/question/152780

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

Вопрос № 152.798

Здравствуйте уважаемые эксперты очень нужна ваша помощ: 1. Вычислить произведение двух матриц A(K,L), B(K,L),K<=40 L<= .(возможно это значение нужно ввести с клавиатуры) 2. Дана действительная матрица размера m*n. Определить числа равные суммам элементов ее строк.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, MyNameIsRuZ! По первому вопросу: умножать можно матрицы, если количество строк в первой=количеству столбцов во второй, т.е. квадратные матрицы и матрицы вида С=А[N,M]*B[K,N]; Т.е. матрицы как у Вас A(K,L), B(K,L)перемножить нельзя. Пример умножения в приложении. Также решение второй задачи. Приложение: 1. Вычислить произведение двух матриц A(K,L), B(K,L),K<=40 L<= .(возможно это значение нужно ввести с клавиатуры) uses crt; const k=3; {размеры матриц} l=5; var a:array[1..k,1..l]of integer;{которую умножаем} b:array[1..l,1..k]of integer;{на которую умножаем} c:array[1..k,1..k]of integer;{результат} i,j,p:integer; begin clrscr; randomize; writeln('Matrica A:'); for i:=1 to k do begin for j:=1 to l do begin a[i,j]:=random(9)+1; write(a[i,j]:3); end; writeln; end; readln; writeln('Matrica B:'); for i:=1 to l do begin for j:=1 to k do begin b[i,j]:=random(9)+1; write(b[i,j]:3); end; writeln; end; readln; for p:=1 to k do {умножение матриц} for j:=1 to k do begin c[k,j]:=0; for i:=1 to k do begin c[p,j]:=c[p,j]+a[p,i]*b[i,j];{сумма произведений соответствующих элементов строк первой матрицы и столбцов второй матрицы} end; end; writeln('Matrica C=A*B:'); for i:=1 to k do begin for j:=1 to k do write(c[i,j]:5); writeln; end; readln; end. 2. Дана действительная матрица размера m*n. Определить числа равные суммам элементов ее строк. uses crt; const m=5; n=7; var a:array[1..m,1..n]of integer; i,j,sm:integer; begin clrscr; randomize; writeln('Matrica A:'); for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(9)+1; write(a[i,j]:3); end; writeln; end; for i:=1 to m do begin sm:=0; for j:=1 to n do {считаем сумму в строках} sm:=sm+a[i,j]; writeln('Summa v stroke ',i,' ravna ',sm); end; readln end.

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

Вопрос № 152.832

Добрый день,уважаемые эксперты,помогите пожалуйста с задачкой,текс такой Даётся круг и его радиус,задаётся координаты точки.Проверить,принадлежит ли точка кругу или нет???на паскале

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

Отвечает: Великий Александр Здравствуйте, Oracle! Предлагаю вам свой вариант решения данной задачи.... Приложение: program Krug; var x, y, x0, y0, r: integer; begin {Вводятся данный параметры окружности} WriteLn ('Write coordinates of centre of circle - O (x0, y0) !'); Write ('x0 = '); Readln (x0); Write ('y0 = '); Readln (y0); Writeln; {Вводятся параметры данной точки} Writeln ('Write radius !'); Readln (r); Writeln; WriteLn ('Write coordinates spot - M (x, y) !'); Write ('x = '); Readln (x); Write ('y = '); Readln (y); Writeln; {Проверяется принадлежит ли эта точка окружности} If Sqr(x-x0)+Sqr(y-y0) = Sqr(r) then WriteLn ('M (',x,', ',y,') be a member of circule.') else WriteLn ('M (',x,', ',y,') do not be a member of circle.'); end.

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

Вопрос № 152.834

Здравствуйте! Помогите пожалуйста!! очень-очень надо.. завтра сдавать.. сами задания (в pascal'e): 1) ввести букву. удалить ее из всех четных слов заданной строки. 2)создать программу, реализующую сортировку массива простыми включениями и методом максимумов. Заранее, огромное спасибо!!!

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

Отвечает: Verena Здравствуйте, Кристина! В первой задаче будем считать словом любую последовательность символов, отделённую пробелом(ами). Задаём индикатор чётности, равный 1 на нечётных словах и -1 на чётных. Идём по строке, пропускаем все пробелы, а в областях между пробелами удаляем заданный символ функцией delete (где, с_какой_позиции, сколько), если индикатор чётности отрицателен. Описание строковых функций можете посмотреть здесь. По второй задаче. Вы не указали, в какую сторону производить сортировку, так что сортирую по убыванию (если нужна обратная - достаточно поменять знак сравнения в условии сортировки на противоположный). В первом алгоритме элементы массива сдвигаются на место текущего до тех пор, пока ему не найдётся подходящее по условию сортировки место. Алгоритма, который назывался бы конкретно "метод максимумов" я не знаю, но, полагаю, это может быть алгоритм сорти ровки выбором, когда в хвосте массива, начиная от текущего элемента, ищется максимум (минимум, в зависимости от направления сортировки) и вставляется на текущую позицию. О распространённых алгоритмах сортировки с примерами на паскале можете почитать в этой статье. Решения в приложении, думаю, остальное будет ясно из комментариев. Удачи! Приложение: {Задача 1} Var s: string; c: char; i, l, k: integer; begin writeln ('Введите строку'); readln (s); {Ввод строки} writeln ('Введите символ'); readln (c); {Ввод символа} i:= 1; {Индекс в строке} l:= length (s); {Длина строки} k:= 1; {Индикатор чётности (1 для нечётных, -1 для чётных} while (i<l) do {Пока не конец строки} begin while (i<l) and (s[i]=' ') do inc (i); {Пропускаем все пробелы} while (i<l) and (s[i]<>' ') do {Пока идут непробельные символы (слово(} if (k<0) and (s[i]=c) then delete (s, i, 1) {Если оно чётное и текущий символ совпадает с удаляемым, удаляем} else inc (i); {Иначе переходим на следующий символ} k:=-1*k; {Меняем индикатор на противоположный} end; writeln ('Rezultat: ', s); {Выводим результат} end. {Задача 2} type mas = array [0..20] of integer; {Описываем тип массива} var i, n, v: integer; a: mas; procedure Sort1 (var a: mas; n: integer); { Сортировка простыми включениями } Var x, i, j, k: integer; begin For i:=2 to n do {Идём по массиву} begin x:=a[i]; {Запоминаем текущий элемент} j:=i-1; {Начиная с предыдущего} While (j>0) and (x>a[j]) do {Пока выполняетсфя условие сортировки и индекс в пределах массива} begin a[j+1]:=a[j]; {Сдвигаем элементы массива} j:=j-1; {Уменьшаем индекс} end; a[j+1]:=x; {Восстанавливаем запомненный элементна новом месте} end; end; procedure Sort2 (var a: mas; n: integer); { Сортировка выбором } Var x, i, j, imax: integer; begin For i:=1 to n-1 do {Идём по массиву} begin imax:=i; {Начиная с текущего элемента ищем максимум} For j:=i+1 to n do {Если следующий больше текущего максимума, перезапоминаем} if a[j]>a[imax] then imax:= j; x:= a[imax]; {Меняем местами текущий элемент с максимумом} a[imax]:=a[i]; a[i]:=x; end; end; begin writeln ('Vvedite n'); {Ввод данных} readln (n); Write('Ishodnii massiv: '); For i:=1 to n do read (a[i]); writeln ('Viberite metod sortirovki'); {Выбор меода сортировки (по убыванию)} writeln ('1 - vklucheniami, 2 - vstavkoi'); repeat {Запрашивать, пока ввод не будет верным} readln (v); until (v=1) or (v=2); case v of {Вызов процедуры сортировки} 1: Sort1 (a, n); 2: Sort2 (a, n); end; Write('Rezultat: '); {Вывод результата} For i:=1 to n do Write(a[i],' '); end. --------- Эта история - не для истории, понимаешь?

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

Вопрос № 152.854

Уважаемые эксперты,мне очень нужна ваша помошь!Помогите написать программку:Дан массив X:array[1,n] of integer, причём известно x[1]<=x[2]<=...<=x[n].Найти количество различных чисел среди элементов этого массива.

Отправлен: 03.12.2008, 21:58 Вопрос задала: Сапрыкина Евгения михайловна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Сапрыкина Евгения михайловна! В приложении решение Вашей задачки. Повторяющиеся элементы программа подкрашивает сиреневым цветов, чтобы удобнее было проверять работу. Приложение: Program Pr152854; Uses CRT; Const N = 80; Value = 10; Var X: Array[0..N] of Integer; i: Integer; Begin ClrScr; Randomize; TextColor(15); X[0] := 0; { Будем использовать как счетчик } WriteLn('Исходный массив:'); WriteLn; for i := 1 to N do begin { Заносим в X[i] случайное число, но не менее предыдущего } X[i] := Random(Value) + X[i - 1]; { Каждый элемент массива, кроме первого, сравниваем с предыдущим. Если элемент повторяет предыдущий, его подкрашиваем сиреневым цветом. } if (i = 1) or (X[i - 1] < X[i]) then begin inc(X[0]); TextColor(15); end else TextColor(13); Write(X[i]:6); if i mod 10 = 0 then begin { Разбивка массива по строкам } WriteLn; WriteLn; end; end; TextColor(15); WriteLn('Найдено различных чисел: ', X[0], ' из ', N); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

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

Вопрос № 152.855

Здравствуйте Уважаемые эксперты! Будьте великодушны помоч с задачей.... Приложение: Записать +1 вместо максимального элемента и -1 вместо минимального элемента каждого столбца матрицы A(K,L), К < 50,L<30.

Отправлен: 03.12.2008, 22:01 Вопрос задал: Bogdanskiy (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Bogdanskiy! Программа в приложении, заменяются только первые встреченные максимальные и минимальные значения в каждом столбце. Удачи! Приложение: var a:array[1..50,1..30]of integer; i,j,x,y,k,l:integer; begin {вводим размер массива} repeat write('Enter K:');readln(k); until (k>0)and(k<50); repeat write('Enter L:');readln(l); until (l>0)and(l<30); {создаем его с помощью генератора} for i:=1 to k do begin for j:=1 to l do begin a[i,j]:=random(20); write(a[i,j]:3); end; writeln; end; {поиск минимума и максимума} for j:=1 to l do begin x:=1; y:=1; for i:=1 to k do if a[x,j]<a[i,j] then x:=i else if a[y,j]>a[i,j] then y:=i; a[x,j]:= 1; a[y,j]:=-1; end; {выводим результат} writeln; for i:=1 to k do begin for j:=1 to l do write(a[i,j]:3); writeln; end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: SHERRY Здравствуйте, Bogdanskiy! Страшная конструкция, приведённая ниже, произведёт замену всех максимальных и минимальных элементов в каждом столбце. Числа генерируются случайным образом. Код: const k = 5; l = 7; {размерность матицы} var a: array [1..k, 1..l] of integer; {матрица} i,j,min, max: integer; {вспомогательные переменные} begin randomize; {инициализируем генератор случайных чисел} for i:=1 to k do begin for j:=1 to l do begin a[i,j] := random(10); {генерируем число в из промежутка [0; 10) } write(a[i,j]:4); {Выводим на экран сгенерированный элемент} end; writeln; {переходим на следующую строку на экране} end; writeln('-------- ---------------------------------------------------'); {просто черта на экране для разделения исходной и обработанной матриц} for j:=1 to l do begin for i:=1 to k do begin {поиск максимумаминимума в столбце} if (i=1) then {предполагаем, что первый элемент столбца и максимальный, и минимальный} begin max := a[i,j]; min := a[i,j]; end else begin if a[i,j] < min then min := a[i,j]; {если найден элемент меньше минимального, то назначим его самым минимальным (:} if a[i,j] > max then max := a[i,j]; {аналогично с максимумом} end; end; {выполним в столбце соответствующие замены} for i:=1 to k do begin if a[i,j] = min then a[i,j] := -1 {выполняем замены} else if a[i,j] = max then a[i,j] := 1; end; end; {вывод им результат работы на экран} for i:=1 to k do begin for j:=1 to l do write(a[i,j]:4); writeln; end; readln; end. Вопросы, чувствую, будут.. Отписывайтесь в мини-форуме или ЛС. Best regard's! --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Вопрос № 152.857

Приуважаемые эксперты,здравствуйте.... помогите пожалуйста с дачкой(см.приложение) в заранее благодарю..... Приложение: Определить лежит ли точка а на прямой у=кх+1

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Bogdanskiy! Программа в приложении вводятся указанные параметры. Результат выводится ввиде истина(лежит на прямой) или ложь(не лежит). Удачи! Приложение: var k,y,x:real; begin write('Enter X:');readln(x); write('Enter Y:');readln(y); write('Enter K:');readln(k); write('Result :',y=(k*x+1)); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: Умняшкин Александр Александрович const = 5; {можно изменить} var x,y:real; begin writeln('Введите x y'); readln(x,y); if y=k*x+1 then Writeln('Лежит') else Writeln('Нележит') end. --------- Консолько - наше все!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Bogdanskiy! Определить лежит ли точка а на прямой у=кх+1 Ясно что точка лежит на прямой, если мы подставим ее координаты в данное выражеение и получим равенство. Кроме того мы имеем дело с вещественными числами и равенство, очевидное для нашего глаза, не всегда очевидно компьютеру. Поэтому мы рассматриваем не абсолютное совпадение, а максимально близкое, для чего вводим погрешность е. Приложение: uses crt; var x,y,k,e:real; begin clrscr; e:=0.000001; write('x=');readln(x); write('y=');readln(y); write('k=');readln(k); if abs(y-k*x-1)<=e then write('Lezit!') else write('Ne lezit!'); readln end.

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

Вопрос № 152.920

Здраствуйте у меня такой вопрос : мне надо зделать программу на тему продажа автомобилей! у кого небудь есть какие небудь предложения?? Зарание спосибо

Отправлен: 04.12.2008, 13:28 Вопрос задал: Meirmanov Dauren (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: 6a3uJI Здравствуйте, Meirmanov Dauren ! Предлагаю сделать небольшую "базу данных" автомобилей. К примеру работать с файлом в котором будет храниться инфармация о марке авто, год выпуска, объем двигателя, телефон продавца. Файл связать с типом type Auto = record Marka: string[20]; Model: string[10]; God:integer; Objem:real; Telefon: string[15]; end; В программе реализовать функцию чтения/запись данных из/в файла, редактирование записей, добавление новых, удаление.

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

Отвечает: Foxbox Здравствуйте, Meirmanov Dauren ! может сменить платформу для начала? например, взять что-то более подходящее для решения задачи хранения и обработки данных... какую-нить СУБД для начала. Если планируемые объемы записей минимальны то подойдут таблицы Paradox. Вот только достучаться до таблиц из TurboPascal хлопотно (мягко говоря). Лучше используйте средство разработки Delphi, если тяготите к синтаксису паскаля. В противном случае Вам придётся писать подобие движка управлением базой данных (списки, коллекции, виртуальные таблицы или что-то ещё), но это крайне хлопотно (в том числе и по времени). Зачем конструировать велосипед, когда уже лет 10 назад труд программиста был упрощен? Если объёмы большие, то Вас хочу огорчить. В автосалонах такая задача уже решена. Кто на аксесе, кто как... Или трехзвенная архитектура, или клиент-сервер... Коммерческий продукт нет смысла делать. Так что 1-й момент. Это выбор СУБД. 2-й момент. Рекомендую использовать реляционную базу данных. Структура таблиц... Ну, чтобы определиться хотя бы с числом таблиц, нужно расписать, какие бизнес-объекты будут жить в системе. Например: - Физические/Юридические лица (покупатели, производители, какие-нибудь поставщики). Это раз таблица. - Марки автомобилей (просто кто делает этот автомобиль - ссылка из предыдущей таблицы, и название марки). Это два таблица. - Сами автомобили (ведь каждый автомобиль имеет свой VIN и свои даты поступления на склад и продажи клиенту). Это три таблица. Много ещё чего можно расписать: каталог допоборудования, территориально разнесённая сеть автосалонов диллера. Фантазия бушует. Поэтому определитесь с тем, какую информацию Вы хотите хранить... А отбрехаться от препода за зачет - Delphi+Paradox ваши помощники. Проблема решается за пару часов.

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

Вопрос № 152.923

Здравствуйте эксперты! Помогите решить задачу: Даны n × n матрицы и n-вектор. Составить программу вычисления С = (Ax - b). где А- матрица размерностью N на N, x,b,c- вектор столбцы вводить матрицы вручную.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Петров Иван Сергеевич! Решение с пояснениями в приложении. Приложение: uses crt; const n=5; var a:array[1..n,1..n]of integer;{матрица} x,b,c:array[1..n]of integer;{векторы} i,j:integer; begin clrscr; writeln('Vvedite ',n*n,' elementov matricy A:'); for i:=1 to n do {выводим через пробел хоть как} for j:=1 to n do read(a[i,j]); readln; clrscr; {очищаем экран} writeln('Matrica A:'); {выводим матрицу в виде таблицы} for i:=1 to n do begin for j:=1 to n do write(a[i,j]:3); writeln; end; writeln('Vvedite ',n,' elementov vektora X:'); for i:=1 to n do readln(x[i]); {вводим столбиком вектор} writeln('Vektor A*x:'); for i:=1 to n do begin c[i]:=0; for j:=1 to n do begin c[i]:=c[i]+a[i,j]*x[j];{умножаем} end; writeln(c[i]);{выводим столбиком} end; readln; writeln('Vvedite ',n,' elementov vektora B:'); for i:=1 to n do readln(b[i]); {вводим столбиком еще один вектор} writeln('Vector C=A*x-b'); for i:=1 to n do begin c[i]:=c[i]-b[i];{вычитаем} writeln(c[i]); {выводим столбиком} end; readln end.

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

Вопрос № 152.924

Здравствуйте эксперты! Помогите решить задачу: Для заданной матрицы A из p-й строки вычесть k-ю, умноженную на Apk/Akk. вводить матрицу вручную

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Петров Иван Сергеевич! Решение задачи с пояснениями в приложении. Приложение: uses crt; const m=5; {размер матрицы} n=6; var a:array[1..m,1..n]of real;{сама матрица} i,j,k,p:integer; x,y:real; begin clrscr; randomize; writeln('Matrica A:'); for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=10*random; write(a[i,j]:5:2); end; writeln; end; repeat write('Vvedite stroku p= ');readln(p);{вводим строки для преобразований, с проверкой условий} write('Vvedite stroku k= ');readln(k); x:=a[p,k];y:=a[k,k]; {запоминаем элементы для пересчета} until (p>0)and(p<=m)and(k>0)and(k<=n)and(k<>p); if a[k,k]<>0 then for j:=1 to n do a[p,j]:=a[p,j]-a[k,j]*(x/y) {делаем преобразования пр условию} else begin writeln('Preobrazovanie nevozmozno!'); readln; halt; end; writeln('Rezultat:'); for i:=1 to m do begin for j:=1 to n do write(a[i,j]:5:2); writeln; end; readln end.

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

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