SPSSX Discussion

FW: Re: [SPSSX-L] Defining variables depending on values

Classic

List

Threaded

1 message

Mike P-5

FW: Re: [SPSSX-L] Defining variables depending on values

Hi Jurgen,

I got this through from Jon Peck, (guess he just forgot to press reply
all) SEE BELOW

So if you have the programmability installed you could use a couple of
lines of python

Mike

-----Original Message-----
From: Peck, Jon [mailto:[hidden email]]
Sent: 02 November 2006 15:58
To: Michael Pearmain
Subject: RE: Re: [SPSSX-L] Defining variables depending on values

This functionality is built in to the spssaux2 module. It's the
CreateBasisVariables function. It discovers the values, generates the
variables, and creates descriptive labels.

-----Original Message-----
From: SPSSX(r) Discussion [mailto:[hidden email]] On Behalf Of
Michael Pearmain
Sent: Thursday, November 02, 2006 9:52 AM
To: [hidden email]
Subject: Re: [SPSSX-L] Defining variables depending on values

Hi Jurgen,

I have a script that converts a categorical into a dichotomous, with a
bit of playing with the script you could make it output the categorical
value instead...

Just copy and paste into a script file and you can call it from spss,
under run script option

Public intUBound As Integer
Public arrVarNames() As String
Public blnCreateSyntax As Boolean
Public arrValueLabels() As String
' holds the labels corresponding to the above values Public
strSelectedVar As String Public arrNewVars() As String ' Holds list of
new variables to be created Public arrVarLabels() As String Option
Explicit Sub Main ' Going to add macro's in to syntax.... possibly '
Here's code to do the variable label stuff
' DEFINE !addVs (!POSITIONAL !TOKENS(1) / !POSITIONAL !TOKENS(1) /
!POSITIONAL !TOKENS(1) ).
' VALUE LABELS !1
' !2 'False'
' !3 'True'.
' !ENDDEFINE.
' !addVs tMale 2 1.
' !addVs tMale 2 1.
' !addVs tMale 2 1.
' !addVs tMale 2 1.
' !addVs tMale 2 1.
' !addVs tMale 2 1.
' -- END OF MACRO STUFF
Debug.Clear
Dim objDocuments As ISpssDocuments
Dim objDataDoc As ISpssDataDoc
Dim varMyVariables
Dim i As Integer
Set objDocuments=objSpssApp.Documents

' Gets the first data document in the documents collection Set
objDataDoc = objDocuments.GetDataDoc (0) ReDim arrValueLabels(0) As
String ReDim arrNewVars(0) As String ' Gets the variables only
varMyVariables = objDataDoc.GetVariables (False) '
variant array - can't use in DialogBox
If UBound(varMyVariables) = -1 Then
MsgBox "You must have an open dataset."
End
End If
ReDim arrVarNames (UBound(varMyVariables)) ' redim
to arrays to number in dataset
ReDim arrVarLabels (UBound(arrVarNames)) For i = 0 To
UBound(varMyVariables) ' Loop through variables in dataset to create
arrVarNames(i) = varMyVariables(i) ' string arrays for both
varnames and varlabels
If objSpssApp.SpssInfo.VariableLabelAt(i) = "" Then ' note if no
label present, no entry in ListBox!
arrVarLabels(i) = "-- Variable_" & i & " --"
' So enter generic var label & column number
Else
arrVarLabels(i) = objSpssApp.SpssInfo.VariableLabelAt(i)
End If
Next 'i

Begin Dialog UserDialog 720,252,"Create Categorical Variable
from Dichotomous",.CreateDichVars ' %GRID:10,6,1,1
GroupBox 10,0,250,246,"Working File Variable
Information",.GroupBox1
GroupBox 270,0,240,246,"New Variable Options",.GroupBox2
GroupBox 520,0,190,246,"New Variable List",.GroupBox3
ListBox 20,36,230,186,arrVarNames(),.lbWorkingVars
CancelButton 280,216,60,24
OKButton 430,216,70,24
Text 280,144,150,12,"New value options:",.Text3
TextBox 440,162,50,18,.tbPosValue
TextBox 440,186,50,18,.tbNegValue
PushButton 350,216,70,24,"Paste",.pbPaste
TextBox 280,162,130,18,.tbPosLabel
TextBox 280,186,130,18,.tbNegLabel
Text 280,102,42,12,"Prefix:",.Text1
Text 280,126,42,12,"Suffix:",.Text4
TextBox 330,96,160,18,.tbPrefix
TextBox 330,120,160,18,.tbSuffix
ListBox 550,18,150,222,arrNewVars(),.lbNewVars
Text 420,165,10,12,"------",.Text5
Text 420,189,10,12,"------",.Text6
Text 280,18,220,24,"This procedure only works with
numeric categorical variables.",.Text2
CheckBox 530,20,10,12,"",.cb1
CheckBox 530,32,10,12,"",.cb2
CheckBox 530,44,10,12,"",.cb3
CheckBox 530,56,10,12,"",.cb4
CheckBox 530,68,10,12,"",.cb5
CheckBox 530,80,10,12,"",.cb6
CheckBox 530,92,10,12,"",.cb7
CheckBox 530,104,10,12,"",.cb8
CheckBox 530,116,10,12,"",.cb9
CheckBox 530,128,10,12,"",.cb10
CheckBox 530,140,10,12,"",.cb11
CheckBox 530,152,10,12,"",.cb12
CheckBox 530,164,10,12,"",.cb13
CheckBox 530,176,10,12,"",.cb14
CheckBox 530,188,10,12,"",.cb15
CheckBox 530,200,10,12,"",.cb16
CheckBox 530,212,10,12,"",.cb17
CheckBox 530,224,10,12,"",.cb18
CheckBox 50,228,170,12,"Show Variable
Labels",.cbVarLabels
Text 14,18,240,12,"",.txtWarning
Text 280,48,210,42,"For numeric variables, any missing
values are recoded in system-missing values.",.Text7
End Dialog
Dim dlg As UserDialog
If Dialog(dlg) = 0 Then
End
End If

End Sub
Private Function CreateDichVars(DlgItem$, Action%, SuppValue&) As
Boolean
Dim iNum As Integer, iNum2 As Integer ' any integer value in
Function
Dim blnShow As Boolean, iX As Integer
Dim vrtValueLabelCounts As Variant
Dim vrtValueLabels As Variant
Select Case Action%
Case 1 ' Dialog box initialization
' Get first variable in list which has categories
Dim objDataDoc As ISpssDataDoc
Set objDataDoc = objSpssApp.Documents.GetDataDoc (0) '
Gets the first data document in the documents collection
iNum = 0
iNum2 = 0
While iNum = 0
iNum = objDataDoc.GetVariableValueLabels (iNum2,
vrtValueLabelCounts, vrtValueLabels)
iNum2 = iNum2 + 1
Wend
DlgValue("lbWorkingVars",iNum2-1) ' select variable in
the ListBox
Set objDataDoc = Nothing
strSelectedVar = arrVarNames(iNum2-1)
DlgText("tbPrefix", strSelectedVar & "_") ' set default
setting for textbox
ReDim arrNewVars(UBound(vrtValueLabels))
For iNum2 = 0 To UBound(vrtValueLabels)
arrNewVars(iNum2) = strSelectedVar & "_" &
Replace(vrtValueLabels(iNum2)," ", "_")
DlgVisible("cb" & iNum2+1, True) ' show
tickboxes for each available label
DlgValue("cb" & iNum2+1,1) ' and set it to
ticked as default
Next ' iNum2
For iNum2 = iNum2+1 To 18 ' loop hides unnecessary
tickboxes
DlgVisible("cb" & iNum2, False)
Next iNum2
DlgListBoxArray("lbNewVars", arrNewVars)
DlgText("tbPosLabel", "True") ' two default
values for listboxes
DlgText("tbNegLabel", "False")
DlgText("tbPosValue","1") ' two
default values for the +ve and -ve outcome values
DlgText("tbNegValue","0")
Case 2 ' Value changing or button pressed
blnShow = True
Select Case DlgItem$
Case "cbVarLabels"
' Alternate between showing var names/labels
iX = DlgValue("lbWorkingVars") '
get selected listbox value - to select after changing array
If DlgValue("cbVarLabels") Then

DlgListBoxArray("lbWorkingVars", arrVarLabels)
Else

DlgListBoxArray("lbWorkingVars", arrVarNames)
End If
DlgValue("lbWorkingVars", iX) '
ensures have same variable selected
Case "lbWorkingVars"
' Gets the first data document
in the documents collection
Set objDataDoc =
objSpssApp.Documents.GetDataDoc (0)
strSelectedVar =
arrVarNames(DlgValue("lbWorkingVars"))
iNum =
objDataDoc.GetVariableValueLabels (DlgValue("lbWorkingVars"),
vrtValueLabelCounts, vrtValueLabels)
If iNum = 0 Then ' No Categories
in variable as defined by labels

DlgText("txtWarning","This variable has no defined labels.")
ReDim arrNewVars(0) '
Show no values in listbox

DlgListBoxArray("lbNewVars", arrNewVars)
DlgText("tbPrefix","") '
no prefix, since can't handle this var
GoTo HandleNoCats
End If
DlgText("txtWarning","") ' have
categories so warning becomes blank
DlgText("tbPrefix",
strSelectedVar & "_") ' have new variable so change PREFIX
value
ReDim
arrNewVars(UBound(vrtValueLabels))
For iNum2 = 0 To
UBound(vrtValueLabels)
arrNewVars(iNum2) =
strSelectedVar & "_" & Replace(vrtValueLabels(iNum2)," ", "_")
DlgVisible("cb" &
iNum2+1, True) ' show tickbox
DlgValue("cb" &
iNum2+1,1) ' set it to ticked
Next ' iNum2
For iNum2 = iNum2+1 To 18
DlgVisible("cb" & iNum2,
False)
Next iNum2
DlgListBoxArray("lbNewVars",
arrNewVars)
Set objDataDoc = Nothing
Case "OK", "pbPaste"
If DlgText("tbPosValue") = "" Or
DlgText("tbNegValue") = "" Then ' Error - MUST HAVE SOME
CHECKING TO DO LATER
MsgBox "You must enter
values for both the positive and negative outcomes."
GoTo HandleNoCats
ElseIf
IsNumeric(DlgText("tbPosValue")) = False Or
IsNumeric(DlgText("tbNegValue")) = False Then
MsgBox "You must enter
numeric values for both the positive and negative outcomes."
GoTo HandleNoCats
Else
' Need Values for
variable for each label
strSelectedVar =
arrVarNames(DlgValue("lbWorkingVars"))
Set objDataDoc =
objSpssApp.Documents.GetDataDoc (0)

objDataDoc.GetVariableValueLabels (DlgValue("lbWorkingVars"),
vrtValueLabelCounts, vrtValueLabels)
If
IsEmpty(vrtValueLabels) = True Then
MsgBox "You must
have existing categories and labels."
GoTo
HandleNoCats
End If
For iX = 1 To
UBound(vrtValueLabels)
arrNewVars(iX) =
DlgText("tbPrefix") & Replace(vrtValueLabels(iX)," ", "_") &
DlgText("tbSuffix")
Next
ReDim
arrValueLabels(UBound(vrtValueLabelCounts))
For iX = 0 To
UBound(arrNewVars)

arrValueLabels(iX) = CStr(vrtValueLabelCounts(iX))
Next ' iX
' Need check here for
string variable
If
objSpssApp.SpssInfo.VarType(DlgValue("lbWorkingVars")) = SpssDataString
Then
For iX = 0 To
UBound(arrNewVars)

arrValueLabels(iX) = "'" & arrValueLabels(iX) & "'"
Next ' iX
End If
' Build up syntax
here...
Dim strComputeSyntax As
String
For iX = 0 To
UBound(arrNewVars)
If DlgValue("cb"
& iX+1) = 1 Then
strComputeSyntax = strComputeSyntax & _
"DO IF " & strSelectedVar & " = " & arrValueLabels(iX) & "." & vbCrLf &
_ "+ COMPUTE " & arrNewVars(iX) & " = " & DlgText("tbPosValue") & "." &
vbCrLf & _ "ELSE." & vbCrLf & _ "+ COMPUTE " & arrNewVars(iX) & " = " &
DlgText("tbNegValue") & "." & vbCrLf & _ "END IF." & vbCrLf
End If
Next iX
If
objSpssApp.SpssInfo.VarType(DlgValue("lbWorkingVars")) <> SpssDataString
Then strComputeSyntax = strComputeSyntax & _ "DO IF MISSING(" &
strSelectedVar & ") = 1." & vbCrLf
For iX = 0 To
UBound(arrNewVars)
If
DlgValue("cb" & iX+1) = 1 Then strComputeSyntax = strComputeSyntax & _
"+ COMPUTE " & arrNewVars(iX) & " = $sysmis." & vbCrLf
End If
Next 'iX
strComputeSyntax = strComputeSyntax & "END IF." & vbCrLf
End If
For iX = 0 To
UBound(arrNewVars)
If DlgValue("cb"
& iX+1) = 1 Then
strComputeSyntax = strComputeSyntax & _
"VALUE LABELS " & arrNewVars(iX) & _
" " & DlgText("tbNegValue") & " '" & DlgText("tbNegLabel") & "'" & _ " "
& DlgText("tbPosValue") & " '" & DlgText("tbPosLabel") & "'." & vbCrLf
End If
Next iX
strComputeSyntax =
strComputeSyntax & "EXE." & vbCrLf
Debug.Print
strComputeSyntax
blnShow = False
If DlgItem$ = "pbPaste"
Then
Dim objSyntaxDoc
As ISpssSyntaxDoc
iX =
objSpssApp.Documents.SyntaxDocCount
'Get and display
the designated syntax document:
If iX = 0 Then
Set
objSyntaxDoc =objSpssApp.NewSyntaxDoc
End If
Set objSyntaxDoc
= objSpssApp.GetDesignatedSyntaxDoc
If
objSyntaxDoc.Text <> "" Then

objSyntaxDoc.Text = objSyntaxDoc.Text & vbCrLf
End If

objSyntaxDoc.Text = objSyntaxDoc.Text & "* Syntax generated from a
Script." & vbCrLf & _
"* At " & CStr(Now) & " for the variable - " & strSelectedVar & "."
& vbCrLf & strComputeSyntax & _
"* End of Script generated syntax."

objSyntaxDoc.Visible = True
Else ' Execute syntax
here

objSpssApp.ExecuteCommands strComputeSyntax, True
End If
End If
Case "Cancel"
End
End Select
' List of GOTO for error messages
HandleNoCats:
CreateDichVars = blnShow ' Prevent button press
from closing the dialog box - TRUE
Case 3 ' TextBox or ComboBox text changed
Select Case DlgItem$
Case "tbPrefix", "tbSuffix"
If InStr(DlgText("tbPrefix"),"
") > 0 Then
DlgText "tbPrefix",
Replace(DlgText("tbPrefix"), " ", "_")
End If
If InStr(DlgText("tbSuffix"),"
") > 0 Then
DlgText "tbSuffix",
Replace(DlgText("tbSuffix"), " ", "_")
End If
strSelectedVar =
arrVarNames(DlgValue("lbWorkingVars"))
Set objDataDoc =
objSpssApp.Documents.GetDataDoc (0)

objDataDoc.GetVariableValueLabels (DlgValue("lbWorkingVars"),
vrtValueLabelCounts, vrtValueLabels)
If IsEmpty(vrtValueLabels) =
False Then
ReDim
arrNewVars(UBound(vrtValueLabels))
For iNum2 = 0 To
UBound(vrtValueLabels)

arrNewVars(iNum2) = DlgText("tbPrefix") &
Replace(vrtValueLabels(iNum2)," ", "_") & DlgText("tbSuffix")
Debug.Print
vrtValueLabels(iNum2)
Next ' iNum2
Else
ReDim arrNewVars(0)
End If
DlgListBoxArray("lbNewVars",
arrNewVars)
Case "tbPosValue", "tbNegValue"
If DlgText("tbPosValue") =
DlgText("tbNegValue") Then
MsgBox "The two new
values must be different."
If DlgItem$ =
"tbPosValue" Then

DlgText("tbPosValue","")

DlgFocus("tbPosValue")
Else

DlgText("tbNegValue","")

DlgFocus("tbNegValue")
End If
End If
Case "tbPosLabel", "tbNegLabel"
If DlgText("tbPosLabel") =
DlgText("tbNegLabel") Then
MsgBox "The two new
labels must be different."
If DlgItem$ =
"tbPosLabel" Then

DlgText("tbPosLabel","")

DlgFocus("tbPosLabel")
Else

DlgText("tbNegLabel","")

DlgFocus("tbNegLabel")
End If
End If
End Select
CreateDichVars = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Function

-----Original Message-----
From: SPSSX(r) Discussion [mailto:[hidden email]] On Behalf Of
Juergen Pueschel
Sent: 02 November 2006 15:27
To: [hidden email]
Subject: Defining variables depending on values

Dear listmembers,

I want to define a set of variables depending on the values of one other
variable.

Example:

VAR_X
2
2
3
3
4
4
5
5

The result should look like this:

VAR_X VAR_2 VAR_5 VAR_7 VAR_9
2 2
2 2
5 5
5 5
7 7
7 7
9 9
9 9

I'll already tried the vector-function in combination with a loop ... /
do if - structure, but the result is a variable set, that, for example,
contains 10 variables, whereof only four variables contain values.

Best regards

Juergen

________________________________________________________________________
This e-mail has been scanned for all viruses by Star. The service is
powered by MessageLabs. For more information on a proactive anti-virus
service working around the clock, around the globe, visit:
http://www.star.net.uk
________________________________________________________________________

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http://www.messagelabs.com/email
______________________________________________________________________

________________________________________________________________________
This e-mail has been scanned for all viruses by Star. The service is
powered by MessageLabs. For more information on a proactive anti-virus
service working around the clock, around the globe, visit:
http://www.star.net.uk
________________________________________________________________________

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http://www.messagelabs.com/email
______________________________________________________________________