This repository has been archived by the owner on Feb 23, 2024. It is now read-only.
/
Set_FuzzySet_FuzzyMultiset.R
169 lines (153 loc) · 6.15 KB
/
Set_FuzzySet_FuzzyMultiset.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#' @name FuzzyMultiset
#' @title Mathematical Fuzzy Multiset
#' @description A general FuzzyMultiset object for mathematical fuzzy multisets, inheriting from `FuzzySet`.
#' @family sets
#'
#' @details
#' Fuzzy multisets generalise standard mathematical multisets to allow for fuzzy relationships. Whereas a
#' standard, or crisp, multiset assumes that an element is either in a multiset or not, a fuzzy multiset allows
#' an element to be in a multiset to a particular degree, known as the membership function, which
#' quantifies the inclusion of an element by a number in \[0, 1\]. Thus a (crisp) multiset is a
#' fuzzy multiset where all elements have a membership equal to \eqn{1}. Similarly to [Multiset]s, elements
#' do not need to be unique.
#'
#' @examples
#' # Different constructors
#' FuzzyMultiset$new(1, 0.5, 2, 1, 3, 0)
#' FuzzyMultiset$new(elements = 1:3, membership = c(0.5, 1, 0))
#'
#' # Crisp sets are a special case FuzzyMultiset
#' # Note membership defaults to full membership
#' FuzzyMultiset$new(elements = 1:5) == Multiset$new(1:5)
#'
#' f <- FuzzyMultiset$new(1, 0.2, 2, 1, 3, 0)
#' f$membership()
#' f$alphaCut(0.3)
#' f$core()
#' f$inclusion(0)
#' f$membership(0)
#' f$membership(1)
#'
#' # Elements can be duplicated, and with different memberships,
#' # although this is not necessarily sensible.
#' FuzzyMultiset$new(1, 0.1, 1, 1)
#'
#' # Like FuzzySets, ordering does not matter.
#' FuzzyMultiset$new(1, 0.1, 2, 0.2) == FuzzyMultiset$new(2, 0.2, 1, 0.1)
#' @export
FuzzyMultiset <- R6Class("FuzzyMultiset",
inherit = FuzzySet,
public = list(
#' @description Tests if two sets are equal.
#' @details Two fuzzy sets are equal if they contain the same elements with the same memberships and
#' in the same order. Infix operators can be used for:
#' \tabular{ll}{
#' Equal \tab `==` \cr
#' Not equal \tab `!=` \cr
#' }
#' @param x [Set] or vector of [Set]s.
#' @param all logical. If `FALSE` tests each `x` separately. Otherwise returns `TRUE` only if all `x` pass test.
#' @return If `all` is `TRUE` then returns `TRUE` if all `x` are equal to the Set, otherwise
#' `FALSE`. If `all` is `FALSE` then returns a vector of logicals corresponding to each individual
#' element of `x`.
equals = function(x, all = FALSE) {
if (all(self$membership() == 1)) {
return(self$core(create = T)$equals(x))
}
x <- listify(x)
ret <- sapply(x, function(el) {
if (!testFuzzySet(el)) {
return(FALSE)
}
if (el$length != self$length) {
return(FALSE)
}
ifelse(all(all.equal(el$multiplicity(), self$multiplicity()) == TRUE), TRUE, FALSE) &&
ifelse(all(all.equal(el$membership(), self$membership()) == TRUE), TRUE, FALSE)
})
returner(ret, all)
},
#' @description Test if one set is a (proper) subset of another
#' @param x any. Object or vector of objects to test.
#' @param proper logical. If `TRUE` tests for proper subsets.
#' @param all logical. If `FALSE` tests each `x` separately. Otherwise returns `TRUE` only if all `x` pass test.
#' @details If using the method directly, and not via one of the operators then the additional boolean
#' argument `proper` can be used to specify testing of subsets or proper subsets. A Set is a proper
#' subset of another if it is fully contained by the other Set (i.e. not equal to) whereas a Set is a
#' (non-proper) subset if it is fully contained by, or equal to, the other Set.
#'
#' Infix operators can be used for:
#' \tabular{ll}{
#' Subset \tab `<` \cr
#' Proper Subset \tab `<=` \cr
#' Superset \tab `>` \cr
#' Proper Superset \tab `>=`
#' }
#'
#' @return If `all` is `TRUE` then returns `TRUE` if all `x` are subsets of the Set, otherwise
#' `FALSE`. If `all` is `FALSE` then returns a vector of logicals corresponding to each individual
#' element of `x`.
isSubset = function(x, proper = FALSE, all = FALSE) {
if (all(self$membership() == 1)) {
return(self$core(create = T)$isSubset(x, proper = proper, all = all))
}
x <- listify(x)
ret <- rep(FALSE, length(x))
ind <- sapply(x, testFuzzyMultiset)
ret[ind] <- sapply(x[ind], function(el) {
self_comp <- paste(self$elements, self$membership(), sep = ";")
el_comp <- paste(el$elements, el$membership(), sep = ";")
if (el$length > self$length) {
return(FALSE)
} else if (el$length == self$length) {
if (!proper & el$equals(self)) {
return(TRUE)
} else {
return(FALSE)
}
} else {
mtc <- match(el_comp, self_comp)
if (all(is.na(mtc))) {
return(FALSE)
} else {
return(TRUE)
}
}
})
returner(ret, all)
},
#' @description The alpha-cut of a fuzzy set is defined as the set
#' \deqn{A_\alpha = \{x \epsilon F | m \ge \alpha\}}{A_\alpha = {x \epsilon F | m \ge \alpha}}
#' where \eqn{x} is an element in the fuzzy set, \eqn{F}, and \eqn{m} is the corresponding membership.
#' @param alpha numeric in \[0, 1\] to determine which elements to return
#' @param strong logical, if `FALSE` (default) then includes elements greater than or equal to alpha, otherwise only strictly greater than
#' @param create logical, if `FALSE` (default) returns the elements in the alpha cut, otherwise returns a crisp set of the elements
#' @return Elements in [FuzzyMultiset] or a [Set] of the elements.
alphaCut = function(alpha, strong = FALSE, create = FALSE) {
els <- self$elements
mem <- self$membership()
if (strong) {
mtc <- match(names(mem[mem > alpha]), private$.str_elements)
} else {
mtc <- match(names(mem[mem >= alpha]), private$.str_elements)
}
els <- els[mtc][!is.na(mtc)]
if (create) {
if (length(els) == 0) {
return(Set$new())
} else {
return(Multiset$new(elements = els))
}
} else {
if (length(els) == 0) {
return(NULL)
} else {
return(els)
}
}
}
),
private = list(
.type = "()"
)
)