Skip to content

Update QR related OPL problems #1280

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
+6,791 −8,215
Open

Update QR related OPL problems #1280

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
fb3dc30
Update QR related OPL problems
pstaabp Feb 25, 2025
7b2f656
missed one.
pstaabp Jun 27, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
205 changes: 78 additions & 127 deletions Contrib/CollegeofIdaho/Statistics/set03IntroCorrRegress/Stats_16_IntroCorrRegress.pg
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
## DESCRIPTION
## For a dataset, find the correlation coefficient and the regression line.
## ENDDESCRIPTION
## DBsubject(Statistics)
## DBchapter(Simple linear regression)
## DBsection(Regression)
Expand All @@ -12,143 +14,92 @@
## Problem1('')
## KEYWORDS('statistic', 'regression','correlation')

DOCUMENT(); # This should be the first executable line in the problem.
DOCUMENT(); # This should be the first executable line in the problem.

loadMacros(
"PGstandard.pl",
"MathObjects.pl",
"answerHints.pl",
"contextCurrency.pl",
"niceTables.pl",
"parserPopUp.pl",
"PGchoicemacros.pl"
);

TEXT(beginproblem());

#################################################
'PGstandard.pl', 'PGML.pl',
'answerHints.pl', 'contextCurrency.pl',
'PGstatisticsmacros.pl', 'parserPopUp.pl',
'PGcourse.pl'
);

# Set-up

@b = (32.98, 49.72, 88.01, 97.34, 64.30, 106.27, 52.44, 70.29, 43.58);
@ab=('32.98', '49.72', '88.01', '97.34', '64.30', '106.27', '52.44', '70.29', '43.58');
@t = ( 4.50, 5.28, 10.00, 16.00, 7.70, 16.00, 7.00, 10.00, 5.50);
@at =('4.50', '5.28', '10.00', '16.00', '7.70', '16.00', '7.00', '10.00', '5.50');
@b = (32.98, 49.72, 88.01, 97.34, 64.30, 106.27, 52.44, 70.29, 43.58);
@ab = (
'32.98', '49.72', '88.01', '97.34', '64.30', '106.27',
'52.44', '70.29', '43.58'
);
@t = (4.50, 5.28, 10.00, 16.00, 7.70, 16.00, 7.00, 10.00, 5.50);
@at = (
'4.50', '5.28', '10.00', '16.00', '7.70', '16.00',
'7.00', '10.00', '5.50'
);

@slice = NchooseK(9,6);
@slice = random_subset(6, 0 .. 8);

@sb = @b[@slice];
@sb = @b[@slice];
@sab = @ab[@slice];
@st = @t[@slice];
@st = @t[@slice];
@sat = @at[@slice];

$sx = 0;
$sy = 0;
$sxy = 0;
$sx2 = 0;
$sy2 = 0;

for($i=0;$i<6;$i++){
$sx = $sx + $sb[$i];
$sy = $sy + $st[$i];
$sxy = $sxy + $sb[$i] * $st[$i];
$sx2 = $sx2 + ($sb[$i])**2;
$sy2 = $sy2 + ($st[$i])**2;
}
$ssxy = $sxy-(($sx*$sy)/6);
$ssx = $sx2-(($sx**2)/6);
$ssy = $sy2-(($sy**2)/6);

$r = $ssxy/sqrt($ssx*$ssy);
$r = sample_correlation(~~@sat, ~~@sab);
($m, $b) = linear_regression(~~@sab, ~~@sat);

$explainb = "\(r\) is close to \(1.\)";
$popupb = PopUp(["?", "No", "Yes"], "Yes");
$popupe = PopUp(["?", "Decrease", "Increase"], "Increase");

$b0 = sprintf("%0.5f",($sy * $sx2 - $sx * $sxy)/(6 * $sx2 - ($sx)**2));

$b1 = sprintf("%0.5f",(6 * $sxy - $sx * $sy)/(6 * $sx2 - ($sx)**2));

$bill = random(40,100,5);
$tip = $b0 + $b1*$bill;

$increase = random(5,10,5);
$changetip = $increase * $b1;

#################################################
# Main

BEGIN_TEXT
The amounts of 6 restaurant bills and the corresponding amounts of the tips are given in the below. Assume that bill amount is the explanatory variable and tip amount the response variable. Use RStudio to find the following.
$BR
\{
LayoutTable(
[
[['Bill',b =>1, noencase=>1],"$sab[0]", "$sab[1]", "$sab[2]", "$sab[3]", "$sab[4]", "$sab[5]"],
[['Tip',b =>1, noencase=>1],"$sat[0]", "$sat[1]", "$sat[2]", "$sat[3]", "$sat[4]", "$sat[5]"],
],
align => ' l |rrrrrr',
encase => ['\(','\)'],
allcellcss => 'padding:8px; '
);
\}
$PAR
(a) Compute the correlation: \( r =\) \{ans_rule(15)\}
$PAR
(b) Does there appear to be a significant correlation?
$BR $SPACE $SPACE
Answer: \{ $popupb->menu() \}
$PAR
(c) The regression equation is \(\hat{y}=\) \{ans_rule(15)\}.
$BR $BR
${BITALIC}For parts (d) and (e): Enter your answer in dollars: ${DOLLAR}xx.xx$EITALIC
$PAR
(d) If the amount of the bill is $DOLLAR\($bill,\) the best prediction for the amount of the tip is
\{ans_rule(10)\}.
$PAR
(e) According to the regression equation, for every $DOLLAR\($increase \) increase in the bill, the tip should \{ $popupe->menu() \} by \{ans_rule(10)\}.
END_TEXT

#################################################
# Answers

$showPartialCorrectAnswers = 1;

$ans_a = Compute($r)->with(tolType=>'absolute', tolerance=>'0.005');
ANS($ans_a->cmp->withPostFilter(AnswerHints(
sub {
my ($correct,$student,$anshash) = @_;
return abs($student-$correct) < .02;
} => ["Your answer is close. Try the calculation using more accuracy."])));

ANS( $popupb->cmp() );

$ans_c = Formula("$b0 + $b1 x");
ANS($ans_c->with(tolType=>'absolute', tolerance=>'0.001')->cmp);
$popupb = DropDown([ "No", "Yes" ], "Yes");
$popupe = DropDown([ "Decrease", "Increase" ], "Increase");

$line = Formula("$m *x + $b");

$bill = random(40, 100, 5);
$tip = $line->eval(x => $bill);

$increase = random(5, 10, 5);
$changetip = $increase * $m;

Context("Currency");
$ans_d = Currency($tip);
ANS($ans_d->with(tolType=>'absolute', tolerance=>'0.04')->cmp);

ANS( $popupe->cmp() );

$ans_e2 = Currency($changetip);
ANS($ans_e2->with(tolType=>'absolute', tolerance=>'0.04')->cmp);

#################################################
# Solution

Context()->texStrings;
BEGIN_SOLUTION
$BR
(a) \(r = $ans_a\)
$BR
(b) ${BBOLD}\{ $popupb->correct_ans() \}${EBOLD}, $explainb
$BR
(c) \(\hat{y} = $ans_c \)
$BR
(d) The predicted amount is \($b0 + $b1($bill) = $tip\) \(\longrightarrow\) \($ans_d\).
$BR
(e) The tip should ${BBOLD}\{ $popupe->correct_ans() \}$EBOLD by \($ans_e2\).
END_SOLUTION

ENDDOCUMENT(); # This should be the last executable line in the problem.
$ans_d = Currency($tip)->with(tolType => 'absolute', tolerance => '0.04')->cmp;

# ANS( $popupe->cmp() );

$ans_e2 =
Currency($changetip)->with(tolType => 'absolute', tolerance => '0.04')->cmp;

BEGIN_PGML
The amounts of 6 restaurant bills and the corresponding amounts of the tips are given in the below. Assume that bill amount is the explanatory variable and tip amount the response variable.

[#
[. **Bill** .] [. [$sab[0]] .][. [$sab[1]] .][. [$sab[2]] .]
[. [$sab[3]] .][. [$sab[4]] .][. [$sab[5]] .]*
[. **Tip** .] [. [$sat[0]] .][. [$sat[1]] .][. [$sat[2]] .]
[. [$sat[3]] .][. [$sat[4]] .][. [$sat[5]] .]*
#]{align => 'r|rrrrrr', padding => [0.5,0.5]}

a) Compute the correlation: [` r =`] [_]{Real($r)}{15}

b) Does there appear to be a significant correlation? [_]{$popupb}

c) The regression equation is [`\hat{y}=`] [_]{$line}{15}.

_For parts (d) and (e): Enter your answer in dollars: $xx.xx_

d) If the amount of the bill is $[`[$bill],`] the best prediction for the amount of the tip is [_]{$ans_d}{10}.

e) According to the regression equation, for every $[`[$increase] `] increase in the bill, the tip should [_]{$popupe} by [_]{$ans_e2}{10}.
END_PGML

BEGIN_PGML_SOLUTION

a) [`r = [$r]`]

b) [$explainb]*

c) [`\hat{y} = [$line] `]

d) The predicted amount is [`[$b] + [$m]([$bill]) = [$tip]`]

e) The tip should [`[@ 10*$m @]`]
END_PGML_SOLUTION

ENDDOCUMENT(); # This should be the last executable line in the problem.
Loading