(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 4.0,
MathReader 4.0, or any compatible application. The data for the notebook
starts with the line containing stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 7764, 200]*)
(*NotebookOutlinePosition[ 8456, 225]*)
(* CellTagsIndexPosition[ 8412, 221]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{
Cell["\<\
Math 2325
Project 3 (Chapter 6) - Randomized Response Surveys\
\>", "Subtitle",
Evaluatable->False],
Cell[CellGroupData[{
Cell["Survey Simulation", "Section"],
Cell[TextData[{
"The following program,Ran1Resp,simulates a randomized response survey. It \
takes 5 paramaters; in order,they are: GrpSize,the size of the group being \
surveyed (Nin the book); YesInGrp, the number of people in the group whose \
true answer to the question is Yes (in the book, ",
StyleBox["p",
FontSlant->"Italic"],
" is YesInGrp divided by ",
StyleBox["N",
FontSlant->"Italic"],
"); PrRealQ, the probability that a person will answer the real question \
(in the book, the probability that the dime lands heads); PrYesDecoy, the \
probability that the answer to the decoy question is yes (in the book, the \
probability that the penny lands heads); and NRep, the number of surveys the \
program will simulate."
}], "Text"],
Cell[BoxData[
\(\(Ran1Resp[GrpSize_, YesInGrp_, PrRealQ_, PrYesDecoy_, NRep_] :=
Module[{Running = \(Result = \(ZeTab = Table[0, {3}, {3}, {3}]\)\),
i, j, TrueYes = 1, TrueNo = 2, Real = 1, Decoy = 2, Yes = 1,
No = 2, Total = 3,
topper = {"\< YES \>", "\< NO \>", "\"}},
Do[Result = ZeTab; \[IndentingNewLine]Do[
If[Random[] < PrRealQ, \(Result[\([TrueYes, Real, Yes]\)]++\),
If[Random[] <
PrYesDecoy, \(Result[\([TrueYes, Decoy,
Yes]\)]++\), \(Result[\([TrueYes, Decoy,
No]\)]++\)]], {YesInGrp}]; \[IndentingNewLine]Do[
If[Random[] < PrRealQ, \(Result[\([TrueNo, Real, No]\)]++\),
If[Random[] <
PrYesDecoy, \(Result[\([TrueNo, Decoy,
Yes]\)]++\), \(Result[\([TrueNo, Decoy,
No]\)]++\)]], {GrpSize -
YesInGrp}]; \[IndentingNewLine]Do[
Result[\([i, j, Total]\)] =
Result[\([i, j, Yes]\)] +
Result[\([i, j, No]\)]; \[IndentingNewLine]Result[\([i,
Total, j]\)] =
Result[\([i, Real, j]\)] +
Result[\([i, Decoy,
j]\)]; \[IndentingNewLine]Result[\([Total, i, j]\)] =
Result[\([TrueYes, i, j]\)] + Result[\([TrueNo, i, j]\)], {i,
3}, {j, 3}]; \[IndentingNewLine]Running =
Running + Result, {NRep}]; \[IndentingNewLine]If[NRep > 1,
Running =
Round[Running/
NRep*10^1]/\((10. ^1)\)]; \[IndentingNewLine]Print["\< \
T R U E Y E S T R U E N O W H O L E G R O U \
P\>"]; \[IndentingNewLine]Print[
MatrixForm[
Transpose[{{"\< \>", "\", "\", "\"}}]],
MatrixForm[Prepend[Running[\([1]\)], topper]], "\<\t\>",
MatrixForm[Prepend[Running[\([2]\)], topper]], "\<\t\>",
MatrixForm[Prepend[Running[\([3]\)], topper]]]];\)\)], "Input"],
Cell["\<\
Here is an example (maximizing the screen will make the display \
easier to read).In this example,the group size is 17,the number of people \
whose true answer to the question is yes is 12,the probabilities of the penny \
and dime landing head are each .5,and the simulation will run 20 times.\
\>", \
"Text"],
Cell[BoxData[
\(Ran1Resp[17, 12, .5, .5, 20]\)], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["Properties of the Estimate", "Section"],
Cell["\<\
The following program, Ran2Resp, will help us explore some \
properties of the estimate you are using. Be sure to also define Estimate \
and OpChar (below) before running Ran2Resp!\
\>", "Text"],
Cell[BoxData[
\(\(Ran2Resp[GrpSize_, YesInGrp_, PrRealQ_, PrYesDecoy_, NRep_] :=
Module[{RunningSum = 0, NYes},
Do[NYes = 0; \[IndentingNewLine]Do[
If[\((Random[] < PrRealQ)\) || \((Random[] <
PrYesDecoy)\), \(NYes++\)], {YesInGrp}]; \
\[IndentingNewLine]Do[
If[\(! \((Random[] < PrRealQ)\)\) && \((Random[] <
PrYesDecoy)\), \(NYes++\)], {GrpSize -
YesInGrp}]; \[IndentingNewLine]RunningSum =
RunningSum +
OpChar[Estimate[GrpSize, NYes, PrRealQ, PrYesDecoy],
YesInGrp/GrpSize], {NRep}]; \[IndentingNewLine]N[
RunningSum/NRep]];\)\)], "Input"],
Cell[TextData[{
"To study properties of your estimate of the proportion of \"True Yesses\" \
(people whose true answer to the question is Yes, i.e., YesInGrp divided by \
GrpSize), set Estimate to your estimate. (In the book, the true proportion \
is denoted by ",
StyleBox["p",
FontSlant->"Italic"],
", and your estimate is denoted by ",
Cell[BoxData[
\(TraditionalForm\`\(p\&^\)\)]],
".) When you open this notebook the first time, Estimate is set to NYes \
divided by GrpSize, which is simply assuming that the number of True Yesses \
is simply the number of people reporting a Yes after flipping coins. So be \
sure to reset it to your estimate."
}], "Text"],
Cell[BoxData[
\(\(Estimate[GrpSize_, \ NYes_, PrRealQ_, PrYesDecoy_] :=
NYes/GrpSize;\)\)], "Input"],
Cell["\<\
OpChar is short for \"operating characteristic\". You change its \
definition, depending on which operating characteristic of your estimate you \
want to investigate. To study bias, set it to Estimate - True; to study mean \
absolute deviation (MAD), set it to Abs[Estimate - True]; to study standard \
deviation, set it to Sqrt[(Estimate - True)^2].\
\>", "Text"],
Cell[BoxData[
\(\(OpChar[Estimate_, True_] := Estimate;\)\)], "Input"],
Cell["\<\
Now that we have set OpChar and Estimate, we can run Ran2Resp\
\>", \
"Text"],
Cell[BoxData[
\(Ran2Resp[17, 12, .5, .5, 20]\)], "Input"]
}, Closed]]
}, Open ]],
Cell["\<\
Art Duval, artduval@math.utep.edu
September 27, 2004\
\>", "Author"]
},
FrontEndVersion->"4.0 for X",
ScreenRectangle->{{0, 1152}, {0, 900}},
CellGrouping->Manual,
WindowSize->{569, 866},
WindowMargins->{{0, Automatic}, {0, Automatic}},
StyleDefinitions -> "Report.nb"
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[1739, 51, 111, 4, 93, "Subtitle",
Evaluatable->False],
Cell[CellGroupData[{
Cell[1875, 59, 36, 0, 67, "Section"],
Cell[1914, 61, 761, 15, 140, "Text"],
Cell[2678, 78, 2158, 37, 464, "Input"],
Cell[4839, 117, 319, 6, 76, "Text"],
Cell[5161, 125, 63, 1, 32, "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell[5261, 131, 45, 0, 41, "Section"],
Cell[5309, 133, 205, 4, 44, "Text"],
Cell[5517, 139, 722, 13, 208, "Input"],
Cell[6242, 154, 685, 14, 108, "Text"],
Cell[6930, 170, 113, 2, 48, "Input"],
Cell[7046, 174, 376, 6, 76, "Text"],
Cell[7425, 182, 74, 1, 32, "Input"],
Cell[7502, 185, 87, 3, 28, "Text"],
Cell[7592, 190, 63, 1, 32, "Input"]
}, Closed]]
}, Open ]],
Cell[7682, 195, 78, 3, 90, "Author"]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)