DataMuseum.dk

top - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »REGOLD.PAS«

└─⟦f8aa97e0f⟧ Bits:30003286 MINICALC eksempler - Piccolo
    └─ ⟦this⟧ »REGOLD.PAS« 

TextFile

program REGRES;	æ Copyright (c), Carl Hemmingsen, FAG 7/4 - 1984 å

æ Dette program er medtaget som et eksempel paa yderligere beregninger
  paa en opgave fra minicalc. Constantdelen og typedelen lige herunder
  indeholder alle oplysninger om opgaven. For at kunne regne paa opgaven
  er det nødvendigt, at lave maaltallene om fra strenge til reelle tal.
 
  Man kan altid diskutere, hvad et program skal kunne og hvad eleverne
  selv maa lave. Mange vil maaske mene at lineær regression ikke hører
  hjemme i en 1g (jeg selv inkluderet). Man kan saa blot fjerne dette
  program fra disketten. å

const	maxrakke = 17; maxsojle = 9;

type	str10 = stringÆ10Å;	str14 = STRINGÆ14Å;
	str50 = stringÆ50Å;
	BTYPE = ARRAYÆ1..maxsojle,1..maxrakkeÅ OF STR14;
	ATYPE = ARRAYÆ1..maxsojle,1..maxrakkeÅ OF STR10;
	NTYPE = ARRAYÆ1..maxsojleÅ OF STR10;
	FTYPE = ARRAYÆ1..maxsojleÅ OF STR50;
	OPGAVE= RECORD
		ASOJLE,RAKKE,BSOJLE: BYTE;	æ antal sojler og rækker å
		A: ATYPE;			æ maaleskemaet		å
		B: BTYPE;			æ beregningsskemaet	å
		Anavn,Bnavn: ntype;		æ overskrifter		å
		F: FTYPE			æ forskrifter		å
	END;

var	FOPG:			FILE OF OPGAVE;	æ en fil af en opgave	å
	OPG:			OPGAVE;		æ en opgave		å
	FILNAVN:		STR14;
	x, y:			arrayÆ1..maxrakkeÅ of real;
	a, b, koeff, haeldning:	real;
	i, j, nrA, nrB, p:	integer;
	ch:			char;
	udf:			text;
	printer:		boolean;

(* ================================================================== *)

procedure HENTOPGAVE;
var	fundet: boolean;
begin
	gotoxy(0,7);
	repeat
		filnavn:='';
		WRITE('Hvad hedder opgaven ? (skriv kun fornavn) : ');
		READLN(FILNAVN); FILNAVN:=FILNAVN + '.MID';
		assign(FOPG,filnavn);
		æ$I-å reset(fopg); æ$I+å
		fundet:= iores = 0;
		if fundet then read(fopg,opg)
		else writeln('Opgaven findes ikke')
	until fundet;
	close(FOPG)
end;	æ gemhent å

PROCEDURE LaesSojler;
begin
	writeln('Målte størrelser :');
	writeln;
	for i:= 1 to opg.asojle do
	write(i:2,') ',opg.anavnÆiÅ,'':12-len(opg.anavnÆiÅ));
	writeln; writeln;
	writeln('Beregnede størrelser :');
	writeln;
	for i:= 1 to opg.bsojle do
	write(i+opg.asojle:2,') ',opg.bnavnÆiÅ,'':12-len(opg.bnavnÆiÅ));
	writeln; writeln;
	write('Angiv nummer på uafhængig variabel : '); readln(nrA);
	if nrA <= opg.asojle then
		for i:=1 to opg.rakke do val(opg.aÆnrA,iÅ,XÆiÅ,p)
	else
		for i:=1 to opg.rakke do val(opg.bÆnrA-opg.asojle,iÅ,XÆiÅ,p);
	write('Angiv nummer på afhængig variabel  : '); readln(nrB);
	if nrB <= opg.asojle then
		for i:=1 to opg.rakke do val(opg.aÆnrB,iÅ,YÆiÅ,p)
	else
		for i:=1 to opg.rakke do val(opg.bÆnrB-opg.asojle,iÅ,YÆiÅ,p);
end;	æ LaesSojler å

PROCEDURE SkrivSojler;
begin
	writeln(lst,filnavn);
	writeln(lst);
	writeln(lst,'Målte størrelser :');
	writeln(lst);
	for i:= 1 to opg.asojle do
	write(lst,i:2,') ',opg.anavnÆiÅ,'':12-len(opg.anavnÆiÅ));
	writeln(lst); writeln(lst);
	writeln(lst,'Beregnede størrelser :');
	writeln(lst);
	for i:= 1 to opg.bsojle do
	write(lst,i+opg.asojle:2,') ',opg.bnavnÆiÅ,'':12-len(opg.bnavnÆiÅ));
	writeln(lst); writeln(lst);
	writeln(lst,'nummer på uafhængig variabel : ',nrA);
	writeln(lst,'nummer på afhængig variabel  : ',nrB);
	writeln(lst)
end;	æ SkrivSojler å

procedure regres;
var	sumx, sumx2, sumy, sumy2, sumxy, SXX, SXY, SYY: real;
begin
	sumx:=0; sumx2:=0; sumy:=0; sumy2:=0; sumxy:=0;
	for i:= 1 to opg.rakke do begin
		sumx:= sumx + xÆiÅ;
		sumy:= sumy + yÆiÅ;
		sumx2:=sumx2 + xÆiÅ*xÆiÅ;
		sumy2:=sumy2 + yÆiÅ*yÆiÅ;
		sumxy:=sumxy + xÆiÅ*yÆiÅ;
	end;
	SXX:= sumx2 - sumx*sumx/opg.rakke;
	SXY:= sumxy - sumx*sumy/opg.rakke;
	SYY:= sumy2 - sumy*sumy/opg.rakke;
	b:= SXY/SXX; a:= sumy/opg.rakke - b*sumx/opg.rakke;
	koeff:= SXY/SQRT(SXX*SYY);
	haeldning:= sumxy/sumx2;
end;
procedure skaermprinter;
begin
	writeln;
	write('Ønskes udskrift på skærm eller printer ? (S/P) ');
	read(kbd,ch); writeln(ch);
	printer:= ch in Æ'P','p'Å;
	if printer then assign(udf,'lst:') else assign(udf,'con:');
	rewrite(udf);
	gotoxy(0,0); clreos
end;

procedure udskriv;
begin
	writeln(udf);
	writeln(udf,'Den bedste rette linie: y = Bx + A er bestemt ved:');
	writeln(udf);
	writeln(udf,'A = ',A:9,' B = ':8,B:9);
	writeln(udf);
	writeln(udf,'korrelationskoefficient : ',koeff:8:4);
	writeln(udf)
end;
procedure proportionalitet;
begin
	write('Ønskes Proportionalitet undersøgt ? (Y/N) ');
	read(kbd,ch); writeln(ch);
	if ch in Æ'Y','y'Å then begin
		writeln(udf);
		writeln(udf,'Forudsættes proportionalitet fås:');
		writeln(udf);
		writeln(udf,'Hældning B = ',haeldning:9);
		writeln(udf)
	end
end;
(* ================= H O V E D P R O G R A M =========================*)
begin
	gotoxy(0,0); clreos;
	writeln('':10,'Regres: et hjælpeprogram til minicalc.');
	writeln('':10,'Programmet beregner den bedste rette linie v.h.a.');
	writeln('':10,'mindste kvadraters metode til måltal, som');
	writeln('':10,'er beregnet v.h.a minicalc.');
	writeln('':10,'Statistisk interesserede henvises til:');
	writeln('':10,'Statistik + diskette af Tommy Borch, FAG.');
	
	hentopgave;			æ opgaven laeses paa disketten å
	skaermprinter;
	LaesSojler;			æ søjlerne findes å
	if printer then SkrivSojler;
	regres;				æ udregningerne foretages å
	udskriv;			æ resultaterne skrives å
	proportionalitet;
end.
«eof»