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

Выпуск № 607
от 19.03.2008, 20:05

Вопрос № 127.215

Дано 50 вещественных чисел. Найти величину наибольшего из них. Приложение: помагите состаить програму и аогоритм

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

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Dolgopolov! Если вам нужен алгоритм этой задачи на словах, то он заключается в следующем: 1. Вводим с клавиатуры первое данное число. Присваиванм ему значение максимального. 2.Вводим второе число. Если оно больше, присваиваем ему значение max, если нет - пропускаем. Все поторяется 50 раз, после чего на экран выводится последнее запомненное максимальное число. 3.Завершение программы. Код в приложении. Вообще-то я думаю, что вам нужен не алгоритм, а блок-схема, но ее здесь приложить нельзя, только по e-mail/ В приложенном примере допущена ошибка: Строка 7 max:=a[1]; - переменной max присваивается значение первого элемента массива a, который еще не заполнен (в TP это значение обычно равно 0.0). Т.о., если пользователь введет 50 отрицательных значений, программа выдаст неверный результат, равный нулю. ----- ∙ Отредактировал: Denisss (Профессионал) ∙ Дата редактирования: 14.03.2008, 11:25 Приложение: uses crt; var a:array[1..50]of real; i:integer; max:real; begin clrscr; max:=a[1]; for i:=1 to 50 do begin readln(a[i]); if a[i] > max then max:=a[i]; end; writeln; writeln('max=',max:4:2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 14.03.2008, 07:28 Оценка за ответ: 5

Отвечает: Delph Здравствуйте, Dolgopolov! В приложении вариант программы, которая сама заполняет массив случайными числами, попутно отыскивая среди них наибольшее. Приложение: Program Pr127215; Uses CRT; Const N = 50; Var Arr : Array[1..N] of Real; i : Integer; Max : Real; Begin ClrScr; { Очистка экрана } Randomize; { Инициализация генератора случайных чисел } WriteLn('Исходный массив вещественных чисел:'); Arr[1] := 20 * Random - 10; Write(Arr[1]:10:5); Max := Arr[1]; for i := 2 to N do begin { Заполняем массив вещественными числами от -10 до +10 } Arr[i] := 20 * Random - 10; Write(Arr[i]:10:5); if Arr[i] > Max then Max := Arr[i]; if i mod 7 = 0 then WriteLn; end; WriteLn; WriteLn; WriteLn('Максимальное число равно ', Max:8:5); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 14.03.2008, 09:26 Оценка за ответ: 5

Вопрос № 127.247

Здравствуйте. В общем проблема в следующем: нужно писать курсовую, база данных на паскаль. Так вот, чтобы сделать несколько полей (ИФО, дата рождения и т.д.) нужно использовать записи. А чтобы эти записи не вбивать вечно нужно использовать файлы. Так вот вопрос в чём, как сделать так, чтобы запись сохранялась в файл, но и в то же время была массивом. ТО беж, чтобы можно было вбить не одну фамилию имя и т.д. а множество и всё это сохранялось, а затем бралось из файла...

Отправлен: 14.03.2008, 07:35 Вопрос задал: Зыков Николай Павлович (статус: 1-ый класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Зыков Николай Павлович! Если подробно рассказывать, как все это делается, будет целая лекция. Лучше я вам выложу образец курсовой работы, аналогичной вашей, она написана с пояснениями, ловольно все понятно, попробуйте сделать также. Когда в процессе работы появятся конкретные вопросы, задавайте. Приложение: Курсовая работа по Паскалю. Програмное средство для работы с массивами записей и текстовыми файлами. Первый курс. 2007год. Program Dyagterev; uses Crt,Dos; type Nalogoviyainspekciya=record Sname_firmi,Name_firmi:string[15]; vidsob:string[20]; viddeyat:string[20]; telephone:string[20]; faks:string[20]; adres:integer; end; var f:file of Nalogoviyainspekciya; zn,filename:string; k:integer; label 11; {-----------------------------------------------------------} procedure Creatfile; begin writeln('ZADAITE IMIA FAILA KOTORIY BUDET SOZDAVATSYA'); readln(filename); assign(f,filename); rewrite(f); end; {-----------------------------------------------------------} procedure Addrecord; var rez:integer; ch:char; begin while rez<>1 do begin writeln('ZADAITE IMIA FAILA, V KOTORIY BUDET DOBOVLIATSA ZAPIS'); readln(filename); assign(f,filename); reset(f); rez:=IOResult; if rez<>0 then begin writeln('PROVERTE PRAVILNOST IMENI FAILA!'); writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA?(Y/N)'); readln(ch); if (ch='n') or (ch='N') then halt (0); end; end; seek(f,filesize(f)); end; {==========================================================} procedure Inputfile; var st:Nalogoviyainspekciya; k:char; begin repeat writeln('VVEDITE DANIE O NOVOY FIRME : '); write('NAZVANIE FIRMI : '); readln(st.Sname_firmi); write('VID SOBSTVENNOSTI:' ); readln(st.vidsob); write('VID DEYATELNOSTI:'); readln(st.viddeyat); write('TELEPHONE:'); readln(st.telephone); write('FAKS:'); readln(st.faks); write('ADRES: '); readln(st.adres); write(f,st); write('NADO LI VVODIT DANNIE O NOVOY FIRME ? (Y/N)>');readln(k); writeln; until(k='n') or (k='N'); close(f); end; {=========================================================} procedure redzap; var st:Nalogoviyainspekciya; filename,str:string; Sname_firmi2,Name_firmi2:string[15]; vidsob2:string[20]; viddeyat2:string[20]; telephone2:string[20]; faks2:string[20]; adres2:integer; x:integer; begin writeln('ZADAITE IMIA FAILA'); readln(filename); assign(f,filename); reset(f); with st do begin write('VVEDITE NAZVANIE FIRMI: ');readln(str); x:=0; while not eof(f) do begin read(f,st); if st.Sname_firmi=str then begin writeln('VVEDITE DANIE O NOVOY FIRME : '); write('NAZVANIE FIRMI : '); readln(st.Sname_firmi); write('VID SOBSTVENNOSTI:' ); readln(st.vidsob); write('VID DEYATELNOSTI:'); readln(st.viddeyat); write('TELEPHONE:'); readln(st.telephone); write('FAKS:'); readln(st.faks); write('ADRES: '); readln(st.adres); Sname_firmi2:=Sname_firmi; viddeyat2:=viddeyat; vidsob2:=vidsob; telephone2:=telephone; faks2:=faks; adres2:=adres; seek(f,filepos(f)-1); write(f,st); x:=1; end; end; close(f); end; if x=0 then begin writeln('zapisi s takoy firmoy net!');readln end; end; {==============================================================} function Openfile: Boolean; var rez: integer; ch: char; begin Openfile:=False; repeat writeln('ZADAITE IMIA FAILA'); readln(filename); assign(f,filename); reset(f); rez:=IOResult; if rez<>0 then begin writeln('PROVERTE PRAVILNOST IMENI FAILA!'); writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA ? (Y/N)'); readln(ch); if UpCase(ch)='N' then halt (0); end else Openfile:=True; until (rez=0) or (UpCase(ch)='N'); end; {============================================================} procedure Outputfile; var st:Nalogoviyainspekciya;k:char; begin writeln('HOTITE POSMOTRET DANNIE O FIRMAH? (Y/N)'); readln(k); if (k='y') or (k='Y') then while not eof(f) do begin read(f,st); clrscr; writeln('NAZVANIE FIRMI :',st.Sname_firmi); writeln('VID SOBSTVENNOSTI:',st.vidsob); writeln('VID DEYATELNOSTI:',st.viddeyat); writeln('TELEPHONE:',st.telephone); writeln('FAKS:',st.faks); writeln('ADRES:',st.adres); writeln('DLYA PRODOLGENIA NAGMITE (enter)'); readln; end; close(f); end; {========================================================} procedure Clearfile; var st:Nalogoviyainspekciya; studtoout:string[20]; fo:file of Nalogoviyainspekciya; begin writeln('ZADAYTE IMIA FAILA IZ KOTOROGO UDALIUTSA ELEMENTI'); readln(filename); assign(f,filename);reset(f); assign(fo,'newfile.dat');rewrite(fo); writeln('Zadayte nazvanie firmi zapis kotoroy udalietsa'); readln(studtoout); while not eof(f) do begin read(f,st); if st.Sname_firmi<>studtoout then write(fo,st); end; close(f);close(fo); erase(f); rename(fo,filename); end; {ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ} Begin 11:clrscr; writeln(' MENU:'); writeln('1:SOZDAT FILE'); writeln('2:DOBAVLENIE ZAPISI V FAIL'); writeln('3:KORREKTIROVKA ZAPISI'); writeln('4:PROSMOTR FAILA'); writeln('5:UDALENIE ZAPISI IS FAILA'); writeln('6:VIHOD IZ PROGRAMMI'); readln(k); case k of 1: begin Creatfile; Inputfile end; 2: begin Addrecord; Inputfile end; 3: redzap; 4: if Openfile then Outputfile; 5: Clearfile; 6: Halt; else writeln('OSHIBKA POVTORITE NOMER REGIMA.') end; goto 11; End.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 14.03.2008, 08:13 Оценка за ответ: 5 Комментарий оценки: Отлично, спасибо сейчас буду разбираться

Отвечает: Delph Здравствуйте, Зыков Николай Павлович! Привожу пример давнего проекта, который сам делал в качестве курсовой работы по языку Turbo Pascal 7.0. Задание было весьма похожим на Ваше. Полный архив проекта Вы можете скачать по ссылке Steller.ZIP (около 6 килобайт). В приложении я привожу текст основной программы и вспомогательного модуля, выполняющего основную работу. Скачайте весь проект, чтобы иметь возможность запустить его, если хотите - поэкспериментируйте. В нём Вы сможете увидеть реализацию необходимых Вам технологий. Использовать проект можете без ограничений. Приложение: { *** Основная программа *** } Program Steller; Uses CRT, DOS, Kursov1; Var sk,num : word; i,j : byte; video : array [1..4096] of byte; f : file; Procedure PrintWin; Assembler; asm mov CX, 0800h mov AX, 0B800h mov ES, AX mov DI, 0 lea SI, video rep movsw end; Procedure Info; var d : dirstr; n : namestr; e : extstr; begin Window(49,9,78,23); WriteLn(' Информация'); WriteLn; FSplit(FileName,d,n,e); WriteLn('Имя базы данных : ',n+e); WriteLn('Всего описаний : ',vol,' '); WriteLn('Резерв : ',512-vol); WriteLn('Размер описания : 112 байт'); WriteLn('Размер файла : ',112*vol,' b'); Window(3,9,45,24) end; Procedure Newer; Begin Write('К какому элементу (1...',vol,') ? ');ReadLn(num); if num > vol then num:=vol End; Procedure Add; begin if vol<512 then begin vol:=vol+1;Add_M(members[vol]);num:=vol end end; Procedure Del; begin Del_M(num);if num>vol then num:=vol end; Procedure Windows; begin TextMode(co80); TextColor(14); ClrScr; PrintWin; TextColor(15);WinErr:=false end; Begin {I-} Assign(f,'scr.dat');Reset(f,512); if IOResult<>0 then begin WriteLn('Не найден файл: SCR.DAT');Halt end; {I+} BlockRead(f,video,8);Close(f); WinErr:=true;num:=1; Repeat if WinErr then Windows; Info; ClrScr; WriteLn; WriteLn('Текущее описание : ',num);WriteLn; View_M(members[num]);WriteLn; sk:=ScanKey; Case sk of 15104,7936 : Sort; 15872,4608 : Edit_M(members[num]); 16896,8192 : Del; 22272,7680 : Add; 18688 : if num>1 then num:=num-1; 20736 : if num<vol then num:=num+1; 12558 : Newer; 24832 : Add_from_File end Until ((sk = 283) or (sk = 4113)); Save_M(FileName); Window(1,1,80,25);ClrScr End. { *** Вспомогательный модуль *** } Unit Kursov1; INTERFACE Var FileName : string; DiskError: byte; WinErr : boolean; Saver : boolean; type memb = record name : string[39]; born : record d,m : byte; y : word end; addr : record town : string[23]; street : string[23]; home,flat : word; telephon : string[15] end end; var members : array [0..512] of memb; member : memb; vol : word; Function ScanKey : Word; Procedure Add_M (var member : memb); Procedure Add_from_File; Procedure View_M (member : memb); Procedure Edit_M (var member : memb); Procedure Save_M(FileName : string); Procedure Del_M(num : word); Procedure Sort; IMPLEMENTATION Uses CRT, DOS; Function ScanKey; var Reg : registers; begin With Reg do begin ah:=0; Intr($16,reg); ScanKey:=ax end end; Function ExistFile(FileName : string) : boolean; var f : file; begin {$I-} Assign(f,FileName); Reset(f,1);DiskError:=IOResult; if DiskError = 0 then ExistFile := (FileSize(f) mod 112 = 0) else ExistFile := false {$I+} end; Function Poisk(start : word; p1, p2, p3, p4 : boolean) : word; Var b1,b2,b3,b4 : boolean; i, pres : word; begin pres:=0; for i := start to vol do begin b1 := members[0].name=members[i].name; b2 := ((members[0].born.d = members[i].born.d) and (members[0].born.m = members[i].born.m) and (members[0].born.y = members[i].born.y)); b3 := ((members[0].addr.town = members[i].addr.town) and (members[0].addr.street = members[i].addr.street) and (members[0].addr.home = members[i].addr.home) and (members[0].addr.flat = members[i].addr.flat)); b4 := members[0].addr.telephon = members[i].addr.telephon; b1 := b1 or (not (p1)); b2 := b2 or (not (p2)); b3 := b3 or (not (p3)); b4 := b4 or (not (p4)); if (b1 and b2 and b3 and b4) then begin pres := i; i:=vol end end; poisk:=pres end; Procedure Add_M; begin WinErr:=true; Window(1,1,80,25); ClrScr; Saver:=true; WriteLn(' *** *** Д О Б А В Л Е Н И Е *** ***'); WriteLn;Write('Введите данные нового человека :');WriteLn; With member do begin Write('Фамилия, Имя, Отчество : ');ReadLn(Name); Write('Дата рождения (дд мм гггг): '); With born do ReadLn(d,m,y); Write('Адрес :'); With addr do begin Write(' Город ');ReadLn(town); Write(' Улица ');ReadLn(street); Write(' Дом ');ReadLn(home); Write(' Квартира ');ReadLn(flat); Write(' Телефон ');ReadLn(telephon) end end end; Procedure Add_from_File; label 1; var p1,p2,p3,p4 : boolean; f : file; FileName : string; begin WinErr:=true; Saver:=True; Window(1,1,80,25); 1: ClrScr; WriteLn(' *** Добавление из файла ***');Writeln;WriteLn; Write(' Введите имя файла (можно указать путь) : '); ReadLn(FileName); if not ExistFile(FileName) then begin WriteLn('Файл с таким именем не найден или повреждён !!!'); Sound(440);Delay(250);NoSound; WriteLn('Повторите ввод имени :');Delay(1250);Goto 1 end; Assign(f,FileName);Reset(f,112); p1:=true;p2:=false;p3:=false;p4:=false; Repeat BlockRead(f,members[0],1); if ((Poisk(1,p1,p2,p3,p4)=0) and (vol<512)) then begin vol:=vol+1;members[vol]:=members[0] end Until eof(f); Close(f) end; Procedure View_M; begin With member do begin Writeln('1) ',name); with born do Writeln('2) Дата рождения : ',d,'.',m,'.',y); with addr do begin WriteLn('3) Адрес : город ',town); Writeln(' улица ',street); Writeln(' дом ',home); Writeln(' квартира ',flat); Writeln('4) Телефон : ',telephon) end end end; Procedure Edit_M(var member : memb); var c : char; Procedure Wind; begin WinErr:=true; Saver:=True; Window(1,1,80,25); ClrScr; WriteLn(' *** *** Р Е Д А К Т И Р О В А Н И Е *** ***'); WriteLn(' (Для возврата в главное меню нажмите "Esc")'); Window(1,6,80,25) end; procedure p1; begin DelLine;GotoXY(1,WhereY); With member.addr do begin Write('Город : ');ReadLn(town); Write('Улица : ');ReadLn(street); Write('Дом : ');ReadLn(home); Write('Квартира : ');ReadLn(flat) end; end; begin Wind; With member do Repeat ClrScr; View_M(member); WriteLn; Write('Что будете изменять (1..4)? ');c:=ReadKey; If c<>#27 then begin WriteLn(c);WriteLn end; Case c of '1': ReadLn(Name); '2': with born do ReadLn(d,m,y); '3': p1; '4': ReadLn(addr.telephon) end Until c = #27 end; Procedure Load_M(FileName : string); var f : file; begin Saver:=False; Assign(f,FileName);reset(f,112);vol:=0; Repeat vol:=vol+1; BlockRead(f,members[vol],1) Until eof(f); Close(f); end; Procedure Save_M; var i : word; f : file; begin if Saver then begin Assign(f,FileName);ReWrite(f,112); for i:=1 to vol do BlockWrite(f,members[i],1); Close(f) end end; Procedure Del_M; var i : word; begin Saver:=true; if num = vol then vol:=vol-1 else begin i:=num; while i<vol do begin members[i]:=members[i+1]; i:=i+1 end; if num<vol then vol:=vol-1 end end; Procedure Sort; var c : char; i,j : word; x : memb; age : longint; begin ClrScr; WriteLn(' *** Сортировка ***');WriteLn;WriteLn; WriteLn('Метод сортировки:');WriteLn; WriteLn(' 1) По имени;'); WriteLn(' 2) По номерам телефонов.');WriteLn; Write('Введите номер метода : ');c:=' '; While not(c in ['1','2',#27]) do c:=ReadKey;WriteLn(c); if c='1' then for i:=2 to vol do begin for j:=vol downto i do if members[j-1].name>members[j].name then begin x:=members[j-1];members[j-1]:=members[j];members[j]:=x end end else if c='2' then for i:=2 to vol do begin for j:=vol downto i do if members[j-1].addr.telephon>members[j].addr.telephon then begin x:=members[j-1];members[j-1]:=members[j];members[j]:=x end end end; Begin If ParamCount>0 then begin FileName:=ParamStr(1); {Здесь можно делать всякие проверки} if ((ParamCount>1) and (ParamStr(2)='-new')) then Add_M(Members[1]) else if ExistFile(FileName) then Load_M(FileName) else begin TextColor(13); Writeln; WriteLn('Указанный файл не найден или повреждён!'); WriteLn; sound(440);delay(250);nosound; TextColor(15); Halt(2) end end else begin FileName:='steller.dat'; if ExistFile(FileName) then Load_M(FileName) else begin WriteLn; WriteLn('Не найден или повреждён файл "',FileName,'" !'); WriteLn; Halt(2) end end End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 14.03.2008, 09:00

Отвечает: Шемет Станіслав Васильович Здравствуйте, Зыков Николай Павлович! После вывода на монитор информации о записи, одновременно и заполниться массив информацией о записях. n - не должно быть меньше максимального числа записей в файле. Можно еще было б создать простой текстовый файл и внего записывать всю информацию о записи по строчно это более экономно так как когда записывается запись она занимает строгий обьем памяти который вычисляться так : нужно про суммировать все обьем всех переменных в записи в нашем случаи так : Year - 2 байта Monce - 1 байт Day - 1 байт Name - 255 байт(єто символы) плюс один байт это количество символов в строке и того получается :2+1+1+255+1=260 байт А допустим мы ввели такое значения записи: Year - 1991 Monce - 12 Day - N Name - Stanislav Если мы б это сохранили построчно то одна запись в файле занимала б : 4+2+1+9=16 байт , а не 260 как при при сохранении целой записи Year занимает 4 байта потому что там 4 символа Monce - 2 байта здесь 2 символа ну и все остальное аналогично. Вот как можно для это улучшить код сохранения информации о записи токо теперь F (текстовый файл) : const n=10; ........(*многоточии єто значит что там дальше объявляются другие переменные и еще какойто программный код нужный для каких - то нужд программы*) var F:text; i:integer; Zapis:array[1..n] of Tzapis; ........ begin assign(f,'d:zapis.txt'); Reset(f); ......... For i:=1 to n do Writeln(f,zapis[i].Year); Writeln(f,Zapis[i].Monce); Writeln(f,zapis[i].Day); Writeln(f,zapis[i].Name); close(f); ............. end. А вот так будет выглядит код для чтения информации из файла: const n=10 ....... Var F:text; I:Integer; Zapis:array[1..n] of Tzapis; .......... Begin assign(f,'d:zapis.txt'); Reset(f); ......... I:=0; Repeat inc(i); Readln(f,zapis[i].Year); Readln(f,Zapis[i].Monce); Readln(f,zapis[i].Day); Readln(f,zapis[i].Name); until eof(f); Close(f); .......... end. Так что решайте скоко памяти должно использовать ваша программа. Удачи! Приложение: uses crt; const n=10; Type(*Запись*) TZapis=record Year:word; Monce:byte; Day:char;(*Первая буква дня недели*) Name:string; end; Var Zapis:array[1..n] of TZapis;(*Массив из n записями*) F:file of Tzapis; i:integer; begin Assign(f,'d:zapis.txt'); Rewrite(f);(*Создаем файл *) For i:=1 to n do(*Вводим информацию для записи*) Begin ClrScr; Write('Year: '); Readln(zapis[i].year); Write('Monce: '); Readln(zapis[i].monce); Write('Day: '); Readln(zapis[i].day); Write('Name: '); Readln(zapis[i].name); Write(f,zapis[i]);(*Сохраняем в файл информацию о текущей записи *) end; close(f); (*Открываем файл для чтения*) Reset(f); i:=0; Repeat inc(i); Writeln; Read(f,zapis[i]);(*Читаем информацию о записи из файла*) Write('Year: ');(*И теперь выводим ее на монитор*) Writeln(zapis[i].year); Write('Monce: '); Writeln(zapis[i].monce); Write('Day: '); Writeln(zapis[i].day); Write('Name: '); Writeln(zapis[i].name); Writeln;(*Ждем нажатия клавишы*) Writeln('Press any key'); Readkey; until eof(f);(*Когда будет конец файла программа выйдет из цыкла*) end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 4-ый класс) Ответ отправлен: 14.03.2008, 11:48

Отвечает: Евчик Сергей Александрович Здравствуйте, Зыков Николай Павлович! Код в приложении... удачи... Приложение: Program z1; uses crt; type auto = record vodila:string; name_auto:string; god:integer; nomer:string; end; var a:array[1..20] of auto; ch:char; i,j,k:integer; s:auto; begin clrscr; Write('Вводить информацию об авто? '); readln(ch); if ch in ['y','Y'] then While ch in ['y','Y'] do begin With s do begin Write('Введите имя водителя: '); readln(s.vodila); Write('Введите марку авто: '); readln(s.name_auto); Write('Введите год выпуска: '); readln(s.god); Write('Введите номер авто: '); readln(s.nomer); end; inc(i); a[i]:=s; Write('Будете вводить еще информацию? '); readln(ch); end; {---Далее сохранение массива в файл---} end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 14.03.2008, 15:52

Вопрос № 127.263

Объем V - цилиндрической подковы вычисляется по формуле ------------------------------- h u V= ------ [a*(3*r^2 - a^2) + 3*r^2*(b-r)* ----- ]. 3*b 180 ------------------------------ Исправленая формула: V= h/(3*b)[a*(3*r^2 - a^2) + 3*r^2*(b-r)* (u/180) ] Составить алгоритм для построения графика зависимости V от угла u , если a,b и r известны, а u изменяется в ди- апазоне от u(1) до u(2) с шагом u. Исправлена формула. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 14.03.2008, 12:52 Приложение: вычеслить с помощьюпрограмм циклических вычислительных (и если можно блок схему на мыло(kolliian@mail.ru)) заранее спс

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Dolgopolov! Написал код вычислений по формуле, которая у вас уехала влево, еле разобрал. Если разобрал неправильно, поправьте. Отправил письмом блок-схему. Код для графика писать долго и нудно, сделаете сами. Код расчетов в приложении. Приложение: uses crt; var V,a,b,h,r,u,u1,u2,du:real; begin clrscr; write('h=');readln(h); write('a=');readln(a); write('b=');readln(b); write('r=');readln(r); write('u1=');readln(u1); write('u2=');readln(u2); write('du=');readln(du); u:=u1; while u<=u2 do begin V:=h/(3*b)*(a*(3*sqr(r)-sqr(a))+3*sqr(r)*(b-r)*(u/180)); write('u=',u:4:2,' V=',V:4:2); writeln; u:=u+du; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 14.03.2008, 13:08 Оценка за ответ: 5 Комментарий оценки: большое спасибо

Вопрос № 127.285

вот тут две задачки. помогите их решить. С клавиатуры вводится натуральное число n <= 100, а затем последовательность из n целых чисел. Определите, сколько среди них пар одинаковых чисел. программа в приложении. Скажите мне, пожалуйста, ошибку в ней. и ещё вот: С клавиатуры вводится натуральное число. Определите, сколько различных цифр присутствует в его записи. Массивы испльзовать можно. Приложение: Var i, j, n, ans: Integer; arr: Array[1..100] Of Integer; Begin ans := 0; ReadLn(n); For i := 1 To n Do Begin Read(arr[i]); End; For i := 1 To n Do Begin For j := 1 To i-1 Do Begin If ((j = arr[i]) Or (i = j) Or (i = arr[i])) Then Begin Inc(ans); End; End; End; WriteLn(ans); WriteLn; ReadLn; End.

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

Отвечает: Delph Здравствуйте, Хощенко Артём Владимирович! В Вашей программе ошибка содержится в 15-й строке. Вот что Вы там написали: If ((j = arr[i]) Or (i = j) Or (i = arr[i])) Then ... Иными словами программа ищет не пары одинаковых чисел, а равенства между номерами и содержимым ячеек массива. Вот на что нужно заменить эту строку: if arr[i] = arr[j] then... --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 14.03.2008, 14:20 Оценка за ответ: 5 Комментарий оценки: Спасибо!

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Певая программа написана вами неправильно, поэтому одну ошибку там искать бесполезно. Посмотрире мрй код и сравните со свойм, может как-то поправите свой. Вторую задачу я решил используя строковый тип записи чисел, так быстрее. Не нужно разбивать число на цифры, создавать из них массив или множество и т.д. Если такой способ не устроит, пишите, переделаю посложнее. Обе задачи в приложении. Приложение: Program 7285_1; uses crt; var mas:array[1..20]of integer; n,i,j,x,kol:integer;//n-размер массива, i,j-счетчики,х-буфер,kol-кол.пар эл-тов begin clrscr; write('n=');readln(n); writeln('Vvedite elem massiva:'); i:=1; while i<=n do begin write('mas[',i,']=');//ввод элементов массива readln(mas[i]); i:=i+1; end; for i:=1 to n-1 do //сортировка for j:=1 to n-1 do if mas[j]>mas[j+1] then begin x:=mas[j];mas[j]:=mas[j+1];mas[j+1]:=x; end; i:=1;kol:=0; while i<=n do if mas[i]=mas[i+1] then //подсчет пар (если 1,1,1-то одна пара) begin kol:=kol+1; i:=i+2; //перескакиваем через 1 элемент end else i:=i+1; writeln('kol=',kol); readln end. program q7285_2; uses crt; var N,s:string; k,i,j:integer; begin clrscr; write('N=');readln(N); s:='0123456789'; k:=0; for i:=1 to length(s) do for j:=1 to length(N) do if s[i]=N[j] then begin k:=k+1; break; end; writeln('k=',k); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 14.03.2008, 14:29 Оценка за ответ: 5 Комментарий оценки: Извините, но я ещё не изучал некоторые фунции и т. д. Если я их использую, то моё решение не зачтут. Пользоваться можно только типами данных интегер и булеан, можно использовать массивы, функции Abs, Inc, Sqr, Dec, Random, Odd, циклами, условными операторами. Заранее спасибо!

Отвечает: Denisss Здравствуйте, Хощенко Артём Владимирович! В приложении приведен пример решения второй задачи с использованием множеств (set). Удачи! Приложение: program q127285_2; uses Crt; var a, b: LongInt; usedDigits: set of Byte; d, cnt: Byte; begin {Очистка экрана} ClrScr; {Вводим число} write('a = '); readln(a); {Инициализация} b:= abs(a); usedDigits:= []; repeat {Получаем цифру} d:= b mod 10; {Делаем сдвиг вправо на 1 цифру} b:= b div 10; {Проверяем наличие цифры в множестве} if not (d in usedDigits) then begin {Добавляем цифру в множество} usedDigits:= usedDigits + [d]; {Увеличиваем счетчик} Inc(cnt); end; until (b = 0); {Выводим результат} writeln('V chisle ', a, ' ispol''zuetsya ', cnt, ' raznyh cifr(y).'); {Даем пользователю возможность насладиться результатом} writeln; write('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 15.03.2008, 13:12 Оценка за ответ: 5 Комментарий оценки: Извините, но я ещё не изучал некоторые фунции и т. д. Если я их использую, то моё решение не зачтут. Пользоваться можно только типами данных интегер и булеан, можно использовать массивы, функции Abs, Inc, Sqr, Dec, Random, Odd, циклами, условными операторами. Заранее спасибо!

Вопрос № 127.310

здравствуйте! у меня проблема с прогарамой! задача звучит так: "в квадратной матрице Д поменять местами елементы стороней диагонали и l-той строки предварительно упорядочив елемены последнего по возростанию". у меня меняет вместо диагонали и строки строку и столбец! помогите пожалуйстя!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, коваль максим владимирович! Немного сомневался насчет сторонней диагонали. Если это по нашему побочная диагональ, то решение перепишите один к одному, если это главная, то я сделал примечание. Решение в приложении. Приложение: program q7310; uses crt; var a:array[1..50,1..50]of integer; n,i,j,k,x:integer; begin clrscr; randomize; write('n=');readln(n); writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); write(a[i,j]:3); end; writeln; end; for i:=1 to n do //сортируем первую строку for j:=1 to n-1 do //по возрастанию for k:=1 to n-1 do if a[1,k]>a[1,k+1] then begin x:=a[1,k];a[1,k]:=a[1,k+1]; a[1,k+1]:=x; end; for i:=1 to n do //меняем элементы побочной(сторонней) for j:=1 to n do //диагонали с элементами первой строки if j=n-i+1 then //если сторонняя это главная, то пишем if i=j then begin x:=a[i,j];a[i,j]:=a[1,j];a[1,j]:=x; end; writeln('Obrabotannaia maetrica:'); for i:=1 to n do begin for j:=1 to n do begin write(a[i,j]:3); end; writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 6-ой класс) Ответ отправлен: 14.03.2008, 17:34 Оценка за ответ: 5 Комментарий оценки: спасибо большое

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