if (require("QCA")) {
# generate heights for 100 people
# with an average of 175cm and a standard deviation of 10cm
set.seed(12345)
x <- rnorm(n = 100, mean = 175, sd = 10)
cx <- calibrate(x, thresholds = 175)
plot(x, cx, main="Binary crisp set using 1 threshold",
xlab = "Raw data", ylab = "Calibrated data", yaxt="n")
axis(2, at = 0:1)
cx <- calibrate(x, thresholds = c(170, 180))
plot(x, cx, main="3 value crisp set using 2 thresholds",
xlab = "Raw data", ylab = "Calibrated data", yaxt="n")
axis(2, at = 0:2)
# calibrate to a increasing, s-shaped fuzzy-set
cx <- calibrate(x, type = "fuzzy", thresholds = "e=165, c=175, i=185")
plot(x, cx, main = "Membership scores in the set of tall people",
xlab = "Raw data", ylab = "Calibrated data")
# calibrate to an decreasing, s-shaped fuzzy-set
cx <- calibrate(x, type = "fuzzy", thresholds = "i=165, c=175, e=185")
plot(x, cx, main = "Membership scores in the set of short people",
xlab = "Raw data", ylab = "Calibrated data")
# when not using the logistic function, linear increase
cx <- calibrate(x, type = "fuzzy", logistic = FALSE,
thresholds = "e=165, c=175, i=185")
plot(x, cx, main = "Membership scores in the set of tall people",
xlab = "Raw data", ylab = "Calibrated data")
# tweaking the parameters "above" and "below" the crossover,
# at value 3.5 approximates a logistic distribution, when e=155 and i=195
cx <- calibrate(x, type = "fuzzy", logistic = FALSE, above = 3.5, below = 3.5,
thresholds = "e=155, c=175, i=195")
plot(x, cx, main = "Membership scores in the set of tall people",
xlab = "Raw data", ylab = "Calibrated data")
# calibrate to a bell-shaped fuzzy set
cx <- calibrate(x, type = "fuzzy", below = 3, above = 3,
thresholds = "e1=155, c1=165, i1=175, i2=175, c2=185, e2=195")
plot(x, cx, main = "Membership scores in the set of average height",
xlab = "Raw data", ylab = "Calibrated data")
# calibrate to an inverse bell-shaped fuzzy set
cx <- calibrate(x, type = "fuzzy", below = 3, above = 3,
thresholds = "i1=155, c1=165, e1=175, e2=175, c2=185, i2=195")
plot(x, cx, main = "Membership scores in the set of non-average height",
xlab = "Raw data", ylab = "Calibrated data")
# the default values of "above" and "below" will produce a triangular shape
cx <- calibrate(x, type = "fuzzy",
thresholds = "e1=155, c1=165, i1=175, i2=175, c2=185, e2=195")
plot(x, cx, main = "Membership scores in the set of average height",
xlab = "Raw data", ylab = "Calibrated data")
# different thresholds to produce a linear trapezoidal shape
cx <- calibrate(x, type = "fuzzy",
thresholds = "e1=155, c1=165, i1=172, i2=179, c2=187, e2=195")
plot(x, cx, main = "Membership scores in the set of average height",
xlab = "Raw data", ylab = "Calibrated data")
# larger values of above and below will increase membership in or out of the set
cx <- calibrate(x, type = "fuzzy", below = 10, above = 10,
thresholds = "e1=155, c1=165, i1=175, i2=175, c2=185, e2=195")
plot(x, cx, main = "Membership scores in the set of average height",
xlab = "Raw data", ylab = "Calibrated data")
# while extremely large values will produce virtually crisp results
cx <- calibrate(x, type = "fuzzy", below = 10000, above = 10000,
thresholds = "e1=155, c1=165, i1=175, i2=175, c2=185, e2=195")
plot(x, cx, main = "Binary crisp scores in the set of average height",
xlab = "Raw data", ylab = "Calibrated data", yaxt="n")
axis(2, at = 0:1)
abline(v = c(165, 185), col = "red", lty = 2)
# check if crisp
round(cx, 0)
# using the empirical cumulative distribution function
# require manually setting logistic to FALSE
cx <- calibrate(x, type = "fuzzy", logistic = FALSE, ecdf = TRUE,
thresholds = "e=155, c=175, i=195")
plot(x, cx, main = "Membership scores in the set of tall people",
xlab = "Raw data", ylab = "Calibrated data")
}
Run the code above in your browser using DataLab