F square bug

CHANGELOG.md

@@ -4,13 +4,14 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [Unreleased]
-- Change code syntax to remove interactions() method and add interactions and HOC to composites()
-- Document all the syntax and features
+## [1.0.2] - 2020-04-28
+- Fixed q bug in fSquares method for single path structural models.
 
 ## [1.0.1] - 2019-12-11
 ### Changed
 - Patched if() conditionals including class() to reflect new CRAN class of matrix as c("matrix","array") in R V4.0.0
+- Change code syntax to remove interactions() method and add interactions and HOC to composites()
+- Document all the syntax and features
 
 ## [0.1.0] - 2019-09-27
 ### Added

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: seminr
 Type: Package
 Title: Domain-Specific Language for Building PLS Structural Equation Models
-Version: 1.0.1
-Date: 2019-12-11
+Version: 1.0.2
+Date: 2020-04-28
 Authors@R: c(person("Soumya", "Ray",
               email = "soumya.ray@gmail.com", role = c("aut", "ths")),
              person("Nicholas Patrick", "Danks",
@@ -18,7 +18,7 @@ Imports:
 License: GPL-3
 Depends: R (>= 3.1.0)
 LazyData: TRUE
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.0
 Suggests: knitr, testthat, rmarkdown
 VignetteBuilder: knitr
 Encoding: UTF-8

R/evaluate_effects.R

@@ -38,6 +38,10 @@
 #' fSquared(mobi_pls, "Image", "Satisfaction")
 #' @export
 fSquared <- function(seminr_model, iv, dv) {
+  if (length(seminr_model$constructs) == 2) {
+    rsq <- (seminr_model$rSquared["Rsq", dv])
+    return((rsq - 0) / (1 - rsq))
+  }
   with_sm <- seminr_model$smMatrix
   without_sm <- subset(with_sm, !((with_sm[, "source"] == iv) & (with_sm[, "target"] == dv)))
 

tests/fixtures/V_3_5_X/fsquared2.csv

@@ -0,0 +1,2 @@
+"","x"
+"1",0.941739145016071

tests/fixtures/V_3_6_0/fsquared2.csv

@@ -0,0 +1,2 @@
+"","x"
+"1",0.941739145016071

tests/testthat/test-metric.R

@@ -1,4 +1,4 @@
-context("SEMinR correctly estimates the model R-Squared\n")
+context("SEMinR correctly estimates the model R-Squared and fSquared\n")
 
 # Test cases
 ## Regular case
@@ -45,3 +45,36 @@ test_that("Seminr estimates the Rsquared correctly", {
 test_that("Seminr estimates the fSquared correctly", {
   expect_equal(fsquared, fsquared_control[1,1], tolerance = 0.00001)
 })
+
+## Single structural path case
+
+# seminr syntax for creating measurement model
+mobi_mm <- constructs(
+  composite("Image",        multi_items("IMAG", 1:5),weights = mode_A),
+  composite("Satisfaction", multi_items("CUSA", 1:3),weights = mode_A)
+)
+
+
+# structural model: note that name of the interactions construct should be
+#  the names of its two main constructs joined by a '*' in between.
+mobi_sm <- relationships(
+  paths(to = "Satisfaction",  from = c("Image"))
+)
+
+# Load data, assemble model, and estimate using semPLS
+seminr_model <- estimate_pls(mobi, mobi_mm, mobi_sm)
+
+# Load outputs
+fsquared <- fSquared(seminr_model, "Image", "Satisfaction")
+
+## Output originally created using following lines
+# write.csv(fSquared(seminr_model, "Image", "Satisfaction"), file = "tests/fixtures/V_3_5_X/fsquared2.csv")
+# write.csv(fSquared(seminr_model, "Image", "Satisfaction"), file = "tests/fixtures/V_3_6_0/fsquared2.csv")
+
+# Load controls
+fsquared_control <- as.matrix(read.csv(file = paste(test_folder,"fsquared2.csv", sep = ""), row.names = 1))
+
+# Testing
+test_that("Seminr estimates the fSquared correctly", {
+  expect_equal(fsquared, fsquared_control[1,1], tolerance = 0.00001)
+})