Is there a name for this property: x + x - x == x

It's not quite idempotence, because more than one function is involved. It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.

If you have associativity, this seems roughly the same as saying there
is an additive inverse for every x, because x + x - x = x => x + (x -
x) = x => x + 0 = x.
On Wed, Jun 4, 2014 at 7:34 AM, Omari Norman
It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Exactly, it's 3 properties: associativity, inverse and identity.
On Wed, Jun 4, 2014 at 11:42 AM, David Thomas
If you have associativity, this seems roughly the same as saying there is an additive inverse for every x, because x + x - x = x => x + (x - x) = x => x + 0 = x.
On Wed, Jun 4, 2014 at 7:34 AM, Omari Norman
wrote: It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Is there a more general name for it? Here's what I'm thinking of. I would
think there's a name for it rather than "inversion", which I made up.
module Builders where
import Test.QuickCheck
-- | Takes a single value, x. Applies a function to that value,
-- and then applies a second function to the result of the
-- application of the first function. Passes if the result of the
-- second function equals the original value.
inversion
:: (Eq a, Show a)
=> (a -> b)
-- ^ Apply this function to the original value
-> (b -> a)
-- ^ Apply this function to the result of the first function
-> a
-> Property
inversion f1 f2 a = f2 (f1 a) === a
On Wed, Jun 4, 2014 at 10:42 AM, David Thomas
If you have associativity, this seems roughly the same as saying there is an additive inverse for every x, because x + x - x = x => x + (x - x) = x => x + 0 = x.
On Wed, Jun 4, 2014 at 7:34 AM, Omari Norman
wrote: It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Inversion seems like the right name. That's typically what people call it when f . g = g . f = id So in the case of x + (x - x) = x we can think of it as (f . g) x where f y = x + y and g y = y - x, and all we're saying is that f . g = g . f = id i.e. f and g are inverse. Alex On 2014-06-04, at 10:46 AM, Omari Norman wrote:
Is there a more general name for it? Here's what I'm thinking of. I would think there's a name for it rather than "inversion", which I made up.
module Builders where
import Test.QuickCheck
-- | Takes a single value, x. Applies a function to that value, -- and then applies a second function to the result of the -- application of the first function. Passes if the result of the -- second function equals the original value.
inversion :: (Eq a, Show a) => (a -> b) -- ^ Apply this function to the original value -> (b -> a) -- ^ Apply this function to the result of the first function -> a -> Property inversion f1 f2 a = f2 (f1 a) === a
On Wed, Jun 4, 2014 at 10:42 AM, David Thomas
wrote: If you have associativity, this seems roughly the same as saying there is an additive inverse for every x, because x + x - x = x => x + (x - x) = x => x + 0 = x. On Wed, Jun 4, 2014 at 7:34 AM, Omari Norman
wrote: It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On 06/04/2014 06:34 PM, Omari Norman wrote:
It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
Hello Omari, I guess it's a corollary of two group axioms. There exists an identity element e such what for any a a + e == e + a == a. And for any element a inverse element -a exists, such that a + (-a) == e. Take a look at http://en.wikipedia.org/wiki/Group_%28mathematics%29 Why not compose a name out of these two? :)

* Omari Norman
It's not quite idempotence, because more than one function is involved.
It's a common property and I figure I can write a higher order function to build QuickCheck tests for it. I was just wondering if it has a name.
This is similar to the inverse semigroup definition (but note the different order of the operands). https://en.wikipedia.org/wiki/Inverse_semigroup Roman

On Wed, Jun 4, 2014 at 10:34 AM, Omari Norman
It's not quite idempotence, because more than one function is involved.
It's a restricted version of the quasigroup law. For non-commutative operators there are actually two laws: left-division: forall a, b. exists (a\b). a*(a\b) == b N.B., it follows that: forall a, b. a \ (a*b) == b right-division: forall a, b. exists (b/a). (b/a)*a == b N.B., it follows that: forall a, b. (a*b) / b == a The "division" in the name just comes from assuming (*) is a "multiplication", as is usually assumed in group theory. We call (*) a left- or right-quasigroup depending on which law holds, or call it a quasigroup if both laws hold. If the quasigroup has an identity element, then it's called a loop, and we can define left- and right-inverse operators by (x\1) and (1/x). If we have various weak forms of associativity then we get left Bol loops, right Bol loops, and Moufang loops depending on what sort of weak associativity we have. If we have full associativity then the loop is a monoid. If the left- and right-inverses coincide, then this monoid is in fact a group. cf., http://winterkoninkje.dreamwidth.org/79868.html also http://en.wikipedia.org/wiki/Quasigroup Alternatively, if you want to view the law as being associated the other way — i.e., (x*y)/y == x — then, as Alexander Vieth said, the way to think about it is in terms of the endomorphism group. That is, given any monoid (G,(*)) we can construct a monoid (Endo(G),(.)) where forall x:G we have (_*x) : Endo(G), and where (.) is function composition. When G happens to be a group every element has a unique multiplicative inverse, therefore every endomorphism has a unique compositional inverse, hence Endo(G) is a group. Thus, we'd just call (_*x) and (_/x) inverses since they're inverse elements in Endo(G). If you want to get fancy, whenever r . s == id we say that s is a "section" of r, and that r is a "retraction" of s. So you could use that terminology, though it's more general and it loses the fact that we actually have both (_*x).(_/x) == id and also (_/x).(_*x) == id. -- Live well, ~wren
participants (7)
-
Alexander Vieth
-
David Thomas
-
Dmitry Vyal
-
Ezequiel Alvarez
-
Omari Norman
-
Roman Cheplyaka
-
wren romano