'#Reference {C9E29036-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2902E-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2902A-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2902D-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29030-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2902B-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29029-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29028-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29024-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2902C-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29022-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29010-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29020-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29005-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29006-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29008-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900F-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29012-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29015-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29016-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29021-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29018-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29019-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2901A-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2901B-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2901C-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2901D-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29014-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29013-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29011-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900D-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900C-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900A-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29009-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29004-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29007-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900E-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E2900B-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29001-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29003-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
'#Reference {C9E29002-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#
Option Base 1
Sub Main
Dim s As Spreadsheet
Set s = ActiveSpreadsheet

boot=100 'the number of simulations to be implemented

'Setup the new Results Spreadsheet - with 27 variables to hold the correlations and standard deviations
Dim rs As New Spreadsheet
rs.SetSize(boot,27)

'This is the header title for my new spreadsheet
rs.Header = "Bootstrap Results Analysis - Correlation and Variance magnitudes as a function of Likert Coding"

'Here I set the variable widths
For i = 1 To 27
rs.VariableWidth(i)=1.1
Next

'Here are my new variable titles for this spreadsheet
rs.VariableName(1)="Corr_Real_1_2"
rs.VariableName(2)="SD_Real_1"
rs.VariableName(3)="SD_Real_2"

rs.VariableName(4)="Corr_Two_1_2"
rs.VariableName(5)="SD_Two_1"
rs.VariableName(6)="SD_Two_2"

rs.VariableName(7)="Corr_Three_1_2"
rs.VariableName(8)="SD_Three_1"
rs.VariableName(9)="SD_Three_2"

rs.VariableName(10)="Corr_Four_1_2"
rs.VariableName(11)="SD_Four_1"
rs.VariableName(12)="SD_Four_2"

rs.VariableName(13)="Corr_Five_1_2"
rs.VariableName(14)="SD_Five_1"
rs.VariableName(15)="SD_Five_2"

rs.VariableName(16)="Corr_Six_1_2"
rs.VariableName(17)="SD_Six_1"
rs.VariableName(18)="SD_Six_2"

rs.VariableName(19)="Corr_Seven_1_2"
rs.VariableName(20)="SD_Seven_1"
rs.VariableName(21)="SD_Seven_2"

rs.VariableName(22)="Corr_Eight_1_2"
rs.VariableName(23)="SD_Eight_1"
rs.VariableName(24)="SD_Eight_2"

rs.VariableName(25)="Corr_Nine_1_2"
rs.VariableName(26)="SD_Nine_1"
rs.VariableName(27)="SD_Nine_2"


'Here I set the format to be a real number with two displayed decimal digit precision
For i = 1 To 27
rs.Variable(i).NumberFormat = "#.00"
Next


'Here I set the displayed width of my new spreadsheet
'and then I display it!
rs.Window.Width=700
rs.Visible=True

'This is the control statement for the number of samples to construct and use to acquire parameter estimates
For mast = 1 To boot

s.Redraw = False

N = s.Cases.Count
sumx=0
sumy=0

'For the first real-valued random variable
For i = 1  To N
s.Cells(i,1)=(RndNormal(2)+4) 'this commands generates random normal variates from a distribution with mean 4 and SD of 2
sumx=sumx+s.Cells(i,1)
Next
mn=sumx/N

'For the second real-valued random variable
For i = 1  To N
s.Cells(i,2)=(RndNormal(2)+4) 'this commands generates random normal variates from a distribution with mean 4 and SD of 2
Next

'Now create correlated variable  {Real_2} with a 0.5 correlation with the first {Real_1}
For i=1 To N
s.Cells(i,2)= 0.5 * s.Cells(i,1) + (Sqr(1-0.5*0.5))*s.Cells(i,2)
sumy=sumy+s.Cells(i,2)
Next
mn1=sumy/N

diff=mn1-mn

'this is where I subtract the difference between means (Real_1-Real_2) from Real_2 values
For i=1 To N
s.Cells(i,2)=s.Cells(i,2)-diff
Next


'This is where I create my categorised variables
'===============================================

'Now produce Likert Integers - two choice - split around mean
For i = 1 To N
If s.Cells (i,1)< 4.0 Then
 s.Cells (i,3)=0
Else
 s.Cells (i,3)=1
End If

If s.Cells (i,2)< 4.0 Then
 s.Cells (i,4)=0
Else
 s.Cells (i,4)=1
End If
Next

'Now produce Likert Integers - Three choice
For i = 1 To N
If s.Cells (i,1)< 2.67 Then s.Cells (i,5)=0
If (s.Cells (i,1)>= 2.67) And (s.Cells (i,1)< 5.33) Then s.Cells (i,5)=1
If s.Cells (i,1) >=5.33 Then s.Cells (i,5)=2

If s.Cells (i,2)< 2.67 Then s.Cells (i,6)=0
If (s.Cells (i,2)>= 2.67) And (s.Cells (i,2)< 5.33) Then s.Cells (i,6)=1
If s.Cells (i,2) >=5.33 Then s.Cells (i,6)=2
Next

'Now produce Likert Integers - Four choice
For i = 1 To N
If s.Cells (i,1)< 2 Then s.Cells (i,7)=0
If (s.Cells (i,1)>= 2) And (s.Cells (i,1)< 4) Then s.Cells (i,7)=1
If (s.Cells (i,1)>= 4) And (s.Cells (i,1)< 6) Then s.Cells (i,7)=2
If s.Cells (i,1) >=6 Then s.Cells (i,7)=3

If s.Cells (i,2)< 2 Then s.Cells (i,8)=0
If (s.Cells (i,2)>= 2) And (s.Cells (i,2)< 4) Then s.Cells (i,8)=1
If (s.Cells (i,2)>= 4) And (s.Cells (i,2)< 6) Then s.Cells (i,8)=2
If s.Cells (i,2) >=6 Then s.Cells (i,8)=3
Next

'Now produce Likert Integers - Five choice
For i = 1 To N
If s.Cells (i,1)< 1.6 Then s.Cells (i,9)=0
If (s.Cells (i,1)>= 1.6) And (s.Cells (i,1)< 3.2) Then s.Cells (i,9)=1
If (s.Cells (i,1)>= 3.2) And (s.Cells (i,1)< 4.8) Then s.Cells (i,9)=2
If (s.Cells (i,1)>= 4.8) And (s.Cells (i,1)< 6.4) Then s.Cells (i,9)=3
If s.Cells (i,1) >= 6.4 Then s.Cells (i,9)=4

If s.Cells (i,2)< 1.6 Then s.Cells (i,10)=0
If (s.Cells (i,2)>= 1.6) And (s.Cells (i,2)< 3.2) Then s.Cells (i,10)=1
If (s.Cells (i,2)>= 3.2) And (s.Cells (i,2)< 4.8) Then s.Cells (i,10)=2
If (s.Cells (i,2)>= 4.8) And (s.Cells (i,2)< 6.4) Then s.Cells (i,10)=3
If s.Cells (i,2) >= 6.4 Then s.Cells (i,10)=4
Next

'Now produce Likert Integers - Six Choice
For i = 1 To N
If s.Cells (i,1)< 1.33 Then s.Cells (i,11)=0
If (s.Cells (i,1)>= 1.33) And (s.Cells (i,1)< 2.66) Then s.Cells (i,11)=1
If (s.Cells (i,1)>= 2.66) And (s.Cells (i,1)< 4.0) Then s.Cells (i,11)=2
If (s.Cells (i,1)>= 4.0) And (s.Cells (i,1)< 5.33) Then s.Cells (i,11)=3
If (s.Cells (i,1)>= 5.33) And (s.Cells (i,1)< 6.66) Then s.Cells (i,11)=4
If s.Cells (i,1) >= 6.66 Then s.Cells (i,11)=5

If s.Cells (i,2)< 1.33 Then s.Cells (i,12)=0
If (s.Cells (i,2)>= 1.33) And (s.Cells (i,2)< 2.66) Then s.Cells (i,12)=1
If (s.Cells (i,2)>= 2.66) And (s.Cells (i,2)< 4.0) Then s.Cells (i,12)=2
If (s.Cells (i,2)>= 4.0) And (s.Cells (i,2)< 5.33) Then s.Cells (i,12)=3
If (s.Cells (i,2)>= 5.33) And (s.Cells (i,2)< 6.66) Then s.Cells (i,12)=4
If s.Cells (i,2) >= 6.66 Then s.Cells (i,12)=5
Next

'Now produce Likert Integers - Seven Choice
For i = 1 To N
If s.Cells (i,1)< 1.1429 Then s.Cells (i,13)=0
If (s.Cells (i,1)>= 1.1429) And (s.Cells (i,1)< 2.2857) Then s.Cells (i,13)=1
If (s.Cells (i,1)>= 2.2857) And (s.Cells (i,1)< 3.4286) Then s.Cells (i,13)=2
If (s.Cells (i,1)>= 3.4286) And (s.Cells (i,1)< 4.5714) Then s.Cells (i,13)=3
If (s.Cells (i,1)>= 4.5714) And (s.Cells (i,1)< 5.7143) Then s.Cells (i,13)=4
If (s.Cells (i,1)>= 5.7143) And (s.Cells (i,1)< 6.8571) Then s.Cells (i,13)=5
If s.Cells (i,1) >= 6.8571 Then s.Cells (i,13)=6

If s.Cells (i,2)< 1.1429 Then s.Cells (i,14)=0
If (s.Cells (i,2)>= 1.1429) And (s.Cells (i,2)< 2.2857) Then s.Cells (i,14)=1
If (s.Cells (i,2)>= 2.2857) And (s.Cells (i,2)< 3.4286) Then s.Cells (i,14)=2
If (s.Cells (i,2)>= 3.4286) And (s.Cells (i,2)< 4.5714) Then s.Cells (i,14)=3
If (s.Cells (i,2)>= 4.5714) And (s.Cells (i,2)< 5.7143) Then s.Cells (i,14)=4
If (s.Cells (i,2)>= 5.7143) And (s.Cells (i,2)< 6.8571) Then s.Cells (i,14)=5
If s.Cells (i,2) >= 6.8571 Then s.Cells (i,14)=6
Next


'Now produce Likert Integers - Eight Choice
For i = 1 To N
If s.Cells (i,1)< 1 Then s.Cells (i,15)=0
If (s.Cells (i,1)>= 1) And (s.Cells (i,1)< 2) Then s.Cells (i,15)=1
If (s.Cells (i,1)>= 2) And (s.Cells (i,1)< 3) Then s.Cells (i,15)=2
If (s.Cells (i,1)>= 3) And (s.Cells (i,1)< 4) Then s.Cells (i,15)=3
If (s.Cells (i,1)>= 4) And (s.Cells (i,1)< 5) Then s.Cells (i,15)=4
If (s.Cells (i,1)>= 5) And (s.Cells (i,1)< 6) Then s.Cells (i,15)=5
If (s.Cells (i,1)>= 6) And (s.Cells (i,1)< 7) Then s.Cells (i,15)=6
If s.Cells (i,1) >= 7 Then s.Cells (i,15)=7

If s.Cells (i,2)< 1 Then s.Cells (i,16)=0
If (s.Cells (i,2)>= 1) And (s.Cells (i,2)< 2) Then s.Cells (i,16)=1
If (s.Cells (i,2)>= 2) And (s.Cells (i,2)< 3) Then s.Cells (i,16)=2
If (s.Cells (i,2)>= 3) And (s.Cells (i,2)< 4) Then s.Cells (i,16)=3
If (s.Cells (i,2)>= 4) And (s.Cells (i,2)< 5) Then s.Cells (i,16)=4
If (s.Cells (i,2)>= 5) And (s.Cells (i,2)< 6) Then s.Cells (i,16)=5
If (s.Cells (i,2)>= 6) And (s.Cells (i,2)< 7) Then s.Cells (i,16)=6
If s.Cells (i,2) >= 7 Then s.Cells (i,16)=7

Next

'Now produce Likert Integers - Nine Choice {0.9}
For i = 1 To N
If s.Cells (i,1)< 0.85 Then s.Cells (i,17)=0
If (s.Cells (i,1)>= 0.85) And (s.Cells (i,1)< 1.75) Then s.Cells (i,17)=1
If (s.Cells (i,1)>= 1.75) And (s.Cells (i,1)< 2.65) Then s.Cells (i,17)=2
If (s.Cells (i,1)>= 2.65) And (s.Cells (i,1)< 3.55) Then s.Cells (i,17)=3
If (s.Cells (i,1)>= 3.55) And (s.Cells (i,1)< 4.45) Then s.Cells (i,17)=4
If (s.Cells (i,1)>= 4.45) And (s.Cells (i,1)< 5.35) Then s.Cells (i,17)=5
If (s.Cells (i,1)>= 5.35) And (s.Cells (i,1)< 6.25) Then s.Cells (i,17)=6
If (s.Cells (i,1)>= 6.25) And (s.Cells (i,1)< 7.15) Then s.Cells (i,17)=7
If s.Cells (i,1) >= 7.15 Then s.Cells (i,17)=8

If s.Cells (i,2)< 0.85 Then s.Cells (i,18)=0
If (s.Cells (i,2)>= 0.85) And (s.Cells (i,2)< 1.75) Then s.Cells (i,18)=1
If (s.Cells (i,2)>= 1.75) And (s.Cells (i,2)< 2.65) Then s.Cells (i,18)=2
If (s.Cells (i,2)>= 2.65) And (s.Cells (i,2)< 3.55) Then s.Cells (i,18)=3
If (s.Cells (i,2)>= 3.55) And (s.Cells (i,2)< 4.45) Then s.Cells (i,18)=4
If (s.Cells (i,2)>= 4.45) And (s.Cells (i,2)< 5.35) Then s.Cells (i,18)=5
If (s.Cells (i,2)>= 5.35) And (s.Cells (i,2)< 6.25) Then s.Cells (i,18)=6
If (s.Cells (i,2)>= 6.25) And (s.Cells (i,2)< 7.15) Then s.Cells (i,18)=7
If s.Cells (i,2) >= 7.15 Then s.Cells (i,18)=8
Next


'Compute sums of squares etc. for Sd and Pearson r
kon=0
kon1=1
For j = 1 To 18 Step 2
sumx=0
sumy=0
sumxy=0
sumx2=0
sumy2=0

col1=j
col2=j+1
kon=kon+1

For k = 1 To N
sumx=sumx+s.Cells(k,col1)
sumx2=sumx2+s.Cells(k,col1)*s.Cells(k,col1)
sumy=sumy+s.Cells(k,col2)
sumy2=sumy2+s.Cells(k,col2)*s.Cells(k,col2)
sumxy=sumxy+s.Cells(k,col1)*s.Cells(k,col2)
Next

'put the parameter values in the appropriate cells of my "results" spreadsheet
pr=(N*sumxy-sumx*sumy)/Sqr((N*sumx2-sumx^2)*(N*sumy2-sumy^2))
rs.Cells(mast,kon1)=pr
mn=sumx/N
rs.Cells(mast,kon1+1)=Sqr((sumx2-N*mn*mn)/(N-1))
mn=sumy/N
rs.Cells(mast,kon1+2)=Sqr((sumy2-N*mn*mn)/(N-1))
kon1=kon1+3
Next 'j

Next 'mast

s.Redraw = True

End Sub

'STATISTICA MACRO FILE VERSION 4
'BEGINPROPERTIES
'NAME=Likert Response Coding Bootstrap Simulation
'DESCRIPTION=
'LANGUAGE=0
'ENDPROPERTIES