Skip to main content
added 3 characters in body
Source Link
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k

I have a couple of ideas that might be improvements over what you are doing but they are neither fully realized nor tested. Consider this answer a work in progress.

Matrix operations

The first is to operate on the truth table itself with matrix operations. Probably this will be faster in some cases and slower in others than what you are doing now. I do find it more "elegant" by my own sensibility.

I shall use an Association idx to keep track of the variables and a mapping to positions in the matrix, m. When variable is used I shall check with KeyFreeQ (undocumented) if it exists in idx, and if not I shall expand m and increment the symbol i.

m = {{}};
idx = <||>;
i = 0;

addKey[x_] /; KeyFreeQ[idx, x] := (
  idx[x] = ++i;
  m = PadRight[m, {i, i}];
 )

Tilde[a_, b_] := (
  addKey /@ {a, b};
  m[[idx @ a, idx @ b]] = 1;
 )

Operations are defined in terms of and acting upon the matrix m:

make["symmetric"] := (m = Unitize[m + m\[Transpose]];)

make["reflexive"] := (m = Unitize[m + IdentityMatrix @ i];)

make["transitive"] :=
  Do[
    m[[n]] = Unitize[ m[[n]] + Total @ Pick[m, m[[n]], 1] ],
    {i}, {n, i}
  ]

To see changes in action create a Dynamic expression with:

Dynamic @ TableForm[m, TableHeadings -> ({#, #} & @ Keys @ idx)]

Now add some rules:

a \[Tilde] b;
c \[Tilde] b;
b \[Tilde] d;
d \[Tilde] e;
f \[Tilde] f;
addKey /@ {x, y};

The table becomes:

enter image description here

We can perform operations by calling e.g.:

make["symmetric"]

enter image description here

make["reflexive"]

enter image description here

make["transitive"]

enter image description here

One could make these updating steps part of the Tilde function itself but I think itsuspect that to get any advantage from the matrix operationsmethod one will need to use a separate update[] function after making multiple rules.

The TildeTilde function could be defined:

TildeTilde[a_, b_] /; KeyMemberQ[idx, a] && KeyMemberQ[idx, b] :=
   1 == m[[idx @ a, idx @ b]]

Tested:

e \[TildeTilde] c
a \[TildeTilde] x
True

False

Regarding symmetry also see the Attribute Orderless but know that it will also change the way \[TildeTilde] expressions are displayed; I don't know if this is acceptable to you so I left it out of my code.

I have a couple of ideas that might be improvements over what you are doing but they are neither fully realized nor tested. Consider this answer a work in progress.

Matrix operations

The first is to operate on the truth table itself with matrix operations. Probably this will be faster in some cases and slower in others than what you are doing now. I do find it more "elegant" by my own sensibility.

I shall use an Association idx to keep track of the variables and a mapping to positions in the matrix, m. When variable is used I shall check with KeyFreeQ (undocumented) if it exists in idx, and if not I shall expand m and increment the symbol i.

m = {{}};
idx = <||>;
i = 0;

addKey[x_] /; KeyFreeQ[idx, x] := (
  idx[x] = ++i;
  m = PadRight[m, {i, i}];
 )

Tilde[a_, b_] := (
  addKey /@ {a, b};
  m[[idx @ a, idx @ b]] = 1;
 )

Operations are defined in terms of and acting upon the matrix m:

make["symmetric"] := (m = Unitize[m + m\[Transpose]];)

make["reflexive"] := (m = Unitize[m + IdentityMatrix @ i];)

make["transitive"] :=
  Do[
    m[[n]] = Unitize[ m[[n]] + Total @ Pick[m, m[[n]], 1] ],
    {i}, {n, i}
  ]

To see changes in action create a Dynamic expression with:

Dynamic @ TableForm[m, TableHeadings -> ({#, #} & @ Keys @ idx)]

Now add some rules:

a \[Tilde] b;
c \[Tilde] b;
b \[Tilde] d;
d \[Tilde] e;
f \[Tilde] f;
addKey /@ {x, y};

The table becomes:

enter image description here

We can perform operations by calling e.g.:

make["symmetric"]

enter image description here

make["reflexive"]

enter image description here

make["transitive"]

enter image description here

One could make these updating steps part of the Tilde function itself but I think it get any advantage from the matrix operations one will need to use a separate update[] function after making multiple rules.

The TildeTilde function could be defined:

TildeTilde[a_, b_] /; KeyMemberQ[idx, a] && KeyMemberQ[idx, b] :=
   1 == m[[idx @ a, idx @ b]]

Tested:

e \[TildeTilde] c
a \[TildeTilde] x
True

False

I have a couple of ideas that might be improvements over what you are doing but they are neither fully realized nor tested. Consider this answer a work in progress.

Matrix operations

The first is to operate on the truth table itself with matrix operations. Probably this will be faster in some cases and slower in others than what you are doing now. I do find it more "elegant" by my own sensibility.

I shall use an Association idx to keep track of the variables and a mapping to positions in the matrix, m. When variable is used I shall check with KeyFreeQ (undocumented) if it exists in idx, and if not I shall expand m and increment the symbol i.

m = {{}};
idx = <||>;
i = 0;

addKey[x_] /; KeyFreeQ[idx, x] := (
  idx[x] = ++i;
  m = PadRight[m, {i, i}];
 )

Tilde[a_, b_] := (
  addKey /@ {a, b};
  m[[idx @ a, idx @ b]] = 1;
 )

Operations are defined in terms of and acting upon the matrix m:

make["symmetric"] := (m = Unitize[m + m\[Transpose]];)

make["reflexive"] := (m = Unitize[m + IdentityMatrix @ i];)

make["transitive"] :=
  Do[
    m[[n]] = Unitize[ m[[n]] + Total @ Pick[m, m[[n]], 1] ],
    {i}, {n, i}
  ]

To see changes in action create a Dynamic expression with:

Dynamic @ TableForm[m, TableHeadings -> ({#, #} & @ Keys @ idx)]

Now add some rules:

a \[Tilde] b;
c \[Tilde] b;
b \[Tilde] d;
d \[Tilde] e;
f \[Tilde] f;
addKey /@ {x, y};

The table becomes:

enter image description here

We can perform operations by calling e.g.:

make["symmetric"]

enter image description here

make["reflexive"]

enter image description here

make["transitive"]

enter image description here

One could make these updating steps part of the Tilde function itself but I suspect that to get any advantage from the matrix method one will need to use a separate update[] function after making multiple rules.

The TildeTilde function could be defined:

TildeTilde[a_, b_] /; KeyMemberQ[idx, a] && KeyMemberQ[idx, b] :=
   1 == m[[idx @ a, idx @ b]]

Tested:

e \[TildeTilde] c
a \[TildeTilde] x
True

False

Regarding symmetry also see the Attribute Orderless but know that it will also change the way \[TildeTilde] expressions are displayed; I don't know if this is acceptable to you so I left it out of my code.

Source Link
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k

I have a couple of ideas that might be improvements over what you are doing but they are neither fully realized nor tested. Consider this answer a work in progress.

Matrix operations

The first is to operate on the truth table itself with matrix operations. Probably this will be faster in some cases and slower in others than what you are doing now. I do find it more "elegant" by my own sensibility.

I shall use an Association idx to keep track of the variables and a mapping to positions in the matrix, m. When variable is used I shall check with KeyFreeQ (undocumented) if it exists in idx, and if not I shall expand m and increment the symbol i.

m = {{}};
idx = <||>;
i = 0;

addKey[x_] /; KeyFreeQ[idx, x] := (
  idx[x] = ++i;
  m = PadRight[m, {i, i}];
 )

Tilde[a_, b_] := (
  addKey /@ {a, b};
  m[[idx @ a, idx @ b]] = 1;
 )

Operations are defined in terms of and acting upon the matrix m:

make["symmetric"] := (m = Unitize[m + m\[Transpose]];)

make["reflexive"] := (m = Unitize[m + IdentityMatrix @ i];)

make["transitive"] :=
  Do[
    m[[n]] = Unitize[ m[[n]] + Total @ Pick[m, m[[n]], 1] ],
    {i}, {n, i}
  ]

To see changes in action create a Dynamic expression with:

Dynamic @ TableForm[m, TableHeadings -> ({#, #} & @ Keys @ idx)]

Now add some rules:

a \[Tilde] b;
c \[Tilde] b;
b \[Tilde] d;
d \[Tilde] e;
f \[Tilde] f;
addKey /@ {x, y};

The table becomes:

enter image description here

We can perform operations by calling e.g.:

make["symmetric"]

enter image description here

make["reflexive"]

enter image description here

make["transitive"]

enter image description here

One could make these updating steps part of the Tilde function itself but I think it get any advantage from the matrix operations one will need to use a separate update[] function after making multiple rules.

The TildeTilde function could be defined:

TildeTilde[a_, b_] /; KeyMemberQ[idx, a] && KeyMemberQ[idx, b] :=
   1 == m[[idx @ a, idx @ b]]

Tested:

e \[TildeTilde] c
a \[TildeTilde] x
True

False