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

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

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

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

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

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

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

Выпуск № 862
от 24.04.2009, 20:05

Вопрос № 165285: Здравствуйте, уважаемые эксперты, помогите решить задачу по массивам: даны векторы а=(а1, а2, а3) и в=(в1, в2, в3). Вычислить скалярное и векторное произведение а и в. Очень надеюсь на вашу помощь....

Вопрос № 165.285

Здравствуйте, уважаемые эксперты, помогите решить задачу по массивам: даны векторы а=(а1, а2, а3) и в=(в1, в2, в3). Вычислить скалярное и векторное произведение а и в. Очень надеюсь на вашу помощь.

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

Отвечает: LfiN Здравствуйте, Юлия-Sonne! Код программы, в которой пользователь вводит по очереди векторы а и в: Приложение: program z; Uses CRT; var a, b: array [1..3] of Real; skal, vekt1, vekt2, vekt3: Real; i: Integer; begin ClrScr; for i:=1 to 3 do begin Write('Vvedite a', i ,': '); ReadLn(a[i]); end; for i:=1 to 3 do begin Write('Vvedite b', i ,': '); ReadLn(b[i]); end; skal:=a[1]*b[1]+a[2]*b[2]+a[3]*b[3]; WriteLn('Skalyarnoe proizvedenie:', skal:6:2); vekt1:=a[2]*b[3]-a[3]*b[2]; vekt2:=-(a[1]*b[3]-a[3]*b[1]); vekt3:=a[1]*b[2]-a[2]*b[1]; WriteLn('Vektornoe proizvedenie: (' ,vekt1:6:2, ',' ,vekt2:6:2, ',' ,vekt3:6:2,')'); ReadLn; end.

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

Вопрос № 165.286

1) Для заданных значений x и n вычислите y=x^n, где n – натуральное число. Решить циклом. HELP ME 2) Составить программу решения квадратного уравнения.Решить функцией. Линейно решить могу, а вот чтобы по заданию!

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

Отвечает: Andrey Popkov Здравствуйте, Tesco! 1. var x, y: Real; n, i: Integer; begin write('Enter X:'); Readln(x); write('Enter N:'); Readln(n); y:= x; for i := 1 to n - 1 do y:= y * x; writeln('x^n = ', y:5:2); Readln; end.

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

Отвечает: Proce Здравствуйте, Tesco! Вот решение второй задачи. Для возврата корней уравнения функцию использовать неудобно т. к. в общем случае в квадратном уравнении 2 корня, поэтому описанная мною функция возвращает информацию о корнях(вещественные или нет), а сами корни записываются в x1 и x2 - параметры переменные. Если функция возвращает falst, то значения x1 и x2 не определены и их использовать нельзя. Приложение: program Project1; function uravn(a, b, c: Real; var x1, x2: Real): Boolean; {возвращает true если есть действительные корни} var d: real; begin d := b*b - 4*a*c; if d >= 0 then begin x1 := (sqrt(d) - b)/(2*a); x2 := (-sqrt(d) - b)/(2*a); result := true; end else result := false end; var a, b, c, x1, x2: Real; begin write('Vvedite a, b, c dlia a*x*x + b*x + c = 0 : '); readln(a, b, c); if uravn(a, b, c, x1, x2) then writeln('x1 = ', x1:0:2,'; x2 = ', x2:0:2) else writeln('Uravnenie ne imeet deistvitelnih korney'); readln end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Tesco! Вариант решения с функцией в приложении. Приложение: uses crt; Function Korn(a,b,c:real):string;{наша функция} var d,x1,x2:real; s:string; s1,s2:string; begin d:=b*b-4*a*c;{дискриминант} if d<0 then s:='Действительных корней нет!' else if d=0 then begin x1:=-b/(2*a);{находим корень} str(x1,s1);{преобразуем в строку} s1:=copy(s1,1,6);{берем первые 6 знаков, можно больше} s:='x1=x2='+s1;{составляем результат} end else begin x1:=(-b-sqrt(d))/(2*a); x2:=(-b+sqrt(d))/(2*a); str(x1,s1); str(x2,s2); s1:=copy(s1,1,6); s2:=copy(s2,1,6); s:='x1='+s1+' x2='+s2; end; Korn:=s; end; var a,b,c:real; begin clrscr; repeat write('a=');readln(a); until a<>0; write('b=');readln(b); write('c=');readln(c); write(Korn(a,b,c)); readln end.

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

Вопрос № 165.288

Уважаемые эксперты!Помогите пожалуйста сделать программу с использованием функций или процедур. Задание такое: создать список студентов (N>10). Определить названия учебных заведений в которых учатся однофамильцы и если у них одинаковые имена, то сообщить, что они тезки. процедуру создания списка студентов я набросал(незнаю правильно или нет). Помогите пожалуйста доделать программу.Заранее спасибо. Приложение: {program ya; const max=11; type Student = Record FirstName:String[32]; SecondName:String[32]; SurName:String[32]; Group:String[32]; Institution:String[32]; end; StudentList=record Student_Array:Array[1..max] of Student; n:integer; end; var Students:StudentList; procedure InputData(var TStudent:StudentList); var n,i:integer; begin repeat writeln('Enter number students: '); readln(n); if (n<=0) or (n>max) then writeln('Error,please try again '); until(n>0)and(n<=max); for i:=1 to n do begin writeln('Enter firstname',i,' '); readln(TStudent.Student_Array[i].FirstName); writeln('Enter secondname',i,' '); readln(TStudent.Student_Array[i].SecondName); writeln('Enter surname',i,' '); readln(TStudent.Student_Array[i].SurName); writeln('Enter group ',i,' '); readln(TStudent.Student_Array[i].Group); writeln('Enter institution',i,' '); readln(TStudent.Student_Array[i].Institution); end; end;}

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Volkov! В процедуру ввода студентов после корректного ввода количества студентов надо добавить строку TStudent.n:=n; или, что даже лучше, вообще удалить переменную n, а вместо нее везде использовать TStudent.n Процедура поиска однофамильцев и их вывода на экран ниже. procedure Odnofam(var Stud: StudentList); var i,j: integer; begin for i:=1 to Stud.n-1 do for j:=i+1 to Stud.n do begin if Stud.Student_Array[i].SecondName=Stud.Student_Array[j].SecondName then begin writeln('Odnofamilcy (',Stud.Student_Array[i].SecondName, ') uchatsya v "',Stud.Student_Array[i].Institution,'" i "', Stud.Student_Array[j].Institution,'"'); if Stud.Student_Array[i].FirstName=Stud.Student_Array[j].FirstName then writeln('Oni teski!'); end; end; end; Тело основной п рограммы begin InputData(Students); Odnofam(Students); readln; end. С уважением, Дмитрий

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

Вопрос № 165.289

Здравствуйте уважаемые эксперты!!! Помогите пожалуйста написать про грамму. Дано следующее описание: type produkt=(хлеб, масло, молоко, мясо, рыба, соль, сыр, сахар, чай, кофе); assortiment=set of produkt; shop=array[1..20] of assortiment; Написать программу, которая по информации из массива m типа shop (m[i] - это множество продуктов в i-магазине) определит: ∙ продукты, которые есть во всех магазинах; ∙ продукты, каждый из которых есть хотя бы в одном магазине; ∙ продукты, которых нет ни в одном магазине. Мне нужно её решить без использования множеств, использовать только циклы, массивы, строки.

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Infant1212! Программа в приложении. С уважением, Дмитрий Приложение: program produkty; uses crt; const produkt:array [1..10] of string[6]=('хлеб','масло','молоко','мясо','рыба','соль','сыр','сахар','чай','кофе'); type assortiment=array [1..10] of byte; shop=array [1..20] of assortiment; var m: shop; schTovarov,schMagazin,SumTovarov: byte; tmp: string[20]; begin clrscr; { Ввод товаров в магазины } writeln('Введите наличие продуктов в магазинах в виде строк 10100100010100110101'); writeln('Единица в i-й позиции означает что данный товар есть в магазине i, 0-нет'); for schTovarov:=1 to 10 do begin write('Введите наличие ',produkt[schTovarov],' в магазинах? '); readln(tmp); tmp:=tmp+'00000000000000000000'; { Чтобы длина была гарантировано не <20 } for schMagazin:=1 to 20 do if tmp[schMagazin]='1' then m[schMagazin][schTovarov]:=1 else m[schMagazin][schTovarov]:=0; end; writeln; { Проверка условий } for schTovarov:=1 to 10 do begin SumTovarov:=0; for schMagazin:=1 to 20 do SumTovarov:=SumTovarov+m[schMagazin][schTovarov]; if SumTovarov=20 then writeln('Продукт ',produkt[schTovarov],' есть во всех магазинах') else if SumTovarov<>0 then writeln('Продукт ',produkt[schTovarov],' есть в некоторых магазинах') else writeln('Продукта ',produkt[schTovarov],' нет ни в одном магазине'); end; end.

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

Вопрос № 165.304

Здравствуйте Помогите пожалуйста бедной студентке!!!!!!!!!! я совсем ничего не понимаю в програмировании а тут задали контрольную работу!!!!!!!!!! Нужно написать программу которая будет упрощать многчлены вводится они будут в таком формате: 6x^5 6545x 4545x^53 x^534 что-то типа этого то есть между одночленами может быть неограниченое число пробелов и переводов строки!!!!!! и что самое страшное всё это нужно организовать на какихто списках????? пожалуйста помогите!!!!!!!!!!1

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

Отвечает: Mixala Здравствуйте, Olgthebest! просто надо считывать группы элементов, разбить на слова, а потом одинаковые сопоставить коэффициенты Приложение: type PList=^TList; //тип списка TList=record s:string; //строка, то есть х^5 напр. x:integer; //коэф n:PList; //ссылка на след. end; var p,top,p1:PList; i,j,n,k:integer; f:boolean; begin Read(s); new(top); top^.n:=nil; For i:=1 to length(s) do begin if (s[i]=' ')and(s1<>'') then begin new(p); p.s:=s1; s1:=''; j:=1; while p.s[j]<>'x' do begin s1:=s1+p.s[j]; j:=j+1; delete(p.s,1,1); end; p.x:=strtoint(s1); p1:=top; f:=false; while p1^.n<>nil do if p1.s=p.s then begin p1.x:=p1.x+p.x; f:=true; break; end; p1:=p1^.n; end; if f then continue; s1:=''; p^.n:=top^.n; top^.n:=p; end else s1:=s1+s[i]; p1:=top; //вывод списка while p1^.n<>nil do Write(p1.x,p1.s); end; end;

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

Вопрос № 165.344

Здравствуйте! У меня программа которая должнв выводить столбцовую диаграмму упеваемости учеников в классе, если известно количество отличников, хорошистов и т.д. Вроде сделал, но есть некоторые вопросы такие, как: 1) вывод идёт под столбцам сверху, а мне надо снизу; 2) как под столбцами разместить подпись с оценками, то есть столбец и под ним надпись с оценкой; 3) и можно ли в стобце вывести кто какую оценку получил. Помогите пожалуйста Приложение: Program KKR4_10; uses CRT,Graph; const MaxNumberOfStudents=99; type TStudent=record Name:string[25]; Mark:2..5; end; TListOfStudents=record Items:array[1..MaxNumberOfStudents] of TStudent; Count:integer; end; TJournal=record Group:string[6]; Students:TListOfStudents; end; type ArrayMarks=array[1..4] of integer; Procedure InputStudent(var s:TStudent); begin write(' Ученик: '); readln(s.Name); write(' Оценка: '); readln(s.Mark); end; Procedure InputListOfStudents(var j:TListOfStudents); var i:integer; begin write('Введите число учеников: '); readln(j.Count); writeln('Список учеников и оценок:'); for i:=1 to j.Count do begin write('№',i ); InputStudent(j.Items[i]); end; clrscr; end; Procedure InputJournal(var j:TJournal); begin write('Класс: '); readln(j.Group); InputListOfStudents(j.Students); end; Procedure OutputRegister(mark:byte; Magazine:TJournal); var i:integer; begin writeln(' Класс - ',Magazine.Group); writeln('Оценка ученика - (',mark,'):'); for i:=1 to Magazine.Students.Count do if Magazine.Students.Items[i].Mark=mark then writeln(Magazine.Students.Items[i].name); readln; end; {Procedure Diagramma (Magazine:TJournal; var sm:ArrayMarks); var i,j:byte; begin for i:=1 to Magazine.Students.Count do if Magazine.Students.Items[i].Mark=2 then sm[1]:=sm[1]+1 else if Magazine.Students.Items[i].Mark=3 then sm[2]:=sm[2]+1 else if Magazine.Students.Items[i].Mark=4 then sm[3]:=sm[3]+1 else if Magazine.Students.Items[i].Mark=5 then sm[4]:=sm[4]+1; for i:=1 to 4 do begin textcolor(i); write('Kolichestvo ',i+1,' '); for j:=1 to sm[i]*2 do write(#178); write(' ',sm[i]); writeln; end; readln; end;} Function CountCoordinateForY(sm:ArrayMarks; i:integer):integer; var y:integer; begin Y:=sm[i]; CountCoordinateForY:=round(200/Y); end; Procedure Diagramma(Magazine:Tjournal; sm:ArrayMarks); var driver,mode,Err,i:integer; begin clrscr; driver:=detect; InitGraph(driver,mode,'C:BGI'); Err:=GraphResult; if Err<>grOK then writeln('Ошибка при инициализации графического режима') else begin SetViewPort(0,0,200,300,ClipOff); for i:=1 to Magazine.Students.Count do if Magazine.Students.Items[i].Mark=2 then sm[1]:=sm[1]+1 else if Magazine.Students.Items[i].Mark=3 then sm[2]:=sm[2]+1 else if Magazine.Students.Items[i].Mark=4 then sm[3]:=sm[3]+1 else if Magazine.Students.Items[i].Mark=5 then sm[4]:=sm[4]+1; {SetColor(Red); Rectangle(0,0,75,CountCoordinateForY(sm,1)); SetColor(blue); Rectangle(75,0,150,CountCoordinateForY(sm,2)); SetColor(green); Rectangle(150,0,225,CountCoordinateForY(sm,3)); SetColor(yellow); Rectangle(225,0,300,CountCoordinateForY(sm,4));} {SetFillStyle(8,Red); Bar(0,0,75,CountCoordinateForY(sm,1)); SetFillStyle(8,Yellow); Bar(75,0,150,CountCoordinateForY(sm,2)); SetFillStyle(8,Blue); Bar(150,0,225,CountCoordinateForY(sm,3)); SetFillStyle(8,Green); Bar(225,0,300,CountCoordinateForY(sm,4));} SetFillStyle(8,Red); Bar3D(0,0,75,CountCoordinateForY(sm,1),0,TopOn); SetFillStyle(8,Yellow); Bar3D(75,0,150,CountCoordinateForY(sm,2),0,TopOn); SetFillStyle(8,Blue); Bar3D(150,0,225,CountCoordinateForY(sm,3),0,TopOn); SetFillStyle(8,Green); Bar3D(225,0,300,CountCoordinateForY(sm,4),0,TopOn); {SetFillStyle(8,Red); Bar3D(0,CountCoordinateForY(sm,1),75,200,0,TopOn); SetFillStyle(8,Yellow); Bar3D(75,CountCoordinateForY(sm,2),15,200,0,TopOn); SetFillStyle(8,Blue); Bar3D(150,CountCoordinateForY(sm,3),225,200,0,TopOn); SetFillStyle(8,Green); Bar3D(225,CountCoordinateForY(sm,4),300,200,0,TopOn);} end; end; var j:TJournal; sm:ArrayMarks; begin clrscr; InputJournal(j); OutputRegister(5,j); OutputRegister(4,j); OutputRegister(3,j); OutputRegister(2,j); Diagramma(j,sm); readln; end.

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Gparev Во первых: Ваша функция CountCoordinateForY не правильно считает высоту столбца При таком подходе: round(200/Y) - у вас получается, что чем больше учеников получило такую оценку, тем ниже будет столбец. Надо так: 202-round(200/Y). т.о. получим: максимальная высота столбца будет 200 (если все 99 учеников получили одну оценку), минимальная 2 - если такой ученик только 1. Так же здесь вы не учитываете, что ни одного ученика с такой оченкой может не оказаться и в таком случае программа вылетит с ошибкой "деление на 0". Вообщем сделать надо так: if y<>0 then CountCoordinateForY:=202-round(200/Y) else CountCoordinateForY:=0; Во-вторых: В процедуре Diagramma 1.Зачем то устанавливаете ViewPort - это лишнее 2.При подсчете оценок в массив sm[] - вы его не удосужились проинициализировать, а вам никто не гарантирует, что в нем изначально будут нули поэтому перед ци клом подсчета надо бы добавить: for i:=1 to 4 do sm[i]:=0; Ну и в третьих по вашим вопросам: 1.В графическом режиме в паскале координаты (0,0) расположены в верхнем левом углу, т.о. если по оси x у нас все более менее понятно (она идет слева-направо), то ось y получается перевернутой, она идет сверху вниз. Поэтому и диаграмма у вас выходит перевернутой. Для того чтобы этого не происходило и все вернулось "с головы на ноги" все кординаты y при отрисовке любого объекта необходимо "переворачивать", т.е. Yэкранный=GetMaxY-Yнаш. т.о. мы сместим точку начала координат из левого верхнего угла в левый нижний. Например, отрисовка вашего столбца диаграммы должна выглядеть так: Bar3D(0,GetMaxY,75,GetMaxY-CountCoordinateForY(sm,1),0,TopOn); Если вам необходимо еще и подписать столбики, то тогда нам нужно сместить Y=0 не в самый низ экрана, а скажем оставив 30 точек на подпись соответстве нно Yэкранный=GetMaxY-30-Yнаш - и столбик уже будет рисоваться так: Bar3D(0,GetMaxY-30,75,GetMaxY-30-CountCoordinateForY(sm,1),0,TopOn); 2.Для вывода подписей к столбцам, используйте OutTextXY(). (Не забудьте перевернуть координату y), как в предыдущем пункте. Это по грубым ошибкам. Ну а по мелочи там еще можно трактат накатать. Надеюсь мои разглагольствования вам помогут. С уважением, Дмитрий

Ответ отправил: Тимошенко Дмитрий (статус: 6-й класс) Ответ отправлен: 20.04.2009, 23:25 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247935 на номер 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