diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb index a6b6806ac87..e88593ac3f1 100644 --- a/instat/clsRLink.vb +++ b/instat/clsRLink.vb @@ -486,7 +486,7 @@ Public Class RLink bInstatObjectExists = True End Sub - Public Sub FillListView(lstView As ListView, strType As String, Optional lstIncludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional lstExcludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional strDataFrameName As String = "", Optional strHeading As String = "Variables", Optional strExcludedItems As String() = Nothing) + Public Sub FillListView(lstView As ListView, strType As String, Optional lstIncludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional lstExcludedDataTypes As List(Of KeyValuePair(Of String, String())) = Nothing, Optional strDataFrameName As String = "", Optional strHeading As String = "Variables", Optional strExcludedItems As String() = Nothing, Optional strDatabaseQuery As String = "") Dim vecColumns As GenericVector Dim chrCurrColumns As CharacterVector Dim i As Integer @@ -517,6 +517,9 @@ Public Class RLink clsGetItems.SetRCommand(strInstatDataObject & "$get_link_names") Case "key" clsGetItems.SetRCommand(strInstatDataObject & "$get_key_names") + Case "database_variables" + clsGetItems.SetRCommand(strInstatDataObject & "$get_database_variable_names") + clsGetItems.AddParameter("query", Chr(34) & strDatabaseQuery & Chr(34)) End Select clsGetItems.AddParameter("as_list", "TRUE") lstView.Clear() @@ -740,5 +743,30 @@ Public Class RLink clsMakeNames.AddParameter("names", Chr(34) & strText & Chr(34)) strOut = RunInternalScriptGetValue(clsMakeNames.ToScript()).AsCharacter(0) Return strOut + End Function + + 'Corruption analysis functions + Public Function GetCorruptionDataFrameNames() As List(Of String) + Dim clsGetDataNames As New RFunction + Dim lstNames As New List(Of String) + Dim expDataNames As SymbolicExpression + + clsGetDataNames.SetRCommand(strInstatDataObject & "$get_corruption_data_names") + expDataNames = RunInternalScriptGetValue(clsGetDataNames.ToScript()) + If Not expDataNames.Type = Internals.SymbolicExpressionType.Null Then + lstNames = expDataNames.AsCharacter.ToList() + End If + Return lstNames + End Function + + Public Function GetCorruptionColumnOfType(strDataName As String, strType As String) As String + Dim clsGetColumnName As New RFunction + Dim strColumn As String + + clsGetColumnName.SetRCommand(strInstatDataObject & "$get_corruption_column_name") + clsGetColumnName.AddParameter("data_name", Chr(34) & strDataName & Chr(34)) + clsGetColumnName.AddParameter("type", Chr(34) & strType & Chr(34)) + strColumn = RunInternalScriptGetValue(clsGetColumnName.ToScript()).AsCharacter(0) + Return strColumn End Function End Class \ No newline at end of file diff --git a/instat/dlgClimSoft.Designer.vb b/instat/dlgClimSoft.Designer.vb index 8269c2e086c..37852c49927 100644 --- a/instat/dlgClimSoft.Designer.vb +++ b/instat/dlgClimSoft.Designer.vb @@ -23,30 +23,167 @@ Partial Class dlgClimSoft _ Private Sub InitializeComponent() Me.ucrBase = New instat.ucrButtons() + Me.cmdEstablishConnection = New System.Windows.Forms.Button() + Me.ucrReceiverMultipleStations = New instat.ucrReceiverMultiple() + Me.lblElements = New System.Windows.Forms.Label() + Me.lblStations = New System.Windows.Forms.Label() + Me.ucrReceiverMultipleElements = New instat.ucrReceiverMultiple() + Me.lblStartDate = New System.Windows.Forms.Label() + Me.ucrSelectorForClimSoft = New instat.ucrSelectorAddRemove() + Me.ucrChkObservationData = New instat.ucrCheck() + Me.ucrInputStartDate = New instat.ucrInputTextBox() + Me.ucrInputEndDate = New instat.ucrInputTextBox() + Me.lblEndDate = New System.Windows.Forms.Label() Me.SuspendLayout() ' 'ucrBase ' - Me.ucrBase.Location = New System.Drawing.Point(6, 201) + Me.ucrBase.Location = New System.Drawing.Point(10, 337) Me.ucrBase.Name = "ucrBase" Me.ucrBase.Size = New System.Drawing.Size(410, 52) - Me.ucrBase.TabIndex = 0 + Me.ucrBase.TabIndex = 11 + ' + 'cmdEstablishConnection + ' + Me.cmdEstablishConnection.Location = New System.Drawing.Point(10, 12) + Me.cmdEstablishConnection.Name = "cmdEstablishConnection" + Me.cmdEstablishConnection.Size = New System.Drawing.Size(114, 23) + Me.cmdEstablishConnection.TabIndex = 0 + Me.cmdEstablishConnection.Text = "Establish Connection" + Me.cmdEstablishConnection.UseVisualStyleBackColor = True + ' + 'ucrReceiverMultipleStations + ' + Me.ucrReceiverMultipleStations.frmParent = Me + Me.ucrReceiverMultipleStations.Location = New System.Drawing.Point(260, 60) + Me.ucrReceiverMultipleStations.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMultipleStations.Name = "ucrReceiverMultipleStations" + Me.ucrReceiverMultipleStations.Selector = Nothing + Me.ucrReceiverMultipleStations.Size = New System.Drawing.Size(120, 100) + Me.ucrReceiverMultipleStations.TabIndex = 3 + ' + 'lblElements + ' + Me.lblElements.AutoSize = True + Me.lblElements.Location = New System.Drawing.Point(260, 176) + Me.lblElements.Name = "lblElements" + Me.lblElements.Size = New System.Drawing.Size(53, 13) + Me.lblElements.TabIndex = 4 + Me.lblElements.Text = "Elements:" + ' + 'lblStations + ' + Me.lblStations.AutoSize = True + Me.lblStations.Location = New System.Drawing.Point(260, 45) + Me.lblStations.Name = "lblStations" + Me.lblStations.Size = New System.Drawing.Size(48, 13) + Me.lblStations.TabIndex = 2 + Me.lblStations.Text = "Stations:" + Me.lblStations.TextAlign = System.Drawing.ContentAlignment.MiddleCenter + ' + 'ucrReceiverMultipleElements + ' + Me.ucrReceiverMultipleElements.frmParent = Me + Me.ucrReceiverMultipleElements.Location = New System.Drawing.Point(260, 193) + Me.ucrReceiverMultipleElements.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMultipleElements.Name = "ucrReceiverMultipleElements" + Me.ucrReceiverMultipleElements.Selector = Nothing + Me.ucrReceiverMultipleElements.Size = New System.Drawing.Size(120, 100) + Me.ucrReceiverMultipleElements.TabIndex = 5 + ' + 'lblStartDate + ' + Me.lblStartDate.AutoSize = True + Me.lblStartDate.Location = New System.Drawing.Point(10, 239) + Me.lblStartDate.Name = "lblStartDate" + Me.lblStartDate.Size = New System.Drawing.Size(58, 13) + Me.lblStartDate.TabIndex = 7 + Me.lblStartDate.Text = "Start Date:" + ' + 'ucrSelectorForClimSoft + ' + Me.ucrSelectorForClimSoft.bShowHiddenColumns = False + Me.ucrSelectorForClimSoft.Location = New System.Drawing.Point(10, 57) + Me.ucrSelectorForClimSoft.Margin = New System.Windows.Forms.Padding(0) + Me.ucrSelectorForClimSoft.Name = "ucrSelectorForClimSoft" + Me.ucrSelectorForClimSoft.Size = New System.Drawing.Size(201, 147) + Me.ucrSelectorForClimSoft.TabIndex = 1 + ' + 'ucrChkObservationData + ' + Me.ucrChkObservationData.Checked = False + Me.ucrChkObservationData.Location = New System.Drawing.Point(10, 207) + Me.ucrChkObservationData.Name = "ucrChkObservationData" + Me.ucrChkObservationData.Size = New System.Drawing.Size(178, 20) + Me.ucrChkObservationData.TabIndex = 6 + ' + 'ucrInputStartDate + ' + Me.ucrInputStartDate.AddQuotesIfUnrecognised = True + Me.ucrInputStartDate.IsMultiline = False + Me.ucrInputStartDate.IsReadOnly = False + Me.ucrInputStartDate.Location = New System.Drawing.Point(10, 255) + Me.ucrInputStartDate.Name = "ucrInputStartDate" + Me.ucrInputStartDate.Size = New System.Drawing.Size(137, 21) + Me.ucrInputStartDate.TabIndex = 8 + ' + 'ucrInputEndDate + ' + Me.ucrInputEndDate.AddQuotesIfUnrecognised = True + Me.ucrInputEndDate.IsMultiline = False + Me.ucrInputEndDate.IsReadOnly = False + Me.ucrInputEndDate.Location = New System.Drawing.Point(10, 304) + Me.ucrInputEndDate.Name = "ucrInputEndDate" + Me.ucrInputEndDate.Size = New System.Drawing.Size(137, 21) + Me.ucrInputEndDate.TabIndex = 10 + ' + 'lblEndDate + ' + Me.lblEndDate.AutoSize = True + Me.lblEndDate.Location = New System.Drawing.Point(10, 288) + Me.lblEndDate.Name = "lblEndDate" + Me.lblEndDate.Size = New System.Drawing.Size(55, 13) + Me.lblEndDate.TabIndex = 9 + Me.lblEndDate.Text = "End Date:" ' 'dlgClimSoft ' Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font - Me.ClientSize = New System.Drawing.Size(412, 261) + Me.ClientSize = New System.Drawing.Size(423, 394) + Me.Controls.Add(Me.ucrInputEndDate) + Me.Controls.Add(Me.ucrInputStartDate) + Me.Controls.Add(Me.ucrChkObservationData) + Me.Controls.Add(Me.lblEndDate) + Me.Controls.Add(Me.ucrSelectorForClimSoft) + Me.Controls.Add(Me.lblStartDate) + Me.Controls.Add(Me.ucrReceiverMultipleElements) + Me.Controls.Add(Me.lblStations) + Me.Controls.Add(Me.lblElements) + Me.Controls.Add(Me.ucrReceiverMultipleStations) + Me.Controls.Add(Me.cmdEstablishConnection) Me.Controls.Add(Me.ucrBase) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow Me.MaximizeBox = False Me.MinimizeBox = False Me.Name = "dlgClimSoft" Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen - Me.Text = "ClimSoft" + Me.Text = "Import From ClimSoft" Me.ResumeLayout(False) + Me.PerformLayout() End Sub Friend WithEvents ucrBase As ucrButtons + Friend WithEvents cmdEstablishConnection As Button + Friend WithEvents ucrReceiverMultipleStations As ucrReceiverMultiple + Friend WithEvents ucrReceiverMultipleElements As ucrReceiverMultiple + Friend WithEvents lblStations As Label + Friend WithEvents lblElements As Label + Friend WithEvents lblStartDate As Label + Friend WithEvents ucrSelectorForClimSoft As ucrSelectorAddRemove + Friend WithEvents ucrChkObservationData As ucrCheck + Friend WithEvents ucrInputEndDate As ucrInputTextBox + Friend WithEvents ucrInputStartDate As ucrInputTextBox + Friend WithEvents lblEndDate As Label End Class diff --git a/instat/dlgClimSoft.vb b/instat/dlgClimSoft.vb index 354fa2bee46..11a587dd4ce 100644 --- a/instat/dlgClimSoft.vb +++ b/instat/dlgClimSoft.vb @@ -16,18 +16,26 @@ Imports instat.Translations Public Class dlgClimSoft - Public bFirstLoad As Boolean = True + Private bFirstLoad As Boolean = True + Private bReset As Boolean = True Private Sub dlgClimSoft_Load(sender As Object, e As EventArgs) Handles MyBase.Load autoTranslate(Me) If bFirstLoad Then InitialiseDialog() - SetDefaults() bFirstLoad = False End If + If bReset Then + SetDefaults() + End If + bReset = False TestOKEnabled() End Sub Private Sub InitialiseDialog() ucrBase.iHelpTopicID = 329 + ucrReceiverMultipleStations.Selector = ucrSelectorForClimSoft + ucrReceiverMultipleElements.Selector = ucrSelectorForClimSoft + ucrReceiverMultipleStations.SetMeAsReceiver() + ucrChkObservationData.SetText("Observation Data") End Sub Private Sub TestOKEnabled() @@ -36,5 +44,14 @@ Public Class dlgClimSoft Private Sub SetDefaults() TestOKEnabled() + ucrSelectorForClimSoft.Reset() + End Sub + + Private Sub cmdEstablishConnection_Click(sender As Object, e As EventArgs) Handles cmdEstablishConnection.Click + sdgImportFromClimSoft.ShowDialog() + End Sub + + Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset + SetDefaults() End Sub End Class \ No newline at end of file diff --git a/instat/dlgRestrict.vb b/instat/dlgRestrict.vb index a3478afeff9..ed2c9379076 100644 --- a/instat/dlgRestrict.vb +++ b/instat/dlgRestrict.vb @@ -24,6 +24,7 @@ Public Class dlgRestrict Private clsFilterView As RFunction Public bIsSubsetDialog As Boolean Public strDefaultDataframe As String = "" + Public strDefaultColumn As String = "" Public Sub New() @@ -31,15 +32,15 @@ Public Class dlgRestrict InitializeComponent() ' Add any initialization after the InitializeComponent() call. - bFirstLoad = True + clsSubset = New RFunction clsRemoveFilter = New RFunction - clsRemoveFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$remove_current_filter") clsSetCurrentFilter = New RFunction - clsSetCurrentFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_current_filter") - clsSubset = New RFunction - clsSubset.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame") - clsSubset.AddParameter("use_current_filter", "FALSE") clsFilterView = New RFunction + + bFirstLoad = True + clsRemoveFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$remove_current_filter") + clsSetCurrentFilter.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_current_filter") + clsSubset.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$copy_data_object") clsFilterView.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$filter_string") End Sub @@ -62,7 +63,7 @@ Public Class dlgRestrict ucrReceiverFilter.SetMeAsReceiver() ucrNewDataFrameName.SetValidationTypeAsRVariable() ucrBase.iHelpTopicID = 340 - rdoApplyAsSubset.Enabled = False + 'rdoApplyAsSubset.Enabled = False End Sub Private Sub SetDefaults() @@ -71,8 +72,8 @@ Public Class dlgRestrict SetDefaultNewDataFrameName() SetFilterSubsetStatus() SetDefaultDataFrame() - ucrNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe - lblNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe + 'ucrNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe + 'lblNewDataFrameName.Visible = False 'temporarily while we have disabled the option to get a new dataframe End Sub Private Sub TestOkEnabled() @@ -109,7 +110,11 @@ Public Class dlgRestrict Private Sub cmdNewFilter_Click(sender As Object, e As EventArgs) Handles cmdDefineNewFilter.Click sdgCreateFilter.ucrCreateFilter.ucrSelectorForFitler.SetDataframe(ucrSelectorFilter.ucrAvailableDataFrames.cboAvailableDataFrames.Text) + If strDefaultColumn <> "" Then + sdgCreateFilter.ucrCreateFilter.ucrFilterByReceiver.Add(strDefaultColumn) + End If sdgCreateFilter.ShowDialog() + strDefaultColumn = "" If sdgCreateFilter.bFilterDefined Then frmMain.clsRLink.RunScript(sdgCreateFilter.clsCurrentFilter.ToScript(), strComment:="Create Filter subdialog: Created new filter") ucrSelectorFilter.SetDataframe(sdgCreateFilter.ucrCreateFilter.ucrSelectorForFitler.ucrAvailableDataFrames.cboAvailableDataFrames.Text) @@ -148,7 +153,11 @@ Public Class dlgRestrict clsFilterView.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames()) clsSubset.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames()) clsSetCurrentFilter.AddParameter("filter_name", ucrReceiverFilter.GetVariableNames()) - ucrInputFilterPreview.SetName(frmMain.clsRLink.RunInternalScriptGetValue(clsFilterView.ToScript()).AsCharacter(0)) + Try + ucrInputFilterPreview.SetName(frmMain.clsRLink.RunInternalScriptGetValue(clsFilterView.ToScript()).AsCharacter(0)) + Catch ex As Exception + ucrInputFilterPreview.SetName("Preview not available") + End Try End If TestOkEnabled() End Sub @@ -162,6 +171,7 @@ Public Class dlgRestrict ucrNewDataFrameName.Visible = True End If SetFilterOptions() + SetBaseFunction() End Sub Private Sub ucrNewDataFrameName_NameChanged() Handles ucrNewDataFrameName.NameChanged @@ -178,10 +188,11 @@ Public Class dlgRestrict ucrBase.clsRsyntax.RemoveAssignTo() Else ucrBase.clsRsyntax.SetBaseRFunction(clsSubset) + clsSubset.AddParameter("new_name", Chr(34) & ucrNewDataFrameName.GetText() & Chr(34)) If Not ucrNewDataFrameName.IsEmpty() Then - ucrBase.clsRsyntax.SetAssignTo(ucrNewDataFrameName.GetText(), strTempDataframe:=ucrNewDataFrameName.GetText()) + 'ucrBase.clsRsyntax.SetAssignTo(ucrNewDataFrameName.GetText(), strTempDataframe:=ucrNewDataFrameName.GetText()) Else - ucrBase.clsRsyntax.RemoveAssignTo() + 'ucrBase.clsRsyntax.RemoveAssignTo() End If End If End Sub diff --git a/instat/frmMain.Designer.vb b/instat/frmMain.Designer.vb index 4bb2785da19..6f8a90b2389 100644 --- a/instat/frmMain.Designer.vb +++ b/instat/frmMain.Designer.vb @@ -415,8 +415,20 @@ Partial Class frmMain Me.mnuCorruptionFile = New System.Windows.Forms.ToolStripMenuItem() Me.mnuCorruptionDefineCorruptionData = New System.Windows.Forms.ToolStripMenuItem() Me.mnuCorruptionPrepare = New System.Windows.Forms.ToolStripMenuItem() + Me.CountryNamesCorrectionsToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.MergeAdditionalDataToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.FilterToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.UseAwardDateToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.UseSignatureDateToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.DefineCorruptionFreeCategoriesToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.DefineContractValueCategoriesToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() Me.mnuCorruptionDescribe = New System.Windows.Forms.ToolStripMenuItem() + Me.AaToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() Me.mnuCorruptionModel = New System.Windows.Forms.ToolStripMenuItem() + Me.AaToolStripMenuItem1 = New System.Windows.Forms.ToolStripMenuItem() + Me.DefineRedFlagsToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.CalculateCRIToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.TestsAndChecksToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() Me.mnuTools = New System.Windows.Forms.ToolStripMenuItem() Me.mnuToolsRunRCode = New System.Windows.Forms.ToolStripMenuItem() Me.mnuToolsRestartR = New System.Windows.Forms.ToolStripMenuItem() @@ -435,7 +447,7 @@ Partial Class frmMain ' Me.mnuDescribe.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuDescribeOneVariable, Me.mnuDescribeTwoVariables, Me.mnuDescribeSpecific, Me.mnuDescribeGeneral, Me.ToolStripSeparator9, Me.mnuDescribeMultivariate, Me.mnuDescribeMoreGraphs, Me.ToolStripSeparator13, Me.mnuDescribeUseGraph, Me.mnuDescribeCombineGraph, Me.mnuDescribeThemes}) Me.mnuDescribe.Name = "mnuDescribe" - Me.mnuDescribe.Size = New System.Drawing.Size(64, 20) + Me.mnuDescribe.Size = New System.Drawing.Size(64, 19) Me.mnuDescribe.Tag = "Describe" Me.mnuDescribe.Text = "Describe" ' @@ -708,7 +720,7 @@ Partial Class frmMain ' Me.mnuModel.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuModelProbabilityDistributions, Me.ToolStripSeparator3, Me.mnuModelOneVariable, Me.mnuModelTwoVariables, Me.mnuModelThreeVariables, Me.mnuModelFourVariables, Me.mnuModelGeneral, Me.ToolStripSeparator4, Me.mnuModelOtherOneVariable, Me.mnuModelOtherTwoVariables, Me.mnuModelOtherThreeVariables, Me.mnuModelOtherGeneral}) Me.mnuModel.Name = "mnuModel" - Me.mnuModel.Size = New System.Drawing.Size(53, 20) + Me.mnuModel.Size = New System.Drawing.Size(53, 19) Me.mnuModel.Tag = "Model" Me.mnuModel.Text = "Model" ' @@ -1138,7 +1150,7 @@ Partial Class frmMain ' Me.mnuView.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuViewDataView, Me.mnuViewOutputWindow, Me.mnuViewLog, Me.mnuViewScriptWindow, Me.mnuViewColumnMetadata, Me.mnuViewDataFrameMetadata, Me.ToolStripSeparator22, Me.mnuViewCascade, Me.mnuViewTileVertically, Me.mnuViewTileHorizontally}) Me.mnuView.Name = "mnuView" - Me.mnuView.Size = New System.Drawing.Size(44, 20) + Me.mnuView.Size = New System.Drawing.Size(44, 19) Me.mnuView.Tag = "View" Me.mnuView.Text = "View" ' @@ -1210,7 +1222,7 @@ Partial Class frmMain ' Me.mnuHelp.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuHelpHelpIntroduction, Me.mnuHelpHistFAQ, Me.mnuHelpSpreadsheet, Me.mnuHelpGetingStarted, Me.ToolStripSeparator28, Me.mnuHelpMenus, Me.mnuHelpR, Me.mnuHelpRPackagesCommands, Me.mnuHelpDataset, Me.ToolStripSeparator29, Me.mnuHelpGuide, Me.mnuHelpAboutRInstat, Me.mnuHelpLicence}) Me.mnuHelp.Name = "mnuHelp" - Me.mnuHelp.Size = New System.Drawing.Size(44, 20) + Me.mnuHelp.Size = New System.Drawing.Size(44, 19) Me.mnuHelp.Tag = "Help" Me.mnuHelp.Text = "Help" ' @@ -1322,7 +1334,7 @@ Partial Class frmMain ' Me.mnuClimatic.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuClimaticFile, Me.ToolStripSeparator18, Me.mnuCliDefineClimaticData, Me.mnuClimaticPrepare, Me.mnuClimaticQualityControl, Me.ToolStripSeparator30, Me.mnuClimdex, Me.mnuClimaticDescribe, Me.mnuClimaticPICSA, Me.ToolStripSeparator16, Me.mnuClimaticModels, Me.mnuClimaticExamine, Me.mnuClimaticProcess, Me.ToolStripSeparator23, Me.mnuClimaticSCF, Me.mnuClimaticEvaporation, Me.mnuClimaticCrop, Me.mnuClimaticHeatSum, Me.mnuClimateMethods}) Me.mnuClimatic.Name = "mnuClimatic" - Me.mnuClimatic.Size = New System.Drawing.Size(63, 20) + Me.mnuClimatic.Size = New System.Drawing.Size(63, 19) Me.mnuClimatic.Tag = "Climatic" Me.mnuClimatic.Text = "Climatic" ' @@ -2136,7 +2148,7 @@ Partial Class frmMain ' Me.mnuEdit.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuEditFind, Me.mnuEditFindNext, Me.mnuEditReplace, Me.mnuEditCut, Me.mnuEditCopy, Me.mnuEditCopySpecial, Me.mnuEditPaste, Me.mnuEditSelectAll}) Me.mnuEdit.Name = "mnuEdit" - Me.mnuEdit.Size = New System.Drawing.Size(39, 20) + Me.mnuEdit.Size = New System.Drawing.Size(39, 19) Me.mnuEdit.Tag = "Edit" Me.mnuEdit.Text = "Edit" ' @@ -2210,10 +2222,11 @@ Partial Class frmMain 'stsStrip ' Me.stsStrip.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.tstatus}) - Me.stsStrip.Location = New System.Drawing.Point(0, 347) + Me.stsStrip.Location = New System.Drawing.Point(0, 851) Me.stsStrip.Name = "stsStrip" + Me.stsStrip.Padding = New System.Windows.Forms.Padding(3, 0, 37, 0) Me.stsStrip.RenderMode = System.Windows.Forms.ToolStripRenderMode.Professional - Me.stsStrip.Size = New System.Drawing.Size(769, 22) + Me.stsStrip.Size = New System.Drawing.Size(1596, 22) Me.stsStrip.TabIndex = 8 Me.stsStrip.Text = "Status" ' @@ -2227,10 +2240,11 @@ Partial Class frmMain ' Me.Tool_strip.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden Me.Tool_strip.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuTbNew, Me.mnuTbOpen, Me.mnuTbSave, Me.mnuTbPrint, Me.toolStripSeparator, Me.mnuTbCut, Me.mnuTbCopy, Me.mnuTbPaste, Me.mnuTbDelete, Me.separator1, Me.EditLastDialogueToolStrip, Me.mnuTbShowLast10, Me.separator2, Me.mnuTbHelp}) - Me.Tool_strip.Location = New System.Drawing.Point(0, 24) + Me.Tool_strip.Location = New System.Drawing.Point(0, 29) Me.Tool_strip.Name = "Tool_strip" + Me.Tool_strip.Padding = New System.Windows.Forms.Padding(0, 0, 3, 0) Me.Tool_strip.RenderMode = System.Windows.Forms.ToolStripRenderMode.System - Me.Tool_strip.Size = New System.Drawing.Size(769, 25) + Me.Tool_strip.Size = New System.Drawing.Size(1596, 25) Me.Tool_strip.TabIndex = 7 Me.Tool_strip.Text = "Tool" ' @@ -2372,9 +2386,10 @@ Partial Class frmMain Me.mnuBar.LayoutStyle = System.Windows.Forms.ToolStripLayoutStyle.HorizontalStackWithOverflow Me.mnuBar.Location = New System.Drawing.Point(0, 0) Me.mnuBar.Name = "mnuBar" + Me.mnuBar.Padding = New System.Windows.Forms.Padding(16, 5, 0, 5) Me.mnuBar.RenderMode = System.Windows.Forms.ToolStripRenderMode.System Me.mnuBar.ShowItemToolTips = True - Me.mnuBar.Size = New System.Drawing.Size(769, 24) + Me.mnuBar.Size = New System.Drawing.Size(1596, 29) Me.mnuBar.TabIndex = 6 Me.mnuBar.Text = "Menu_strip" ' @@ -2382,7 +2397,7 @@ Partial Class frmMain ' Me.mnuFile.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuFileNewDataFrame, Me.mnuFileOpenFromFile, Me.mnuFileOpenFromLibrary, Me.mnuImportFromODK, Me.ToolStripSeparator27, Me.mnuFileConvert, Me.tlSeparatorFile, Me.mnuFileSave, Me.mnuFileSaveAs, Me.mnuExport, Me.mnuFilePrint, Me.mnuFilePrintPreview, Me.tlSeparatorFile3, Me.mnuFileCloseData, Me.ToolStripSeparator8, Me.mnuFIleExit}) Me.mnuFile.Name = "mnuFile" - Me.mnuFile.Size = New System.Drawing.Size(37, 20) + Me.mnuFile.Size = New System.Drawing.Size(37, 19) Me.mnuFile.Tag = "File" Me.mnuFile.Text = "File" ' @@ -2453,7 +2468,7 @@ Partial Class frmMain ' Me.mnuPrepare.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuPrepareDataFrame, Me.mnuPrepareCheckData, Me.ToolStripSeparator6, Me.mnuPrepareColumnCalculate, Me.mnuPrepareColumnGenerate, Me.mnuPrepareColumnFactor, Me.mnuPrepareColumnText, Me.mnuPrepareColumnDate, Me.mnuPrepareColumnReshape, Me.ToolStripSeparator7, Me.mnuPrepareKeysAndLinks, Me.mnuPrepareDataObject, Me.mnuPrepareRObjects}) Me.mnuPrepare.Name = "mnuPrepare" - Me.mnuPrepare.Size = New System.Drawing.Size(59, 20) + Me.mnuPrepare.Size = New System.Drawing.Size(59, 19) Me.mnuPrepare.Tag = "Prepare" Me.mnuPrepare.Text = "Prepare" ' @@ -3173,16 +3188,16 @@ Partial Class frmMain ' 'mnuCorruption ' - Me.mnuCorruption.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuCorruptionFile, Me.mnuCorruptionDefineCorruptionData, Me.mnuCorruptionPrepare, Me.mnuCorruptionDescribe, Me.mnuCorruptionModel}) + Me.mnuCorruption.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuCorruptionFile, Me.mnuCorruptionDefineCorruptionData, Me.mnuCorruptionPrepare, Me.mnuCorruptionDescribe, Me.mnuCorruptionModel, Me.DefineRedFlagsToolStripMenuItem, Me.CalculateCRIToolStripMenuItem, Me.TestsAndChecksToolStripMenuItem}) Me.mnuCorruption.Name = "mnuCorruption" - Me.mnuCorruption.Size = New System.Drawing.Size(77, 20) + Me.mnuCorruption.Size = New System.Drawing.Size(77, 19) Me.mnuCorruption.Text = "Corruption" ' 'mnuCorruptionFile ' Me.mnuCorruptionFile.Name = "mnuCorruptionFile" Me.mnuCorruptionFile.Size = New System.Drawing.Size(205, 22) - Me.mnuCorruptionFile.Text = "File..." + Me.mnuCorruptionFile.Text = "Open from Library..." ' 'mnuCorruptionDefineCorruptionData ' @@ -3192,27 +3207,102 @@ Partial Class frmMain ' 'mnuCorruptionPrepare ' + Me.mnuCorruptionPrepare.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.CountryNamesCorrectionsToolStripMenuItem, Me.MergeAdditionalDataToolStripMenuItem, Me.FilterToolStripMenuItem, Me.UseAwardDateToolStripMenuItem, Me.UseSignatureDateToolStripMenuItem, Me.DefineCorruptionFreeCategoriesToolStripMenuItem, Me.DefineContractValueCategoriesToolStripMenuItem}) Me.mnuCorruptionPrepare.Name = "mnuCorruptionPrepare" Me.mnuCorruptionPrepare.Size = New System.Drawing.Size(205, 22) Me.mnuCorruptionPrepare.Text = "Prepare..." ' + 'CountryNamesCorrectionsToolStripMenuItem + ' + Me.CountryNamesCorrectionsToolStripMenuItem.Name = "CountryNamesCorrectionsToolStripMenuItem" + Me.CountryNamesCorrectionsToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.CountryNamesCorrectionsToolStripMenuItem.Text = "Country Names Corrections..." + ' + 'MergeAdditionalDataToolStripMenuItem + ' + Me.MergeAdditionalDataToolStripMenuItem.Name = "MergeAdditionalDataToolStripMenuItem" + Me.MergeAdditionalDataToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.MergeAdditionalDataToolStripMenuItem.Text = "Merge additional data..." + ' + 'FilterToolStripMenuItem + ' + Me.FilterToolStripMenuItem.Name = "FilterToolStripMenuItem" + Me.FilterToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.FilterToolStripMenuItem.Text = "Choose Countries for Analysis..." + ' + 'UseAwardDateToolStripMenuItem + ' + Me.UseAwardDateToolStripMenuItem.Name = "UseAwardDateToolStripMenuItem" + Me.UseAwardDateToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.UseAwardDateToolStripMenuItem.Text = "Use Award Date..." + ' + 'UseSignatureDateToolStripMenuItem + ' + Me.UseSignatureDateToolStripMenuItem.Name = "UseSignatureDateToolStripMenuItem" + Me.UseSignatureDateToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.UseSignatureDateToolStripMenuItem.Text = "Use Signature Date..." + ' + 'DefineCorruptionFreeCategoriesToolStripMenuItem + ' + Me.DefineCorruptionFreeCategoriesToolStripMenuItem.Name = "DefineCorruptionFreeCategoriesToolStripMenuItem" + Me.DefineCorruptionFreeCategoriesToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.DefineCorruptionFreeCategoriesToolStripMenuItem.Text = "Define Corruption Free Categories..." + ' + 'DefineContractValueCategoriesToolStripMenuItem + ' + Me.DefineContractValueCategoriesToolStripMenuItem.Name = "DefineContractValueCategoriesToolStripMenuItem" + Me.DefineContractValueCategoriesToolStripMenuItem.Size = New System.Drawing.Size(262, 22) + Me.DefineContractValueCategoriesToolStripMenuItem.Text = "Define Contract Value Categories..." + ' 'mnuCorruptionDescribe ' + Me.mnuCorruptionDescribe.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.AaToolStripMenuItem}) Me.mnuCorruptionDescribe.Name = "mnuCorruptionDescribe" Me.mnuCorruptionDescribe.Size = New System.Drawing.Size(205, 22) Me.mnuCorruptionDescribe.Text = "Describe..." ' + 'AaToolStripMenuItem + ' + Me.AaToolStripMenuItem.Name = "AaToolStripMenuItem" + Me.AaToolStripMenuItem.Size = New System.Drawing.Size(86, 22) + Me.AaToolStripMenuItem.Text = "aa" + ' 'mnuCorruptionModel ' + Me.mnuCorruptionModel.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.AaToolStripMenuItem1}) Me.mnuCorruptionModel.Name = "mnuCorruptionModel" Me.mnuCorruptionModel.Size = New System.Drawing.Size(205, 22) Me.mnuCorruptionModel.Text = "Model..." ' + 'AaToolStripMenuItem1 + ' + Me.AaToolStripMenuItem1.Name = "AaToolStripMenuItem1" + Me.AaToolStripMenuItem1.Size = New System.Drawing.Size(86, 22) + Me.AaToolStripMenuItem1.Text = "aa" + ' + 'DefineRedFlagsToolStripMenuItem + ' + Me.DefineRedFlagsToolStripMenuItem.Name = "DefineRedFlagsToolStripMenuItem" + Me.DefineRedFlagsToolStripMenuItem.Size = New System.Drawing.Size(205, 22) + Me.DefineRedFlagsToolStripMenuItem.Text = "Define Red Flags..." + ' + 'CalculateCRIToolStripMenuItem + ' + Me.CalculateCRIToolStripMenuItem.Name = "CalculateCRIToolStripMenuItem" + Me.CalculateCRIToolStripMenuItem.Size = New System.Drawing.Size(205, 22) + Me.CalculateCRIToolStripMenuItem.Text = "Calculate CRI..." + ' + 'TestsAndChecksToolStripMenuItem + ' + Me.TestsAndChecksToolStripMenuItem.Name = "TestsAndChecksToolStripMenuItem" + Me.TestsAndChecksToolStripMenuItem.Size = New System.Drawing.Size(205, 22) + Me.TestsAndChecksToolStripMenuItem.Text = "Tests and checks..." + ' 'mnuTools ' Me.mnuTools.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuToolsRunRCode, Me.mnuToolsRestartR, Me.mnuToolsCheckForUpdates, Me.mnuToolsClearOutputWindow, Me.ToolStripSeparator5, Me.mnuToolsSaveCurrentOptions, Me.mnuToolsLoadOptions, Me.mnuToolsOptions}) Me.mnuTools.Name = "mnuTools" - Me.mnuTools.Size = New System.Drawing.Size(47, 20) + Me.mnuTools.Size = New System.Drawing.Size(47, 19) Me.mnuTools.Text = "Tools" ' 'mnuToolsRunRCode @@ -3276,15 +3366,16 @@ Partial Class frmMain ' 'frmMain ' - Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) + Me.AutoScaleDimensions = New System.Drawing.SizeF(16.0!, 31.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font - Me.ClientSize = New System.Drawing.Size(769, 369) + Me.ClientSize = New System.Drawing.Size(1596, 873) Me.Controls.Add(Me.stsStrip) Me.Controls.Add(Me.Tool_strip) Me.Controls.Add(Me.mnuBar) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.IsMdiContainer = True Me.MainMenuStrip = Me.mnuBar + Me.Margin = New System.Windows.Forms.Padding(8, 7, 8, 7) Me.Name = "frmMain" Me.Text = "R-Instat" Me.WindowState = System.Windows.Forms.FormWindowState.Maximized @@ -3701,4 +3792,16 @@ Partial Class frmMain Friend WithEvents Extremes As ToolStripMenuItem Friend WithEvents mnuCorruptionDefineCorruptionData As ToolStripMenuItem Friend WithEvents mnuClimaticSCFSupportCumulativeExceedanceGraphs As ToolStripMenuItem + Friend WithEvents CountryNamesCorrectionsToolStripMenuItem As ToolStripMenuItem + Friend WithEvents MergeAdditionalDataToolStripMenuItem As ToolStripMenuItem + Friend WithEvents FilterToolStripMenuItem As ToolStripMenuItem + Friend WithEvents UseAwardDateToolStripMenuItem As ToolStripMenuItem + Friend WithEvents UseSignatureDateToolStripMenuItem As ToolStripMenuItem + Friend WithEvents DefineCorruptionFreeCategoriesToolStripMenuItem As ToolStripMenuItem + Friend WithEvents DefineContractValueCategoriesToolStripMenuItem As ToolStripMenuItem + Friend WithEvents DefineRedFlagsToolStripMenuItem As ToolStripMenuItem + Friend WithEvents AaToolStripMenuItem As ToolStripMenuItem + Friend WithEvents AaToolStripMenuItem1 As ToolStripMenuItem + Friend WithEvents CalculateCRIToolStripMenuItem As ToolStripMenuItem + Friend WithEvents TestsAndChecksToolStripMenuItem As ToolStripMenuItem End Class diff --git a/instat/frmMain.vb b/instat/frmMain.vb index 3805c208881..5b3cd5f7b6a 100644 --- a/instat/frmMain.vb +++ b/instat/frmMain.vb @@ -1151,6 +1151,20 @@ Public Class frmMain dlgCumulativeDistribution.ShowDialog() End Sub + Private Sub FilterToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles FilterToolStripMenuItem.Click + Dim lstDataNames As List(Of String) + + dlgRestrict.bIsSubsetDialog = True + lstDataNames = clsRLink.GetCorruptionDataFrameNames() + If lstDataNames.Count = 1 Then + dlgRestrict.strDefaultDataframe = lstDataNames(0) + dlgRestrict.strDefaultColumn = clsRLink.GetCorruptionColumnOfType(lstDataNames(0), "corruption_country_label") + Else + dlgRestrict.strDefaultDataframe = "" + dlgRestrict.strDefaultColumn = "" + End If + dlgRestrict.ShowDialog() + End Sub 'Private Sub TESTToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles TESTToolStripMenuItem.Click ' 'TEST temporary diff --git a/instat/instat.vbproj b/instat/instat.vbproj index c5bbbc61429..f4aa167a218 100644 --- a/instat/instat.vbproj +++ b/instat/instat.vbproj @@ -456,6 +456,12 @@ Form + + sdgImportFromClimSoft.vb + + + Form + sdgMerge.vb @@ -2821,6 +2827,9 @@ sdgFactorDataFrame.vb + + sdgImportFromClimSoft.vb + sdgMerge.vb @@ -3646,6 +3655,7 @@ dlgStartofRains.vb + My.Resources dlgStartofRains.vb diff --git a/instat/sdgClimdexIndices.vb b/instat/sdgClimdexIndices.vb index 3de211ef94c..d1d3fb76715 100644 --- a/instat/sdgClimdexIndices.vb +++ b/instat/sdgClimdexIndices.vb @@ -187,13 +187,13 @@ Public Class sdgClimdexIndices ucrInputTempQtiles.SetParameter(New RParameter("x")) ucrInputTempQtiles.SetValidationTypeAsNumericList() - ucrInputTempQtiles.bAddQuotesIfUnrecognised = False + ucrInputTempQtiles.AddQuotesIfUnrecognised = False ucrInputTempQtiles.clsParameter.bIncludeArgumentName = False ucrInputTempQtiles.SetRDefault("0.1, 0.9") ucrInputPrecQtiles.SetParameter(New RParameter("x")) ucrInputPrecQtiles.SetValidationTypeAsNumericList() - ucrInputPrecQtiles.bAddQuotesIfUnrecognised = False + ucrInputPrecQtiles.AddQuotesIfUnrecognised = False ucrInputPrecQtiles.clsParameter.bIncludeArgumentName = False ucrInputPrecQtiles.SetRDefault("0.95, 0.99") diff --git a/instat/sdgImportFromClimSoft.Designer.vb b/instat/sdgImportFromClimSoft.Designer.vb new file mode 100644 index 00000000000..2b9ae9c8547 --- /dev/null +++ b/instat/sdgImportFromClimSoft.Designer.vb @@ -0,0 +1,177 @@ + _ +Partial Class sdgImportFromClimSoft + Inherits System.Windows.Forms.Form + + 'Form overrides dispose to clean up the component list. + _ + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + Try + If disposing AndAlso components IsNot Nothing Then + components.Dispose() + End If + Finally + MyBase.Dispose(disposing) + End Try + End Sub + + 'Required by the Windows Form Designer + Private components As System.ComponentModel.IContainer + + 'NOTE: The following procedure is required by the Windows Form Designer + 'It can be modified using the Windows Form Designer. + 'Do not modify it using the code editor. + _ + Private Sub InitializeComponent() + Me.ucrInputDatabaseName = New instat.ucrInputTextBox() + Me.lblDatabaseName = New System.Windows.Forms.Label() + Me.ucrInputHost = New instat.ucrInputTextBox() + Me.lblHost = New System.Windows.Forms.Label() + Me.ucrInputPart = New instat.ucrInputTextBox() + Me.lblPart = New System.Windows.Forms.Label() + Me.ucrInputUserName = New instat.ucrInputTextBox() + Me.lblUserName = New System.Windows.Forms.Label() + Me.lblConnection = New System.Windows.Forms.Label() + Me.ucrBaseSdgClimSoft = New instat.ucrButtonsSubdialogue() + Me.cmdEnterPassword = New System.Windows.Forms.Button() + Me.SuspendLayout() + ' + 'ucrInputDatabaseName + ' + Me.ucrInputDatabaseName.AddQuotesIfUnrecognised = True + Me.ucrInputDatabaseName.IsMultiline = False + Me.ucrInputDatabaseName.IsReadOnly = False + Me.ucrInputDatabaseName.Location = New System.Drawing.Point(101, 12) + Me.ucrInputDatabaseName.Name = "ucrInputDatabaseName" + Me.ucrInputDatabaseName.Size = New System.Drawing.Size(137, 21) + Me.ucrInputDatabaseName.TabIndex = 1 + ' + 'lblDatabaseName + ' + Me.lblDatabaseName.AutoSize = True + Me.lblDatabaseName.Location = New System.Drawing.Point(10, 15) + Me.lblDatabaseName.Name = "lblDatabaseName" + Me.lblDatabaseName.Size = New System.Drawing.Size(87, 13) + Me.lblDatabaseName.TabIndex = 0 + Me.lblDatabaseName.Text = "Database Name:" + ' + 'ucrInputHost + ' + Me.ucrInputHost.AddQuotesIfUnrecognised = True + Me.ucrInputHost.IsMultiline = False + Me.ucrInputHost.IsReadOnly = False + Me.ucrInputHost.Location = New System.Drawing.Point(101, 46) + Me.ucrInputHost.Name = "ucrInputHost" + Me.ucrInputHost.Size = New System.Drawing.Size(137, 21) + Me.ucrInputHost.TabIndex = 3 + ' + 'lblHost + ' + Me.lblHost.AutoSize = True + Me.lblHost.Location = New System.Drawing.Point(10, 50) + Me.lblHost.Name = "lblHost" + Me.lblHost.Size = New System.Drawing.Size(32, 13) + Me.lblHost.TabIndex = 2 + Me.lblHost.Text = "Host:" + ' + 'ucrInputPart + ' + Me.ucrInputPart.AddQuotesIfUnrecognised = True + Me.ucrInputPart.IsMultiline = False + Me.ucrInputPart.IsReadOnly = False + Me.ucrInputPart.Location = New System.Drawing.Point(101, 80) + Me.ucrInputPart.Name = "ucrInputPart" + Me.ucrInputPart.Size = New System.Drawing.Size(137, 21) + Me.ucrInputPart.TabIndex = 5 + ' + 'lblPart + ' + Me.lblPart.AutoSize = True + Me.lblPart.Location = New System.Drawing.Point(10, 85) + Me.lblPart.Name = "lblPart" + Me.lblPart.Size = New System.Drawing.Size(29, 13) + Me.lblPart.TabIndex = 4 + Me.lblPart.Text = "Part:" + ' + 'ucrInputUserName + ' + Me.ucrInputUserName.AddQuotesIfUnrecognised = True + Me.ucrInputUserName.IsMultiline = False + Me.ucrInputUserName.IsReadOnly = False + Me.ucrInputUserName.Location = New System.Drawing.Point(101, 114) + Me.ucrInputUserName.Name = "ucrInputUserName" + Me.ucrInputUserName.Size = New System.Drawing.Size(137, 21) + Me.ucrInputUserName.TabIndex = 7 + ' + 'lblUserName + ' + Me.lblUserName.AutoSize = True + Me.lblUserName.Location = New System.Drawing.Point(10, 119) + Me.lblUserName.Name = "lblUserName" + Me.lblUserName.Size = New System.Drawing.Size(58, 13) + Me.lblUserName.TabIndex = 6 + Me.lblUserName.Text = "Username:" + ' + 'lblConnection + ' + Me.lblConnection.AutoSize = True + Me.lblConnection.Location = New System.Drawing.Point(162, 148) + Me.lblConnection.Name = "lblConnection" + Me.lblConnection.Size = New System.Drawing.Size(78, 13) + Me.lblConnection.TabIndex = 9 + Me.lblConnection.Text = "No Connection" + ' + 'ucrBaseSdgClimSoft + ' + Me.ucrBaseSdgClimSoft.Location = New System.Drawing.Point(72, 178) + Me.ucrBaseSdgClimSoft.Name = "ucrBaseSdgClimSoft" + Me.ucrBaseSdgClimSoft.Size = New System.Drawing.Size(142, 30) + Me.ucrBaseSdgClimSoft.TabIndex = 10 + ' + 'cmdEnterPassword + ' + Me.cmdEnterPassword.Location = New System.Drawing.Point(10, 148) + Me.cmdEnterPassword.Name = "cmdEnterPassword" + Me.cmdEnterPassword.Size = New System.Drawing.Size(107, 22) + Me.cmdEnterPassword.TabIndex = 8 + Me.cmdEnterPassword.Text = "Enter Password" + Me.cmdEnterPassword.UseVisualStyleBackColor = True + ' + 'sdgImportFromClimSoft + ' + Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) + Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font + Me.ClientSize = New System.Drawing.Size(289, 220) + Me.Controls.Add(Me.ucrBaseSdgClimSoft) + Me.Controls.Add(Me.lblConnection) + Me.Controls.Add(Me.cmdEnterPassword) + Me.Controls.Add(Me.lblUserName) + Me.Controls.Add(Me.ucrInputUserName) + Me.Controls.Add(Me.lblPart) + Me.Controls.Add(Me.ucrInputPart) + Me.Controls.Add(Me.lblHost) + Me.Controls.Add(Me.ucrInputHost) + Me.Controls.Add(Me.lblDatabaseName) + Me.Controls.Add(Me.ucrInputDatabaseName) + Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow + Me.MaximizeBox = False + Me.MinimizeBox = False + Me.Name = "sdgImportFromClimSoft" + Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen + Me.Text = "Connect To ClimSoft Database" + Me.ResumeLayout(False) + Me.PerformLayout() + + End Sub + + Friend WithEvents ucrInputDatabaseName As ucrInputTextBox + Friend WithEvents lblDatabaseName As Label + Friend WithEvents ucrInputHost As ucrInputTextBox + Friend WithEvents lblHost As Label + Friend WithEvents ucrInputPart As ucrInputTextBox + Friend WithEvents lblPart As Label + Friend WithEvents ucrInputUserName As ucrInputTextBox + Friend WithEvents lblUserName As Label + Friend WithEvents lblConnection As Label + Friend WithEvents ucrBaseSdgClimSoft As ucrButtonsSubdialogue + Friend WithEvents cmdEnterPassword As Button +End Class diff --git a/instat/sdgImportFromClimSoft.resx b/instat/sdgImportFromClimSoft.resx new file mode 100644 index 00000000000..29dcb1b3a35 --- /dev/null +++ b/instat/sdgImportFromClimSoft.resx @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + \ No newline at end of file diff --git a/instat/sdgImportFromClimSoft.vb b/instat/sdgImportFromClimSoft.vb new file mode 100644 index 00000000000..79736fe448b --- /dev/null +++ b/instat/sdgImportFromClimSoft.vb @@ -0,0 +1,20 @@ +' Instat-R +' Copyright (C) 2015 +' +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License k +' along with this program. If not, see . + +Imports instat.Translations +Public Class sdgImportFromClimSoft + +End Class \ No newline at end of file diff --git a/instat/static/InstatObject/R/Rsetup.R b/instat/static/InstatObject/R/Rsetup.R index 610d9fd81cb..8b7411a8a80 100644 --- a/instat/static/InstatObject/R/Rsetup.R +++ b/instat/static/InstatObject/R/Rsetup.R @@ -1,5 +1,5 @@ # Necessary packages for the Instat Object -packs_lib <- c("ncdf4","reshape2", "lubridate","plyr", "dplyr", "rtf", "openxlsx", "ggplot2", "extRemes", "GGally", "agridat", "DAAG", "FactoMineR", "plotrix", "candisc", "R6", "openair", "circular", "survival", "Evapotranspiration", "clifro", "devtools", "factoextra", "circlize", "CircStats", "gridExtra", "ggfortify", "rio", "readxl", "lme4", "dummies", "ggthemes", "lazyeval", "stringr", "httr", "jsonlite", "fitdistrplus", "visreg", "climdex.pcic", "mosaic") +packs_lib <- c("ncdf4","reshape2", "lubridate","plyr", "dplyr", "rtf", "openxlsx", "ggplot2", "extRemes", "GGally", "agridat", "DAAG", "FactoMineR", "plotrix", "candisc", "R6", "openair", "circular", "survival", "Evapotranspiration", "clifro", "devtools", "factoextra", "circlize", "CircStats", "gridExtra", "ggfortify", "rio", "readxl", "lme4", "dummies", "ggthemes", "lazyeval", "stringr", "httr", "jsonlite", "fitdistrplus", "visreg", "climdex.pcic", "mosaic", "getPass", "RMySQL", "DBI") # Packages including dependencies (generated from miniCRAN package) packs <- c("reshape2", "lubridate", "plyr", "dplyr", "rtf", "openxlsx", "ggplot2", "extRemes", "GGally", "agridat", "DAAG", "FactoMineR", "plotrix", "candisc", "R6", "openair", "circular", "survival", "Evapotranspiration", "clifro", "devtools", "factoextra", "circlize", "CircStats", "gridExtra", "ggfortify", "rio", "readxl", "lme4", "dummies", "ggthemes", "lazyeval", "stringr", "httr", "jsonlite", "fitdistrplus", "visreg", "climdex.pcic", "mosaic", "Rcpp", "stringi", "magrittr", "assertthat", "tibble", "DBI", "BH", "R.oo", "R.methodsS3", "digest", "gtable", "MASS", "scales", "RColorBrewer", "dichromat", "munsell", "labeling", "colorspace", "Lmoments", "distillery", "car", "mgcv", "nnet", "pbkrtest", "quantreg", "nlme", "Matrix", "SparseM", "MatrixModels", "lattice", "minqa", "nloptr", "RcppEigen", "reshape", "latticeExtra", "cluster", "ellipse", "flashClust", "leaps", "scatterplot3d", "data.table", "knitr", "chron", "evaluate", "formatR", "highr", "markdown", "yaml", "mime", "heplots", "maps", "mapproj", "hexbin", "mapdata", "boot", "zoo", "XML", "selectr", "RCurl", "bitops", "memoise", "whisker", "rstudioapi", "git2r", "withr", "curl", "openssl", "dendextend", "ggrepel", "abind", "fpc", "mclust", "flexmix", "prabclus", "class", "diptest", "mvtnorm", "robustbase", "kernlab", "trimcluster", "modeltools", "DEoptimR", "GlobalOptions", "shape", "tidyr", "urltools", "foreign", "haven", "readODS", "xml2", "readr", "csvy", "hms", "cellranger", "triebeard", "rematch", "PCICt", "caTools", "mosaicData", "ggdendro") success <- invisible(sapply(packs, function(x) length(find.package(x, quiet = TRUE))>0)) diff --git a/instat/static/InstatObject/R/data_object_R6.R b/instat/static/InstatObject/R/data_object_R6.R index 7ff4811b494..f3a338ab0db 100644 --- a/instat/static/InstatObject/R/data_object_R6.R +++ b/instat/static/InstatObject/R/data_object_R6.R @@ -231,7 +231,7 @@ data_object$set("public", "set_metadata_changed", function(new_val) { } ) -data_object$set("public", "get_data_frame", function(convert_to_character = FALSE, include_hidden_columns = TRUE, use_current_filter = TRUE, filter_name = "", stack_data = FALSE, remove_attr = FALSE, ...) { +data_object$set("public", "get_data_frame", function(convert_to_character = FALSE, include_hidden_columns = TRUE, use_current_filter = TRUE, filter_name = "", stack_data = FALSE, remove_attr = FALSE, retain_attr = FALSE, ...) { if(!stack_data) { if(!include_hidden_columns && self$is_variables_metadata(is_hidden_label)) { hidden <- self$get_variables_metadata(property = is_hidden_label) @@ -259,6 +259,19 @@ data_object$set("public", "get_data_frame", function(convert_to_character = FALS attributes(out[[i]])[!names(attributes(out[[i]])) %in% c("class", "levels")] <- NULL } } + + # If a filter has been done, some column attributes are lost. + # This ensures they are present in the returned data. + if(retain_attr) { + for(col_name in names(out)) { + for(attr_name in names(attributes(private$data[[col_name]]))) { + if(!attr_name %in% c("class", "levels")) { + attr(out[[col_name]], attr_name) <- attr(private$data[[col_name]], attr_name) + } + } + } + } + if(convert_to_character) { decimal_places = self$get_variables_metadata(property = display_decimal_label, column = names(out)) decimal_places[is.na(decimal_places)] <- 0 @@ -387,7 +400,6 @@ data_object$set("public", "get_calculation_names", function() { ) data_object$set("public", "add_columns_to_data", function(col_name = "", col_data, use_col_name_as_prefix = FALSE, hidden = FALSE, before = FALSE, adjacent_column, num_cols) { - # Column name must be character if(!is.character(col_name)) stop("Column name must be of type: character") if(missing(num_cols)) { @@ -2009,27 +2021,131 @@ data_object$set("public","get_key_names", function(include_overall = TRUE, inclu } ) -# labels for climatic column types +# Labels for climatic column types +### Primary corruption column types corruption_country_label="country" +corruption_region_label="region" corruption_procuring_authority_label="procuring_authority" -corruption_procuring_authority_id_label="procuring_authority_id" corruption_award_date_label="award_date" +corruption_fiscal_year_label="fiscal_year" corruption_signature_date_label="signature_date" -corruption_contract_name_label="contract_name" -corruption_sector_label="sector" +corruption_contract_title_label="contract_title" +corruption_contract_sector_label="contract_sector" corruption_procurement_category_label="procurement_category" corruption_winner_name_label="winner_name" -corruption_winner_id_label="winner_id" corruption_winner_country_label="winner_country" corruption_original_contract_value_label="original_contract_value" +corruption_no_bids_received_label="no_bids_received" +corruption_no_bids_considered_label="no_bids_considered" +corruption_method_type_label="method_type" + +all_primary_corruption_column_types <- c(corruption_country_label, + corruption_region_label, + corruption_procuring_authority_label, + corruption_award_date_label, + corruption_fiscal_year_label, + corruption_signature_date_label, + corruption_contract_title_label, + corruption_contract_sector_label, + corruption_procurement_category_label, + corruption_winner_name_label, + corruption_winner_country_label, + corruption_original_contract_value_label, + corruption_no_bids_received_label, + corruption_no_bids_considered_label, + corruption_method_type_label) + +### Calculated corruption column types +corruption_award_year_label="award_year" corruption_procedure_type_label="procedure_type" -corruption_no_bids_label="no_bids" -corruption_no_considered_bids_label="no_considered_bids" -corruption_country_iso_label="country_iso" +corruption_country_iso2_label="country_iso2" +corruption_country_iso3_label="country_iso3" +corruption_w_country_iso2_label="w_country_iso2" +corruption_w_country_iso3_label="w_country_iso3" +corruption_procuring_authority_id_label="procuring_authority_id" +corruption_winner_id_label="winner_id" corruption_foreign_winner_label="foreign_winner" corruption_ppp_conversion_rate_label="ppp_conversion_rate" - -all_corruption_column_types <- c(corruption_country_label, corruption_procuring_authority_label, corruption_procuring_authority_id_label, corruption_award_date_label, corruption_signature_date_label, corruption_contract_name_label, corruption_sector_label, corruption_procurement_category_label, corruption_winner_name_label, corruption_winner_id_label, corruption_winner_country_label, corruption_original_contract_value_label, corruption_procedure_type_label, corruption_no_bids_label, corruption_no_considered_bids_label, corruption_country_iso_label, corruption_foreign_winner_label, corruption_ppp_conversion_rate_label) +corruption_ppp_adjusted_contract_value_label="ppp_adjusted_contr_value" +corruption_contract_value_cats_label="contr_value_cats" +corruption_procurement_type_cats_label="procurement_type_cats" +corruption_procurement_type_2_label="procurement_type2" +corruption_procurement_type_3_label="procurement_type3" +corruption_signature_period_label="signature_period" +corruption_signature_period_corrected_label="signature_period_corrected" +corruption_signature_period_5Q_label="signature_period5Q" +corruption_signature_period_25Q_label="signature_period25Q" +corruption_signature_period_cats_label="signature_period_cats" +corruption_secrecy_score_label="secrecy_score" +corruption_tax_haven_label="tax_haven" +corruption_tax_haven2_label="tax_haven2" +corruption_tax_haven3_label="tax_haven3" +corruption_tax_haven3bi_label="tax_haven3bi" +corruption_roll_num_winner_label="roll_num_winner" +corruption_roll_num_issuer_label="roll_num_issuer" +corruption_roll_sum_winner_label="roll_sum_winner" +corruption_roll_sum_issuer_label="roll_sum_issuer" +corruption_roll_share_winner_label="roll_share_winner" +corruption_single_bidder_label="single_bidder" +corruption_all_bids_label="all_bids" +corruption_all_bids_trimmed_label="all_bids_trimmed" +corruption_contract_value_share_over_threshold_label="contract_value_share_over_threshold" + +all_calculated_corruption_column_types <- c(corruption_award_year_label, + corruption_procedure_type_label, + corruption_country_iso2_label, + corruption_country_iso3_label, + corruption_w_country_iso2_label, + corruption_w_country_iso3_label, + corruption_procuring_authority_id_label, + corruption_winner_id_label, + corruption_procedure_type_label, + corruption_foreign_winner_label, + corruption_ppp_conversion_rate_label, + corruption_ppp_adjusted_contract_value_label, + corruption_contract_value_cats_label, + corruption_procurement_type_cats_label, + corruption_procurement_type_2_label, + corruption_procurement_type_3_label, + corruption_signature_period_label, + corruption_signature_period_corrected_label, + corruption_signature_period_5Q_label, + corruption_signature_period_25Q_label, + corruption_signature_period_cats_label, + corruption_secrecy_score_label, + corruption_tax_haven_label, + corruption_tax_haven2_label, + corruption_tax_haven3_label, + corruption_tax_haven3bi_label, + corruption_roll_num_winner_label, + corruption_roll_num_issuer_label, + corruption_roll_sum_winner_label, + corruption_roll_sum_issuer_label, + corruption_roll_share_winner_label, + corruption_single_bidder_label, + corruption_all_bids_label, + corruption_all_bids_trimmed_label, + corruption_contract_value_share_over_threshold_label + ) + +corruption_ctry_iso2_label="iso2" +corruption_ctry_iso3_label="iso3" +corruption_ctry_wb_ppp_label="wb_ppp" +corruption_ctry_ss_2009_label="ss_2009" +corruption_ctry_ss_2011_label="ss_2011" +corruption_ctry_ss_2013_label="ss_2013" +corruption_ctry_ss_2015_label="ss_2015" +corruption_ctry_small_state_label="small_state" + +all_primary_corruption_country_level_column_types <- c(corruption_ctry_iso2_label, + corruption_ctry_iso3_label, + corruption_ctry_wb_ppp_label, + corruption_ctry_ss_2009_label, + corruption_ctry_ss_2011_label, + corruption_ctry_ss_2013_label, + corruption_ctry_ss_2015_label, + corruption_ctry_small_state_label + ) # Column metadata for corruption colums corruption_type_label = "Corruption_Type" @@ -2037,19 +2153,483 @@ corruption_type_label = "Corruption_Type" # Data frame metadata for corruption dataframes is_corruption_label = "Is_Corruption" -instat_object$set("public","define_as_corruption", function(data_name, types) { +instat_object$set("public","define_as_corruption", function(data_name, primary_types = c(), calculated_types = c(), auto_generate = TRUE) { self$append_to_dataframe_metadata(data_name, is_corruption_label, TRUE) for(curr_data_name in self$get_data_names()) { if(!self$get_data_objects(data_name)$is_metadata(is_corruption_label)) { self$append_to_dataframe_metadata(curr_data_name, is_corruption_label, FALSE) } } - self$get_data_objects(data_name)$set_corruption_types(types) + self$get_data_objects(data_name)$set_corruption_types(primary_types, calculated_types, auto_generate) +} +) + +instat_object$set("public","define_as_corruption_country_level_data", function(data_name, contract_level_data_name, types = c(), auto_generate = TRUE) { + self$get_data_objects(data_name)$define_as_corruption_country_level_data(types, auto_generate) +} +) + +data_object$set("public","define_as_corruption_country_level_data", function(contract_level_data_name, types = c(), auto_generate = TRUE) { + invisible(sapply(names(primary_types), function(x) self$append_to_variables_metadata(primary_types[[x]], corruption_type_label, x))) +} +) + +data_object$set("public","is_corruption_type_present", function(type) { + return(self$is_metadata(is_corruption_label) && self$get_metadata(is_corruption_label) && self$is_variables_metadata(corruption_type_label) && (type %in% self$get_variables_metadata(property = corruption_type_label))) +} +) + +instat_object$set("public","get_corruption_column_name", function(data_name, type) { + self$get_data_objects(data_name)$get_corruption_column_name(type) +} +) + +data_object$set("public","get_corruption_column_name", function(type) { + if(self$is_corruption_type_present(type)) { + var_metadata <- self$get_variables_metadata() + col_name <- var_metadata[!is.na(var_metadata[[corruption_type_label]]) & var_metadata[[corruption_type_label]] == type, name_label] + if(length(col_name >= 1)) return(col_name) + else return("") + } + return("") +} +) + +data_object$set("public","set_corruption_types", function(primary_types = c(), calculated_types = c(), auto_generate = TRUE) { + if(!all(names(primary_types) %in% all_primary_corruption_column_types)) stop("Cannot recognise the following primary corruption data types: ", paste(names(primary_types)[!names(primary_types) %in% all_primary_corruption_column_types], collapse = ", ")) + if(!all(names(calculated_types) %in% all_calculated_corruption_column_types)) stop("Cannot recognise the following calculated corruption data types: ", paste(names(calculated_types)[!names(calculated_types) %in% all_calculated_corruption_column_types], collapse = ", ")) + invisible(sapply(names(primary_types), function(x) self$append_to_variables_metadata(primary_types[[x]], corruption_type_label, x))) + invisible(sapply(names(calculated_types), function(x) self$append_to_variables_metadata(calculated_types[[x]], corruption_type_label, x))) + if(auto_generate) { + # Tried to make these independent of order called, but need to test + self$generate_award_year() + self$generate_procedure_type() + self$generate_procuring_authority_id() + self$generate_winner_id() + self$generate_foreign_winner() + self$generate_procurement_type_categories() + self$generate_procurement_type_2() + self$generate_procurement_type_3() + self$generate_signature_period() + self$generate_signature_period_corrected() + self$generate_signature_period_5Q() + self$generate_signature_period_25Q() + self$generate_rolling_contract_no_winners() + self$generate_rolling_contract_no_issuer() + self$generate_rolling_contract_value_sum_issuer() + self$generate_rolling_contract_value_sum_winner() + self$generate_rolling_contract_value_share_winner() + self$generate_single_bidder() + self$generate_contract_value_share_over_threshold() + self$generate_all_bids() + self$generate_all_bids_trimmed() + } +} +) + +data_object$set("public","generate_award_year", function() { + if(!self$is_corruption_type_present(corruption_award_year_label)) { + if(!self$is_corruption_type_present(corruption_award_date_label)) message("Cannot auto generate ", corruption_award_year_label, " because ", corruption_award_date_label, " column is not present.") + else { + award_date <- self$get_columns_from_data(self$get_corruption_column_name(corruption_award_date_label)) + if(!is.Date(award_date)) message(message("Cannot auto generate ", corruption_award_year_label, " because ", corruption_award_date_label, " column is not of type Date.")) + else { + col_name <- next_default_item(corruption_award_year_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, year(award_date)) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_award_year_label) + self$append_to_variables_metadata(col_name, "label", "Award year") + } + } + } +} +) + +data_object$set("public","generate_procedure_type", function() { + if(!self$is_corruption_type_present(corruption_procedure_type_label)) { + if(!self$is_corruption_type_present(corruption_method_type_label)) message("Cannot auto generate ", corruption_procedure_type_label, " because ", corruption_method_type_label, " is not defined.") + else { + procedure_type <- self$get_columns_from_data(self$get_corruption_column_name(corruption_method_type_label)) + procedure_type[procedure_type == "CQS"] <- "Selection Based On Consultant's Qualification" + procedure_type[procedure_type == "SHOP"] <- "International Shopping" + procedure_type <- factor(procedure_type, levels = c("Commercial Practices", "Direct Contracting", "Force Account", "INDB", "Individual", "International Competitive Bidding", "International Shopping", "Least Cost Selection", "Limited International Bidding", "National Competitive Bidding", "National Shopping", "Quality And Cost-Based Selection", "Quality Based Selection", "Selection Based On Consultant's Qualification", "Selection Under a Fixed Budget", "Service Delivery Contracts", "Single Source Selection")) + + col_name <- next_default_item(corruption_procedure_type_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, procedure_type) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_procedure_type_label) + self$append_to_variables_metadata(col_name, "label", "Procedure type") + } + } +} +) + +data_object$set("public","generate_procuring_authority_id", function() { + if(!self$is_corruption_type_present(corruption_procuring_authority_id_label)) { + if(!self$is_corruption_type_present(corruption_procuring_authority_label) | !self$is_corruption_type_present(corruption_country_label)) message("Cannot auto generate ", corruption_procuring_authority_id_label, " because ", corruption_procuring_authority_label, "or ", corruption_award_year_label, " is not defined.") + else { + id <- as.numeric(factor(paste0(self$get_columns_from_data(self$get_corruption_column_name(corruption_country_label)), self$get_columns_from_data(self$get_corruption_column_name(corruption_procuring_authority_label))), levels = unique(paste0(self$get_columns_from_data(self$get_corruption_column_name(corruption_country_label)), self$get_columns_from_data(self$get_corruption_column_name(corruption_procuring_authority_label)))))) + + col_name <- next_default_item(corruption_procuring_authority_id_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, id) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_procuring_authority_id_label) + self$append_to_variables_metadata(col_name, "label", "Procurement Auth. ID") + } + } +} +) + +data_object$set("public","generate_winner_id", function() { + if(!self$is_corruption_type_present(corruption_winner_id_label)) { + if(!self$is_corruption_type_present(corruption_winner_name_label)) message("Cannot auto generate ", corruption_winner_id_label, " because ", corruption_winner_name_label, " is not defined.") + else { + id <- as.numeric(factor(self$get_columns_from_data(self$get_corruption_column_name(corruption_winner_name_label)), levels = unique(self$get_columns_from_data(self$get_corruption_column_name(corruption_winner_name_label))))) + + col_name <- next_default_item(corruption_winner_id_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, id) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_winner_id_label) + self$append_to_variables_metadata(col_name, "label", "w_name ID") + } + } +} +) + +data_object$set("public","generate_foreign_winner", function() { + if(!self$is_corruption_type_present(corruption_foreign_winner_label)) { + if(!self$is_corruption_type_present(corruption_country_label) || !self$is_corruption_type_present(corruption_winner_country_label)) message("Cannot auto generate ", corruption_foreign_winner_label, " because ", corruption_country_label, " or ", corruption_winner_country_label, " are not defined.") + else { + f_winner <- (self$get_columns_from_data(self$get_corruption_column_name(corruption_country_label)) != self$get_columns_from_data(self$get_corruption_column_name(corruption_winner_country_label))) + + col_name <- next_default_item(corruption_foreign_winner_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, f_winner) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_foreign_winner_label) + self$append_to_variables_metadata(col_name, "label", "Foreign w_name dummy") + } + } +} +) + +data_object$set("public","generate_procurement_type_categories", function() { + if(!self$is_corruption_type_present(corruption_procurement_type_cats_label)) { + if(!self$is_corruption_type_present(corruption_procedure_type_label)) message("Cannot auto generate ", corruption_procurement_type_cats_label, " because ", corruption_procedure_type_label, " are not defined.") + else { + procedure_type <- self$get_columns_from_data(self$get_corruption_column_name(corruption_procedure_type_label)) + procurement_type <- "other, missing" + procurement_type[procedure_type == "Direct Contracting" | procedure_type == "Individual" | procedure_type == "Single Source Selection"] <- "single source" + procurement_type[procedure_type == "Force Account" | procedure_type == "Service Delivery Contracts"] <- "own provision" + procurement_type[procedure_type == "International Competitive Bidding" | procedure_type == "National Competitive Bidding"] <- "open" + procurement_type[procedure_type == "International Shopping" | procedure_type == "Limited International Bidding" | procedure_type == "National Shopping"] <- "restricted" + procurement_type[procedure_type == "Quality And Cost-Based Selection" | procedure_type == "Quality Based Selection" | procedure_type == "Selection Under a Fixed Budget"] <- "consultancy,cost" + procurement_type[procedure_type == "Least Cost Selection" | procedure_type == "Selection Based On Consultant's Qualification"] <- "consultancy,cost" + procurement_type <- factor(procurement_type, levels = c("open", "restricted", "single source", "consultancy,quality", "consultancy,cost", "own provision", "other, missing")) + + col_name <- next_default_item(corruption_procurement_type_cats_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, procurement_type) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_procurement_type_cats_label) + self$append_to_variables_metadata(col_name, "label", "Main procurement type category") + } + } +} +) + +data_object$set("public","generate_procurement_type_2", function() { + if(!self$is_corruption_type_present(corruption_procurement_type_2_label)) { + if(!self$is_corruption_type_present(corruption_procurement_type_cats_label)) message("Cannot auto generate ", corruption_procurement_type_2_label, " because ", corruption_procurement_type_cats_label, " are not defined.") + else { + procurement_type_cats <- self$get_columns_from_data(self$get_corruption_column_name(corruption_procurement_type_cats_label)) + procurement_type2 <- NA + procurement_type2[procurement_type_cats == "open"] <- FALSE + procurement_type2[procurement_type_cats == "restricted" | procurement_type_cats == "single source" | procurement_type_cats == "consultancy,quality" | procurement_type_cats == "consultancy,cost"] <- TRUE + + col_name <- next_default_item(corruption_procurement_type_2_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, procurement_type2) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_procurement_type_2_label) + self$append_to_variables_metadata(col_name, "label", "Proc. type is restricted, single source, consultancy") + } + } +} +) + +data_object$set("public","generate_procurement_type_3", function() { + if(!self$is_corruption_type_present(corruption_procurement_type_3_label)) { + if(!self$is_corruption_type_present(corruption_procurement_type_cats_label)) message("Cannot auto generate ", corruption_procurement_type_3_label, " because ", corruption_procurement_type_cats_label, " are not defined.") + else { + procurement_type_cats <- self$get_columns_from_data(self$get_corruption_column_name(corruption_procurement_type_cats_label)) + procurement_type3 <- NA + procurement_type3[procurement_type_cats == "open"] <- "open procedure" + procurement_type3[procurement_type_cats == "restricted" | procurement_type_cats == "single source"] <- "closed procedure risk" + procurement_type3[procurement_type_cats == "consultancy,quality" | procurement_type_cats == "consultancy,cost"] <- "consultancy spending risk" + procurement_type3 <- factor(procurement_type3, levels = c("open procedure", "closed procedure risk", "consultancy spending risk")) + + col_name <- next_default_item(corruption_procurement_type_3_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, procurement_type3) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_procurement_type_3_label) + self$append_to_variables_metadata(col_name, "label", "Procedure type (open, closed, consultancy)") + } + } +} +) + +data_object$set("public","generate_signature_period", function() { + if(!self$is_corruption_type_present(corruption_signature_period_label)) { + if(!self$is_corruption_type_present(corruption_award_date_label) || !self$is_corruption_type_present(corruption_signature_date_label)) message("Cannot auto generate ", corruption_signature_period_label, " because ", corruption_award_date_label, "or", corruption_signature_date_label, " are not defined.") + else { + signature_period <- self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_date_label)) - self$get_columns_from_data(self$get_corruption_column_name(corruption_award_date_label)) + + col_name <- next_default_item(corruption_signature_period_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, signature_period) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_signature_period_label) + self$append_to_variables_metadata(col_name, "label", "Signature period") + } + } +} +) + +data_object$set("public","generate_signature_period_corrected", function() { + if(!self$is_corruption_type_present(corruption_signature_period_corrected_label)) { + if(!self$is_corruption_type_present(corruption_signature_period_label)) self$generate_signature_period() + signature_period_corrected <- self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_period_label)) + signature_period_corrected[signature_period_corrected < 0 | signature_period_corrected > 730] <- NA + + col_name <- next_default_item(corruption_signature_period_corrected_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, signature_period_corrected) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_signature_period_corrected_label) + self$append_to_variables_metadata(col_name, "label", "Signature period - corrected") + } +} +) + +data_object$set("public","generate_signature_period_5Q", function() { + if(!self$is_corruption_type_present(corruption_signature_period_5Q_label)) { + if(!self$is_corruption_type_present(corruption_signature_period_label)) self$generate_signature_period() + signature_period_5Q <- .bincode(self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_period_label)), quantile(self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_period_label)), seq(0, 1, length.out = 5 + 1), type = 2, na.rm = TRUE), include.lowest = TRUE) + + col_name <- next_default_item(corruption_signature_period_5Q_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, signature_period_5Q) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_signature_period_5Q_label) + } +} +) + +data_object$set("public","generate_signature_period_25Q", function() { + if(!self$is_corruption_type_present(corruption_signature_period_25Q_label)) { + if(!self$is_corruption_type_present(corruption_signature_period_label)) self$generate_signature_period() + signature_period_25Q <- .bincode(self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_period_label)), quantile(self$get_columns_from_data(self$get_corruption_column_name(corruption_signature_period_label)), seq(0, 1, length.out = 25 + 1), type = 2, na.rm = TRUE), include.lowest = TRUE) + + col_name <- next_default_item(corruption_signature_period_25Q_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, signature_period_25Q) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_signature_period_25Q_label) + } +} +) + +data_object$set("public","generate_rolling_contract_no_winners", function() { + if(!self$is_corruption_type_present(corruption_roll_num_winner_label)) { + self$generate_procuring_authority_id() + self$generate_winner_id() + if(!self$is_corruption_type_present(corruption_procuring_authority_id_label) | !self$is_corruption_type_present(corruption_winner_id_label) | !self$is_corruption_type_present(corruption_award_date_label)) { + message("Cannot auto generate ", corruption_roll_num_winner_label, " because ", corruption_procuring_authority_id_label, " or ", corruption_winner_id_label, " or ", corruption_award_date_label, " are not defined.") + } + else { + temp <- self$get_data_frame(use_current_filter = FALSE) + authority_id_label <- self$get_corruption_column_name(corruption_procuring_authority_id_label) + winner_id_label <- self$get_corruption_column_name(corruption_winner_id_label) + award_date_label <- self$get_corruption_column_name(corruption_award_date_label) + col_name <- next_default_item(corruption_roll_num_winner_label, self$get_column_names(), include_index = FALSE) + exp <- interp(~ sum(temp[[authority_id1]] == authority_id2 & temp[[winner_id1]] == winner_id2 & temp[[award_date1]] <= award_date2 & temp[[award_date1]] > award_date2 - 365), authority_id1 = authority_id_label, authority_id2 = as.name(authority_id_label), winner_id1 = winner_id_label, winner_id2 = as.name(winner_id_label), award_date1 = award_date_label, award_date2 = as.name(award_date_label)) + temp <- self$get_data_frame(use_current_filter = FALSE) + temp <- temp %>% rowwise() %>% mutate_(.dots = setNames(list(exp), col_name)) + self$add_columns_to_data(col_name, temp[[col_name]]) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_roll_num_winner_label) + self$append_to_variables_metadata(col_name, "label", "12 month rolling contract number of winner for each contract awarded") + } + + } } ) -data_object$set("public","set_corruption_types", function(types) { - if(!all(names(types) %in% all_corruption_column_types)) stop("Cannot recognise the following corruption data types: ", paste(names(types)[!names(types) %in% all_corruption_column_types], collapse = ", ")) - invisible(sapply(names(types), function(name) self$append_to_variables_metadata(types[name], corruption_type_label, name))) +data_object$set("public","generate_rolling_contract_no_issuer", function() { + if(!self$is_corruption_type_present(corruption_roll_num_issuer_label)) { + self$generate_procuring_authority_id() + if(!self$is_corruption_type_present(corruption_procuring_authority_id_label) | !self$is_corruption_type_present(corruption_award_date_label)) { + message("Cannot auto generate ", corruption_roll_num_issuer_label, " because ", corruption_procuring_authority_id_label, " or ", corruption_award_date_label, " are not defined.") + } + else { + temp <- self$get_data_frame(use_current_filter = FALSE) + authority_id_label <- self$get_corruption_column_name(corruption_procuring_authority_id_label) + award_date_label <- self$get_corruption_column_name(corruption_award_date_label) + col_name <- next_default_item(corruption_roll_num_issuer_label, self$get_column_names(), include_index = FALSE) + exp <- interp(~ sum(temp[[authority_id1]] == authority_id2 & temp[[award_date1]] <= award_date2 & temp[[award_date1]] > award_date2 - 365), authority_id1 = authority_id_label, authority_id2 = as.name(authority_id_label), award_date1 = award_date_label, award_date2 = as.name(award_date_label)) + temp <- self$get_data_frame(use_current_filter = FALSE) + temp <- temp %>% rowwise() %>% mutate_(.dots = setNames(list(exp), col_name)) + self$add_columns_to_data(col_name, temp[[col_name]]) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_roll_num_issuer_label) + self$append_to_variables_metadata(col_name, "label", "12 month rolling contract number of issuer for each contract awarded") + } + + } +} +) + +data_object$set("public","generate_rolling_contract_value_sum_issuer", function() { + if(!self$is_corruption_type_present(corruption_roll_sum_issuer_label)) { + self$generate_procuring_authority_id() + # Need better checks than just for original contract value + if(!self$is_corruption_type_present(corruption_procuring_authority_id_label) | !self$is_corruption_type_present(corruption_award_date_label) | !self$is_corruption_type_present(corruption_original_contract_value_label)) { + message("Cannot auto generate ", corruption_roll_num_issuer_label, " because ", corruption_procuring_authority_id_label, " or ", corruption_award_date_label, " are not defined.") + } + else { + temp <- self$get_data_frame(use_current_filter = FALSE) + authority_id_label <- self$get_corruption_column_name(corruption_procuring_authority_id_label) + award_date_label <- self$get_corruption_column_name(corruption_award_date_label) + if(self$is_corruption_type_present(corruption_ppp_adjusted_contract_value_label)) { + contract_value_label <- self$get_corruption_column_name(corruption_ppp_adjusted_contract_value_label) + } + else if(self$is_corruption_type_present(corruption_ppp_conversion_rate_label)) { + self$generate_ppp_adjusted_contract_value() + contract_value_label <- self$get_corruption_column_name(corruption_ppp_adjusted_contract_value_label) + } + else { + contract_value_label <- self$get_corruption_column_name(corruption_original_contract_value_label) + } + col_name <- next_default_item(corruption_roll_sum_issuer_label, self$get_column_names(), include_index = FALSE) + exp <- interp(~ sum(temp[[contract_value]][temp[[authority_id1]] == authority_id2 & temp[[award_date1]] <= award_date2 & temp[[award_date1]] > award_date2 - 365]), authority_id1 = authority_id_label, authority_id2 = as.name(authority_id_label), award_date1 = award_date_label, award_date2 = as.name(award_date_label), contract_value = contract_value_label) + temp <- self$get_data_frame(use_current_filter = FALSE) + temp <- temp %>% rowwise() %>% mutate_(.dots = setNames(list(exp), col_name)) + self$add_columns_to_data(col_name, temp[[col_name]]) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_roll_sum_issuer_label) + self$append_to_variables_metadata(col_name, "label", "12 month rolling sum of contract value of issuer") + } + } +} +) + +data_object$set("public","generate_rolling_contract_value_sum_winner", function() { + if(!self$is_corruption_type_present(corruption_roll_sum_winner_label)) { + self$generate_procuring_authority_id() + self$generate_winner_id() + # Need better checks than just for original contract value + if(!self$is_corruption_type_present(corruption_procuring_authority_id_label) | !self$is_corruption_type_present(corruption_winner_id_label) | !self$is_corruption_type_present(corruption_award_date_label) | !self$is_corruption_type_present(corruption_original_contract_value_label)) { + message("Cannot auto generate ", corruption_roll_num_issuer_label, " because ", corruption_procuring_authority_id_label, " or ", corruption_winner_id_label, " or ", corruption_award_date_label, " are not defined.") + } + else { + temp <- self$get_data_frame(use_current_filter = FALSE) + authority_id_label <- self$get_corruption_column_name(corruption_procuring_authority_id_label) + winner_id_label <- self$get_corruption_column_name(corruption_winner_id_label) + award_date_label <- self$get_corruption_column_name(corruption_award_date_label) + if(self$is_corruption_type_present(corruption_ppp_adjusted_contract_value_label)) { + contract_value_label <- self$get_corruption_column_name(corruption_ppp_adjusted_contract_value_label) + } + else if(self$is_corruption_type_present(corruption_ppp_conversion_rate_label)) { + self$generate_ppp_adjusted_contract_value() + contract_value_label <- self$get_corruption_column_name(corruption_ppp_adjusted_contract_value_label) + } + else { + contract_value_label <- self$get_corruption_column_name(corruption_original_contract_value_label) + } + col_name <- next_default_item(corruption_roll_sum_winner_label, self$get_column_names(), include_index = FALSE) + exp <- interp(~ sum(temp[[contract_value]][temp[[authority_id1]] == authority_id2 & temp[[winner_id1]] == winner_id2 & temp[[award_date1]] <= award_date2 & temp[[award_date1]] > award_date2 - 365]), authority_id1 = authority_id_label, authority_id2 = as.name(authority_id_label), winner_id1 = winner_id_label, winner_id2 = as.name(winner_id_label), award_date1 = award_date_label, award_date2 = as.name(award_date_label), contract_value = contract_value_label) + temp <- self$get_data_frame(use_current_filter = FALSE) + temp <- temp %>% rowwise() %>% mutate_(.dots = setNames(list(exp), col_name)) + self$add_columns_to_data(col_name, temp[[col_name]]) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_roll_sum_winner_label) + self$append_to_variables_metadata(col_name, "label", "12 month rolling sum of contract value of winner") + } + } +} +) + +data_object$set("public","generate_rolling_contract_value_share_winner", function() { + if(!self$is_corruption_type_present(corruption_roll_share_winner_label)) { + self$generate_rolling_contract_value_sum_issuer() + self$generate_rolling_contract_value_sum_winner() + if(!self$is_corruption_type_present(corruption_roll_sum_winner_label) | !self$is_corruption_type_present(corruption_roll_sum_issuer_label)) { + message("Cannot auto generate ", corruption_roll_share_winner_label, " because ", corruption_roll_sum_winner_label, " or ", corruption_roll_sum_issuer_label, " are not defined.") + } + else { + share <- self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_sum_winner_label)) / self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_sum_issuer_label)) + + col_name <- next_default_item(corruption_roll_share_winner_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, share) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_roll_share_winner_label) + self$append_to_variables_metadata(col_name, "label", "12 month rolling contract share of winner for each contract awarded") + } + } +} +) + +data_object$set("public","generate_single_bidder", function() { + if(!self$is_corruption_type_present(corruption_single_bidder_label)) { + self$generate_all_bids_trimmed() + if(!self$is_corruption_type_present(corruption_all_bids_trimmed_label)) { + message("Cannot auto generate ", corruption_single_bidder_label, " because ", corruption_all_bids_trimmed_label, " is not defined.") + } + else { + single_bidder <- (self$get_columns_from_data(self$get_corruption_column_name(corruption_all_bids_trimmed_label)) == 1) + + col_name <- next_default_item(corruption_single_bidder_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, single_bidder) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_single_bidder_label) + self$append_to_variables_metadata(col_name, "label", "Single bidder dummy") + } + } +} +) + +data_object$set("public","generate_contract_value_share_over_threshold", function() { + if(!self$is_corruption_type_present(corruption_contract_value_share_over_threshold_label)) { + self$generate_rolling_contract_value_share_winner() + self$generate_rolling_contract_no_issuer() + if(!self$is_corruption_type_present(corruption_roll_share_winner_label) | !self$is_corruption_type_present(corruption_roll_num_issuer_label)) { + message("Cannot auto generate ", corruption_contract_value_share_over_threshold_label, " because ", corruption_roll_share_winner_label, " or ", corruption_roll_num_issuer_label, " are not defined.") + } + else { + contr_share_over_threshold <- rep(NA, self$get_data_frame_length()) + contr_share_over_threshold[(self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_num_issuer_label)) >= 3) & (self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_share_winner_label)) >= 0.5)] <- TRUE + contr_share_over_threshold[(self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_num_issuer_label)) >= 3) & (self$get_columns_from_data(self$get_corruption_column_name(corruption_roll_share_winner_label)) < 0.5)] <- FALSE + + col_name <- next_default_item(corruption_contract_value_share_over_threshold_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, contr_share_over_threshold) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_contract_value_share_over_threshold_label) + self$append_to_variables_metadata(col_name, "label", "Winner share at least 50% where issuers awarded at least 3 contracts") + } + } +} +) + +data_object$set("public","generate_all_bids", function() { + if(!self$is_corruption_type_present(corruption_all_bids_label)) { + if(!self$is_corruption_type_present(corruption_no_bids_considered_label)) { + message("Cannot auto generate ", corruption_all_bids_label, " because ", corruption_no_bids_considered_label, " is not defined.") + } + else { + all_bids <- self$get_columns_from_data(self$get_corruption_column_name(corruption_no_bids_considered_label)) + if(self$is_corruption_type_present(corruption_no_bids_received_label)) { + all_bids[is.na(all_bids)] <- self$get_columns_from_data(self$get_corruption_column_name(corruption_no_bids_received_label))[is.na(all_bids)] + } + + col_name <- next_default_item(corruption_all_bids_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, all_bids) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_all_bids_label) + self$append_to_variables_metadata(col_name, "label", "# Bids (all)") + } + } +} +) + +data_object$set("public","generate_all_bids_trimmed", function() { + if(!self$is_corruption_type_present(corruption_all_bids_trimmed_label)) { + self$generate_all_bids() + if(!self$is_corruption_type_present(corruption_all_bids_label)) { + message("Cannot auto generate ", corruption_all_bids_trimmed_label, " because ", corruption_all_bids_label, " is not defined.") + } + else { + all_bids_trimmed <- self$get_columns_from_data(self$get_corruption_column_name(corruption_all_bids_label)) + all_bids_trimmed[all_bids_trimmed > 50] <- 50 + + col_name <- next_default_item(corruption_all_bids_trimmed_label, self$get_column_names(), include_index = FALSE) + self$add_columns_to_data(col_name, all_bids_trimmed) + self$append_to_variables_metadata(col_name, corruption_type_label, corruption_all_bids_trimmed_label) + self$append_to_variables_metadata(col_name, "label", "# Bids (trimmed at 50)") + } + } } ) \ No newline at end of file diff --git a/instat/static/InstatObject/R/instat_object_R6.R b/instat/static/InstatObject/R/instat_object_R6.R index a03ec7c54ae..126d98fdce9 100644 --- a/instat/static/InstatObject/R/instat_object_R6.R +++ b/instat/static/InstatObject/R/instat_object_R6.R @@ -28,7 +28,8 @@ instat_object <- R6Class("instat_object", .metadata = list(), .objects = list(), .links = list(), - .data_objects_changed = FALSE + .data_objects_changed = FALSE, + .database_connection = NULL ), active = list( data_objects_changed = function(new_value) { @@ -114,6 +115,18 @@ instat_object$set("public", "set_data_objects", function(new_data_objects) { } ) +instat_object$set("public", "copy_data_object", function(data_name, new_name, filter_name = "", reset_row_names = TRUE) { + new_obj <- self$get_data_objects(data_name)$data_clone() + if(filter_name != "") { + subset_data <- self$get_data_objects(data_name)$get_data_frame(use_current_filter = FALSE, filter_name = filter_name, retain_attr = TRUE) + if(reset_row_names) rownames(subset_data) <- 1:nrow(subset_data) + new_obj$set_data(subset_data) + } + self$append_data_object(new_name, new_obj) +} +) + + instat_object$set("public", "import_RDS", function(data_RDS, keep_existing = TRUE, overwrite_existing = FALSE, include_objects = TRUE, include_metadata = TRUE, include_logs = TRUE, include_filters = TRUE, include_calculations = TRUE) # TODO add include_calcuations options @@ -223,17 +236,17 @@ instat_object$set("public", "get_data_objects", function(data_name, as_list = FA } ) -instat_object$set("public", "get_data_frame", function(data_name, convert_to_character = FALSE, stack_data = FALSE, include_hidden_columns = TRUE, use_current_filter = TRUE, filter_name = "", remove_attr = FALSE, ...) { +instat_object$set("public", "get_data_frame", function(data_name, convert_to_character = FALSE, stack_data = FALSE, include_hidden_columns = TRUE, use_current_filter = TRUE, filter_name = "", remove_attr = FALSE, retain_attr = FALSE, ...) { if(!stack_data) { if(missing(data_name)) data_name <- self$get_data_names() if(length(data_name) > 1) { retlist <- list() for (curr_name in data_name) { - retlist[[curr_name]] = self$get_data_objects(curr_name)$get_data_frame(convert_to_character = convert_to_character, include_hidden_columns = include_hidden_columns, use_current_filter = use_current_filter, filter_name = filter_name, remove_attr = remove_attr) + retlist[[curr_name]] = self$get_data_objects(curr_name)$get_data_frame(convert_to_character = convert_to_character, include_hidden_columns = include_hidden_columns, use_current_filter = use_current_filter, filter_name = filter_name, remove_attr = remove_attr, retain_attr = retain_attr) } return(retlist) } - else return(self$get_data_objects(data_name)$get_data_frame(convert_to_character = convert_to_character, include_hidden_columns = include_hidden_columns, use_current_filter = use_current_filter, filter_name = filter_name, remove_attr = remove_attr)) + else return(self$get_data_objects(data_name)$get_data_frame(convert_to_character = convert_to_character, include_hidden_columns = include_hidden_columns, use_current_filter = use_current_filter, filter_name = filter_name, remove_attr = remove_attr, retain_attr = retain_attr)) } else { if(missing(data_name)) stop("data to be stacked is missing") @@ -1179,4 +1192,62 @@ instat_object$set("public", "get_climatic_column_name", function(data_name, col_ instat_object$set("public", "merge_data", function(data_name, new_data, by = NULL, type = "left", match = "all") { self$get_data_objects(data_name)$merge_data(new_data = new_data, by = by, type = type, match = match) } +) + +instat_object$set("public", "get_corruption_data_names", function() { + corruption_names <- c() + for(curr_name in self$get_data_names()) { + if(self$get_data_objects(curr_name)$is_metadata(is_corruption_label) && self$get_data_objects(curr_name)$get_metadata(is_corruption_label)) { + corruption_names <- c(corruption_names, curr_name) + } + } + return(corruption_names) +} +) + +instat_object$set("public", "get_database_variable_names", function(query, data_name, include_overall = TRUE, include, exclude, include_empty = FALSE, as_list = FALSE, excluded_items = c()) { + if(self$has_database_connection) { + temp_data <- dbGetQuery(self$get_database_connection(), query) + if(as_list) { + out <- list() + out[["database"]] <- tempdata[[1]] + return(out) + } + else return(tempdata[[1]]) + } + else return(list()) +} +) + +instat_object$set("public", "has_database_connection", function() { + return(!is.null(self$get_database_connection())) +} +) + +instat_object$set("public", "database_connect", function(dbname, user, host, port, drv = MySQL()) { + password <- getPass(paste0(username, " password:")) + out <- NULL + out <- dbConnect(drv = drv, dbname = dbname, user = user, password = password, host = host, port = port) + if(!is.null(out)) { + self$set_database_connection(out) + } +} +) + +instat_object$set("public", "get_database_connection", function() { + return(private$.database_connection) +} +) + +instat_object$set("public", "set_database_connection", function(dbi_connection) { + private$.database_connection <- dbi_connection +} +) + +instat_object$set("public", "database_disconnect", function() { + if(!is.null(self$get_database_connection())) { + dbDisconnect(private$.database_connection) + self$set_database_connection(NULL) + } +} ) \ No newline at end of file diff --git a/instat/ucrReceiver.vb b/instat/ucrReceiver.vb index 3769a09d641..8796254d952 100644 --- a/instat/ucrReceiver.vb +++ b/instat/ucrReceiver.vb @@ -29,6 +29,9 @@ Public Class ucrReceiver Public bExcludeFromSelector As Boolean = False Public Event SelectionChanged(sender As Object, e As EventArgs) Public WithEvents frmParent As Form + + Public strDatabaseQuery As String = "" + Public bAddParameterIfEmpty As Boolean = False 'If the control is used to set a parameter that is a string i.e. column = "ID" Private bParameterIsString As Boolean = False diff --git a/instat/ucrSelector.vb b/instat/ucrSelector.vb index 9100b266848..e8f60d70e24 100644 --- a/instat/ucrSelector.vb +++ b/instat/ucrSelector.vb @@ -78,9 +78,9 @@ Public Class ucrSelector strExclud = lstVariablesInReceivers.ToArray End If If CurrentReceiver.bTypeSet Then - frmMain.clsRLink.FillListView(lstAvailableVariable, strType:=CurrentReceiver.GetItemType(), lstIncludedDataTypes:=lstCombinedMetadataLists(0), lstExcludedDataTypes:=lstCombinedMetadataLists(1), strHeading:=CurrentReceiver.strSelectorHeading, strDataFrameName:=strCurrentDataFrame, strExcludedItems:=strExclud) + frmMain.clsRLink.FillListView(lstAvailableVariable, strType:=CurrentReceiver.GetItemType(), lstIncludedDataTypes:=lstCombinedMetadataLists(0), lstExcludedDataTypes:=lstCombinedMetadataLists(1), strHeading:=CurrentReceiver.strSelectorHeading, strDataFrameName:=strCurrentDataFrame, strExcludedItems:=strExclud, strDatabaseQuery:=CurrentReceiver.strDatabaseQuery) Else - frmMain.clsRLink.FillListView(lstAvailableVariable, strType:=strType, lstIncludedDataTypes:=lstCombinedMetadataLists(0), lstExcludedDataTypes:=lstCombinedMetadataLists(1), strHeading:=CurrentReceiver.strSelectorHeading, strDataFrameName:=strCurrentDataFrame, strExcludedItems:=strExclud) + frmMain.clsRLink.FillListView(lstAvailableVariable, strType:=strType, lstIncludedDataTypes:=lstCombinedMetadataLists(0), lstExcludedDataTypes:=lstCombinedMetadataLists(1), strHeading:=CurrentReceiver.strSelectorHeading, strDataFrameName:=strCurrentDataFrame, strExcludedItems:=strExclud, strDatabaseQuery:=CurrentReceiver.strDatabaseQuery) End If Else frmMain.clsRLink.FillListView(lstAvailableVariable, strType:=strType, lstIncludedDataTypes:=lstIncludedMetadataProperties, lstExcludedDataTypes:=lstExcludedMetadataProperties, strDataFrameName:=strCurrentDataFrame)