diff --git a/benchmarks/UF250.1065.100/uf250-01.cnf b/benchmarks/UF250.1065.100/uf250-01.cnf --- a/benchmarks/UF250.1065.100/uf250-01.cnf +++ b/benchmarks/UF250.1065.100/uf250-01.cnf @@ -1071,6 +1071,3 @@ -184 203 126 0 -249 81 -231 0 141 231 25 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-010.cnf b/benchmarks/UF250.1065.100/uf250-010.cnf --- a/benchmarks/UF250.1065.100/uf250-010.cnf +++ b/benchmarks/UF250.1065.100/uf250-010.cnf @@ -1071,6 +1071,3 @@ -175 141 143 0 8 -52 35 0 224 -163 24 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-0100.cnf b/benchmarks/UF250.1065.100/uf250-0100.cnf --- a/benchmarks/UF250.1065.100/uf250-0100.cnf +++ b/benchmarks/UF250.1065.100/uf250-0100.cnf @@ -1071,6 +1071,3 @@ -139 197 50 0 -84 -240 18 0 37 -16 5 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-011.cnf b/benchmarks/UF250.1065.100/uf250-011.cnf --- a/benchmarks/UF250.1065.100/uf250-011.cnf +++ b/benchmarks/UF250.1065.100/uf250-011.cnf @@ -1071,6 +1071,3 @@ 105 -128 -205 0 -107 1 60 0 -184 70 190 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-012.cnf b/benchmarks/UF250.1065.100/uf250-012.cnf --- a/benchmarks/UF250.1065.100/uf250-012.cnf +++ b/benchmarks/UF250.1065.100/uf250-012.cnf @@ -1071,6 +1071,3 @@ 202 -84 73 0 180 -214 -52 0 -102 -97 222 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-013.cnf b/benchmarks/UF250.1065.100/uf250-013.cnf --- a/benchmarks/UF250.1065.100/uf250-013.cnf +++ b/benchmarks/UF250.1065.100/uf250-013.cnf @@ -1071,6 +1071,3 @@ -210 128 -190 0 -226 -56 -127 0 118 -104 -67 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-014.cnf b/benchmarks/UF250.1065.100/uf250-014.cnf --- a/benchmarks/UF250.1065.100/uf250-014.cnf +++ b/benchmarks/UF250.1065.100/uf250-014.cnf @@ -1071,6 +1071,3 @@ 144 -172 -173 0 -159 104 -66 0 -1 44 -243 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-015.cnf b/benchmarks/UF250.1065.100/uf250-015.cnf --- a/benchmarks/UF250.1065.100/uf250-015.cnf +++ b/benchmarks/UF250.1065.100/uf250-015.cnf @@ -1071,6 +1071,3 @@ -188 129 -18 0 -104 87 223 0 204 -32 54 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-016.cnf b/benchmarks/UF250.1065.100/uf250-016.cnf --- a/benchmarks/UF250.1065.100/uf250-016.cnf +++ b/benchmarks/UF250.1065.100/uf250-016.cnf @@ -1071,6 +1071,3 @@ 60 -245 94 0 192 172 -177 0 -162 -180 59 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-017.cnf b/benchmarks/UF250.1065.100/uf250-017.cnf --- a/benchmarks/UF250.1065.100/uf250-017.cnf +++ b/benchmarks/UF250.1065.100/uf250-017.cnf @@ -1071,6 +1071,3 @@ -173 -84 103 0 98 14 118 0 192 209 -170 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-018.cnf b/benchmarks/UF250.1065.100/uf250-018.cnf --- a/benchmarks/UF250.1065.100/uf250-018.cnf +++ b/benchmarks/UF250.1065.100/uf250-018.cnf @@ -1071,6 +1071,3 @@ 131 -47 -220 0 137 -177 100 0 -131 45 36 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-019.cnf b/benchmarks/UF250.1065.100/uf250-019.cnf --- a/benchmarks/UF250.1065.100/uf250-019.cnf +++ b/benchmarks/UF250.1065.100/uf250-019.cnf @@ -1071,6 +1071,3 @@ -161 73 -121 0 124 -134 -172 0 -188 -227 -113 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-02.cnf b/benchmarks/UF250.1065.100/uf250-02.cnf --- a/benchmarks/UF250.1065.100/uf250-02.cnf +++ b/benchmarks/UF250.1065.100/uf250-02.cnf @@ -1071,6 +1071,3 @@ 79 -33 -202 0 -40 -134 212 0 -239 146 250 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-020.cnf b/benchmarks/UF250.1065.100/uf250-020.cnf --- a/benchmarks/UF250.1065.100/uf250-020.cnf +++ b/benchmarks/UF250.1065.100/uf250-020.cnf @@ -1071,6 +1071,3 @@ -110 -143 151 0 80 89 -94 0 -116 129 186 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-021.cnf b/benchmarks/UF250.1065.100/uf250-021.cnf --- a/benchmarks/UF250.1065.100/uf250-021.cnf +++ b/benchmarks/UF250.1065.100/uf250-021.cnf @@ -1071,6 +1071,3 @@ -217 -100 63 0 -83 67 -85 0 17 -159 -223 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-022.cnf b/benchmarks/UF250.1065.100/uf250-022.cnf --- a/benchmarks/UF250.1065.100/uf250-022.cnf +++ b/benchmarks/UF250.1065.100/uf250-022.cnf @@ -1071,6 +1071,3 @@ -207 66 193 0 -112 174 25 0 -122 27 -131 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-023.cnf b/benchmarks/UF250.1065.100/uf250-023.cnf --- a/benchmarks/UF250.1065.100/uf250-023.cnf +++ b/benchmarks/UF250.1065.100/uf250-023.cnf @@ -1071,6 +1071,3 @@ 154 131 -208 0 204 210 -82 0 -116 158 137 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-024.cnf b/benchmarks/UF250.1065.100/uf250-024.cnf --- a/benchmarks/UF250.1065.100/uf250-024.cnf +++ b/benchmarks/UF250.1065.100/uf250-024.cnf @@ -1071,6 +1071,3 @@ 66 208 -187 0 -61 149 -165 0 -136 153 -22 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-025.cnf b/benchmarks/UF250.1065.100/uf250-025.cnf --- a/benchmarks/UF250.1065.100/uf250-025.cnf +++ b/benchmarks/UF250.1065.100/uf250-025.cnf @@ -1071,6 +1071,3 @@ 192 -234 -203 0 -182 -82 143 0 247 -205 -221 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-026.cnf b/benchmarks/UF250.1065.100/uf250-026.cnf --- a/benchmarks/UF250.1065.100/uf250-026.cnf +++ b/benchmarks/UF250.1065.100/uf250-026.cnf @@ -1071,6 +1071,3 @@ 37 157 -34 0 176 -134 -81 0 -228 -110 207 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-027.cnf b/benchmarks/UF250.1065.100/uf250-027.cnf --- a/benchmarks/UF250.1065.100/uf250-027.cnf +++ b/benchmarks/UF250.1065.100/uf250-027.cnf @@ -1071,6 +1071,3 @@ -178 -72 -132 0 232 185 -209 0 -229 -231 -113 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-028.cnf b/benchmarks/UF250.1065.100/uf250-028.cnf --- a/benchmarks/UF250.1065.100/uf250-028.cnf +++ b/benchmarks/UF250.1065.100/uf250-028.cnf @@ -1071,6 +1071,3 @@ -94 -220 65 0 83 74 84 0 -81 124 197 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-029.cnf b/benchmarks/UF250.1065.100/uf250-029.cnf --- a/benchmarks/UF250.1065.100/uf250-029.cnf +++ b/benchmarks/UF250.1065.100/uf250-029.cnf @@ -1071,6 +1071,3 @@ -180 237 204 0 91 130 239 0 7 181 25 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-03.cnf b/benchmarks/UF250.1065.100/uf250-03.cnf --- a/benchmarks/UF250.1065.100/uf250-03.cnf +++ b/benchmarks/UF250.1065.100/uf250-03.cnf @@ -1071,6 +1071,3 @@ 215 101 177 0 -209 140 240 0 160 -191 127 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-030.cnf b/benchmarks/UF250.1065.100/uf250-030.cnf --- a/benchmarks/UF250.1065.100/uf250-030.cnf +++ b/benchmarks/UF250.1065.100/uf250-030.cnf @@ -1071,6 +1071,3 @@ 93 82 -6 0 76 101 241 0 4 -93 -108 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-031.cnf b/benchmarks/UF250.1065.100/uf250-031.cnf --- a/benchmarks/UF250.1065.100/uf250-031.cnf +++ b/benchmarks/UF250.1065.100/uf250-031.cnf @@ -1071,6 +1071,3 @@ -140 102 -203 0 59 -132 73 0 52 -14 -111 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-032.cnf b/benchmarks/UF250.1065.100/uf250-032.cnf --- a/benchmarks/UF250.1065.100/uf250-032.cnf +++ b/benchmarks/UF250.1065.100/uf250-032.cnf @@ -1071,6 +1071,3 @@ 170 -213 63 0 142 -127 55 0 72 -78 -121 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-033.cnf b/benchmarks/UF250.1065.100/uf250-033.cnf --- a/benchmarks/UF250.1065.100/uf250-033.cnf +++ b/benchmarks/UF250.1065.100/uf250-033.cnf @@ -1071,6 +1071,3 @@ 179 53 214 0 -58 223 -29 0 129 102 35 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-034.cnf b/benchmarks/UF250.1065.100/uf250-034.cnf --- a/benchmarks/UF250.1065.100/uf250-034.cnf +++ b/benchmarks/UF250.1065.100/uf250-034.cnf @@ -1071,6 +1071,3 @@ -245 -179 -191 0 217 191 -67 0 226 167 -227 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-035.cnf b/benchmarks/UF250.1065.100/uf250-035.cnf --- a/benchmarks/UF250.1065.100/uf250-035.cnf +++ b/benchmarks/UF250.1065.100/uf250-035.cnf @@ -1071,6 +1071,3 @@ 42 96 -17 0 -134 -238 45 0 223 129 185 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-036.cnf b/benchmarks/UF250.1065.100/uf250-036.cnf --- a/benchmarks/UF250.1065.100/uf250-036.cnf +++ b/benchmarks/UF250.1065.100/uf250-036.cnf @@ -1071,6 +1071,3 @@ -139 -222 -183 0 -144 106 -107 0 175 154 -11 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-037.cnf b/benchmarks/UF250.1065.100/uf250-037.cnf --- a/benchmarks/UF250.1065.100/uf250-037.cnf +++ b/benchmarks/UF250.1065.100/uf250-037.cnf @@ -1071,6 +1071,3 @@ -183 77 -186 0 22 -69 -168 0 21 -95 -127 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-038.cnf b/benchmarks/UF250.1065.100/uf250-038.cnf --- a/benchmarks/UF250.1065.100/uf250-038.cnf +++ b/benchmarks/UF250.1065.100/uf250-038.cnf @@ -1071,6 +1071,3 @@ 157 -172 2 0 214 -230 120 0 -156 84 -40 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-039.cnf b/benchmarks/UF250.1065.100/uf250-039.cnf --- a/benchmarks/UF250.1065.100/uf250-039.cnf +++ b/benchmarks/UF250.1065.100/uf250-039.cnf @@ -1071,6 +1071,3 @@ 15 -189 -13 0 209 -199 78 0 195 -66 -84 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-04.cnf b/benchmarks/UF250.1065.100/uf250-04.cnf --- a/benchmarks/UF250.1065.100/uf250-04.cnf +++ b/benchmarks/UF250.1065.100/uf250-04.cnf @@ -1071,6 +1071,3 @@ -57 -223 13 0 181 70 -7 0 -232 69 186 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-040.cnf b/benchmarks/UF250.1065.100/uf250-040.cnf --- a/benchmarks/UF250.1065.100/uf250-040.cnf +++ b/benchmarks/UF250.1065.100/uf250-040.cnf @@ -1071,6 +1071,3 @@ 48 150 96 0 194 -105 -169 0 -34 -76 246 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-041.cnf b/benchmarks/UF250.1065.100/uf250-041.cnf --- a/benchmarks/UF250.1065.100/uf250-041.cnf +++ b/benchmarks/UF250.1065.100/uf250-041.cnf @@ -1071,6 +1071,3 @@ 220 -146 232 0 -127 39 -18 0 -107 11 86 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-042.cnf b/benchmarks/UF250.1065.100/uf250-042.cnf --- a/benchmarks/UF250.1065.100/uf250-042.cnf +++ b/benchmarks/UF250.1065.100/uf250-042.cnf @@ -1071,6 +1071,3 @@ 93 136 205 0 -94 171 -145 0 160 101 83 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-043.cnf b/benchmarks/UF250.1065.100/uf250-043.cnf --- a/benchmarks/UF250.1065.100/uf250-043.cnf +++ b/benchmarks/UF250.1065.100/uf250-043.cnf @@ -1071,6 +1071,3 @@ 207 6 227 0 217 98 101 0 132 -9 -157 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-044.cnf b/benchmarks/UF250.1065.100/uf250-044.cnf --- a/benchmarks/UF250.1065.100/uf250-044.cnf +++ b/benchmarks/UF250.1065.100/uf250-044.cnf @@ -1071,6 +1071,3 @@ 154 21 165 0 3 221 -85 0 -179 151 31 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-045.cnf b/benchmarks/UF250.1065.100/uf250-045.cnf --- a/benchmarks/UF250.1065.100/uf250-045.cnf +++ b/benchmarks/UF250.1065.100/uf250-045.cnf @@ -1071,6 +1071,3 @@ -216 52 172 0 74 224 37 0 62 73 17 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-046.cnf b/benchmarks/UF250.1065.100/uf250-046.cnf --- a/benchmarks/UF250.1065.100/uf250-046.cnf +++ b/benchmarks/UF250.1065.100/uf250-046.cnf @@ -1071,6 +1071,3 @@ -94 39 142 0 146 -27 -3 0 -71 -25 93 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-047.cnf b/benchmarks/UF250.1065.100/uf250-047.cnf --- a/benchmarks/UF250.1065.100/uf250-047.cnf +++ b/benchmarks/UF250.1065.100/uf250-047.cnf @@ -1071,6 +1071,3 @@ 46 193 -37 0 142 -15 -138 0 -161 -133 -62 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-048.cnf b/benchmarks/UF250.1065.100/uf250-048.cnf --- a/benchmarks/UF250.1065.100/uf250-048.cnf +++ b/benchmarks/UF250.1065.100/uf250-048.cnf @@ -1071,6 +1071,3 @@ -145 -160 -138 0 142 -133 100 0 135 61 -3 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-049.cnf b/benchmarks/UF250.1065.100/uf250-049.cnf --- a/benchmarks/UF250.1065.100/uf250-049.cnf +++ b/benchmarks/UF250.1065.100/uf250-049.cnf @@ -1071,6 +1071,3 @@ -50 -200 209 0 131 170 -3 0 -146 207 -147 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-05.cnf b/benchmarks/UF250.1065.100/uf250-05.cnf --- a/benchmarks/UF250.1065.100/uf250-05.cnf +++ b/benchmarks/UF250.1065.100/uf250-05.cnf @@ -1071,6 +1071,3 @@ -137 -139 -216 0 -128 107 47 0 184 -231 -169 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-050.cnf b/benchmarks/UF250.1065.100/uf250-050.cnf --- a/benchmarks/UF250.1065.100/uf250-050.cnf +++ b/benchmarks/UF250.1065.100/uf250-050.cnf @@ -1071,6 +1071,3 @@ -160 -43 -37 0 201 -200 28 0 -152 -185 -41 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-051.cnf b/benchmarks/UF250.1065.100/uf250-051.cnf --- a/benchmarks/UF250.1065.100/uf250-051.cnf +++ b/benchmarks/UF250.1065.100/uf250-051.cnf @@ -1071,6 +1071,3 @@ 207 -7 2 0 162 156 -24 0 106 -99 -32 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-052.cnf b/benchmarks/UF250.1065.100/uf250-052.cnf --- a/benchmarks/UF250.1065.100/uf250-052.cnf +++ b/benchmarks/UF250.1065.100/uf250-052.cnf @@ -1071,6 +1071,3 @@ 193 -197 -182 0 -115 -241 189 0 152 -86 206 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-053.cnf b/benchmarks/UF250.1065.100/uf250-053.cnf --- a/benchmarks/UF250.1065.100/uf250-053.cnf +++ b/benchmarks/UF250.1065.100/uf250-053.cnf @@ -1071,6 +1071,3 @@ -25 122 -80 0 137 57 -50 0 -233 220 -12 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-054.cnf b/benchmarks/UF250.1065.100/uf250-054.cnf --- a/benchmarks/UF250.1065.100/uf250-054.cnf +++ b/benchmarks/UF250.1065.100/uf250-054.cnf @@ -1071,6 +1071,3 @@ -198 -242 -117 0 140 -225 -227 0 42 -76 45 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-055.cnf b/benchmarks/UF250.1065.100/uf250-055.cnf --- a/benchmarks/UF250.1065.100/uf250-055.cnf +++ b/benchmarks/UF250.1065.100/uf250-055.cnf @@ -1071,6 +1071,3 @@ 185 -156 36 0 200 -109 -159 0 -35 249 -194 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-056.cnf b/benchmarks/UF250.1065.100/uf250-056.cnf --- a/benchmarks/UF250.1065.100/uf250-056.cnf +++ b/benchmarks/UF250.1065.100/uf250-056.cnf @@ -1071,6 +1071,3 @@ 187 -193 239 0 203 -143 -5 0 -27 131 -115 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-057.cnf b/benchmarks/UF250.1065.100/uf250-057.cnf --- a/benchmarks/UF250.1065.100/uf250-057.cnf +++ b/benchmarks/UF250.1065.100/uf250-057.cnf @@ -1071,6 +1071,3 @@ -219 -247 148 0 11 -59 151 0 -41 -21 36 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-058.cnf b/benchmarks/UF250.1065.100/uf250-058.cnf --- a/benchmarks/UF250.1065.100/uf250-058.cnf +++ b/benchmarks/UF250.1065.100/uf250-058.cnf @@ -1071,6 +1071,3 @@ -190 -228 -26 0 -13 -144 -76 0 -248 191 180 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-059.cnf b/benchmarks/UF250.1065.100/uf250-059.cnf --- a/benchmarks/UF250.1065.100/uf250-059.cnf +++ b/benchmarks/UF250.1065.100/uf250-059.cnf @@ -1071,6 +1071,3 @@ -66 10 67 0 -211 -136 -150 0 -30 -190 78 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-06.cnf b/benchmarks/UF250.1065.100/uf250-06.cnf --- a/benchmarks/UF250.1065.100/uf250-06.cnf +++ b/benchmarks/UF250.1065.100/uf250-06.cnf @@ -1071,6 +1071,3 @@ 76 -99 -30 0 212 70 177 0 -55 57 -250 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-060.cnf b/benchmarks/UF250.1065.100/uf250-060.cnf --- a/benchmarks/UF250.1065.100/uf250-060.cnf +++ b/benchmarks/UF250.1065.100/uf250-060.cnf @@ -1071,6 +1071,3 @@ 160 124 50 0 108 -200 -157 0 -82 -133 -2 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-061.cnf b/benchmarks/UF250.1065.100/uf250-061.cnf --- a/benchmarks/UF250.1065.100/uf250-061.cnf +++ b/benchmarks/UF250.1065.100/uf250-061.cnf @@ -1071,6 +1071,3 @@ -250 -157 -98 0 102 -143 -179 0 -48 -19 -132 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-062.cnf b/benchmarks/UF250.1065.100/uf250-062.cnf --- a/benchmarks/UF250.1065.100/uf250-062.cnf +++ b/benchmarks/UF250.1065.100/uf250-062.cnf @@ -1071,6 +1071,3 @@ 154 188 65 0 174 -100 -213 0 -131 77 26 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-063.cnf b/benchmarks/UF250.1065.100/uf250-063.cnf --- a/benchmarks/UF250.1065.100/uf250-063.cnf +++ b/benchmarks/UF250.1065.100/uf250-063.cnf @@ -1071,6 +1071,3 @@ -121 245 105 0 152 188 76 0 -115 143 250 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-064.cnf b/benchmarks/UF250.1065.100/uf250-064.cnf --- a/benchmarks/UF250.1065.100/uf250-064.cnf +++ b/benchmarks/UF250.1065.100/uf250-064.cnf @@ -1071,6 +1071,3 @@ -160 95 15 0 -120 -214 -209 0 -107 -195 -93 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-065.cnf b/benchmarks/UF250.1065.100/uf250-065.cnf --- a/benchmarks/UF250.1065.100/uf250-065.cnf +++ b/benchmarks/UF250.1065.100/uf250-065.cnf @@ -1071,6 +1071,3 @@ 91 66 249 0 144 51 -127 0 214 3 -166 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-066.cnf b/benchmarks/UF250.1065.100/uf250-066.cnf --- a/benchmarks/UF250.1065.100/uf250-066.cnf +++ b/benchmarks/UF250.1065.100/uf250-066.cnf @@ -1071,6 +1071,3 @@ 48 93 -115 0 -49 4 120 0 176 -126 135 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-067.cnf b/benchmarks/UF250.1065.100/uf250-067.cnf --- a/benchmarks/UF250.1065.100/uf250-067.cnf +++ b/benchmarks/UF250.1065.100/uf250-067.cnf @@ -1071,6 +1071,3 @@ -108 -37 226 0 2 103 -83 0 208 82 -154 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-068.cnf b/benchmarks/UF250.1065.100/uf250-068.cnf --- a/benchmarks/UF250.1065.100/uf250-068.cnf +++ b/benchmarks/UF250.1065.100/uf250-068.cnf @@ -1071,6 +1071,3 @@ 227 -238 -94 0 111 211 -180 0 90 92 142 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-069.cnf b/benchmarks/UF250.1065.100/uf250-069.cnf --- a/benchmarks/UF250.1065.100/uf250-069.cnf +++ b/benchmarks/UF250.1065.100/uf250-069.cnf @@ -1071,6 +1071,3 @@ -44 235 -156 0 -22 -223 14 0 161 -205 -149 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-07.cnf b/benchmarks/UF250.1065.100/uf250-07.cnf --- a/benchmarks/UF250.1065.100/uf250-07.cnf +++ b/benchmarks/UF250.1065.100/uf250-07.cnf @@ -1071,6 +1071,3 @@ -14 -143 -62 0 169 198 250 0 -234 -157 10 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-070.cnf b/benchmarks/UF250.1065.100/uf250-070.cnf --- a/benchmarks/UF250.1065.100/uf250-070.cnf +++ b/benchmarks/UF250.1065.100/uf250-070.cnf @@ -1071,6 +1071,3 @@ -162 -83 -217 0 -226 177 120 0 160 200 -134 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-071.cnf b/benchmarks/UF250.1065.100/uf250-071.cnf --- a/benchmarks/UF250.1065.100/uf250-071.cnf +++ b/benchmarks/UF250.1065.100/uf250-071.cnf @@ -1071,6 +1071,3 @@ 136 -195 -202 0 32 -220 -16 0 -210 180 -12 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-072.cnf b/benchmarks/UF250.1065.100/uf250-072.cnf --- a/benchmarks/UF250.1065.100/uf250-072.cnf +++ b/benchmarks/UF250.1065.100/uf250-072.cnf @@ -1071,6 +1071,3 @@ 44 109 -55 0 -145 -68 171 0 43 -239 -120 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-073.cnf b/benchmarks/UF250.1065.100/uf250-073.cnf --- a/benchmarks/UF250.1065.100/uf250-073.cnf +++ b/benchmarks/UF250.1065.100/uf250-073.cnf @@ -1071,6 +1071,3 @@ -232 -84 -171 0 -198 -250 83 0 218 -238 -157 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-074.cnf b/benchmarks/UF250.1065.100/uf250-074.cnf --- a/benchmarks/UF250.1065.100/uf250-074.cnf +++ b/benchmarks/UF250.1065.100/uf250-074.cnf @@ -1071,6 +1071,3 @@ -141 173 123 0 -68 -229 221 0 -128 225 -219 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-075.cnf b/benchmarks/UF250.1065.100/uf250-075.cnf --- a/benchmarks/UF250.1065.100/uf250-075.cnf +++ b/benchmarks/UF250.1065.100/uf250-075.cnf @@ -1071,6 +1071,3 @@ 177 -120 -137 0 155 -249 -128 0 -186 154 -165 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-076.cnf b/benchmarks/UF250.1065.100/uf250-076.cnf --- a/benchmarks/UF250.1065.100/uf250-076.cnf +++ b/benchmarks/UF250.1065.100/uf250-076.cnf @@ -1071,6 +1071,3 @@ 250 123 -151 0 -80 -90 -135 0 215 -83 200 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-077.cnf b/benchmarks/UF250.1065.100/uf250-077.cnf --- a/benchmarks/UF250.1065.100/uf250-077.cnf +++ b/benchmarks/UF250.1065.100/uf250-077.cnf @@ -1071,6 +1071,3 @@ -13 -34 -25 0 198 55 -8 0 -149 -152 -27 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-078.cnf b/benchmarks/UF250.1065.100/uf250-078.cnf --- a/benchmarks/UF250.1065.100/uf250-078.cnf +++ b/benchmarks/UF250.1065.100/uf250-078.cnf @@ -1071,6 +1071,3 @@ 118 -82 -168 0 8 93 -154 0 130 -220 -159 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-079.cnf b/benchmarks/UF250.1065.100/uf250-079.cnf --- a/benchmarks/UF250.1065.100/uf250-079.cnf +++ b/benchmarks/UF250.1065.100/uf250-079.cnf @@ -1071,6 +1071,3 @@ -166 95 73 0 -154 213 -2 0 -203 -137 230 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-08.cnf b/benchmarks/UF250.1065.100/uf250-08.cnf --- a/benchmarks/UF250.1065.100/uf250-08.cnf +++ b/benchmarks/UF250.1065.100/uf250-08.cnf @@ -1071,6 +1071,3 @@ 67 -10 23 0 -122 134 -167 0 75 185 -193 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-080.cnf b/benchmarks/UF250.1065.100/uf250-080.cnf --- a/benchmarks/UF250.1065.100/uf250-080.cnf +++ b/benchmarks/UF250.1065.100/uf250-080.cnf @@ -1071,6 +1071,3 @@ 149 -59 118 0 -136 -96 229 0 164 -69 -107 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-081.cnf b/benchmarks/UF250.1065.100/uf250-081.cnf --- a/benchmarks/UF250.1065.100/uf250-081.cnf +++ b/benchmarks/UF250.1065.100/uf250-081.cnf @@ -1071,6 +1071,3 @@ -241 58 168 0 113 122 178 0 185 -245 85 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-082.cnf b/benchmarks/UF250.1065.100/uf250-082.cnf --- a/benchmarks/UF250.1065.100/uf250-082.cnf +++ b/benchmarks/UF250.1065.100/uf250-082.cnf @@ -1071,6 +1071,3 @@ 160 -158 -216 0 44 -34 -247 0 -16 36 139 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-083.cnf b/benchmarks/UF250.1065.100/uf250-083.cnf --- a/benchmarks/UF250.1065.100/uf250-083.cnf +++ b/benchmarks/UF250.1065.100/uf250-083.cnf @@ -1071,6 +1071,3 @@ -133 -119 86 0 -10 -191 -103 0 -154 250 -219 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-084.cnf b/benchmarks/UF250.1065.100/uf250-084.cnf --- a/benchmarks/UF250.1065.100/uf250-084.cnf +++ b/benchmarks/UF250.1065.100/uf250-084.cnf @@ -1071,6 +1071,3 @@ 39 -248 -209 0 -115 -90 125 0 174 -90 51 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-085.cnf b/benchmarks/UF250.1065.100/uf250-085.cnf --- a/benchmarks/UF250.1065.100/uf250-085.cnf +++ b/benchmarks/UF250.1065.100/uf250-085.cnf @@ -1071,6 +1071,3 @@ -226 -68 110 0 15 -169 -241 0 142 -124 -215 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-086.cnf b/benchmarks/UF250.1065.100/uf250-086.cnf --- a/benchmarks/UF250.1065.100/uf250-086.cnf +++ b/benchmarks/UF250.1065.100/uf250-086.cnf @@ -1071,6 +1071,3 @@ 179 147 209 0 124 -132 -241 0 -239 -163 -247 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-087.cnf b/benchmarks/UF250.1065.100/uf250-087.cnf --- a/benchmarks/UF250.1065.100/uf250-087.cnf +++ b/benchmarks/UF250.1065.100/uf250-087.cnf @@ -1071,6 +1071,3 @@ 113 31 100 0 1 -228 61 0 197 -28 152 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-088.cnf b/benchmarks/UF250.1065.100/uf250-088.cnf --- a/benchmarks/UF250.1065.100/uf250-088.cnf +++ b/benchmarks/UF250.1065.100/uf250-088.cnf @@ -1071,6 +1071,3 @@ -129 -163 -98 0 -164 -222 49 0 235 -8 195 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-089.cnf b/benchmarks/UF250.1065.100/uf250-089.cnf --- a/benchmarks/UF250.1065.100/uf250-089.cnf +++ b/benchmarks/UF250.1065.100/uf250-089.cnf @@ -1071,6 +1071,3 @@ -103 84 170 0 -109 -86 93 0 110 76 -102 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-09.cnf b/benchmarks/UF250.1065.100/uf250-09.cnf --- a/benchmarks/UF250.1065.100/uf250-09.cnf +++ b/benchmarks/UF250.1065.100/uf250-09.cnf @@ -1071,6 +1071,3 @@ -166 -103 -249 0 166 -36 208 0 144 -137 174 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-090.cnf b/benchmarks/UF250.1065.100/uf250-090.cnf --- a/benchmarks/UF250.1065.100/uf250-090.cnf +++ b/benchmarks/UF250.1065.100/uf250-090.cnf @@ -1071,6 +1071,3 @@ -105 -159 -180 0 -150 244 179 0 192 -16 -154 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-091.cnf b/benchmarks/UF250.1065.100/uf250-091.cnf --- a/benchmarks/UF250.1065.100/uf250-091.cnf +++ b/benchmarks/UF250.1065.100/uf250-091.cnf @@ -1071,6 +1071,3 @@ -202 183 -195 0 -12 -172 -67 0 -108 57 240 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-092.cnf b/benchmarks/UF250.1065.100/uf250-092.cnf --- a/benchmarks/UF250.1065.100/uf250-092.cnf +++ b/benchmarks/UF250.1065.100/uf250-092.cnf @@ -1071,6 +1071,3 @@ -99 75 -160 0 -99 108 53 0 238 92 -53 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-093.cnf b/benchmarks/UF250.1065.100/uf250-093.cnf --- a/benchmarks/UF250.1065.100/uf250-093.cnf +++ b/benchmarks/UF250.1065.100/uf250-093.cnf @@ -1071,6 +1071,3 @@ 2 -6 48 0 198 181 244 0 241 9 146 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-094.cnf b/benchmarks/UF250.1065.100/uf250-094.cnf --- a/benchmarks/UF250.1065.100/uf250-094.cnf +++ b/benchmarks/UF250.1065.100/uf250-094.cnf @@ -1071,6 +1071,3 @@ -247 -88 176 0 233 -205 -132 0 -71 248 -127 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-095.cnf b/benchmarks/UF250.1065.100/uf250-095.cnf --- a/benchmarks/UF250.1065.100/uf250-095.cnf +++ b/benchmarks/UF250.1065.100/uf250-095.cnf @@ -1071,6 +1071,3 @@ -211 -233 -30 0 37 4 -125 0 47 109 -151 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-096.cnf b/benchmarks/UF250.1065.100/uf250-096.cnf --- a/benchmarks/UF250.1065.100/uf250-096.cnf +++ b/benchmarks/UF250.1065.100/uf250-096.cnf @@ -1071,6 +1071,3 @@ -51 -208 156 0 137 -43 126 0 -1 250 22 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-097.cnf b/benchmarks/UF250.1065.100/uf250-097.cnf --- a/benchmarks/UF250.1065.100/uf250-097.cnf +++ b/benchmarks/UF250.1065.100/uf250-097.cnf @@ -1071,6 +1071,3 @@ -210 -167 -181 0 -52 -173 -60 0 -43 29 235 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-098.cnf b/benchmarks/UF250.1065.100/uf250-098.cnf --- a/benchmarks/UF250.1065.100/uf250-098.cnf +++ b/benchmarks/UF250.1065.100/uf250-098.cnf @@ -1071,6 +1071,3 @@ -95 109 -150 0 -196 -8 16 0 51 -15 91 0 -% -0 - diff --git a/benchmarks/UF250.1065.100/uf250-099.cnf b/benchmarks/UF250.1065.100/uf250-099.cnf --- a/benchmarks/UF250.1065.100/uf250-099.cnf +++ b/benchmarks/UF250.1065.100/uf250-099.cnf @@ -1071,6 +1071,3 @@ -24 -144 9 0 137 -120 -228 0 -24 -117 158 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-01.cnf b/benchmarks/UUF250.1065.100/uuf250-01.cnf --- a/benchmarks/UUF250.1065.100/uuf250-01.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-01.cnf @@ -1071,6 +1071,3 @@ -206 107 -223 0 -159 -243 -13 0 118 -9 57 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-010.cnf b/benchmarks/UUF250.1065.100/uuf250-010.cnf --- a/benchmarks/UUF250.1065.100/uuf250-010.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-010.cnf @@ -1071,6 +1071,3 @@ 207 128 -96 0 -17 92 -195 0 -198 -228 -247 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-0100.cnf b/benchmarks/UUF250.1065.100/uuf250-0100.cnf --- a/benchmarks/UUF250.1065.100/uuf250-0100.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-0100.cnf @@ -1071,6 +1071,3 @@ 119 41 -152 0 -99 -187 -14 0 -207 -121 171 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-011.cnf b/benchmarks/UUF250.1065.100/uuf250-011.cnf --- a/benchmarks/UUF250.1065.100/uuf250-011.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-011.cnf @@ -1071,6 +1071,3 @@ 208 75 64 0 -171 163 207 0 -76 19 158 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-012.cnf b/benchmarks/UUF250.1065.100/uuf250-012.cnf --- a/benchmarks/UUF250.1065.100/uuf250-012.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-012.cnf @@ -1071,6 +1071,3 @@ 138 -111 201 0 -53 25 -175 0 115 230 -97 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-013.cnf b/benchmarks/UUF250.1065.100/uuf250-013.cnf --- a/benchmarks/UUF250.1065.100/uuf250-013.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-013.cnf @@ -1071,6 +1071,3 @@ -45 -64 56 0 9 220 150 0 149 32 -74 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-014.cnf b/benchmarks/UUF250.1065.100/uuf250-014.cnf --- a/benchmarks/UUF250.1065.100/uuf250-014.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-014.cnf @@ -1071,6 +1071,3 @@ -172 -98 139 0 48 83 -97 0 -8 239 -61 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-015.cnf b/benchmarks/UUF250.1065.100/uuf250-015.cnf --- a/benchmarks/UUF250.1065.100/uuf250-015.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-015.cnf @@ -1071,6 +1071,3 @@ 51 63 187 0 239 210 243 0 -30 -198 -169 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-016.cnf b/benchmarks/UUF250.1065.100/uuf250-016.cnf --- a/benchmarks/UUF250.1065.100/uuf250-016.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-016.cnf @@ -1071,6 +1071,3 @@ 49 -213 -32 0 -222 -4 -28 0 -106 -165 56 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-017.cnf b/benchmarks/UUF250.1065.100/uuf250-017.cnf --- a/benchmarks/UUF250.1065.100/uuf250-017.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-017.cnf @@ -1071,6 +1071,3 @@ 21 61 77 0 219 55 -237 0 61 -248 1 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-018.cnf b/benchmarks/UUF250.1065.100/uuf250-018.cnf --- a/benchmarks/UUF250.1065.100/uuf250-018.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-018.cnf @@ -1071,6 +1071,3 @@ -240 237 69 0 95 209 157 0 146 -149 224 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-019.cnf b/benchmarks/UUF250.1065.100/uuf250-019.cnf --- a/benchmarks/UUF250.1065.100/uuf250-019.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-019.cnf @@ -1071,6 +1071,3 @@ -140 -97 99 0 -73 23 -77 0 -96 4 -6 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-02.cnf b/benchmarks/UUF250.1065.100/uuf250-02.cnf --- a/benchmarks/UUF250.1065.100/uuf250-02.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-02.cnf @@ -1071,6 +1071,3 @@ 51 53 198 0 -94 13 -217 0 -211 188 -43 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-020.cnf b/benchmarks/UUF250.1065.100/uuf250-020.cnf --- a/benchmarks/UUF250.1065.100/uuf250-020.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-020.cnf @@ -1071,6 +1071,3 @@ -228 74 165 0 195 -7 74 0 129 190 76 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-021.cnf b/benchmarks/UUF250.1065.100/uuf250-021.cnf --- a/benchmarks/UUF250.1065.100/uuf250-021.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-021.cnf @@ -1071,6 +1071,3 @@ -200 195 -214 0 -230 -184 -113 0 -248 -58 -125 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-022.cnf b/benchmarks/UUF250.1065.100/uuf250-022.cnf --- a/benchmarks/UUF250.1065.100/uuf250-022.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-022.cnf @@ -1071,6 +1071,3 @@ 126 -144 164 0 -79 114 116 0 -62 -55 84 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-023.cnf b/benchmarks/UUF250.1065.100/uuf250-023.cnf --- a/benchmarks/UUF250.1065.100/uuf250-023.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-023.cnf @@ -1071,6 +1071,3 @@ -34 -122 129 0 126 21 171 0 4 11 -83 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-024.cnf b/benchmarks/UUF250.1065.100/uuf250-024.cnf --- a/benchmarks/UUF250.1065.100/uuf250-024.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-024.cnf @@ -1071,6 +1071,3 @@ -127 -38 194 0 -246 -66 128 0 -195 -175 -33 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-025.cnf b/benchmarks/UUF250.1065.100/uuf250-025.cnf --- a/benchmarks/UUF250.1065.100/uuf250-025.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-025.cnf @@ -1071,6 +1071,3 @@ 230 -161 5 0 -210 123 118 0 156 25 -115 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-026.cnf b/benchmarks/UUF250.1065.100/uuf250-026.cnf --- a/benchmarks/UUF250.1065.100/uuf250-026.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-026.cnf @@ -1071,6 +1071,3 @@ -93 -133 43 0 85 -152 -57 0 89 7 230 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-027.cnf b/benchmarks/UUF250.1065.100/uuf250-027.cnf --- a/benchmarks/UUF250.1065.100/uuf250-027.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-027.cnf @@ -1071,6 +1071,3 @@ -2 -236 -116 0 241 156 55 0 -99 59 190 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-028.cnf b/benchmarks/UUF250.1065.100/uuf250-028.cnf --- a/benchmarks/UUF250.1065.100/uuf250-028.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-028.cnf @@ -1071,6 +1071,3 @@ 48 231 -178 0 138 -58 42 0 -45 -62 -54 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-029.cnf b/benchmarks/UUF250.1065.100/uuf250-029.cnf --- a/benchmarks/UUF250.1065.100/uuf250-029.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-029.cnf @@ -1071,6 +1071,3 @@ -170 250 -47 0 208 -245 106 0 -225 91 98 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-03.cnf b/benchmarks/UUF250.1065.100/uuf250-03.cnf --- a/benchmarks/UUF250.1065.100/uuf250-03.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-03.cnf @@ -1071,6 +1071,3 @@ -216 45 -179 0 -30 -236 -59 0 244 -124 -189 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-030.cnf b/benchmarks/UUF250.1065.100/uuf250-030.cnf --- a/benchmarks/UUF250.1065.100/uuf250-030.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-030.cnf @@ -1071,6 +1071,3 @@ -81 -124 -207 0 131 -27 -39 0 37 113 -245 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-031.cnf b/benchmarks/UUF250.1065.100/uuf250-031.cnf --- a/benchmarks/UUF250.1065.100/uuf250-031.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-031.cnf @@ -1071,6 +1071,3 @@ 70 -180 -238 0 172 -231 -87 0 -42 -85 -54 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-032.cnf b/benchmarks/UUF250.1065.100/uuf250-032.cnf --- a/benchmarks/UUF250.1065.100/uuf250-032.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-032.cnf @@ -1071,6 +1071,3 @@ -166 -151 243 0 106 -84 -140 0 -246 144 -24 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-033.cnf b/benchmarks/UUF250.1065.100/uuf250-033.cnf --- a/benchmarks/UUF250.1065.100/uuf250-033.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-033.cnf @@ -1071,6 +1071,3 @@ 131 -80 244 0 114 -215 153 0 -42 -54 -55 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-034.cnf b/benchmarks/UUF250.1065.100/uuf250-034.cnf --- a/benchmarks/UUF250.1065.100/uuf250-034.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-034.cnf @@ -1071,6 +1071,3 @@ -47 38 223 0 -215 207 -196 0 -23 56 -167 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-035.cnf b/benchmarks/UUF250.1065.100/uuf250-035.cnf --- a/benchmarks/UUF250.1065.100/uuf250-035.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-035.cnf @@ -1071,6 +1071,3 @@ -51 22 -17 0 -208 96 -215 0 -10 7 125 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-036.cnf b/benchmarks/UUF250.1065.100/uuf250-036.cnf --- a/benchmarks/UUF250.1065.100/uuf250-036.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-036.cnf @@ -1071,6 +1071,3 @@ 152 13 -34 0 86 -184 -99 0 142 149 226 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-037.cnf b/benchmarks/UUF250.1065.100/uuf250-037.cnf --- a/benchmarks/UUF250.1065.100/uuf250-037.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-037.cnf @@ -1071,6 +1071,3 @@ 79 -106 -8 0 -93 -21 232 0 45 13 -30 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-038.cnf b/benchmarks/UUF250.1065.100/uuf250-038.cnf --- a/benchmarks/UUF250.1065.100/uuf250-038.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-038.cnf @@ -1071,6 +1071,3 @@ -74 -200 -39 0 134 -198 88 0 232 211 214 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-039.cnf b/benchmarks/UUF250.1065.100/uuf250-039.cnf --- a/benchmarks/UUF250.1065.100/uuf250-039.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-039.cnf @@ -1071,6 +1071,3 @@ -19 -208 164 0 246 -225 241 0 -159 40 -227 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-04.cnf b/benchmarks/UUF250.1065.100/uuf250-04.cnf --- a/benchmarks/UUF250.1065.100/uuf250-04.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-04.cnf @@ -1071,6 +1071,3 @@ 77 -158 170 0 -157 28 6 0 137 116 118 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-040.cnf b/benchmarks/UUF250.1065.100/uuf250-040.cnf --- a/benchmarks/UUF250.1065.100/uuf250-040.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-040.cnf @@ -1071,6 +1071,3 @@ -131 46 -87 0 27 -39 143 0 -93 6 -247 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-041.cnf b/benchmarks/UUF250.1065.100/uuf250-041.cnf --- a/benchmarks/UUF250.1065.100/uuf250-041.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-041.cnf @@ -1071,6 +1071,3 @@ 228 -144 66 0 150 227 66 0 135 61 47 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-042.cnf b/benchmarks/UUF250.1065.100/uuf250-042.cnf --- a/benchmarks/UUF250.1065.100/uuf250-042.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-042.cnf @@ -1071,6 +1071,3 @@ -8 49 237 0 -118 -103 -39 0 26 23 -231 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-043.cnf b/benchmarks/UUF250.1065.100/uuf250-043.cnf --- a/benchmarks/UUF250.1065.100/uuf250-043.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-043.cnf @@ -1071,6 +1071,3 @@ 219 85 31 0 -176 139 -28 0 27 74 -72 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-044.cnf b/benchmarks/UUF250.1065.100/uuf250-044.cnf --- a/benchmarks/UUF250.1065.100/uuf250-044.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-044.cnf @@ -1071,6 +1071,3 @@ -88 136 19 0 -10 -170 58 0 16 113 -146 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-045.cnf b/benchmarks/UUF250.1065.100/uuf250-045.cnf --- a/benchmarks/UUF250.1065.100/uuf250-045.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-045.cnf @@ -1071,6 +1071,3 @@ -61 234 193 0 -5 -115 99 0 217 193 7 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-046.cnf b/benchmarks/UUF250.1065.100/uuf250-046.cnf --- a/benchmarks/UUF250.1065.100/uuf250-046.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-046.cnf @@ -1071,6 +1071,3 @@ -176 84 -64 0 -105 -39 -227 0 -149 141 -246 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-047.cnf b/benchmarks/UUF250.1065.100/uuf250-047.cnf --- a/benchmarks/UUF250.1065.100/uuf250-047.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-047.cnf @@ -1071,6 +1071,3 @@ -25 7 215 0 10 230 -138 0 154 -176 188 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-048.cnf b/benchmarks/UUF250.1065.100/uuf250-048.cnf --- a/benchmarks/UUF250.1065.100/uuf250-048.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-048.cnf @@ -1071,6 +1071,3 @@ -138 -237 81 0 -27 -199 121 0 -248 -65 156 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-049.cnf b/benchmarks/UUF250.1065.100/uuf250-049.cnf --- a/benchmarks/UUF250.1065.100/uuf250-049.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-049.cnf @@ -1071,6 +1071,3 @@ 61 -60 -106 0 -38 86 62 0 -145 107 228 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-05.cnf b/benchmarks/UUF250.1065.100/uuf250-05.cnf --- a/benchmarks/UUF250.1065.100/uuf250-05.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-05.cnf @@ -1071,6 +1071,3 @@ 168 -3 175 0 1 -233 -51 0 -185 196 145 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-050.cnf b/benchmarks/UUF250.1065.100/uuf250-050.cnf --- a/benchmarks/UUF250.1065.100/uuf250-050.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-050.cnf @@ -1071,6 +1071,3 @@ 69 -171 -109 0 223 247 -196 0 56 145 -167 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-051.cnf b/benchmarks/UUF250.1065.100/uuf250-051.cnf --- a/benchmarks/UUF250.1065.100/uuf250-051.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-051.cnf @@ -1071,6 +1071,3 @@ 235 -132 133 0 -138 144 -109 0 192 138 179 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-052.cnf b/benchmarks/UUF250.1065.100/uuf250-052.cnf --- a/benchmarks/UUF250.1065.100/uuf250-052.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-052.cnf @@ -1071,6 +1071,3 @@ -217 239 47 0 -175 68 34 0 -16 195 65 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-053.cnf b/benchmarks/UUF250.1065.100/uuf250-053.cnf --- a/benchmarks/UUF250.1065.100/uuf250-053.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-053.cnf @@ -1071,6 +1071,3 @@ -46 247 -15 0 213 -82 -189 0 -17 -148 -86 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-054.cnf b/benchmarks/UUF250.1065.100/uuf250-054.cnf --- a/benchmarks/UUF250.1065.100/uuf250-054.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-054.cnf @@ -1071,6 +1071,3 @@ 66 -170 -70 0 -98 169 141 0 181 190 -103 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-055.cnf b/benchmarks/UUF250.1065.100/uuf250-055.cnf --- a/benchmarks/UUF250.1065.100/uuf250-055.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-055.cnf @@ -1071,6 +1071,3 @@ 201 -93 -215 0 185 -195 107 0 86 69 -143 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-056.cnf b/benchmarks/UUF250.1065.100/uuf250-056.cnf --- a/benchmarks/UUF250.1065.100/uuf250-056.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-056.cnf @@ -1071,6 +1071,3 @@ -123 -124 48 0 139 86 171 0 27 177 -108 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-057.cnf b/benchmarks/UUF250.1065.100/uuf250-057.cnf --- a/benchmarks/UUF250.1065.100/uuf250-057.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-057.cnf @@ -1071,6 +1071,3 @@ -93 161 201 0 -141 -186 1 0 -132 -156 101 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-058.cnf b/benchmarks/UUF250.1065.100/uuf250-058.cnf --- a/benchmarks/UUF250.1065.100/uuf250-058.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-058.cnf @@ -1071,6 +1071,3 @@ 136 77 167 0 75 -117 24 0 -146 -184 -70 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-059.cnf b/benchmarks/UUF250.1065.100/uuf250-059.cnf --- a/benchmarks/UUF250.1065.100/uuf250-059.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-059.cnf @@ -1071,6 +1071,3 @@ 73 -194 134 0 89 -75 81 0 -195 -95 232 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-06.cnf b/benchmarks/UUF250.1065.100/uuf250-06.cnf --- a/benchmarks/UUF250.1065.100/uuf250-06.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-06.cnf @@ -1071,6 +1071,3 @@ -223 -4 152 0 147 173 181 0 -176 150 54 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-060.cnf b/benchmarks/UUF250.1065.100/uuf250-060.cnf --- a/benchmarks/UUF250.1065.100/uuf250-060.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-060.cnf @@ -1071,6 +1071,3 @@ 10 -219 -211 0 208 216 -91 0 127 99 34 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-061.cnf b/benchmarks/UUF250.1065.100/uuf250-061.cnf --- a/benchmarks/UUF250.1065.100/uuf250-061.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-061.cnf @@ -1071,6 +1071,3 @@ 147 160 -115 0 141 -76 101 0 -117 30 212 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-062.cnf b/benchmarks/UUF250.1065.100/uuf250-062.cnf --- a/benchmarks/UUF250.1065.100/uuf250-062.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-062.cnf @@ -1071,6 +1071,3 @@ -124 5 229 0 -86 -136 -131 0 -241 -47 -19 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-063.cnf b/benchmarks/UUF250.1065.100/uuf250-063.cnf --- a/benchmarks/UUF250.1065.100/uuf250-063.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-063.cnf @@ -1071,6 +1071,3 @@ 138 224 23 0 230 -178 116 0 119 116 223 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-064.cnf b/benchmarks/UUF250.1065.100/uuf250-064.cnf --- a/benchmarks/UUF250.1065.100/uuf250-064.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-064.cnf @@ -1071,6 +1071,3 @@ -168 -183 -173 0 119 -102 3 0 214 -98 34 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-065.cnf b/benchmarks/UUF250.1065.100/uuf250-065.cnf --- a/benchmarks/UUF250.1065.100/uuf250-065.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-065.cnf @@ -1071,6 +1071,3 @@ -18 47 -148 0 -13 -91 -54 0 -175 -12 -90 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-066.cnf b/benchmarks/UUF250.1065.100/uuf250-066.cnf --- a/benchmarks/UUF250.1065.100/uuf250-066.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-066.cnf @@ -1071,6 +1071,3 @@ 80 180 15 0 187 -185 -27 0 31 45 -29 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-067.cnf b/benchmarks/UUF250.1065.100/uuf250-067.cnf --- a/benchmarks/UUF250.1065.100/uuf250-067.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-067.cnf @@ -1071,6 +1071,3 @@ 249 11 -93 0 -10 203 85 0 -239 -21 -214 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-068.cnf b/benchmarks/UUF250.1065.100/uuf250-068.cnf --- a/benchmarks/UUF250.1065.100/uuf250-068.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-068.cnf @@ -1071,6 +1071,3 @@ -231 -185 -109 0 17 -80 -236 0 -88 -163 -71 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-069.cnf b/benchmarks/UUF250.1065.100/uuf250-069.cnf --- a/benchmarks/UUF250.1065.100/uuf250-069.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-069.cnf @@ -1071,6 +1071,3 @@ -151 30 -111 0 35 15 -92 0 134 -228 -186 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-07.cnf b/benchmarks/UUF250.1065.100/uuf250-07.cnf --- a/benchmarks/UUF250.1065.100/uuf250-07.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-07.cnf @@ -1071,6 +1071,3 @@ -91 10 173 0 161 191 210 0 -141 243 218 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-070.cnf b/benchmarks/UUF250.1065.100/uuf250-070.cnf --- a/benchmarks/UUF250.1065.100/uuf250-070.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-070.cnf @@ -1071,6 +1071,3 @@ -68 28 -147 0 33 -179 -164 0 -148 -132 -154 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-071.cnf b/benchmarks/UUF250.1065.100/uuf250-071.cnf --- a/benchmarks/UUF250.1065.100/uuf250-071.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-071.cnf @@ -1071,6 +1071,3 @@ -145 155 233 0 -202 31 -144 0 53 42 -165 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-072.cnf b/benchmarks/UUF250.1065.100/uuf250-072.cnf --- a/benchmarks/UUF250.1065.100/uuf250-072.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-072.cnf @@ -1071,6 +1071,3 @@ -107 -38 -211 0 129 211 -47 0 -23 120 -196 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-073.cnf b/benchmarks/UUF250.1065.100/uuf250-073.cnf --- a/benchmarks/UUF250.1065.100/uuf250-073.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-073.cnf @@ -1071,6 +1071,3 @@ 53 -25 -183 0 242 -16 -223 0 -171 241 127 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-074.cnf b/benchmarks/UUF250.1065.100/uuf250-074.cnf --- a/benchmarks/UUF250.1065.100/uuf250-074.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-074.cnf @@ -1071,6 +1071,3 @@ 46 -24 176 0 -217 130 -154 0 68 -118 -64 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-075.cnf b/benchmarks/UUF250.1065.100/uuf250-075.cnf --- a/benchmarks/UUF250.1065.100/uuf250-075.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-075.cnf @@ -1071,6 +1071,3 @@ -176 -83 67 0 102 -13 -3 0 92 119 -70 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-076.cnf b/benchmarks/UUF250.1065.100/uuf250-076.cnf --- a/benchmarks/UUF250.1065.100/uuf250-076.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-076.cnf @@ -1071,6 +1071,3 @@ -15 38 -187 0 -201 -245 -59 0 -173 -42 38 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-077.cnf b/benchmarks/UUF250.1065.100/uuf250-077.cnf --- a/benchmarks/UUF250.1065.100/uuf250-077.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-077.cnf @@ -1071,6 +1071,3 @@ -20 104 246 0 94 79 136 0 -88 -37 -173 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-078.cnf b/benchmarks/UUF250.1065.100/uuf250-078.cnf --- a/benchmarks/UUF250.1065.100/uuf250-078.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-078.cnf @@ -1071,6 +1071,3 @@ -193 -199 -220 0 -186 184 -178 0 -105 -72 -247 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-079.cnf b/benchmarks/UUF250.1065.100/uuf250-079.cnf --- a/benchmarks/UUF250.1065.100/uuf250-079.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-079.cnf @@ -1071,6 +1071,3 @@ 196 132 -91 0 -76 52 -178 0 191 -77 227 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-08.cnf b/benchmarks/UUF250.1065.100/uuf250-08.cnf --- a/benchmarks/UUF250.1065.100/uuf250-08.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-08.cnf @@ -1071,6 +1071,3 @@ -17 -194 -202 0 -233 -70 -176 0 126 92 -57 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-080.cnf b/benchmarks/UUF250.1065.100/uuf250-080.cnf --- a/benchmarks/UUF250.1065.100/uuf250-080.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-080.cnf @@ -1071,6 +1071,3 @@ 9 -171 -192 0 -100 -234 163 0 213 162 -118 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-081.cnf b/benchmarks/UUF250.1065.100/uuf250-081.cnf --- a/benchmarks/UUF250.1065.100/uuf250-081.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-081.cnf @@ -1071,6 +1071,3 @@ -75 -231 -2 0 98 -197 189 0 -32 155 246 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-082.cnf b/benchmarks/UUF250.1065.100/uuf250-082.cnf --- a/benchmarks/UUF250.1065.100/uuf250-082.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-082.cnf @@ -1071,6 +1071,3 @@ -85 76 -241 0 171 216 71 0 228 -2 -15 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-083.cnf b/benchmarks/UUF250.1065.100/uuf250-083.cnf --- a/benchmarks/UUF250.1065.100/uuf250-083.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-083.cnf @@ -1071,6 +1071,3 @@ -151 126 -192 0 -171 -49 11 0 -60 -248 195 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-084.cnf b/benchmarks/UUF250.1065.100/uuf250-084.cnf --- a/benchmarks/UUF250.1065.100/uuf250-084.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-084.cnf @@ -1071,6 +1071,3 @@ -79 -11 172 0 -30 67 37 0 -131 36 110 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-085.cnf b/benchmarks/UUF250.1065.100/uuf250-085.cnf --- a/benchmarks/UUF250.1065.100/uuf250-085.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-085.cnf @@ -1071,6 +1071,3 @@ 150 -187 -52 0 205 52 -155 0 -250 51 -105 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-086.cnf b/benchmarks/UUF250.1065.100/uuf250-086.cnf --- a/benchmarks/UUF250.1065.100/uuf250-086.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-086.cnf @@ -1071,6 +1071,3 @@ 161 -89 -229 0 127 232 212 0 -126 -151 161 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-087.cnf b/benchmarks/UUF250.1065.100/uuf250-087.cnf --- a/benchmarks/UUF250.1065.100/uuf250-087.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-087.cnf @@ -1071,6 +1071,3 @@ -223 -141 -154 0 -8 -54 242 0 -31 161 99 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-088.cnf b/benchmarks/UUF250.1065.100/uuf250-088.cnf --- a/benchmarks/UUF250.1065.100/uuf250-088.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-088.cnf @@ -1071,6 +1071,3 @@ 13 -221 -72 0 -85 175 -48 0 -77 44 217 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-089.cnf b/benchmarks/UUF250.1065.100/uuf250-089.cnf --- a/benchmarks/UUF250.1065.100/uuf250-089.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-089.cnf @@ -1071,6 +1071,3 @@ -99 195 -168 0 201 -153 -197 0 -57 -39 -125 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-09.cnf b/benchmarks/UUF250.1065.100/uuf250-09.cnf --- a/benchmarks/UUF250.1065.100/uuf250-09.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-09.cnf @@ -1071,6 +1071,3 @@ -10 210 238 0 215 124 -100 0 -48 224 141 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-090.cnf b/benchmarks/UUF250.1065.100/uuf250-090.cnf --- a/benchmarks/UUF250.1065.100/uuf250-090.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-090.cnf @@ -1071,6 +1071,3 @@ -59 -218 231 0 112 8 -102 0 100 235 -126 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-091.cnf b/benchmarks/UUF250.1065.100/uuf250-091.cnf --- a/benchmarks/UUF250.1065.100/uuf250-091.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-091.cnf @@ -1071,6 +1071,3 @@ 198 -13 203 0 3 -42 -170 0 -124 47 16 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-092.cnf b/benchmarks/UUF250.1065.100/uuf250-092.cnf --- a/benchmarks/UUF250.1065.100/uuf250-092.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-092.cnf @@ -1071,6 +1071,3 @@ -94 25 182 0 2 -120 -134 0 239 69 -190 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-093.cnf b/benchmarks/UUF250.1065.100/uuf250-093.cnf --- a/benchmarks/UUF250.1065.100/uuf250-093.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-093.cnf @@ -1071,6 +1071,3 @@ -66 -65 -178 0 198 228 151 0 -233 -162 -189 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-094.cnf b/benchmarks/UUF250.1065.100/uuf250-094.cnf --- a/benchmarks/UUF250.1065.100/uuf250-094.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-094.cnf @@ -1071,6 +1071,3 @@ 215 199 -237 0 -112 239 155 0 -105 -94 203 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-095.cnf b/benchmarks/UUF250.1065.100/uuf250-095.cnf --- a/benchmarks/UUF250.1065.100/uuf250-095.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-095.cnf @@ -1071,6 +1071,3 @@ 90 -152 -197 0 -23 -75 -46 0 221 140 -139 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-096.cnf b/benchmarks/UUF250.1065.100/uuf250-096.cnf --- a/benchmarks/UUF250.1065.100/uuf250-096.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-096.cnf @@ -1071,6 +1071,3 @@ 97 -83 124 0 -16 76 -26 0 36 -54 174 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-097.cnf b/benchmarks/UUF250.1065.100/uuf250-097.cnf --- a/benchmarks/UUF250.1065.100/uuf250-097.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-097.cnf @@ -1071,6 +1071,3 @@ 156 8 101 0 91 -220 98 0 228 -200 -109 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-098.cnf b/benchmarks/UUF250.1065.100/uuf250-098.cnf --- a/benchmarks/UUF250.1065.100/uuf250-098.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-098.cnf @@ -1071,6 +1071,3 @@ 103 206 204 0 -33 -147 -15 0 182 -189 -160 0 -% -0 - diff --git a/benchmarks/UUF250.1065.100/uuf250-099.cnf b/benchmarks/UUF250.1065.100/uuf250-099.cnf --- a/benchmarks/UUF250.1065.100/uuf250-099.cnf +++ b/benchmarks/UUF250.1065.100/uuf250-099.cnf @@ -1071,6 +1071,3 @@ -140 -187 46 0 -166 -6 138 0 239 -111 -223 0 -% -0 - diff --git a/src/Algorithm/CAD.hs b/src/Algorithm/CAD.hs --- a/src/Algorithm/CAD.hs +++ b/src/Algorithm/CAD.hs @@ -29,7 +29,6 @@ -- * Basic data structures Point (..) , Cell (..) - , module Data.Sign -- * Projection , project @@ -50,7 +49,9 @@ import Data.List import Data.Maybe import Data.Ord +import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) import qualified Data.Set as Set import Text.Printf import Text.PrettyPrint.HughesPJClass @@ -58,9 +59,12 @@ import Data.ArithRel import qualified Data.AlgebraicNumber.Real as AReal import Data.DNF -import Data.Polynomial -import Data.Sign +import Data.Polynomial (Polynomial, UPolynomial, X (..), PrettyVar, PrettyCoeff) +import qualified Data.Polynomial as P +import Data.Sign (Sign (..)) +import qualified Data.Sign as Sign + import Debug.Trace -- --------------------------------------------------------------------------- @@ -84,7 +88,7 @@ -- --------------------------------------------------------------------------- -type SignConf c = [(Cell c, Map.Map (UPolynomial c) Sign)] +type SignConf c = [(Cell c, Map (UPolynomial c) Sign)] emptySignConf :: SignConf c emptySignConf = @@ -99,9 +103,9 @@ f :: SignConf c -> [String] f = concatMap $ \(cell, m) -> showCell cell : g m - g :: Map.Map (UPolynomial c) Sign -> [String] + g :: Map (UPolynomial c) Sign -> [String] g m = - [printf " %s: %s" (prettyShow p) (showSign s) | (p, s) <- Map.toList m] + [printf " %s: %s" (prettyShow p) (Sign.symbol s) | (p, s) <- Map.toList m] -- --------------------------------------------------------------------------- @@ -112,70 +116,70 @@ -> UPolynomial k -> (k, Integer, UPolynomial k) mr p q - | n >= m = assert (constant (bm^(n-m+1)) * p == q * l + r && m > deg r) $ (bm, n-m+1, r) + | n >= m = assert (P.constant (bm^(n-m+1)) * p == q * l + r && m > P.deg r) $ (bm, n-m+1, r) | otherwise = error "mr p q: not (deg p >= deg q)" where - x = var X - n = deg p - m = deg q - (bm, _) = leadingTerm grlex q + x = P.var X + n = P.deg p + m = P.deg q + bm = P.lc P.grlex q (l,r) = f p n f :: UPolynomial k -> Integer -> (UPolynomial k, UPolynomial k) f p n | n==m = - let l = constant an - r = constant bm * p - constant an * q - in assert (constant (bm^(n-m+1)) * p == q*l + r && m > deg r) $ (l, r) + let l = P.constant an + r = P.constant bm * p - P.constant an * q + in assert (P.constant (bm^(n-m+1)) * p == q*l + r && m > P.deg r) $ (l, r) | otherwise = - let p' = (constant bm * p - constant an * x^(n-m) * q) + let p' = (P.constant bm * p - P.constant an * x^(n-m) * q) (l',r) = f p' (n-1) - l = l' + constant (an*bm^(n-m)) * x^(n-m) - in assert (n > deg p') $ - assert (constant (bm^(n-m+1)) * p == q*l + r && m > deg r) $ (l, r) + l = l' + P.constant (an*bm^(n-m)) * x^(n-m) + in assert (n > P.deg p') $ + assert (P.constant (bm^(n-m+1)) * p == q*l + r && m > P.deg r) $ (l, r) where - an = coeff (mmFromList [(X, n)]) p + an = P.coeff (P.var X `P.mpow` n) p test_mr_1 :: (Coeff Int, Integer, UPolynomial (Coeff Int)) -test_mr_1 = mr (toUPolynomialOf p 3) (toUPolynomialOf q 3) +test_mr_1 = mr (P.toUPolynomialOf p 3) (P.toUPolynomialOf q 3) where - a = var 0 - b = var 1 - c = var 2 - x = var 3 + a = P.var 0 + b = P.var 1 + c = P.var 2 + x = P.var 3 p = a*x^(2::Int) + b*x + c q = 2*a*x + b test_mr_2 :: (Coeff Int, Integer, UPolynomial (Coeff Int)) -test_mr_2 = mr (toUPolynomialOf p 3) (toUPolynomialOf p 3) +test_mr_2 = mr (P.toUPolynomialOf p 3) (P.toUPolynomialOf p 3) where - a = var 0 - b = var 1 - c = var 2 - x = var 3 + a = P.var 0 + b = P.var 1 + c = P.var 2 + x = P.var 3 p = a*x^(2::Int) + b*x + c -- --------------------------------------------------------------------------- type Coeff v = Polynomial Rational v -type M v = StateT (Map.Map (Polynomial Rational v) (Set.Set Sign)) [] +type M v = StateT (Map (Polynomial Rational v) (Set Sign)) [] -runM :: M v a -> [(a, Map.Map (Polynomial Rational v) (Set.Set Sign))] +runM :: M v a -> [(a, Map (Polynomial Rational v) (Set Sign))] runM m = runStateT m Map.empty assume :: (Ord v, Show v, PrettyVar v) => Polynomial Rational v -> [Sign] -> M v () assume p ss = - if deg p == 0 + if P.deg p <= 0 then do - let c = coeff mmOne p - guard $ signOf c `elem` ss - else do - let (c,_) = leadingTerm grlex p - p' = mapCoeff (/c) p + let c = P.coeff P.mone p + guard $ Sign.signOf c `elem` ss + else do + let c = P.lc P.grlex p + p' = P.mapCoeff (/c) p m <- get let ss1 = Map.findWithDefault (Set.fromList [Neg, Zero, Pos]) p' m - ss2 = Set.intersection ss1 $ Set.fromList $ [s `signDiv` signOf c | s <- ss] + ss2 = Set.intersection ss1 $ Set.fromList $ [s `Sign.div` Sign.signOf c | s <- ss] guard $ not $ Set.null ss2 put $ Map.insert p' ss2 m @@ -185,24 +189,24 @@ -> [([(Polynomial Rational v, [Sign])], [Cell (Polynomial Rational v)])] project cs = [ (guess2cond gs, cells) | (cells, gs) <- result ] where - result :: [([Cell (Polynomial Rational v)], Map.Map (Polynomial Rational v) (Set.Set Sign))] + result :: [([Cell (Polynomial Rational v)], Map (Polynomial Rational v) (Set Sign))] result = runM $ do forM_ cs $ \(p,ss) -> do - when (1 > deg p) $ assume (coeff mmOne p) ss + when (1 > P.deg p) $ assume (P.coeff P.mone p) ss conf <- buildSignConf (map fst cs) let satCells = [cell | (cell, m) <- conf, cell /= Point NegInf, cell /= Point PosInf, ok m] guard $ not $ null satCells return satCells - ok :: Map.Map (UPolynomial (Polynomial Rational v)) Sign -> Bool + ok :: Map (UPolynomial (Polynomial Rational v)) Sign -> Bool ok m = and [checkSign m p ss | (p,ss) <- cs] where checkSign m p ss = - if 1 > deg p + if 1 > P.deg p then True -- already assumed else (m Map.! p) `elem` ss - guess2cond :: Map.Map (Polynomial Rational v) (Set.Set Sign) -> [(Polynomial Rational v, [Sign])] + guess2cond :: Map (Polynomial Rational v) (Set Sign) -> [(Polynomial Rational v, [Sign])] guess2cond gs = [(p, Set.toList ss) | (p, ss) <- Map.toList gs] buildSignConf @@ -211,20 +215,20 @@ -> M v (SignConf (Polynomial Rational v)) buildSignConf ps = do ps2 <- collectPolynomials (Set.fromList ps) - let ts = sortBy (comparing deg) (Set.toList ps2) + let ts = sortBy (comparing P.deg) (Set.toList ps2) foldM (flip refineSignConf) emptySignConf ts collectPolynomials :: (Ord v, Show v, PrettyVar v) - => Set.Set (UPolynomial (Polynomial Rational v)) - -> M v (Set.Set (UPolynomial (Polynomial Rational v))) + => Set (UPolynomial (Polynomial Rational v)) + -> M v (Set (UPolynomial (Polynomial Rational v))) collectPolynomials ps = go Set.empty (f ps) where - f = Set.filter (\p -> deg p > 0) + f = Set.filter (\p -> P.deg p > 0) go result ps | Set.null ps = return result go result ps = do - let rs1 = filter (\p -> deg p > 0) [deriv p X | p <- Set.toList ps] - rs2 <- liftM (filter (\p -> deg p > 0) . map (\(_,_,r) -> r) . concat) $ + let rs1 = filter (\p -> P.deg p > 0) [P.deriv p X | p <- Set.toList ps] + rs2 <- liftM (filter (\p -> P.deg p > 0) . map (\(_,_,r) -> r) . concat) $ forM [(p1,p2) | p1 <- Set.toList ps, p2 <- Set.toList ps ++ Set.toList result, p1 /= p2] $ \(p1,p2) -> do ret1 <- zmod p1 p2 ret2 <- zmod p2 p1 @@ -238,7 +242,7 @@ -> M v (Polynomial Rational v, Integer) getHighestNonzeroTerm p = go $ sortBy (flip (comparing snd)) cs where - cs = [(c, deg mm) | (c,mm) <- terms p] + cs = [(c, P.deg mm) | (c,mm) <- P.terms p] go :: [(Polynomial Rational v, Integer)] -> M v (Polynomial Rational v, Integer) go [] = return (0, -1) @@ -258,8 +262,8 @@ if not (d >= e) || 0 >= e then return Nothing else do - let p' = fromTerms [(pi, mm) | (pi, mm) <- terms p, deg mm <= d] - q' = fromTerms [(qi, mm) | (qi, mm) <- terms q, deg mm <= e] + let p' = P.fromTerms [(pi, mm) | (pi, mm) <- P.terms p, P.deg mm <= d] + q' = P.fromTerms [(qi, mm) | (qi, mm) <- P.terms q, P.deg mm <= e] return $ Just $ mr p' q' refineSignConf @@ -270,8 +274,8 @@ refineSignConf p conf = liftM (extendIntervals 0) $ mapM extendPoint conf where extendPoint - :: (Cell (Polynomial Rational v), Map.Map (UPolynomial (Polynomial Rational v)) Sign) - -> M v (Cell (Polynomial Rational v), Map.Map (UPolynomial (Polynomial Rational v)) Sign) + :: (Cell (Polynomial Rational v), Map (UPolynomial (Polynomial Rational v)) Sign) + -> M v (Cell (Polynomial Rational v), Map (UPolynomial (Polynomial Rational v)) Sign) extendPoint (Point pt, m) = do s <- signAt pt m return (Point pt, Map.insert p s m) @@ -279,8 +283,8 @@ extendIntervals :: Int - -> [(Cell (Polynomial Rational v), Map.Map (UPolynomial (Polynomial Rational v)) Sign)] - -> [(Cell (Polynomial Rational v), Map.Map (UPolynomial (Polynomial Rational v)) Sign)] + -> [(Cell (Polynomial Rational v), Map (UPolynomial (Polynomial Rational v)) Sign)] + -> [(Cell (Polynomial Rational v), Map (UPolynomial (Polynomial Rational v)) Sign)] extendIntervals !n (pt1@(Point _, m1) : (Interval lb ub, m) : pt2@(Point _, m2) : xs) = pt1 : ys ++ extendIntervals n2 (pt2 : xs) where @@ -300,7 +304,7 @@ ) extendIntervals _ xs = xs - signAt :: Point (Polynomial Rational v) -> Map.Map (UPolynomial (Polynomial Rational v)) Sign -> M v Sign + signAt :: Point (Polynomial Rational v) -> Map (UPolynomial (Polynomial Rational v)) Sign -> M v Sign signAt PosInf _ = do (c,_) <- getHighestNonzeroTerm p signCoeff c @@ -308,18 +312,18 @@ (c,d) <- getHighestNonzeroTerm p if even d then signCoeff c - else liftM signNegate $ signCoeff c + else liftM Sign.negate $ signCoeff c signAt (RootOf q _) m = do Just (bm,k,r) <- zmod p q - s1 <- if deg r > 0 + s1 <- if P.deg r > 0 then return $ m Map.! r - else signCoeff $ coeff mmOne r + else signCoeff $ P.coeff P.mone r -- 場合分けを出来るだけ避ける if even k then return s1 else do s2 <- signCoeff bm - return $ signDiv s1 (signPow s2 k) + return $ s1 `Sign.div` Sign.pow s2 k signCoeff :: Polynomial Rational v -> M v Sign signCoeff c = @@ -329,7 +333,7 @@ -- --------------------------------------------------------------------------- -type Model v = Map.Map v AReal.AReal +type Model v = Map v AReal.AReal findSample :: Ord v => Model v -> Cell (Polynomial Rational v) -> Maybe AReal.AReal findSample m cell = @@ -359,13 +363,13 @@ evalPoint _ PosInf = PosInf evalPoint m (RootOf p n) = RootOf (AReal.minimalPolynomial a) (AReal.rootIndex a) where - a = AReal.realRootsEx (mapCoeff (eval (m Map.!) . mapCoeff fromRational) p) !! n + a = AReal.realRootsEx (P.mapCoeff (P.eval (m Map.!) . P.mapCoeff fromRational) p) !! n -- --------------------------------------------------------------------------- solve :: forall v. (Ord v, Show v, PrettyVar v) - => Set.Set v + => Set v -> [(Rel (Polynomial Rational v))] -> Maybe (Model v) solve vs cs0 = solve' vs (map f cs0) @@ -380,18 +384,18 @@ solve' :: forall v. (Ord v, Show v, PrettyVar v) - => Set.Set v + => Set v -> [(Polynomial Rational v, [Sign])] -> Maybe (Model v) solve' vs0 cs0 = go (Set.toList vs0) cs0 where go :: [v] -> [(Polynomial Rational v, [Sign])] -> Maybe (Model v) go [] cs = - if and [signOf v `elem` ss | (p,ss) <- cs, let v = eval (\_ -> undefined) p] + if and [Sign.signOf v `elem` ss | (p,ss) <- cs, let v = P.eval (\_ -> undefined) p] then Just Map.empty else Nothing go (v:vs) cs = listToMaybe $ do - (cs2, cell:_) <- project [(toUPolynomialOf p v, ss) | (p,ss) <- cs] + (cs2, cell:_) <- project [(P.toUPolynomialOf p v, ss) | (p,ss) <- cs] case go vs cs2 of Nothing -> mzero Just m -> do @@ -440,7 +444,7 @@ dumpSignConf :: forall v. (Ord v, PrettyVar v, Show v) - => [(SignConf (Polynomial Rational v), Map.Map (Polynomial Rational v) (Set.Set Sign))] + => [(SignConf (Polynomial Rational v), Map (Polynomial Rational v) (Set Sign))] -> IO () dumpSignConf x = forM_ x $ \(conf, as) -> do @@ -454,7 +458,7 @@ test1a :: IO () test1a = mapM_ putStrLn $ showSignConf conf where - x = var X + x = P.var X ps :: [UPolynomial (Polynomial Rational Int)] ps = [x + 1, -2*x + 3, x] [(conf, _)] = runM $ buildSignConf ps @@ -462,7 +466,7 @@ test1b :: Bool test1b = isJust $ solve vs cs where - x = var X + x = P.var X vs = Set.singleton X cs = [x + 1 .>. 0, -2*x + 3 .>. 0, x .>. 0] @@ -471,16 +475,16 @@ m <- solve' (Set.singleton X) cs guard $ and $ do (p, ss) <- cs - let val = eval (m Map.!) (mapCoeff fromRational p) - return $ signOf val `elem` ss + let val = P.eval (m Map.!) (P.mapCoeff fromRational p) + return $ Sign.signOf val `elem` ss where - x = var X + x = P.var X cs = [(x + 1, [Pos]), (-2*x + 3, [Pos]), (x, [Pos])] test2a :: IO () test2a = mapM_ putStrLn $ showSignConf conf where - x = var X + x = P.var X ps :: [UPolynomial (Polynomial Rational Int)] ps = [x^(2::Int)] [(conf, _)] = runM $ buildSignConf ps @@ -488,7 +492,7 @@ test2b :: Bool test2b = isNothing $ solve vs cs where - x = var X + x = P.var X vs = Set.singleton X cs = [x^(2::Int) .<. 0] @@ -497,53 +501,53 @@ test_project :: DNF (Polynomial Rational Int, [Sign]) test_project = DNF $ map fst $ project [(p', [Zero])] where - a = var 0 - b = var 1 - c = var 2 - x = var 3 + a = P.var 0 + b = P.var 1 + c = P.var 2 + x = P.var 3 p :: Polynomial Rational Int p = a*x^(2::Int) + b*x + c - p' = toUPolynomialOf p 3 + p' = P.toUPolynomialOf p 3 test_project_print :: IO () test_project_print = putStrLn $ showDNF $ test_project test_project_2 = project [(p, [Zero]), (x, [Pos])] where - x = var X + x = P.var X p :: UPolynomial (Polynomial Rational Int) p = x^(2::Int) + 4*x - 10 -test_project_3_print = dumpProjection $ project [(toUPolynomialOf p 0, [Neg])] +test_project_3_print = dumpProjection $ project [(P.toUPolynomialOf p 0, [Neg])] where - a = var 0 - b = var 1 - c = var 2 + a = P.var 0 + b = P.var 1 + c = P.var 2 p :: Polynomial Rational Int p = a^(2::Int) + b^(2::Int) + c^(2::Int) - 1 test_solve = solve vs [p .<. 0] where - a = var 0 - b = var 1 - c = var 2 + a = P.var 0 + b = P.var 1 + c = P.var 2 vs = Set.fromList [0,1,2] p :: Polynomial Rational Int p = a^(2::Int) + b^(2::Int) + c^(2::Int) - 1 test_collectPolynomials - :: [( Set.Set (UPolynomial (Polynomial Rational Int)) - , Map.Map (Polynomial Rational Int) (Set.Set Sign) + :: [( Set (UPolynomial (Polynomial Rational Int)) + , Map (Polynomial Rational Int) (Set Sign) )] test_collectPolynomials = runM $ collectPolynomials (Set.singleton p') where - a = var 0 - b = var 1 - c = var 2 - x = var 3 + a = P.var 0 + b = P.var 1 + c = P.var 2 + x = P.var 3 p :: Polynomial Rational Int p = a*x^(2::Int) + b*x + c - p' = toUPolynomialOf p 3 + p' = P.toUPolynomialOf p 3 test_collectPolynomials_print :: IO () test_collectPolynomials_print = do @@ -553,33 +557,33 @@ forM_ (Map.toList s) $ \(p, sign) -> printf "%s %s\n" (prettyShow p) (show sign) -test_buildSignConf :: [(SignConf (Polynomial Rational Int), Map.Map (Polynomial Rational Int) (Set.Set Sign))] -test_buildSignConf = runM $ buildSignConf [toUPolynomialOf p 3] +test_buildSignConf :: [(SignConf (Polynomial Rational Int), Map (Polynomial Rational Int) (Set Sign))] +test_buildSignConf = runM $ buildSignConf [P.toUPolynomialOf p 3] where - a = var 0 - b = var 1 - c = var 2 - x = var 3 + a = P.var 0 + b = P.var 1 + c = P.var 2 + x = P.var 3 p :: Polynomial Rational Int p = a*x^(2::Int) + b*x + c test_buildSignConf_print :: IO () test_buildSignConf_print = dumpSignConf test_buildSignConf -test_buildSignConf_2 :: [(SignConf (Polynomial Rational Int), Map.Map (Polynomial Rational Int) (Set.Set Sign))] -test_buildSignConf_2 = runM $ buildSignConf [toUPolynomialOf p 0 | p <- ps] +test_buildSignConf_2 :: [(SignConf (Polynomial Rational Int), Map (Polynomial Rational Int) (Set Sign))] +test_buildSignConf_2 = runM $ buildSignConf [P.toUPolynomialOf p 0 | p <- ps] where - x = var 0 + x = P.var 0 ps :: [Polynomial Rational Int] ps = [x + 1, -2*x + 3, x] test_buildSignConf_2_print :: IO () test_buildSignConf_2_print = dumpSignConf test_buildSignConf_2 -test_buildSignConf_3 :: [(SignConf (Polynomial Rational Int), Map.Map (Polynomial Rational Int) (Set.Set Sign))] -test_buildSignConf_3 = runM $ buildSignConf [toUPolynomialOf p 0 | p <- ps] +test_buildSignConf_3 :: [(SignConf (Polynomial Rational Int), Map (Polynomial Rational Int) (Set Sign))] +test_buildSignConf_3 = runM $ buildSignConf [P.toUPolynomialOf p 0 | p <- ps] where - x = var 0 + x = P.var 0 ps :: [Polynomial Rational Int] ps = [x, 2*x] diff --git a/src/Algorithm/CongruenceClosure.hs b/src/Algorithm/CongruenceClosure.hs --- a/src/Algorithm/CongruenceClosure.hs +++ b/src/Algorithm/CongruenceClosure.hs @@ -31,7 +31,8 @@ import Control.Monad import Data.IORef import Data.Maybe -import qualified Data.IntMap as IM +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap type Var = Int @@ -47,20 +48,20 @@ = Solver { svVarCounter :: IORef Int , svPending :: IORef [PendingEqn] - , svRepresentativeTable :: IORef (IM.IntMap Var) -- 本当は配列が良い - , svClassList :: IORef (IM.IntMap [Var]) - , svUseList :: IORef (IM.IntMap [Eqn1]) - , svLookupTable :: IORef (IM.IntMap (IM.IntMap Eqn1)) + , svRepresentativeTable :: IORef (IntMap Var) -- 本当は配列が良い + , svClassList :: IORef (IntMap [Var]) + , svUseList :: IORef (IntMap [Eqn1]) + , svLookupTable :: IORef (IntMap (IntMap Eqn1)) } newSolver :: IO Solver newSolver = do vcnt <- newIORef 0 pending <- newIORef [] - rep <- newIORef IM.empty - classes <- newIORef IM.empty - useList <- newIORef IM.empty - lookup <- newIORef IM.empty + rep <- newIORef IntMap.empty + classes <- newIORef IntMap.empty + useList <- newIORef IntMap.empty + lookup <- newIORef IntMap.empty return $ Solver { svVarCounter = vcnt @@ -75,9 +76,9 @@ newVar solver = do v <- readIORef (svVarCounter solver) writeIORef (svVarCounter solver) $! v + 1 - modifyIORef (svRepresentativeTable solver) (IM.insert v v) - modifyIORef (svClassList solver) (IM.insert v [v]) - modifyIORef (svUseList solver) (IM.insert v []) + modifyIORef (svRepresentativeTable solver) (IntMap.insert v v) + modifyIORef (svClassList solver) (IntMap.insert v [v]) + modifyIORef (svUseList solver) (IntMap.insert v []) return v merge :: Solver -> (FlatTerm, Var) -> IO () @@ -97,8 +98,8 @@ Nothing -> do setLookup solver a1' a2' (FTApp a1 a2, a) modifyIORef (svUseList solver) $ - IM.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a1' . - IM.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a2' + IntMap.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a1' . + IntMap.alter (Just . ((FTApp a1 a2, a) :) . fromMaybe []) a2' propagate :: Solver -> IO () propagate solver = go @@ -122,20 +123,20 @@ then return () else do clist <- readIORef (svClassList solver) - let classA = clist IM.! a' - classB = clist IM.! b' + let classA = clist IntMap.! a' + classB = clist IntMap.! b' if length classA < length classB then update a' b' classA classB else update b' a' classB classA update a' b' classA classB = do modifyIORef (svRepresentativeTable solver) $ - IM.union (IM.fromList [(c,b') | c <- classA]) + IntMap.union (IntMap.fromList [(c,b') | c <- classA]) modifyIORef (svClassList solver) $ - IM.insert b' (classA ++ classB) . IM.delete a' + IntMap.insert b' (classA ++ classB) . IntMap.delete a' useList <- readIORef (svUseList solver) - forM_ (useList IM.! a') $ \(FTApp c1 c2, c) -> do -- FIXME: not exhaustive + forM_ (useList IntMap.! a') $ \(FTApp c1 c2, c) -> do -- FIXME: not exhaustive c1' <- getRepresentative solver c1 c2' <- getRepresentative solver c2 ret <- lookup solver c1' c2' @@ -144,7 +145,7 @@ addToPending solver $ Right ((FTApp c1 c2, c), (FTApp d1 d2, d)) Nothing -> do return () - writeIORef (svUseList solver) $ IM.delete a' useList + writeIORef (svUseList solver) $ IntMap.delete a' useList areCongruent :: Solver -> FlatTerm -> FlatTerm -> IO Bool areCongruent solver t1 t2 = do @@ -170,13 +171,13 @@ lookup solver c1 c2 = do tbl <- readIORef $ svLookupTable solver return $ do - m <- IM.lookup c1 tbl - IM.lookup c2 m + m <- IntMap.lookup c1 tbl + IntMap.lookup c2 m setLookup :: Solver -> Var -> Var -> Eqn1 -> IO () setLookup solver a1 a2 eqn = do modifyIORef (svLookupTable solver) $ - IM.insertWith IM.union a1 (IM.singleton a2 eqn) + IntMap.insertWith IntMap.union a1 (IntMap.singleton a2 eqn) addToPending :: Solver -> PendingEqn -> IO () addToPending solver eqn = modifyIORef (svPending solver) (eqn :) @@ -184,20 +185,4 @@ getRepresentative :: Solver -> Var -> IO Var getRepresentative solver c = do m <- readIORef $ svRepresentativeTable solver - return $ m IM.! c - -{-------------------------------------------------------------------- - Test ---------------------------------------------------------------------} - -test = do - solver <- newSolver - a <- newVar solver - b <- newVar solver - c <- newVar solver - d <- newVar solver - merge solver (FTConst a, c) - print =<< areCongruent solver (FTApp a b) (FTApp c d) -- False - merge solver (FTConst b, d) - print =<< areCongruent solver (FTApp a b) (FTApp c d) -- True - + return $ m IntMap.! c diff --git a/src/Algorithm/ContiTraverso.hs b/src/Algorithm/ContiTraverso.hs --- a/src/Algorithm/ContiTraverso.hs +++ b/src/Algorithm/ContiTraverso.hs @@ -32,6 +32,7 @@ import Data.Function import qualified Data.IntMap as IM import qualified Data.IntSet as IS +import qualified Data.Map as Map import Data.List import Data.Monoid import Data.Ratio @@ -40,8 +41,9 @@ import Data.ArithRel import qualified Data.LA as LA import Data.OptDir -import Data.Polynomial -import Data.Polynomial.GBasis as GB +import Data.Polynomial (Polynomial, UPolynomial, Monomial, MonomialOrder) +import qualified Data.Polynomial as P +import Data.Polynomial.GroebnerBasis as GB import Data.Var import qualified Algorithm.LPUtil as LPUtil @@ -89,22 +91,22 @@ cmp2 = elimOrdering (IS.fromList vs2) `mappend` elimOrdering (IS.singleton t) `mappend` costOrdering obj `mappend` cmp gb :: [Polynomial Rational Var] - gb = GB.basis' GB.defaultOptions cmp2 (product (map var (t:vs2)) - 1 : phi) + gb = GB.basis' GB.defaultOptions cmp2 (product (map P.var (t:vs2)) - 1 : phi) where phi = do xj <- vs let aj = [(yi, aij) | (yi,(ai,_)) <- zip vs2 cs, let aij = LA.coeff xj ai] - return $ product [var yi ^ aij | (yi, aij) <- aj, aij > 0] - - product [var yi ^ (-aij) | (yi, aij) <- aj, aij < 0] * var xj + return $ product [P.var yi ^ aij | (yi, aij) <- aj, aij > 0] + - product [P.var yi ^ (-aij) | (yi, aij) <- aj, aij < 0] * P.var xj - yb = product [var yi ^ bi | ((_,bi),yi) <- zip cs vs2] + yb = product [P.var yi ^ bi | ((_,bi),yi) <- zip cs vs2] - [(_,z)] = terms (reduce cmp2 yb gb) + [(_,z)] = P.terms (P.reduce cmp2 yb gb) m = mkModel (vs++vs2++[t]) z -mkModel :: [Var] -> MonicMonomial Var -> Model Integer -mkModel vs xs = mmToIntMap xs `IM.union` IM.fromList [(x, 0) | x <- vs] +mkModel :: [Var] -> Monomial Var -> Model Integer +mkModel vs xs = IM.fromDistinctAscList (Map.toAscList (P.mindicesMap xs)) `IM.union` IM.fromList [(x, 0) | x <- vs] -- IM.union is left-biased costOrdering :: LA.Expr Integer -> MonomialOrder Var @@ -116,4 +118,6 @@ elimOrdering :: IS.IntSet -> MonomialOrder Var elimOrdering xs = compare `on` f where - f ys = not $ IS.null $ xs `IS.intersection` IM.keysSet (mmToIntMap ys) + f ys = not $ IS.null $ xs `IS.intersection` ys' + where + ys' = IS.fromDistinctAscList [y | (y,_) <- Map.toAscList $ P.mindicesMap ys] diff --git a/src/Algorithm/FOLModelFinder.hs b/src/Algorithm/FOLModelFinder.hs --- a/src/Algorithm/FOLModelFinder.hs +++ b/src/Algorithm/FOLModelFinder.hs @@ -50,7 +50,9 @@ import Data.IORef import Data.List import Data.Maybe +import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) import qualified Data.Set as Set import Text.Printf @@ -68,7 +70,7 @@ type PSym = String class Vars a where - vars :: a -> Set.Set Var + vars :: a -> Set Var instance Vars a => Vars [a] where vars = Set.unions . map vars @@ -168,7 +170,7 @@ toSkolemNF :: forall m. Monad m => (String -> Int -> m FSym) -> Formula -> m [Clause] toSkolemNF skolem phi = f [] Map.empty (toNNF phi) where - f :: [Var] -> Map.Map Var Term -> Formula -> m [Clause] + f :: [Var] -> Map Var Term -> Formula -> m [Clause] f _ _ T = return [] f _ _ F = return [[]] f _ s (Atom a) = return [[Pos (substAtom s a)]] @@ -189,15 +191,15 @@ f uvs (Map.insert v (TmApp fsym [TmVar v | v <- reverse uvs]) s) phi f _ _ _ = error "toSkolemNF: should not happen" - gensym :: String -> Set.Set Var -> Var + gensym :: String -> Set Var -> Var gensym template vs = head [name | name <- names, Set.notMember name vs] where names = template : [template ++ show n | n <-[1..]] - substAtom :: Map.Map Var Term -> Atom -> Atom + substAtom :: Map Var Term -> Atom -> Atom substAtom s (PApp p ts) = PApp p (map (substTerm s) ts) - substTerm :: Map.Map Var Term -> Term -> Term + substTerm :: Map Var Term -> Term -> Term substTerm s (TmVar v) = fromMaybe (TmVar v) (Map.lookup v s) substTerm s (TmApp f ts) = TmApp f (map (substTerm s) ts) @@ -255,7 +257,7 @@ -- --------------------------------------------------------------------------- -type M = State (Set.Set Var, Int, [SLit]) +type M = State (Set Var, Int, [SLit]) flatten :: Clause -> SClause flatten c = @@ -359,9 +361,9 @@ type GroundLit = GenLit GroundAtom type GroundClause = [GroundLit] -type Subst = Map.Map Var Entity +type Subst = Map Var Entity -enumSubst :: Set.Set Var -> [Entity] -> [Subst] +enumSubst :: Set Var -> [Entity] -> [Subst] enumSubst vs univ = do ps <- sequence [[(v,e) | e <- univ] | v <- Set.toList vs] return $ Map.fromList ps @@ -391,25 +393,25 @@ f (Pos (SEq (STmVar x) y)) = if x==y then Nothing else return [] f lit = return [lit] -collectFSym :: SClause -> Set.Set (FSym, Int) +collectFSym :: SClause -> Set (FSym, Int) collectFSym = Set.unions . map f where - f :: SLit -> Set.Set (FSym, Int) + f :: SLit -> Set (FSym, Int) f (Pos a) = g a f (Neg a) = g a - g :: SAtom -> Set.Set (FSym, Int) + g :: SAtom -> Set (FSym, Int) g (SEq (STmApp f xs) _) = Set.singleton (f, length xs) g _ = Set.empty -collectPSym :: SClause -> Set.Set (PSym, Int) +collectPSym :: SClause -> Set (PSym, Int) collectPSym = Set.unions . map f where - f :: SLit -> Set.Set (PSym, Int) + f :: SLit -> Set (PSym, Int) f (Pos a) = g a f (Neg a) = g a - g :: SAtom -> Set.Set (PSym, Int) + g :: SAtom -> Set (PSym, Int) g (SPApp p xs) = Set.singleton (p, length xs) g _ = Set.empty @@ -418,8 +420,8 @@ data Model = Model { mUniverse :: [Entity] - , mRelations :: Map.Map PSym [[Entity]] - , mFunctions :: Map.Map FSym [([Entity], Entity)] + , mRelations :: Map PSym [[Entity]] + , mFunctions :: Map FSym [([Entity], Entity)] } showModel :: Model -> [String] diff --git a/src/Algorithm/Simplex2.hs b/src/Algorithm/Simplex2.hs --- a/src/Algorithm/Simplex2.hs +++ b/src/Algorithm/Simplex2.hs @@ -98,8 +98,10 @@ import Data.List import Data.Maybe import Data.Ratio +import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.IntMap as IM +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap import Text.Printf import Data.Time import Data.OptDir @@ -120,15 +122,15 @@ data GenericSolver v = GenericSolver - { svTableau :: !(IORef (IM.IntMap (LA.Expr Rational))) - , svLB :: !(IORef (IM.IntMap v)) - , svUB :: !(IORef (IM.IntMap v)) - , svModel :: !(IORef (IM.IntMap v)) + { svTableau :: !(IORef (IntMap (LA.Expr Rational))) + , svLB :: !(IORef (IntMap v)) + , svUB :: !(IORef (IntMap v)) + , svModel :: !(IORef (IntMap v)) , svVCnt :: !(IORef Int) , svOk :: !(IORef Bool) , svOptDir :: !(IORef OptDir) - , svDefDB :: !(IORef (Map.Map (LA.Expr Rational) Var)) + , svDefDB :: !(IORef (Map (LA.Expr Rational) Var)) , svLogger :: !(IORef (Maybe (String -> IO ()))) , svPivotStrategy :: !(IORef PivotStrategy) @@ -143,10 +145,10 @@ newSolver :: SolverValue v => IO (GenericSolver v) newSolver = do - t <- newIORef (IM.singleton objVar zeroV) - l <- newIORef IM.empty - u <- newIORef IM.empty - m <- newIORef (IM.singleton objVar zeroV) + t <- newIORef (IntMap.singleton objVar zeroV) + l <- newIORef IntMap.empty + u <- newIORef IntMap.empty + m <- newIORef (IntMap.singleton objVar zeroV) v <- newIORef 0 ok <- newIORef True dir <- newIORef OptMin @@ -223,7 +225,7 @@ delta0 = if null ys then 0.1 else minimum ys f :: Delta Rational -> Rational f (Delta r k) = r + k * delta0 - liftM (IM.map f) $ readIORef (svModel solver) + liftM (IntMap.map f) $ readIORef (svModel solver) {- Largest coefficient rule: original rule suggested by G. Dantzig. @@ -250,7 +252,7 @@ newVar solver = do v <- readIORef (svVCnt solver) writeIORef (svVCnt solver) $! v+1 - modifyIORef (svModel solver) (IM.insert v zeroV) + modifyIORef (svModel solver) (IntMap.insert v zeroV) return v assertAtom :: Solver -> LA.Atom Rational -> IO () @@ -315,7 +317,7 @@ (Just l0', _) | l <= l0' -> return () (_, Just u0') | u0' < l -> markBad solver _ -> do - modifyIORef (svLB solver) (IM.insert x l) + modifyIORef (svLB solver) (IntMap.insert x l) b <- isNonBasicVariable solver x v <- getValue solver x when (b && not (l <= v)) $ update solver x l @@ -329,7 +331,7 @@ (_, Just u0') | u0' <= u -> return () (Just l0', _) | u < l0' -> markBad solver _ -> do - modifyIORef (svUB solver) (IM.insert x u) + modifyIORef (svUB solver) (IntMap.insert x u) b <- isNonBasicVariable solver x v <- getValue solver x when (b && not (v <= u)) $ update solver x u @@ -345,9 +347,9 @@ setRow :: SolverValue v => GenericSolver v -> Var -> LA.Expr Rational -> IO () setRow solver v e = do modifyIORef (svTableau solver) $ \t -> - IM.insert v (LA.applySubst t e) t + IntMap.insert v (LA.applySubst t e) t modifyIORef (svModel solver) $ \m -> - IM.insert v (LA.evalLinear m (toValue 1) e) m + IntMap.insert v (LA.evalLinear m (toValue 1) e) m setOptDir :: GenericSolver v -> OptDir -> IO () setOptDir solver dir = writeIORef (svOptDir solver) dir @@ -365,7 +367,7 @@ isBasicVariable :: GenericSolver v -> Var -> IO Bool isBasicVariable solver v = do t <- readIORef (svTableau solver) - return $ v `IM.member` t + return $ v `IntMap.member` t isNonBasicVariable :: GenericSolver v -> Var -> IO Bool isNonBasicVariable solver x = liftM not (isBasicVariable solver x) @@ -568,7 +570,7 @@ -- Upper bounds of θ -- NOTE: xj 自体の上限も考慮するのに注意 - ubs <- liftM concat $ forM ((xj,1) : IM.toList col) $ \(xi,aij) -> do + ubs <- liftM concat $ forM ((xj,1) : IntMap.toList col) $ \(xi,aij) -> do v1 <- getValue solver xi li <- getLB solver xi ui <- getUB solver xi @@ -591,7 +593,7 @@ -- Lower bounds of θ -- NOTE: xj 自体の下限も考慮するのに注意 - lbs <- liftM concat $ forM ((xj,1) : IM.toList col) $ \(xi,aij) -> do + lbs <- liftM concat $ forM ((xj,1) : IntMap.toList col) $ \(xi,aij) -> do v1 <- getValue solver xi li <- getLB solver xi ui <- getUB solver xi @@ -690,19 +692,19 @@ Extract results --------------------------------------------------------------------} -type RawModel v = IM.IntMap v +type RawModel v = IntMap v rawModel :: GenericSolver v -> IO (RawModel v) rawModel solver = do xs <- variables solver - liftM IM.fromList $ forM xs $ \x -> do + liftM IntMap.fromList $ forM xs $ \x -> do val <- getValue solver x return (x,val) getObjValue :: GenericSolver v -> IO v getObjValue solver = getValue solver objVar -type Model = IM.IntMap Rational +type Model = IntMap Rational {-------------------------------------------------------------------- major function @@ -718,8 +720,8 @@ aj <- getCol solver xj modifyIORef (svModel solver) $ \m -> - let m2 = IM.map (\aij -> aij *^ diff) aj - in IM.insert xj v $ IM.unionWith (^+^) m2 m + let m2 = IntMap.map (\aij -> aij *^ diff) aj + in IntMap.insert xj v $ IntMap.unionWith (^+^) m2 m -- log solver $ printf "after update x%d (%s)" xj (show v) -- dump solver @@ -728,9 +730,9 @@ pivot solver xi xj = do modifyIORef' (svNPivot solver) (+1) modifyIORef' (svTableau solver) $ \defs -> - case LA.solveFor (LA.var xi .==. (defs IM.! xi)) xj of + case LA.solveFor (LA.var xi .==. (defs IntMap.! xi)) xj of Just (Eql, xj_def) -> - IM.insert xj xj_def . IM.map (LA.applySubst1 xj xj_def) . IM.delete xi $ defs + IntMap.insert xj xj_def . IntMap.map (LA.applySubst1 xj xj_def) . IntMap.delete xi $ defs _ -> error "pivot: should not happen" pivotAndUpdate :: SolverValue v => GenericSolver v -> Var -> Var -> v -> IO () @@ -745,13 +747,13 @@ m <- readIORef (svModel solver) aj <- getCol solver xj - let aij = aj IM.! xi - let theta = (v ^-^ (m IM.! xi)) ^/ aij + let aij = aj IntMap.! xi + let theta = (v ^-^ (m IntMap.! xi)) ^/ aij - let m' = IM.fromList $ - [(xi, v), (xj, (m IM.! xj) ^+^ theta)] ++ - [(xk, (m IM.! xk) ^+^ (akj *^ theta)) | (xk, akj) <- IM.toList aj, xk /= xi] - writeIORef (svModel solver) (IM.union m' m) -- note that 'IM.union' is left biased. + let m' = IntMap.fromList $ + [(xi, v), (xj, (m IntMap.! xj) ^+^ theta)] ++ + [(xk, (m IntMap.! xk) ^+^ (akj *^ theta)) | (xk, akj) <- IntMap.toList aj, xk /= xi] + writeIORef (svModel solver) (IntMap.union m' m) -- note that 'IntMap.union' is left biased. pivot solver xi xj @@ -761,34 +763,34 @@ getLB :: GenericSolver v -> Var -> IO (Maybe v) getLB solver x = do lb <- readIORef (svLB solver) - return $ IM.lookup x lb + return $ IntMap.lookup x lb getUB :: GenericSolver v -> Var -> IO (Maybe v) getUB solver x = do ub <- readIORef (svUB solver) - return $ IM.lookup x ub + return $ IntMap.lookup x ub -getTableau :: GenericSolver v -> IO (IM.IntMap (LA.Expr Rational)) +getTableau :: GenericSolver v -> IO (IntMap (LA.Expr Rational)) getTableau solver = do t <- readIORef (svTableau solver) - return $ IM.delete objVar t + return $ IntMap.delete objVar t getValue :: GenericSolver v -> Var -> IO v getValue solver x = do m <- readIORef (svModel solver) - return $ m IM.! x + return $ m IntMap.! x getRow :: GenericSolver v -> Var -> IO (LA.Expr Rational) getRow solver x = do -- x should be basic variable or 'objVar' t <- readIORef (svTableau solver) - return $! (t IM.! x) + return $! (t IntMap.! x) -- aijが非ゼロの列も全部探しているのは効率が悪い -getCol :: SolverValue v => GenericSolver v -> Var -> IO (IM.IntMap Rational) +getCol :: SolverValue v => GenericSolver v -> Var -> IO (IntMap Rational) getCol solver xj = do t <- readIORef (svTableau solver) - return $ IM.mapMaybe (LA.lookupCoeff xj) t + return $ IntMap.mapMaybe (LA.lookupCoeff xj) t getCoeff :: GenericSolver v -> Var -> Var -> IO Rational getCoeff solver xi xj = do @@ -826,7 +828,7 @@ basicVariables :: GenericSolver v -> IO [Var] basicVariables solver = do t <- readIORef (svTableau solver) - return (IM.keys t) + return (IntMap.keys t) #if !MIN_VERSION_base(4,6,0) @@ -900,9 +902,9 @@ x0 <- newVar solver x1 <- newVar solver - writeIORef (svTableau solver) (IM.fromList [(x1, LA.var x0)]) - writeIORef (svLB solver) (IM.fromList [(x0, toValue 0), (x1, toValue 0)]) - writeIORef (svUB solver) (IM.fromList [(x0, toValue 2), (x1, toValue 3)]) + writeIORef (svTableau solver) (IntMap.fromList [(x1, LA.var x0)]) + writeIORef (svLB solver) (IntMap.fromList [(x0, toValue 0), (x1, toValue 0)]) + writeIORef (svUB solver) (IntMap.fromList [(x0, toValue 2), (x1, toValue 3)]) setObj solver (LA.fromTerms [(-1, x0)]) ret <- optimize solver defaultOptions @@ -916,9 +918,9 @@ x0 <- newVar solver x1 <- newVar solver - writeIORef (svTableau solver) (IM.fromList [(x1, LA.var x0)]) - writeIORef (svLB solver) (IM.fromList [(x0, toValue 0), (x1, toValue 0)]) - writeIORef (svUB solver) (IM.fromList [(x0, toValue 2), (x1, toValue 0)]) + writeIORef (svTableau solver) (IntMap.fromList [(x1, LA.var x0)]) + writeIORef (svLB solver) (IntMap.fromList [(x0, toValue 0), (x1, toValue 0)]) + writeIORef (svUB solver) (IntMap.fromList [(x0, toValue 2), (x1, toValue 0)]) setObj solver (LA.fromTerms [(-1, x0)]) checkFeasibility solver @@ -946,10 +948,10 @@ dumpSize :: SolverValue v => GenericSolver v -> IO () dumpSize solver = do t <- readIORef (svTableau solver) - let nrows = IM.size t - 1 -- -1 is objVar + let nrows = IntMap.size t - 1 -- -1 is objVar xs <- variables solver let ncols = length xs - nrows - let nnz = sum [IM.size $ LA.coeffMap xi_def | (xi,xi_def) <- IM.toList t, xi /= objVar] + let nnz = sum [IntMap.size $ LA.coeffMap xi_def | (xi,xi_def) <- IntMap.toList t, xi /= objVar] log solver $ printf "%d rows, %d columns, %d non-zeros" nrows ncols nnz dump :: SolverValue v => GenericSolver v -> IO () @@ -958,8 +960,8 @@ log solver "Tableau:" t <- readIORef (svTableau solver) - log solver $ printf "obj = %s" (show (t IM.! objVar)) - forM_ (IM.toList t) $ \(xi, e) -> do + log solver $ printf "obj = %s" (show (t IntMap.! objVar)) + forM_ (IntMap.toList t) $ \(xi, e) -> do when (xi /= objVar) $ log solver $ printf "x%d = %s" xi (show e) log solver "" diff --git a/src/Converter/LP2SMT.hs b/src/Converter/LP2SMT.hs --- a/src/Converter/LP2SMT.hs +++ b/src/Converter/LP2SMT.hs @@ -22,6 +22,7 @@ import Data.List import Data.Ratio import qualified Data.Set as Set +import Data.Map (Map) import qualified Data.Map as Map import System.IO import Text.Printf @@ -54,7 +55,7 @@ -- ------------------------------------------------------------------------ type Var = String -type Env = Map.Map LP.Var Var +type Env = Map LP.Var Var concatS :: [ShowS] -> ShowS concatS = foldr (.) id diff --git a/src/Converter/MaxSAT2LP.hs b/src/Converter/MaxSAT2LP.hs --- a/src/Converter/MaxSAT2LP.hs +++ b/src/Converter/MaxSAT2LP.hs @@ -14,12 +14,12 @@ ( convert ) where -import qualified Data.Map as Map +import Data.Map (Map) import qualified Text.LPFile as LPFile import qualified Text.MaxSAT as MaxSAT import SAT.Types import qualified Converter.MaxSAT2WBO as MaxSAT2WBO import qualified Converter.PB2LP as PB2LP -convert :: Bool -> MaxSAT.WCNF -> (LPFile.LP, Map.Map LPFile.Var Rational -> Model) +convert :: Bool -> MaxSAT.WCNF -> (LPFile.LP, Map LPFile.Var Rational -> Model) convert useIndicator wcnf = PB2LP.convertWBO useIndicator (MaxSAT2WBO.convert wcnf) diff --git a/src/Converter/PB2LP.hs b/src/Converter/PB2LP.hs --- a/src/Converter/PB2LP.hs +++ b/src/Converter/PB2LP.hs @@ -18,14 +18,16 @@ import Data.Array.IArray import Data.List import Data.Maybe -import qualified Data.IntSet as IS +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import qualified Data.Set as Set +import Data.Map (Map) import qualified Data.Map as Map import qualified Text.PBFile as PBFile import qualified Text.LPFile as LPFile import qualified SAT.Types as SAT -convert :: PBFile.Formula -> (LPFile.LP, Map.Map LPFile.Var Rational -> SAT.Model) +convert :: PBFile.Formula -> (LPFile.LP, Map LPFile.Var Rational -> SAT.Model) convert formula@(obj, cs) = (lp, mtrans (PBFile.pbNumVars formula)) where lp = LPFile.LP @@ -47,7 +49,7 @@ } vs1 = collectVariables formula - vs2 = (Set.fromList . map convVar . IS.toList) $ vs1 + vs2 = (Set.fromList . map convVar . IntSet.toList) $ vs1 (dir,obj2) = case obj of @@ -90,16 +92,16 @@ convVar :: PBFile.Var -> LPFile.Var convVar x = ("x" ++ show x) -collectVariables :: PBFile.Formula -> IS.IntSet -collectVariables (obj, cs) = IS.unions $ maybe IS.empty f obj : [f s | (s,_,_) <- cs] +collectVariables :: PBFile.Formula -> IntSet +collectVariables (obj, cs) = IntSet.unions $ maybe IntSet.empty f obj : [f s | (s,_,_) <- cs] where - f :: PBFile.Sum -> IS.IntSet - f xs = IS.fromList $ do + f :: PBFile.Sum -> IntSet + f xs = IntSet.fromList $ do (_,ts) <- xs lit <- ts return $ abs lit -convertWBO :: Bool -> PBFile.SoftFormula -> (LPFile.LP, Map.Map LPFile.Var Rational -> SAT.Model) +convertWBO :: Bool -> PBFile.SoftFormula -> (LPFile.LP, Map LPFile.Var Rational -> SAT.Model) convertWBO useIndicator formula@(top, cs) = (lp, mtrans (PBFile.wboNumVars formula)) where lp = LPFile.LP @@ -121,7 +123,7 @@ } vs1 = collectVariablesWBO formula - vs2 = ((Set.fromList . map convVar . IS.toList) $ vs1) `Set.union` vs3 + vs2 = ((Set.fromList . map convVar . IntSet.toList) $ vs1) `Set.union` vs3 vs3 = Set.fromList [v | (ts, _) <- cs2, (_, v) <- ts] obj2 = [LPFile.Term (fromIntegral w) [v] | (ts, _) <- cs2, (w, v) <- ts] @@ -194,16 +196,16 @@ where lhs_ub = sum [max c 0 | LPFile.Term c _ <- lhs] -collectVariablesWBO :: PBFile.SoftFormula -> IS.IntSet -collectVariablesWBO (_top, cs) = IS.unions [f s | (_,(s,_,_)) <- cs] +collectVariablesWBO :: PBFile.SoftFormula -> IntSet +collectVariablesWBO (_top, cs) = IntSet.unions [f s | (_,(s,_,_)) <- cs] where - f :: PBFile.Sum -> IS.IntSet - f xs = IS.fromList $ do + f :: PBFile.Sum -> IntSet + f xs = IntSet.fromList $ do (_,ts) <- xs lit <- ts return $ abs lit -mtrans :: Int -> Map.Map LPFile.Var Rational -> SAT.Model +mtrans :: Int -> Map LPFile.Var Rational -> SAT.Model mtrans nvar m = array (1, nvar) [　(i, val) diff --git a/src/Converter/SAT2LP.hs b/src/Converter/SAT2LP.hs --- a/src/Converter/SAT2LP.hs +++ b/src/Converter/SAT2LP.hs @@ -14,12 +14,12 @@ ( convert ) where -import qualified Data.Map as Map +import Data.Map (Map) import qualified Text.LPFile as LPFile import qualified Language.CNF.Parse.ParseDIMACS as DIMACS import qualified SAT.Types as SAT import qualified Converter.PB2LP as PB2LP import qualified Converter.SAT2PB as SAT2PB -convert :: DIMACS.CNF -> (LPFile.LP, Map.Map LPFile.Var Rational -> SAT.Model) +convert :: DIMACS.CNF -> (LPFile.LP, Map LPFile.Var Rational -> SAT.Model) convert cnf = PB2LP.convert (SAT2PB.convert cnf) diff --git a/src/Data/AlgebraicNumber/Real.hs b/src/Data/AlgebraicNumber/Real.hs --- a/src/Data/AlgebraicNumber/Real.hs +++ b/src/Data/AlgebraicNumber/Real.hs @@ -28,7 +28,6 @@ -- * Properties , minimalPolynomial - , deg , isRational , isAlgebraicInteger , height @@ -54,9 +53,8 @@ import qualified Text.PrettyPrint.HughesPJClass as PP import Text.PrettyPrint.HughesPJClass (Doc, PrettyLevel, Pretty (..), prettyParen) -import Data.Polynomial +import Data.Polynomial (Polynomial, UPolynomial, X (..)) import qualified Data.Polynomial as P -import qualified Data.Polynomial.Factorization.Rational as FactorQ import qualified Data.Polynomial.RootSeparation.Sturm as Sturm import Data.Interval (Interval, EndPoint (..), (<=..<), (<..<=), (<..<), (!)) import qualified Data.Interval as Interval @@ -73,25 +71,25 @@ -- | Real roots of the polynomial in ascending order. realRoots :: UPolynomial Rational -> [AReal] realRoots p = Set.toAscList $ Set.fromList $ do - (q,_) <- FactorQ.factor p + (q,_) <- P.factor p realRoots' q -- | Real roots of the polynomial in ascending order. realRootsEx :: UPolynomial AReal -> [AReal] realRootsEx p - | and [isRational c | (c,_) <- terms p] = realRoots $ mapCoeff toRational p - | otherwise = [a | a <- realRoots (simpARealPoly p), a `isRootOf` p] + | and [isRational c | (c,_) <- P.terms p] = realRoots $ P.mapCoeff toRational p + | otherwise = [a | a <- realRoots (simpARealPoly p), a `P.isRootOf` p] -- p must already be factored. realRoots' :: UPolynomial Rational -> [AReal] realRoots' p = do - guard $ deg p > 0 + guard $ P.deg p > 0 i <- Sturm.separate p return $ realRoot' p i realRoot :: UPolynomial Rational -> Interval Rational -> AReal realRoot p i = - case [q | (q,_) <- FactorQ.factor p, deg q > 0, Sturm.numRoots q i == 1] of + case [q | (q,_) <- P.factor p, P.deg q > 0, Sturm.numRoots q i == 1] of p2:_ -> realRoot' p2 i [] -> error "Data.AlgebraicNumber.Real.realRoot: invalid interval" @@ -104,7 +102,7 @@ --------------------------------------------------------------------} isZero :: AReal -> Bool -isZero a = 0 `Interval.member` (interval a) && 0 `isRootOf` minimalPolynomial a +isZero a = 0 `Interval.member` (interval a) && 0 `P.isRootOf` minimalPolynomial a scaleAReal :: Rational -> AReal -> AReal scaleAReal r a = realRoot' p2 i2 @@ -202,23 +200,30 @@ fromInteger = fromRational . toRational instance Fractional AReal where - fromRational r = realRoot' (x - constant r) (Interval.singleton r) + fromRational r = realRoot' (x - P.constant r) (Interval.singleton r) where - x = var X + x = P.var X recip a | isZero a = error "AReal.recip: zero division" | otherwise = realRoot' p2 i2 where p2 = rootRecip (minimalPolynomial a) - i2 = recip (interval a) + c1 = sturmChain a + c2 = Sturm.sturmChain p2 + i2 = go (interval a) (Sturm.separate' c2) + go i1 is2 = + case [i2 | i2 <- is2, Interval.member 1 (i1 * i2)] of + [] -> error "AReal.recip: should not happen" + [i2] -> i2 + is2' -> go (Sturm.halve' c1 i1) [Sturm.halve' c2 i2 | i2 <- is2'] instance Real AReal where toRational x | isRational x = let p = minimalPolynomial x a = P.coeff (P.var X) p - b = P.coeff P.mmOne p + b = P.coeff P.mone p in - b / a | otherwise = error "toRational: proper algebraic number" @@ -365,29 +370,25 @@ -- -- If the algebraic number's 'minimalPolynomial' has degree @n@, -- then the algebraic number is said to be degree @n@. -instance Degree AReal where - deg a = deg $ minimalPolynomial a +instance P.Degree AReal where + deg a = P.deg $ minimalPolynomial a -- | Whether the algebraic number is a rational. isRational :: AReal -> Bool -isRational x = deg x == 1 +isRational x = P.deg x == 1 -- | Whether the algebraic number is a root of a polynomial with integer -- coefficients with leading coefficient @1@ (a monic polynomial). isAlgebraicInteger :: AReal -> Bool -isAlgebraicInteger x = cn * fromIntegral d == 1 - where - p = minimalPolynomial x - d = foldl' lcm 1 [denominator c | (c,_) <- terms p] - (cn,_) = leadingTerm grlex p +isAlgebraicInteger x = abs (P.lc P.grlex (P.pp (minimalPolynomial x))) == 1 -- | Height of the algebraic number. +-- +-- The height of an algebraic number is the greatest absolute value of the +-- coefficients of the irreducible and primitive polynomial with integral +-- rational coefficients. height :: AReal -> Integer -height x = maximum [ assert (denominator c' == 1) (abs (numerator c')) - | (c,_) <- terms p, let c' = c * fromInteger d ] - where - p = minimalPolynomial x - d = foldl' lcm 1 [denominator c | (c,_) <- terms p] +height x = maximum [abs (numerator c) | (c,_) <- P.terms $ P.pp $ minimalPolynomial x] -- | root index, satisfying -- @@ -412,7 +413,7 @@ p = minimalPolynomial r appPrec = 10 -instance PrettyCoeff AReal where +instance P.PrettyCoeff AReal where pPrintCoeff = pPrintPrec isNegativeCoeff = (0>) @@ -432,4 +433,4 @@ goldenRatio :: AReal goldenRatio = (1 + root5) / 2 where - [_, root5] = sort $ realRoots' ((var X)^2 - 5) + [_, root5] = sort $ realRoots' ((P.var X)^2 - 5) diff --git a/src/Data/AlgebraicNumber/Root.hs b/src/Data/AlgebraicNumber/Root.hs --- a/src/Data/AlgebraicNumber/Root.hs +++ b/src/Data/AlgebraicNumber/Root.hs @@ -20,11 +20,13 @@ import Data.List import Data.Maybe +import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set -import Data.Polynomial -import qualified Data.Polynomial.GBasis as GB +import Data.Polynomial (Polynomial, UPolynomial, X (..)) +import qualified Data.Polynomial as P +import qualified Data.Polynomial.GroebnerBasis as GB type Var = Int @@ -33,11 +35,7 @@ --------------------------------------------------------------------} normalizePoly :: UPolynomial Rational -> UPolynomial Rational -normalizePoly p - | c == 1 = p - | otherwise = mapCoeff (/ c) p - where - (c,_) = leadingTerm grlex p +normalizePoly = P.toMonic P.grlex rootAdd :: UPolynomial Rational -> UPolynomial Rational -> UPolynomial Rational rootAdd p1 p2 = lift2 (+) p1 p2 @@ -47,35 +45,35 @@ rootShift :: Rational -> UPolynomial Rational -> UPolynomial Rational rootShift 0 p = p -rootShift r p = normalizePoly $ subst p (\X -> var X - constant r) +rootShift r p = normalizePoly $ P.subst p (\X -> P.var X - P.constant r) rootScale :: Rational -> UPolynomial Rational -> UPolynomial Rational -rootScale 0 p = var X -rootScale r p = normalizePoly $ subst p (\X -> constant (recip r) * var X) +rootScale 0 p = P.var X +rootScale r p = normalizePoly $ P.subst p (\X -> P.constant (recip r) * P.var X) rootRecip :: UPolynomial Rational -> UPolynomial Rational -rootRecip p = normalizePoly $ fromTerms [(c, mmFromList [(X, d - deg xs)]) | (c, xs) <- terms p] +rootRecip p = normalizePoly $ P.fromTerms [(c, P.var X `P.mpow` (d - P.deg xs)) | (c, xs) <- P.terms p] where - d = deg p + d = P.deg p -- 代数的数を係数とする多項式の根を、有理数係数多項式の根として表す rootSimpPoly :: (a -> UPolynomial Rational) -> UPolynomial a -> UPolynomial Rational -rootSimpPoly f p = findPoly (var 0) ps +rootSimpPoly f p = findPoly (P.var 0) ps where ys :: [(UPolynomial Rational, Var)] - ys = zip (Set.toAscList $ Set.fromList [f c | (c, _) <- terms p]) [1..] + ys = zip (Set.toAscList $ Set.fromList [f c | (c, _) <- P.terms p]) [1..] - m :: Map.Map (UPolynomial Rational) Var + m :: Map (UPolynomial Rational) Var m = Map.fromDistinctAscList ys p' :: Polynomial Rational Var - p' = eval (\X -> var 0) (mapCoeff (\c -> var (m Map.! (f c))) p) + p' = P.eval (\X -> P.var 0) (P.mapCoeff (\c -> P.var (m Map.! (f c))) p) ps :: [Polynomial Rational Var] - ps = p' : [subst q (\X -> var x) | (q, x) <- ys] + ps = p' : [P.subst q (\X -> P.var x) | (q, x) <- ys] rootNthRoot :: Integer -> UPolynomial Rational -> UPolynomial Rational -rootNthRoot n p = subst p (\X -> (var X)^n) +rootNthRoot n p = P.subst p (\X -> (P.var X)^n) lift2 :: (forall a. Num a => a -> a -> a) -> UPolynomial Rational -> UPolynomial Rational -> UPolynomial Rational @@ -86,37 +84,37 @@ b = 1 f_a_b :: Polynomial Rational Var - f_a_b = f (var a) (var b) + f_a_b = f (P.var a) (P.var b) gbase :: [Polynomial Rational Var] - gbase = [ subst p1 (\X -> var a), subst p2 (\X -> var b) ] + gbase = [ P.subst p1 (\X -> P.var a), P.subst p2 (\X -> P.var b) ] -- ps のもとで c を根とする多項式を求める findPoly :: Polynomial Rational Var -> [Polynomial Rational Var] -> UPolynomial Rational -findPoly c ps = normalizePoly $ sum [constant coeff * (var X) ^ n | (n,coeff) <- zip [0..] coeffs] +findPoly c ps = normalizePoly $ sum [P.constant coeff * (P.var X) ^ n | (n,coeff) <- zip [0..] coeffs] where vn :: Var vn = if Set.null vs then 0 else Set.findMax vs + 1 where - vs = Set.fromList [x | p <- (c:ps), (_,xs) <- terms p, (x,_) <- mmToList xs] + vs = Set.fromList [x | p <- (c:ps), (_,xs) <- P.terms p, (x,_) <- P.mindices xs] coeffs :: [Rational] coeffs = head $ catMaybes $ [isLinearlyDependent cs2 | cs2 <- inits cs] where - cmp = grlex + cmp = P.grlex ps' = GB.basis cmp ps - cs = iterate (\p -> reduce cmp (c * p) ps') 1 + cs = iterate (\p -> P.reduce cmp (c * p) ps') 1 isLinearlyDependent :: [Polynomial Rational Var] -> Maybe [Rational] isLinearlyDependent cs = if any (0/=) sol then Just sol else Nothing where cs2 = zip [vn..] cs - sol = map (\(l,_) -> eval (\_ -> 1) $ reduce cmp2 (var l) gbase2) cs2 - cmp2 = grlex + sol = map (\(l,_) -> P.eval (\_ -> 1) $ P.reduce cmp2 (P.var l) gbase2) cs2 + cmp2 = P.grlex gbase2 = GB.basis cmp2 es es = Map.elems $ Map.fromListWith (+) $ do - (n,xs) <- terms $ sum [var ln * cn | (ln,cn) <- cs2] - let xs' = mmToList xs - ys = mmFromList [(x,m) | (x,m) <- xs', x < vn] - zs = mmFromList [(x,m) | (x,m) <- xs', x >= vn] - return (ys, fromMonomial (n,zs)) + (n,xs) <- P.terms $ sum [P.var ln * cn | (ln,cn) <- cs2] + let xs' = P.mindicesMap xs + ys = P.mfromIndicesMap $ Map.filterWithKey (\x _ -> x < vn) xs' + zs = P.mfromIndicesMap $ Map.filterWithKey (\x _ -> x >= vn) xs' + return (ys, P.fromTerm (n,zs)) diff --git a/src/Data/LA.hs b/src/Data/LA.hs --- a/src/Data/LA.hs +++ b/src/Data/LA.hs @@ -58,8 +58,9 @@ import Control.DeepSeq import Data.List import Data.Maybe -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet import qualified Data.ArithRel as ArithRel import Data.Interval import Data.Var @@ -73,23 +74,23 @@ newtype Expr r = Expr { -- | a mapping from variables to coefficients - coeffMap :: IM.IntMap r + coeffMap :: IntMap r } deriving (Eq, Ord) -- | Create a @Expr@ from a mapping from variables to coefficients. -fromCoeffMap :: (Num r, Eq r) => IM.IntMap r -> Expr r +fromCoeffMap :: (Num r, Eq r) => IntMap r -> Expr r fromCoeffMap m = normalizeExpr (Expr m) -- | terms contained in the expression. terms :: Expr r -> [(r,Var)] -terms (Expr m) = [(c,v) | (v,c) <- IM.toList m] +terms (Expr m) = [(c,v) | (v,c) <- IntMap.toList m] -- | Create a @Expr@ from a list of terms. fromTerms :: (Num r, Eq r) => [(r,Var)] -> Expr r -fromTerms ts = fromCoeffMap $ IM.fromListWith (+) [(x,c) | (c,x) <- ts] +fromTerms ts = fromCoeffMap $ IntMap.fromListWith (+) [(x,c) | (c,x) <- ts] instance Variables (Expr r) where - vars (Expr m) = IS.delete unitVar (IM.keysSet m) + vars (Expr m) = IntSet.delete unitVar (IntMap.keysSet m) instance Show r => Show (Expr r) where showsPrec d m = showParen (d > 10) $ @@ -110,41 +111,41 @@ asConst :: Num r => Expr r -> Maybe r asConst (Expr m) = - case IM.toList m of + case IntMap.toList m of [] -> Just 0 [(v,x)] | v==unitVar -> Just x _ -> Nothing normalizeExpr :: (Num r, Eq r) => Expr r -> Expr r -normalizeExpr (Expr t) = Expr $ IM.filter (0/=) t +normalizeExpr (Expr t) = Expr $ IntMap.filter (0/=) t -- | variable var :: Num r => Var -> Expr r -var v = Expr $ IM.singleton v 1 +var v = Expr $ IntMap.singleton v 1 -- | constant constant :: (Num r, Eq r) => r -> Expr r -constant c = normalizeExpr $ Expr $ IM.singleton unitVar c +constant c = normalizeExpr $ Expr $ IntMap.singleton unitVar c -- | map coefficients. mapCoeff :: (Num b, Eq b) => (a -> b) -> Expr a -> Expr b -mapCoeff f (Expr t) = Expr $ IM.mapMaybe g t +mapCoeff f (Expr t) = Expr $ IntMap.mapMaybe g t where g c = if c' == 0 then Nothing else Just c' where c' = f c -- | map coefficients. mapCoeffWithVar :: (Num b, Eq b) => (a -> Var -> b) -> Expr a -> Expr b -mapCoeffWithVar f (Expr t) = Expr $ IM.mapMaybeWithKey g t +mapCoeffWithVar f (Expr t) = Expr $ IntMap.mapMaybeWithKey g t where g v c = if c' == 0 then Nothing else Just c' where c' = f c v instance (Num r, Eq r) => AdditiveGroup (Expr r) where - Expr t ^+^ e2 | IM.null t = e2 - e1 ^+^ Expr t | IM.null t = e1 + Expr t ^+^ e2 | IntMap.null t = e2 + e1 ^+^ Expr t | IntMap.null t = e1 e1 ^+^ e2 = normalizeExpr $ plus e1 e2 - zeroV = Expr $ IM.empty + zeroV = Expr $ IntMap.empty negateV = ((-1) *^) instance (Num r, Eq r) => VectorSpace (Expr r) where @@ -154,30 +155,30 @@ c *^ e = mapCoeff (c*) e plus :: Num r => Expr r -> Expr r -> Expr r -plus (Expr t1) (Expr t2) = Expr $ IM.unionWith (+) t1 t2 +plus (Expr t1) (Expr t2) = Expr $ IntMap.unionWith (+) t1 t2 -- | evaluate the expression under the model. evalExpr :: Num r => Model r -> Expr r -> r -evalExpr m (Expr t) = sum [(m' IM.! v) * c | (v,c) <- IM.toList t] - where m' = IM.insert unitVar 1 m +evalExpr m (Expr t) = sum [(m' IntMap.! v) * c | (v,c) <- IntMap.toList t] + where m' = IntMap.insert unitVar 1 m -- | evaluate the expression under the model. evalLinear :: VectorSpace a => Model a -> a -> Expr (Scalar a) -> a -evalLinear m u (Expr t) = sumV [c *^ (m' IM.! v) | (v,c) <- IM.toList t] - where m' = IM.insert unitVar u m +evalLinear m u (Expr t) = sumV [c *^ (m' IntMap.! v) | (v,c) <- IntMap.toList t] + where m' = IntMap.insert unitVar u m lift1 :: VectorSpace x => x -> (Var -> x) -> Expr (Scalar x) -> x -lift1 unit f (Expr t) = sumV [c *^ (g v) | (v,c) <- IM.toList t] +lift1 unit f (Expr t) = sumV [c *^ (g v) | (v,c) <- IntMap.toList t] where g v | v==unitVar = unit | otherwise = f v applySubst :: (Num r, Eq r) => VarMap (Expr r) -> Expr r -> Expr r -applySubst s (Expr m) = sumV (map f (IM.toList m)) +applySubst s (Expr m) = sumV (map f (IntMap.toList m)) where f (v,c) = c *^ ( - case IM.lookup v s of + case IntMap.lookup v s of Just tm -> tm Nothing -> var v) @@ -193,7 +194,7 @@ -- coeff v e == fst (extract v e) -- @ coeff :: Num r => Var -> Expr r -> r -coeff v (Expr m) = IM.findWithDefault 0 v m +coeff v (Expr m) = IntMap.findWithDefault 0 v m -- | lookup a coefficient of the variable. -- It returns @Nothing@ if the expression does not contain @v@. @@ -201,15 +202,15 @@ -- lookupCoeff v e == fmap fst (extractMaybe v e) -- @ lookupCoeff :: Num r => Var -> Expr r -> Maybe r -lookupCoeff v (Expr m) = IM.lookup v m +lookupCoeff v (Expr m) = IntMap.lookup v m -- | @extract v e@ returns @(c, e')@ such that @e == c *^ v ^+^ e'@ extract :: Num r => Var -> Expr r -> (r, Expr r) -extract v (Expr m) = (IM.findWithDefault 0 v m, Expr (IM.delete v m)) +extract v (Expr m) = (IntMap.findWithDefault 0 v m, Expr (IntMap.delete v m)) {- -- Alternative implementation which may be faster but allocte more memory extract v (Expr m) = - case IM.updateLookupWithKey (\_ _ -> Nothing) v m of + case IntMap.updateLookupWithKey (\_ _ -> Nothing) v m of (Nothing, _) -> (0, Expr m) (Just c, m2) -> (c, Expr m2) -} @@ -218,13 +219,13 @@ -- if @e@ contains v, and returns @Nothing@ otherwise. extractMaybe :: Num r => Var -> Expr r -> Maybe (r, Expr r) extractMaybe v (Expr m) = - case IM.lookup v m of + case IntMap.lookup v m of Nothing -> Nothing - Just c -> Just (c, Expr (IM.delete v m)) + Just c -> Just (c, Expr (IntMap.delete v m)) {- -- Alternative implementation which may be faster but allocte more memory extractMaybe v (Expr m) = - case IM.updateLookupWithKey (\_ _ -> Nothing) v m of + case IntMap.updateLookupWithKey (\_ _ -> Nothing) v m of (Nothing, _) -> Nothing (Just c, m2) -> Just (c, Expr m2) -} @@ -241,8 +242,8 @@ ts = [if c==1 then showString (env x) else showsPrec 8 c . showString "*" . showString (env x) - | (x,c) <- IM.toList m, x /= unitVar] ++ - [showsPrec 7 c | c <- maybeToList (IM.lookup unitVar m)] + | (x,c) <- IntMap.toList m, x /= unitVar] ++ + [showsPrec 7 c | c <- maybeToList (IntMap.lookup unitVar m)] ----------------------------------------------------------------------------- diff --git a/src/Data/Polyhedron.hs b/src/Data/Polyhedron.hs --- a/src/Data/Polyhedron.hs +++ b/src/Data/Polyhedron.hs @@ -22,7 +22,8 @@ import Data.List import Data.Ratio -import qualified Data.IntSet as IS +import qualified Data.IntSet as IntSet +import Data.Map (Map) import qualified Data.Map as Map import Data.VectorSpace import Prelude hiding (null) @@ -43,13 +44,13 @@ -- | Intersection of half-spaces data Polyhedron - = Polyhedron (Map.Map ExprZ IntervalR) + = Polyhedron (Map ExprZ IntervalR) | Empty deriving (Eq) instance Variables Polyhedron where - vars (Polyhedron m) = IS.unions [vars e | e <- Map.keys m] - vars Empty = IS.empty + vars (Polyhedron m) = IntSet.unions [vars e | e <- Map.keys m] + vars Empty = IntSet.empty instance JoinSemiLattice Polyhedron where join Empty b = b diff --git a/src/Data/Polynomial.hs b/src/Data/Polynomial.hs --- a/src/Data/Polynomial.hs +++ b/src/Data/Polynomial.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies, BangPatterns, DeriveDataTypeable #-} +{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Polynomial @@ -7,7 +7,7 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (ScopedTypeVariables, TypeFamilies, BangPatterns, DeriveDataTypeable) +-- Portability : portable -- -- Polynomials -- @@ -24,76 +24,84 @@ ( -- * Polynomial type Polynomial - , UPolynomial - , X (..) -- * Conversion - , Variables (..) + , Var (..) , constant , terms , fromTerms , coeffMap , fromCoeffMap - , fromMonomial + , fromTerm -- * Query , Degree (..) - , leadingTerm + , Vars (..) + , lt + , lc + , lm , coeff , lookupCoeff , isPrimitive + , isRootOf -- * Operations + , Factor (..) + , SQFree (..) , ContPP (..) , deriv , integral , eval - , evalA - , evalM , subst - , substA - , substM - , isRootOf - , mapVar , mapCoeff - , associatedMonicPolynomial + , toMonic , toUPolynomialOf - , polyDiv - , polyMod - , polyDivMod - , polyGCD - , polyLCM - , prem - , polyGCD' - , polyMDivMod + , divModMP , reduce - -- * Monomial - , Monomial - , monomialDegree - , monomialProd - , monomialDivisible - , monomialDiv - , monomialDeriv - , monomialIntegral + -- * Univariate polynomials + , UPolynomial + , X (..) + , UTerm + , UMonomial + , div + , mod + , divMod + , divides + , gcd + , lcm + , exgcd + , pdivMod + , pdiv + , pmod + , gcd' + , isSquareFree + -- * Term + , Term + , tdeg + , tmult + , tdivides + , tdiv + , tderiv + , tintegral + -- * Monic monomial - , MonicMonomial - , mmOne - , mmFromList - , mmFromMap - , mmFromIntMap - , mmToList - , mmToMap - , mmToIntMap - , mmProd - , mmDivisible - , mmDiv - , mmDeriv - , mmIntegral - , mmLCM - , mmGCD - , mmMapVar + , Monomial + , mone + , mfromIndices + , mfromIndicesMap + , mindices + , mindicesMap + , mmult + , mpow + , mdivides + , mdiv + , mderiv + , mintegral + , mlcm + , mgcd + , mcoprime -- * Monomial order , MonomialOrder @@ -110,637 +118,8 @@ , PrettyVar (..) ) where -import Prelude hiding (lex) -import Control.Applicative -import Control.DeepSeq -import Control.Exception (assert) -import Control.Monad -import Data.Data -import qualified Data.FiniteField as FF -import Data.Function -import Data.List -import Data.Monoid -import Data.Ratio -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.IntMap as IM -import Data.Traversable (for, traverse) -import Data.Typeable -import Data.VectorSpace -import qualified Text.PrettyPrint.HughesPJClass as PP -import Text.PrettyPrint.HughesPJClass (Doc, PrettyLevel, Pretty (..), prettyParen) - -infixl 7 `polyDiv`, `polyMod` - -{-------------------------------------------------------------------- - Classes ---------------------------------------------------------------------} - -class Variables f where - var :: Ord v => v -> f v - variables :: Ord v => f v -> Set.Set v - --- | total degree of a given polynomial -class Degree t where - deg :: t -> Integer - -{-------------------------------------------------------------------- - Polynomial type ---------------------------------------------------------------------} - --- | Polynomial over commutative ring r -newtype Polynomial k v = Polynomial{ coeffMap :: Map.Map (MonicMonomial v) k } - deriving (Eq, Ord, Typeable) - -instance (Eq k, Num k, Ord v) => Num (Polynomial k v) where - (+) = plus - (*) = prod - negate = neg - abs x = x -- OK? - signum x = 1 -- OK? - fromInteger x = constant (fromInteger x) - -instance (Eq k, Num k, Ord v) => AdditiveGroup (Polynomial k v) where - (^+^) = plus - zeroV = zero - negateV = neg - -instance (Eq k, Num k, Ord v) => VectorSpace (Polynomial k v) where - type Scalar (Polynomial k v) = k - k *^ p = scale k p - -instance (Show v, Ord v, Show k) => Show (Polynomial k v) where - showsPrec d p = showParen (d > 10) $ - showString "fromTerms " . shows (terms p) - -instance (NFData k, NFData v) => NFData (Polynomial k v) where - rnf (Polynomial m) = rnf m - -instance (Eq k, Num k) => Variables (Polynomial k) where - var x = fromMonomial (1, var x) - variables p = Set.unions $ [variables mm | (_, mm) <- terms p] - -instance Degree (Polynomial k v) where - deg p - | isZero p = -1 - | otherwise = maximum [deg mm | (_,mm) <- terms p] - -normalize :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -normalize (Polynomial m) = Polynomial (Map.filter (0/=) m) - -asConstant :: Num k => Polynomial k v -> Maybe k -asConstant p = - case terms p of - [] -> Just 0 - [(c,xs)] | Map.null (mmToMap xs) -> Just c - _ -> Nothing - -scale :: (Eq k, Num k, Ord v) => k -> Polynomial k v -> Polynomial k v -scale 0 _ = zero -scale 1 p = p -scale a (Polynomial m) = normalize $ Polynomial (Map.map (a*) m) - -zero :: (Eq k, Num k, Ord v) => Polynomial k v -zero = Polynomial $ Map.empty - -plus :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -> Polynomial k v -plus (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.unionWith (+) m1 m2 - -neg :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -neg (Polynomial m) = Polynomial $ Map.map negate m - -prod :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -> Polynomial k v -prod a b - | Just c <- asConstant a = scale c b - | Just c <- asConstant b = scale c a -prod (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.fromListWith (+) - [ (xs1 `mmProd` xs2, c1*c2) - | (xs1,c1) <- Map.toList m1, (xs2,c2) <- Map.toList m2 - ] - -isZero :: Polynomial k v -> Bool -isZero (Polynomial m) = Map.null m - --- | construct a polynomial from a constant -constant :: (Eq k, Num k, Ord v) => k -> Polynomial k v -constant c = fromMonomial (c, mmOne) - --- | construct a polynomial from a list of monomials -fromTerms :: (Eq k, Num k, Ord v) => [Monomial k v] -> Polynomial k v -fromTerms = normalize . Polynomial . Map.fromListWith (+) . map (\(c,xs) -> (xs,c)) - -fromCoeffMap :: (Eq k, Num k, Ord v) => Map.Map (MonicMonomial v) k -> Polynomial k v -fromCoeffMap m = normalize $ Polynomial m - --- | construct a polynomial from a monomial -fromMonomial :: (Eq k, Num k, Ord v) => Monomial k v -> Polynomial k v -fromMonomial (c,xs) = normalize $ Polynomial $ Map.singleton xs c - --- | list of monomials -terms :: Polynomial k v -> [Monomial k v] -terms (Polynomial m) = [(c,xs) | (xs,c) <- Map.toList m] - --- | leading term with respect to a given monomial order -leadingTerm :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> Monomial k v -leadingTerm cmp p = - case terms p of - [] -> (0, mmOne) -- should be error? - ms -> maximumBy (cmp `on` snd) ms - -coeff :: (Num k, Ord v) => MonicMonomial v -> Polynomial k v -> k -coeff xs (Polynomial m) = Map.findWithDefault 0 xs m - -lookupCoeff :: Ord v => MonicMonomial v -> Polynomial k v -> Maybe k -lookupCoeff xs (Polynomial m) = Map.lookup xs m - -contI :: (Integral r, Ord v) => Polynomial r v -> r -contI 0 = 1 -contI p = foldl1' gcd [abs c | (c,_) <- terms p] - -ppI :: (Integral r, Ord v) => Polynomial r v -> Polynomial r v -ppI p = mapCoeff f p - where - c = contI p - f x = assert (x `mod` c == 0) $ x `div` c - -class ContPP k where - -- | Content of a polynomial - cont :: (Ord v) => Polynomial k v -> k - -- constructive-algebra-0.3.0 では cont 0 は error になる - - -- | Primitive part of a polynomial - pp :: (Ord v) => Polynomial k v -> Polynomial k v - -instance ContPP Integer where - cont = contI - pp = ppI - -instance Integral r => ContPP (Ratio r) where - {-# SPECIALIZE instance ContPP (Ratio Integer) #-} - - cont 0 = 1 - cont p = foldl1' gcd ns % foldl' lcm 1 ds - where - ns = [abs (numerator c) | (c,_) <- terms p] - ds = [denominator c | (c,_) <- terms p] - - pp p = mapCoeff (/ c) p - where - c = cont p - -isPrimitive :: (Eq k, Num k, ContPP k, Ord v) => Polynomial k v -> Bool -isPrimitive p = isZero p || cont p == 1 - --- | Formal derivative of polynomials -deriv :: (Eq k, Num k, Ord v) => Polynomial k v -> v -> Polynomial k v -deriv p x = sumV [fromMonomial (monomialDeriv m x) | m <- terms p] - --- | Formal integral of polynomials -integral :: (Eq k, Fractional k, Ord v) => Polynomial k v -> v -> Polynomial k v -integral p x = sumV [fromMonomial (monomialIntegral m x) | m <- terms p] - --- | Evaluation -eval :: (Num k, Ord v) => (v -> k) -> Polynomial k v -> k -eval env p = sum [c * product [(env x) ^ e | (x,e) <- mmToList xs] | (c,xs) <- terms p] - --- | Evaluation -evalA :: forall k v f. (Num k, Ord v, Applicative f) => (v -> f k) -> Polynomial k v -> f k -evalA env p = sum <$> traverse f (terms p) - where - f :: Monomial k v -> f k - f (c,xs) = ((c*) . product) <$> g xs - g :: MonicMonomial v -> f [k] - g xs = traverse (\(x,e) -> liftA (^ e) (env x)) (mmToList xs) - --- | Evaluation -evalM :: (Num k, Ord v, Monad m) => (v -> m k) -> Polynomial k v -> m k -evalM env p = do - liftM sum $ forM (terms p) $ \(c,xs) -> do - rs <- mapM (\(x,e) -> liftM (^ e) (env x)) (mmToList xs) - return (c * product rs) - --- | Substitution or bind -subst - :: (Eq k, Num k, Ord v1, Ord v2) - => Polynomial k v1 -> (v1 -> Polynomial k v2) -> Polynomial k v2 -subst p s = - sumV [constant c * product [(s x)^e | (x,e) <- mmToList xs] | (c, xs) <- terms p] - --- | Substitution or bind -substA - :: forall k v1 v2 f. (Eq k, Num k, Ord v1, Ord v2, Applicative f) - => Polynomial k v1 -> (v1 -> f (Polynomial k v2)) -> f (Polynomial k v2) -substA p s = sumV <$> traverse f (terms p) - where - f :: Monomial k v1 -> f (Polynomial k v2) - f (c,xs) = ((constant c *) . product) <$> g xs - g :: MonicMonomial v1 -> f [Polynomial k v2] - g xs = traverse (\(x,e) -> liftA (^ e) (s x)) (mmToList xs) - --- | Substitution or bind -substM - :: (Eq k, Num k, Ord v1, Ord v2, Monad m) - => Polynomial k v1 -> (v1 -> m (Polynomial k v2)) -> m (Polynomial k v2) -substM p s = liftM sum $ forM (terms p) $ \(c,xs) -> do - xs <- forM (mmToList xs) $ \(x,e) -> liftM (^e) (s x) - return $ constant c * product xs - -isRootOf :: (Eq k, Num k) => k -> UPolynomial k -> Bool -isRootOf x p = eval (\_ -> x) p == 0 - -mapVar :: (Eq k, Num k, Ord v1, Ord v2) => (v1 -> v2) -> Polynomial k v1 -> Polynomial k v2 -mapVar f (Polynomial m) = normalize $ Polynomial $ Map.mapKeysWith (+) (mmMapVar f) m - -mapCoeff :: (Eq k1, Num k1, Ord v) => (k -> k1) -> Polynomial k v -> Polynomial k1 v -mapCoeff f (Polynomial m) = Polynomial $ Map.mapMaybe g m - where - g x = if y == 0 then Nothing else Just y - where - y = f x - -associatedMonicPolynomial :: (Eq r, Fractional r, Ord v) => MonomialOrder v -> Polynomial r v -> Polynomial r v -associatedMonicPolynomial cmp p - | c == 0 = p - | otherwise = mapCoeff (/c) p - where - (c,_) = leadingTerm cmp p - -toUPolynomialOf :: (Ord k, Num k, Ord v) => Polynomial k v -> v -> UPolynomial (Polynomial k v) -toUPolynomialOf p v = fromTerms $ do - (c,mm) <- terms p - let m = mmToMap mm - return ( fromTerms [(c, mmFromMap (Map.delete v m))] - , mmFromList [(X, Map.findWithDefault 0 v m)] - ) - --- | Multivariate division algorithm -polyMDivMod - :: forall k v. (Eq k, Fractional k, Ord v) - => MonomialOrder v -> Polynomial k v -> [Polynomial k v] -> ([Polynomial k v], Polynomial k v) -polyMDivMod cmp p fs = go IM.empty p - where - ls = [(leadingTerm cmp f, f) | f <- fs] - - go :: IM.IntMap (Polynomial k v) -> Polynomial k v -> ([Polynomial k v], Polynomial k v) - go qs g = - case xs of - [] -> ([IM.findWithDefault 0 i qs | i <- [0 .. length fs - 1]], g) - (i, b, g') : _ -> go (IM.insertWith (+) i b qs) g' - where - ms = sortBy (flip cmp `on` snd) (terms g) - xs = do - (i,(a,f)) <- zip [0..] ls - h <- ms - guard $ monomialDivisible h a - let b = fromMonomial $ monomialDiv h a - return (i, b, g - b * f) - --- | Multivariate division algorithm -reduce - :: (Eq k, Fractional k, Ord v) - => MonomialOrder v -> Polynomial k v -> [Polynomial k v] -> Polynomial k v -reduce cmp p fs = go p - where - ls = [(leadingTerm cmp f, f) | f <- fs] - go g = if null xs then g else go (head xs) - where - ms = sortBy (flip cmp `on` snd) (terms g) - xs = do - (a,f) <- ls - h <- ms - guard $ monomialDivisible h a - return (g - fromMonomial (monomialDiv h a) * f) - -{-------------------------------------------------------------------- - Pretty printing ---------------------------------------------------------------------} - -data PrintOptions k v - = PrintOptions - { pOptPrintVar :: PrettyLevel -> Rational -> v -> Doc - , pOptPrintCoeff :: PrettyLevel -> Rational -> k -> Doc - , pOptIsNegativeCoeff :: k -> Bool - , pOptMonomialOrder :: MonomialOrder v - } - -defaultPrintOptions :: (PrettyCoeff k, PrettyVar v, Ord v) => PrintOptions k v -defaultPrintOptions - = PrintOptions - { pOptPrintVar = pPrintVar - , pOptPrintCoeff = pPrintCoeff - , pOptIsNegativeCoeff = isNegativeCoeff - , pOptMonomialOrder = grlex - } - -instance (Ord k, Num k, Ord v, PrettyCoeff k, PrettyVar v) => Pretty (Polynomial k v) where - pPrintPrec = prettyPrint defaultPrintOptions - -prettyPrint - :: (Ord k, Num k, Ord v) - => PrintOptions k v - -> PrettyLevel -> Rational -> Polynomial k v -> Doc -prettyPrint opt lv prec p = - case sortBy (flip (pOptMonomialOrder opt) `on` snd) $ terms p of - [] -> PP.int 0 - [t] -> pLeadingTerm prec t - t:ts -> - prettyParen (prec > addPrec) $ - PP.hcat (pLeadingTerm addPrec t : map pTrailingTerm ts) - where - pLeadingTerm prec (c,xs) = - if pOptIsNegativeCoeff opt c - then prettyParen (prec > addPrec) $ - PP.char '-' <> prettyPrintMonomial opt lv (addPrec+1) (-c,xs) - else prettyPrintMonomial opt lv prec (c,xs) - - pTrailingTerm (c,xs) = - if pOptIsNegativeCoeff opt c - then PP.space <> PP.char '-' <> PP.space <> prettyPrintMonomial opt lv (addPrec+1) (-c,xs) - else PP.space <> PP.char '+' <> PP.space <> prettyPrintMonomial opt lv (addPrec+1) (c,xs) - -prettyPrintMonomial - :: (Ord k, Num k, Ord v) - => PrintOptions k v - -> PrettyLevel -> Rational -> Monomial k v -> Doc -prettyPrintMonomial opt lv prec (c,xs) - | len == 0 = pOptPrintCoeff opt lv (appPrec+1) c - -- intentionally specify (appPrec+1) to parenthesize any composite expression - | len == 1 && c == 1 = pPow prec $ head (mmToList xs) - | otherwise = - prettyParen (prec > mulPrec) $ - PP.hcat $ intersperse (PP.char '*') fs - where - len = length $ mmToList xs - fs = [pOptPrintCoeff opt lv (appPrec+1) c | c /= 1] ++ [pPow (mulPrec+1) p | p <- mmToList xs] - -- intentionally specify (appPrec+1) to parenthesize any composite expression - - pPow prec (x,1) = pOptPrintVar opt lv prec x - pPow prec (x,n) = - prettyParen (prec > expPrec) $ - pOptPrintVar opt lv (expPrec+1) x <> PP.char '^' <> PP.integer n - -class PrettyCoeff a where - pPrintCoeff :: PrettyLevel -> Rational -> a -> Doc - isNegativeCoeff :: a -> Bool - isNegativeCoeff _ = False - -instance PrettyCoeff Integer where - pPrintCoeff = pPrintPrec - isNegativeCoeff = (0>) - -instance (PrettyCoeff a, Integral a) => PrettyCoeff (Ratio a) where - pPrintCoeff lv p r - | denominator r == 1 = pPrintCoeff lv p (numerator r) - | otherwise = - prettyParen (p > ratPrec) $ - pPrintCoeff lv (ratPrec+1) (numerator r) <> - PP.char '/' <> - pPrintCoeff lv (ratPrec+1) (denominator r) - isNegativeCoeff x = isNegativeCoeff (numerator x) - -instance PrettyCoeff (FF.PrimeField a) where - pPrintCoeff lv p a = pPrintCoeff lv p (FF.toInteger a) - isNegativeCoeff _ = False - -instance (Num c, Ord c, PrettyCoeff c, Ord v, PrettyVar v) => PrettyCoeff (Polynomial c v) where - pPrintCoeff = pPrintPrec - -class PrettyVar a where - pPrintVar :: PrettyLevel -> Rational -> a -> Doc - -instance PrettyVar Int where - pPrintVar _ _ n = PP.char 'x' <> PP.int n - -instance PrettyVar X where - pPrintVar _ _ X = PP.char 'x' - -addPrec, mulPrec, ratPrec, expPrec :: Rational -addPrec = 6 -- Precedence of '+' -mulPrec = 7 -- Precedence of '*' -ratPrec = 7 -- Precedence of '/' -expPrec = 8 -- Precedence of '^' -appPrec = 10 -- Precedence of function application - -{-------------------------------------------------------------------- - Univariate polynomials ---------------------------------------------------------------------} - --- | Univariate polynomials over commutative ring r -type UPolynomial r = Polynomial r X - -data X = X - deriving (Eq, Ord, Bounded, Enum, Show, Read, Typeable, Data) - -instance NFData X - --- | division of univariate polynomials -polyDiv :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k -polyDiv f1 f2 = fst (polyDivMod f1 f2) - --- | division of univariate polynomials -polyMod :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k -polyMod f1 f2 = snd (polyDivMod f1 f2) - --- | division of univariate polynomials -polyDivMod :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> (UPolynomial k, UPolynomial k) -polyDivMod f g - | isZero g = error "polyDivMod: division by zero" - | otherwise = go 0 f - where - lt_g = leadingTerm lex g - go !q !r - | deg r < deg g = (q,r) - | otherwise = go (q + t) (r - t * g) - where - lt_r = leadingTerm lex r - t = fromMonomial $ lt_r `monomialDiv` lt_g - --- | GCD of univariate polynomials -polyGCD :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k -polyGCD f1 0 = associatedMonicPolynomial grlex f1 -polyGCD f1 f2 = polyGCD f2 (f1 `polyMod` f2) - --- | LCM of univariate polynomials -polyLCM :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k -polyLCM _ 0 = 0 -polyLCM 0 _ = 0 -polyLCM f1 f2 = associatedMonicPolynomial grlex $ (f1 `polyMod` (polyGCD f1 f2)) * f2 - --- | pseudo reminder -prem :: (Eq r, Integral r) => UPolynomial r -> UPolynomial r -> UPolynomial r -prem _ 0 = error "prem: division by 0" -prem f g - | deg f < deg g = f - | otherwise = go (scale (lc_g ^ (deg f - deg g + 1)) f) - where - (lc_g, lm_g) = leadingTerm lex g - deg_g = deg g - go !f1 - | deg_g > deg f1 = f1 - | otherwise = - assert (lc_f1 `mod` lc_g == 0 && mmDivisible lm_f1 lm_g) $ - go (f1 - fromMonomial (lc_f1 `div` lc_g, lm_f1 `mmDiv` lm_g) * g) - where - (lc_f1, lm_f1) = leadingTerm lex f1 - --- | GCD of univariate polynomials -polyGCD' :: (Eq r, Integral r) => UPolynomial r -> UPolynomial r -> UPolynomial r -polyGCD' f1 0 = ppI f1 -polyGCD' f1 f2 = polyGCD' f2 (f1 `prem` f2) - -{-------------------------------------------------------------------- - Monomial ---------------------------------------------------------------------} - -type Monomial k v = (k, MonicMonomial v) - -monomialDegree :: Monomial k v -> Integer -monomialDegree (_,xs) = deg xs - -monomialProd :: (Num k, Ord v) => Monomial k v -> Monomial k v -> Monomial k v -monomialProd (c1,xs1) (c2,xs2) = (c1*c2, xs1 `mmProd` xs2) - -monomialDivisible :: (Fractional k, Ord v) => Monomial k v -> Monomial k v -> Bool -monomialDivisible (c1,xs1) (c2,xs2) = mmDivisible xs1 xs2 - -monomialDiv :: (Fractional k, Ord v) => Monomial k v -> Monomial k v -> Monomial k v -monomialDiv (c1,xs1) (c2,xs2) = (c1 / c2, xs1 `mmDiv` xs2) - -monomialDeriv :: (Eq k, Num k, Ord v) => Monomial k v -> v -> Monomial k v -monomialDeriv (c,xs) x = - case mmDeriv xs x of - (s,ys) -> (c * fromIntegral s, ys) - -monomialIntegral :: (Eq k, Fractional k, Ord v) => Monomial k v -> v -> Monomial k v -monomialIntegral (c,xs) x = - case mmIntegral xs x of - (s,ys) -> (c * fromRational s, ys) - -{-------------------------------------------------------------------- - Monic Monomial ---------------------------------------------------------------------} - --- 本当は変数の型に応じて type family で表現を変えたい - --- | Monic monomials -newtype MonicMonomial v = MonicMonomial{ mmToMap :: Map.Map v Integer } - deriving (Eq, Ord, Typeable) - -instance (Ord v, Show v) => Show (MonicMonomial v) where - showsPrec d m = showParen (d > 10) $ - showString "mmFromList " . shows (mmToList m) - -instance (NFData v) => NFData (MonicMonomial v) where - rnf (MonicMonomial m) = rnf m - -instance Degree (MonicMonomial v) where - deg (MonicMonomial m) = sum $ Map.elems m - -instance Variables MonicMonomial where - var x = MonicMonomial $ Map.singleton x 1 - variables mm = Map.keysSet (mmToMap mm) - -mmNormalize :: Ord v => MonicMonomial v -> MonicMonomial v -mmNormalize (MonicMonomial m) = MonicMonomial $ Map.filter (>0) m - -mmOne :: MonicMonomial v -mmOne = MonicMonomial $ Map.empty - -mmFromList :: Ord v => [(v, Integer)] -> MonicMonomial v -mmFromList xs - | any (\(x,e) -> 0>e) xs = error "mmFromList: negative exponent" - | otherwise = MonicMonomial $ Map.fromListWith (+) [(x,e) | (x,e) <- xs, e > 0] - -mmFromMap :: Ord v => Map.Map v Integer -> MonicMonomial v -mmFromMap m - | any (\(x,e) -> 0>e) (Map.toList m) = error "mmFromFromMap: negative exponent" - | otherwise = mmNormalize $ MonicMonomial m - -mmFromIntMap :: IM.IntMap Integer -> MonicMonomial Int -mmFromIntMap = mmFromMap . Map.fromDistinctAscList . IM.toAscList - -mmToList :: Ord v => MonicMonomial v -> [(v, Integer)] -mmToList (MonicMonomial m) = Map.toAscList m - -mmToIntMap :: MonicMonomial Int -> IM.IntMap Integer -mmToIntMap (MonicMonomial m) = IM.fromDistinctAscList $ Map.toAscList m - -mmProd :: Ord v => MonicMonomial v -> MonicMonomial v -> MonicMonomial v -mmProd (MonicMonomial xs1) (MonicMonomial xs2) = mmNormalize $ MonicMonomial $ Map.unionWith (+) xs1 xs2 - -mmDivisible :: Ord v => MonicMonomial v -> MonicMonomial v -> Bool -mmDivisible (MonicMonomial xs1) (MonicMonomial xs2) = Map.isSubmapOfBy (<=) xs2 xs1 - -mmDiv :: Ord v => MonicMonomial v -> MonicMonomial v -> MonicMonomial v -mmDiv (MonicMonomial xs1) (MonicMonomial xs2) = MonicMonomial $ Map.differenceWith f xs1 xs2 - where - f m n - | m <= n = Nothing - | otherwise = Just (m - n) - -mmDeriv :: Ord v => MonicMonomial v -> v -> (Integer, MonicMonomial v) -mmDeriv (MonicMonomial xs) x - | n==0 = (0, mmOne) - | otherwise = (n, MonicMonomial $ Map.update f x xs) - where - n = Map.findWithDefault 0 x xs - f m - | m <= 1 = Nothing - | otherwise = Just $! m - 1 - -mmIntegral :: Ord v => MonicMonomial v -> v -> (Rational, MonicMonomial v) -mmIntegral (MonicMonomial xs) x = - (1 % fromIntegral (n + 1), MonicMonomial $ Map.insert x (n+1) xs) - where - n = Map.findWithDefault 0 x xs - -mmLCM :: Ord v => MonicMonomial v -> MonicMonomial v -> MonicMonomial v -mmLCM (MonicMonomial m1) (MonicMonomial m2) = MonicMonomial $ Map.unionWith max m1 m2 - -mmGCD :: Ord v => MonicMonomial v -> MonicMonomial v -> MonicMonomial v -mmGCD (MonicMonomial m1) (MonicMonomial m2) = MonicMonomial $ Map.intersectionWith min m1 m2 - -mmMapVar :: (Ord v1, Ord v2) => (v1 -> v2) -> MonicMonomial v1 -> MonicMonomial v2 -mmMapVar f (MonicMonomial m) = MonicMonomial $ Map.mapKeysWith (+) f m - -{-------------------------------------------------------------------- - Monomial Order ---------------------------------------------------------------------} - -type MonomialOrder v = MonicMonomial v -> MonicMonomial v -> Ordering - --- | Lexicographic order -lex :: Ord v => MonomialOrder v -lex xs1 xs2 = go (mmToList xs1) (mmToList xs2) - where - go [] [] = EQ - go [] _ = LT -- = cmpare 0 n2 - go _ [] = GT -- = cmpare n1 0 - go ((x1,n1):xs1) ((x2,n2):xs2) = - case compare x1 x2 of - LT -> GT -- = compare n1 0 - GT -> LT -- = compare 0 n2 - EQ -> compare n1 n2 `mappend` go xs1 xs2 - --- | Reverse lexicographic order --- Note that revlex is NOT a monomial order. -revlex :: Ord v => MonicMonomial v -> MonicMonomial v -> Ordering -revlex xs1 xs2 = go (reverse (mmToList xs1)) (reverse (mmToList xs2)) - where - go [] [] = EQ - go [] _ = GT -- = cmp 0 n2 - go _ [] = LT -- = cmp n1 0 - go ((x1,n1):xs1) ((x2,n2):xs2) = - case compare x1 x2 of - LT -> GT -- = cmp 0 n2 - GT -> LT -- = cmp n1 0 - EQ -> cmp n1 n2 `mappend` go xs1 xs2 - cmp n1 n2 = compare n2 n1 - --- | graded lexicographic order -grlex :: Ord v => MonomialOrder v -grlex = (compare `on` deg) `mappend` lex - --- | graded reverse lexicographic order -grevlex :: Ord v => MonomialOrder v -grevlex = (compare `on` deg) `mappend` revlex +import Prelude hiding (lex, div, mod, divMod, gcd, lcm) +import Data.Polynomial.Base +import Data.Polynomial.Factorization.FiniteField () +import Data.Polynomial.Factorization.Integer () +import Data.Polynomial.Factorization.Rational () diff --git a/src/Data/Polynomial/Base.hs b/src/Data/Polynomial/Base.hs new file mode 100644 --- /dev/null +++ b/src/Data/Polynomial/Base.hs @@ -0,0 +1,802 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, BangPatterns, DeriveDataTypeable #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Polynomial.Base +-- Copyright : (c) Masahiro Sakai 2012-2013 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, BangPatterns, DeriveDataTypeable) +-- +-- Polynomials +-- +-- References: +-- +-- * Monomial order +-- +-- * Polynomial class for Ruby +-- +-- * constructive-algebra package +-- +----------------------------------------------------------------------------- +module Data.Polynomial.Base + ( + -- * Polynomial type + Polynomial + + -- * Conversion + , Var (..) + , constant + , terms + , fromTerms + , coeffMap + , fromCoeffMap + , fromTerm + + -- * Query + , Degree (..) + , Vars (..) + , lt + , lc + , lm + , coeff + , lookupCoeff + , isPrimitive + , isRootOf + + -- * Operations + , Factor (..) + , SQFree (..) + , ContPP (..) + , deriv + , integral + , eval + , subst + , mapCoeff + , toMonic + , toUPolynomialOf + , divModMP + , reduce + + -- * Univariate polynomials + , UPolynomial + , X (..) + , UTerm + , UMonomial + , div + , mod + , divMod + , divides + , gcd + , lcm + , exgcd + , pdivMod + , pdiv + , pmod + , gcd' + , isSquareFree + + -- * Term + , Term + , tdeg + , tmult + , tdivides + , tdiv + , tderiv + , tintegral + + -- * Monic monomial + , Monomial + , mone + , mfromIndices + , mfromIndicesMap + , mindices + , mindicesMap + , mmult + , mpow + , mdivides + , mdiv + , mderiv + , mintegral + , mlcm + , mgcd + , mcoprime + + -- * Monomial order + , MonomialOrder + , lex + , revlex + , grlex + , grevlex + + -- * Pretty Printing + , PrintOptions (..) + , defaultPrintOptions + , prettyPrint + , PrettyCoeff (..) + , PrettyVar (..) + ) where + +import Prelude hiding (lex, div, mod, divMod, gcd, lcm) +import qualified Prelude +import Control.DeepSeq +import Control.Exception (assert) +import Control.Monad +import Data.Data +import qualified Data.FiniteField as FF +import Data.Function +import Data.List +import Data.Monoid +import Data.Ratio +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.Typeable +import Data.VectorSpace +import qualified Text.PrettyPrint.HughesPJClass as PP +import Text.PrettyPrint.HughesPJClass (Doc, PrettyLevel, Pretty (..), prettyParen) + +infixl 7 `div`, `mod` + +{-------------------------------------------------------------------- + Classes +--------------------------------------------------------------------} + +class Vars a v => Var a v | a -> v where + var :: v -> a + +class Ord v => Vars a v | a -> v where + vars :: a -> Set v + +-- | total degree of a given polynomial +class Degree t where + deg :: t -> Integer + +{-------------------------------------------------------------------- + Polynomial type +--------------------------------------------------------------------} + +-- | Polynomial over commutative ring r +newtype Polynomial r v = Polynomial{ coeffMap :: Map (Monomial v) r } + deriving (Eq, Ord, Typeable) + +instance (Eq k, Num k, Ord v) => Num (Polynomial k v) where + (+) = plus + (*) = mult + negate = neg + abs x = x -- OK? + signum _ = 1 -- OK? + fromInteger x = constant (fromInteger x) + +instance (Eq k, Num k, Ord v) => AdditiveGroup (Polynomial k v) where + (^+^) = plus + zeroV = zero + negateV = neg + +instance (Eq k, Num k, Ord v) => VectorSpace (Polynomial k v) where + type Scalar (Polynomial k v) = k + k *^ p = scale k p + +instance (Show v, Ord v, Show k) => Show (Polynomial k v) where + showsPrec d p = showParen (d > 10) $ + showString "fromTerms " . shows (terms p) + +instance (NFData k, NFData v) => NFData (Polynomial k v) where + rnf (Polynomial m) = rnf m + +instance (Eq k, Num k, Ord v) => Var (Polynomial k v) v where + var x = fromTerm (1, var x) + +instance (Eq k, Num k, Ord v) => Vars (Polynomial k v) v where + vars p = Set.unions $ [vars mm | (_, mm) <- terms p] + +instance Degree (Polynomial k v) where + deg p + | isZero p = -1 + | otherwise = maximum [deg mm | (_,mm) <- terms p] + +normalize :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v +normalize (Polynomial m) = Polynomial (Map.filter (0/=) m) + +asConstant :: Num k => Polynomial k v -> Maybe k +asConstant p = + case terms p of + [] -> Just 0 + [(c,xs)] | Map.null (mindicesMap xs) -> Just c + _ -> Nothing + +scale :: (Eq k, Num k, Ord v) => k -> Polynomial k v -> Polynomial k v +scale 0 _ = zero +scale 1 p = p +scale a (Polynomial m) = normalize $ Polynomial (Map.map (a*) m) + +zero :: (Eq k, Num k, Ord v) => Polynomial k v +zero = Polynomial $ Map.empty + +plus :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -> Polynomial k v +plus (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.unionWith (+) m1 m2 + +neg :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v +neg (Polynomial m) = Polynomial $ Map.map negate m + +mult :: (Eq k, Num k, Ord v) => Polynomial k v -> Polynomial k v -> Polynomial k v +mult a b + | Just c <- asConstant a = scale c b + | Just c <- asConstant b = scale c a +mult (Polynomial m1) (Polynomial m2) = normalize $ Polynomial $ Map.fromListWith (+) + [ (xs1 `mmult` xs2, c1*c2) + | (xs1,c1) <- Map.toList m1, (xs2,c2) <- Map.toList m2 + ] + +isZero :: Polynomial k v -> Bool +isZero (Polynomial m) = Map.null m + +-- | construct a polynomial from a constant +constant :: (Eq k, Num k, Ord v) => k -> Polynomial k v +constant c = fromTerm (c, mone) + +-- | construct a polynomial from a list of monomials +fromTerms :: (Eq k, Num k, Ord v) => [Term k v] -> Polynomial k v +fromTerms = normalize . Polynomial . Map.fromListWith (+) . map (\(c,xs) -> (xs,c)) + +fromCoeffMap :: (Eq k, Num k, Ord v) => Map (Monomial v) k -> Polynomial k v +fromCoeffMap m = normalize $ Polynomial m + +-- | construct a polynomial from a monomial +fromTerm :: (Eq k, Num k, Ord v) => Term k v -> Polynomial k v +fromTerm (c,xs) = normalize $ Polynomial $ Map.singleton xs c + +-- | list of monomials +terms :: Polynomial k v -> [Term k v] +terms (Polynomial m) = [(c,xs) | (xs,c) <- Map.toList m] + +-- | leading term with respect to a given monomial order +lt :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> Term k v +lt cmp p = + case terms p of + [] -> (0, mone) -- should be error? + ms -> maximumBy (cmp `on` snd) ms + +-- | leading coefficient with respect to a given monomial order +lc :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> k +lc cmp = fst . lt cmp + +-- | leading monomial with respect to a given monomial order +lm :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> Monomial v +lm cmp = snd . lt cmp + +coeff :: (Num k, Ord v) => Monomial v -> Polynomial k v -> k +coeff xs (Polynomial m) = Map.findWithDefault 0 xs m + +lookupCoeff :: Ord v => Monomial v -> Polynomial k v -> Maybe k +lookupCoeff xs (Polynomial m) = Map.lookup xs m + +contI :: (Integral r, Ord v) => Polynomial r v -> r +contI 0 = 1 +contI p = foldl1' Prelude.gcd [abs c | (c,_) <- terms p] + +ppI :: (Integral r, Ord v) => Polynomial r v -> Polynomial r v +ppI p = mapCoeff f p + where + c = contI p + f x = assert (x `Prelude.mod` c == 0) $ x `Prelude.div` c + +class ContPP k where + -- | Content of a polynomial + cont :: (Ord v) => Polynomial k v -> k + -- constructive-algebra-0.3.0 では cont 0 は error になる + + -- | Primitive part of a polynomial + pp :: (Ord v) => Polynomial k v -> Polynomial k v + +instance ContPP Integer where + cont = contI + pp = ppI + +instance Integral r => ContPP (Ratio r) where + {-# SPECIALIZE instance ContPP (Ratio Integer) #-} + + cont 0 = 1 + cont p = foldl1' Prelude.gcd ns % foldl' Prelude.lcm 1 ds + where + ns = [abs (numerator c) | (c,_) <- terms p] + ds = [denominator c | (c,_) <- terms p] + + pp p = mapCoeff (/ c) p + where + c = cont p + +isPrimitive :: (Eq k, Num k, ContPP k, Ord v) => Polynomial k v -> Bool +isPrimitive p = isZero p || cont p == 1 + +-- | Formal derivative of polynomials +deriv :: (Eq k, Num k, Ord v) => Polynomial k v -> v -> Polynomial k v +deriv p x = sumV [fromTerm (tderiv m x) | m <- terms p] + +-- | Formal integral of polynomials +integral :: (Eq k, Fractional k, Ord v) => Polynomial k v -> v -> Polynomial k v +integral p x = sumV [fromTerm (tintegral m x) | m <- terms p] + +-- | Evaluation +eval :: (Num k, Ord v) => (v -> k) -> Polynomial k v -> k +eval env p = sum [c * product [(env x) ^ e | (x,e) <- mindices xs] | (c,xs) <- terms p] + +-- | Substitution or bind +subst + :: (Eq k, Num k, Ord v1, Ord v2) + => Polynomial k v1 -> (v1 -> Polynomial k v2) -> Polynomial k v2 +subst p s = + sumV [constant c * product [(s x)^e | (x,e) <- mindices xs] | (c, xs) <- terms p] + +isRootOf :: (Eq k, Num k) => k -> UPolynomial k -> Bool +isRootOf x p = eval (\_ -> x) p == 0 + +isSquareFree :: (Eq k, Fractional k) => UPolynomial k -> Bool +isSquareFree p = gcd p (deriv p X) == 1 + +mapCoeff :: (Eq k1, Num k1, Ord v) => (k -> k1) -> Polynomial k v -> Polynomial k1 v +mapCoeff f (Polynomial m) = Polynomial $ Map.mapMaybe g m + where + g x = if y == 0 then Nothing else Just y + where + y = f x + +toMonic :: (Eq r, Fractional r, Ord v) => MonomialOrder v -> Polynomial r v -> Polynomial r v +toMonic cmp p + | c == 0 || c == 1 = p + | otherwise = mapCoeff (/c) p + where + c = lc cmp p + +toUPolynomialOf :: (Ord k, Num k, Ord v) => Polynomial k v -> v -> UPolynomial (Polynomial k v) +toUPolynomialOf p v = fromTerms $ do + (c,mm) <- terms p + let m = mindicesMap mm + return ( fromTerms [(c, mfromIndicesMap (Map.delete v m))] + , var X `mpow` Map.findWithDefault 0 v m + ) + +-- | Multivariate division algorithm +divModMP + :: forall k v. (Eq k, Fractional k, Ord v) + => MonomialOrder v -> Polynomial k v -> [Polynomial k v] -> ([Polynomial k v], Polynomial k v) +divModMP cmp p fs = go IntMap.empty p + where + ls = [(lt cmp f, f) | f <- fs] + + go :: IntMap (Polynomial k v) -> Polynomial k v -> ([Polynomial k v], Polynomial k v) + go qs g = + case xs of + [] -> ([IntMap.findWithDefault 0 i qs | i <- [0 .. length fs - 1]], g) + (i, b, g') : _ -> go (IntMap.insertWith (+) i b qs) g' + where + ms = sortBy (flip cmp `on` snd) (terms g) + xs = do + (i,(a,f)) <- zip [0..] ls + h <- ms + guard $ a `tdivides` h + let b = fromTerm $ tdiv h a + return (i, b, g - b * f) + +-- | Multivariate division algorithm +reduce + :: (Eq k, Fractional k, Ord v) + => MonomialOrder v -> Polynomial k v -> [Polynomial k v] -> Polynomial k v +reduce cmp p fs = go p + where + ls = [(lt cmp f, f) | f <- fs] + go g = if null xs then g else go (head xs) + where + ms = sortBy (flip cmp `on` snd) (terms g) + xs = do + (a,f) <- ls + h <- ms + guard $ a `tdivides` h + return (g - fromTerm (tdiv h a) * f) + +-- | Factorization of polynomials +class Factor a where + -- | factor a polynomial @p@ into @p1 ^ n1 + p2 ^ n2 + ..@ and + -- return a list @[(p1,n1), (p2,n2), ..]@. + factor :: a -> [(a, Integer)] + +-- | Square-free factorization of polynomials +class SQFree a where + -- | factor a polynomial @p@ into @p1 ^ n1 + p2 ^ n2 + ..@ and + -- return a list @[(p1,n1), (p2,n2), ..]@. + sqfree :: a -> [(a, Integer)] + +{-------------------------------------------------------------------- + Pretty printing +--------------------------------------------------------------------} + +data PrintOptions k v + = PrintOptions + { pOptPrintVar :: PrettyLevel -> Rational -> v -> Doc + , pOptPrintCoeff :: PrettyLevel -> Rational -> k -> Doc + , pOptIsNegativeCoeff :: k -> Bool + , pOptMonomialOrder :: MonomialOrder v + } + +defaultPrintOptions :: (PrettyCoeff k, PrettyVar v, Ord v) => PrintOptions k v +defaultPrintOptions + = PrintOptions + { pOptPrintVar = pPrintVar + , pOptPrintCoeff = pPrintCoeff + , pOptIsNegativeCoeff = isNegativeCoeff + , pOptMonomialOrder = grlex + } + +instance (Ord k, Num k, Ord v, PrettyCoeff k, PrettyVar v) => Pretty (Polynomial k v) where + pPrintPrec = prettyPrint defaultPrintOptions + +prettyPrint + :: (Ord k, Num k, Ord v) + => PrintOptions k v + -> PrettyLevel -> Rational -> Polynomial k v -> Doc +prettyPrint opt lv prec p = + case sortBy (flip (pOptMonomialOrder opt) `on` snd) $ terms p of + [] -> PP.int 0 + [t] -> pLeadingTerm prec t + t:ts -> + prettyParen (prec > addPrec) $ + PP.hcat (pLeadingTerm addPrec t : map pTrailingTerm ts) + where + pLeadingTerm prec (c,xs) = + if pOptIsNegativeCoeff opt c + then prettyParen (prec > addPrec) $ + PP.char '-' <> prettyPrintTerm opt lv (addPrec+1) (-c,xs) + else prettyPrintTerm opt lv prec (c,xs) + + pTrailingTerm (c,xs) = + if pOptIsNegativeCoeff opt c + then PP.space <> PP.char '-' <> PP.space <> prettyPrintTerm opt lv (addPrec+1) (-c,xs) + else PP.space <> PP.char '+' <> PP.space <> prettyPrintTerm opt lv (addPrec+1) (c,xs) + +prettyPrintTerm + :: (Ord k, Num k, Ord v) + => PrintOptions k v + -> PrettyLevel -> Rational -> Term k v -> Doc +prettyPrintTerm opt lv prec (c,xs) + | len == 0 = pOptPrintCoeff opt lv (appPrec+1) c + -- intentionally specify (appPrec+1) to parenthesize any composite expression + | len == 1 && c == 1 = pPow prec $ head (mindices xs) + | otherwise = + prettyParen (prec > mulPrec) $ + PP.hcat $ intersperse (PP.char '*') fs + where + len = Map.size $ mindicesMap xs + fs = [pOptPrintCoeff opt lv (appPrec+1) c | c /= 1] ++ [pPow (mulPrec+1) p | p <- mindices xs] + -- intentionally specify (appPrec+1) to parenthesize any composite expression + + pPow prec (x,1) = pOptPrintVar opt lv prec x + pPow prec (x,n) = + prettyParen (prec > expPrec) $ + pOptPrintVar opt lv (expPrec+1) x <> PP.char '^' <> PP.integer n + +class PrettyCoeff a where + pPrintCoeff :: PrettyLevel -> Rational -> a -> Doc + isNegativeCoeff :: a -> Bool + isNegativeCoeff _ = False + +instance PrettyCoeff Integer where + pPrintCoeff = pPrintPrec + isNegativeCoeff = (0>) + +instance (PrettyCoeff a, Integral a) => PrettyCoeff (Ratio a) where + pPrintCoeff lv p r + | denominator r == 1 = pPrintCoeff lv p (numerator r) + | otherwise = + prettyParen (p > ratPrec) $ + pPrintCoeff lv (ratPrec+1) (numerator r) <> + PP.char '/' <> + pPrintCoeff lv (ratPrec+1) (denominator r) + isNegativeCoeff x = isNegativeCoeff (numerator x) + +instance PrettyCoeff (FF.PrimeField a) where + pPrintCoeff lv p a = pPrintCoeff lv p (FF.toInteger a) + isNegativeCoeff _ = False + +instance (Num c, Ord c, PrettyCoeff c, Ord v, PrettyVar v) => PrettyCoeff (Polynomial c v) where + pPrintCoeff = pPrintPrec + +class PrettyVar a where + pPrintVar :: PrettyLevel -> Rational -> a -> Doc + +instance PrettyVar Int where + pPrintVar _ _ n = PP.char 'x' <> PP.int n + +instance PrettyVar X where + pPrintVar _ _ X = PP.char 'x' + +addPrec, mulPrec, ratPrec, expPrec, appPrec :: Rational +addPrec = 6 -- Precedence of '+' +mulPrec = 7 -- Precedence of '*' +ratPrec = 7 -- Precedence of '/' +expPrec = 8 -- Precedence of '^' +appPrec = 10 -- Precedence of function application + +{-------------------------------------------------------------------- + Univariate polynomials +--------------------------------------------------------------------} + +-- | Univariate polynomials over commutative ring r +type UPolynomial r = Polynomial r X + +data X = X + deriving (Eq, Ord, Bounded, Enum, Show, Read, Typeable, Data) + +instance NFData X + +ucmp :: MonomialOrder X +ucmp = grlex + +-- | division of univariate polynomials +div :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k +div f1 f2 = fst (divMod f1 f2) + +-- | division of univariate polynomials +mod :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k +mod f1 f2 = snd (divMod f1 f2) + +-- | division of univariate polynomials +divMod :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> (UPolynomial k, UPolynomial k) +divMod f g + | isZero g = error "divMod: division by zero" + | otherwise = go 0 f + where + lt_g = lt ucmp g + go !q !r + | deg r < deg g = (q,r) + | otherwise = go (q + t) (r - t * g) + where + lt_r = lt ucmp r + t = fromTerm $ lt_r `tdiv` lt_g + +divides :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> Bool +divides f1 f2 = f2 `mod` f1 == 0 + +-- | GCD of univariate polynomials +gcd :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k +gcd f1 0 = toMonic ucmp f1 +gcd f1 f2 = gcd f2 (f1 `mod` f2) + +-- | LCM of univariate polynomials +lcm :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> UPolynomial k +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm f1 f2 = toMonic ucmp $ (f1 `mod` (gcd f1 f2)) * f2 + +-- | Extended GCD algorithm +exgcd + :: (Eq k, Fractional k) + => UPolynomial k + -> UPolynomial k + -> (UPolynomial k, UPolynomial k, UPolynomial k) +exgcd f1 f2 = f $ go f1 f2 1 0 0 1 + where + go !r0 !r1 !s0 !s1 !t0 !t1 + | r1 == 0 = (r0, s0, t0) + | otherwise = go r1 r2 s1 s2 t1 t2 + where + (q, r2) = r0 `divMod` r1 + s2 = s0 - q*s1 + t2 = t0 - q*t1 + f (g,u,v) + | lc_g == 0 = (g, u, v) + | otherwise = (mapCoeff (/lc_g) g, mapCoeff (/lc_g) u, mapCoeff (/lc_g) v) + where + lc_g = lc ucmp g + +-- | pseudo division +pdivMod :: (Eq r, Num r) => UPolynomial r -> UPolynomial r -> (r, UPolynomial r, UPolynomial r) +pdivMod _ 0 = error "pdivMod: division by 0" +pdivMod f g + | deg f < deg g = (1, 0, f) + | otherwise = go (deg f - deg g + 1) f 0 + where + (lc_g, lm_g) = lt ucmp g + b = lc_g ^ (deg f - deg_g + 1) + deg_g = deg g + go !n !f1 !q + | deg_g > deg f1 = (b, q, scale (lc_g ^ n) f1) + | otherwise = go (n - 1) (scale lc_g f1 - s * g) (q + scale (lc_g ^ (n-1)) s) + where + (lc_f1, lm_f1) = lt ucmp f1 + s = fromTerm (lc_f1, lm_f1 `mdiv` lm_g) + +-- | pseudo quotient +pdiv :: (Eq r, Num r) => UPolynomial r -> UPolynomial r -> UPolynomial r +pdiv f g = + case f `pdivMod` g of + (_, q, _) -> q + +-- | pseudo reminder +pmod :: (Eq r, Num r) => UPolynomial r -> UPolynomial r -> UPolynomial r +pmod _ 0 = error "pmod: division by 0" +pmod f g + | deg f < deg g = f + | otherwise = go (deg f - deg g + 1) f + where + (lc_g, lm_g) = lt ucmp g + deg_g = deg g + go !n !f1 + | deg_g > deg f1 = scale (lc_g ^ n) f1 + | otherwise = go (n - 1) (scale lc_g f1 - s * g) + where + (lc_f1, lm_f1) = lt ucmp f1 + s = fromTerm (lc_f1, lm_f1 `mdiv` lm_g) + +-- | GCD of univariate polynomials +gcd' :: (Eq r, Integral r) => UPolynomial r -> UPolynomial r -> UPolynomial r +gcd' f1 0 = ppI f1 +gcd' f1 f2 = gcd' f2 (f1 `pmod` f2) + +{-------------------------------------------------------------------- + Term +--------------------------------------------------------------------} + +type Term k v = (k, Monomial v) +type UTerm k = Term k X + +tdeg :: Term k v -> Integer +tdeg (_,xs) = deg xs + +tmult :: (Num k, Ord v) => Term k v -> Term k v -> Term k v +tmult (c1,xs1) (c2,xs2) = (c1*c2, xs1 `mmult` xs2) + +tdivides :: (Fractional k, Ord v) => Term k v -> Term k v -> Bool +tdivides (_,xs1) (_,xs2) = xs1 `mdivides` xs2 + +tdiv :: (Fractional k, Ord v) => Term k v -> Term k v -> Term k v +tdiv (c1,xs1) (c2,xs2) = (c1 / c2, xs1 `mdiv` xs2) + +tderiv :: (Eq k, Num k, Ord v) => Term k v -> v -> Term k v +tderiv (c,xs) x = + case mderiv xs x of + (s,ys) -> (c * fromIntegral s, ys) + +tintegral :: (Eq k, Fractional k, Ord v) => Term k v -> v -> Term k v +tintegral (c,xs) x = + case mintegral xs x of + (s,ys) -> (c * fromRational s, ys) + +{-------------------------------------------------------------------- + Monic Monomial +--------------------------------------------------------------------} + +-- 本当は変数の型に応じて type family で表現を変えたい + +-- | Monic monomials +newtype Monomial v = Monomial{ mindicesMap :: Map v Integer } + deriving (Eq, Ord, Typeable) + +type UMonomial = Monomial X + +instance (Ord v, Show v) => Show (Monomial v) where + showsPrec d m = showParen (d > 10) $ + showString "mfromIndices " . shows (mindices m) + +instance (NFData v) => NFData (Monomial v) where + rnf (Monomial m) = rnf m + +instance Degree (Monomial v) where + deg (Monomial m) = sum $ Map.elems m + +instance Ord v => Var (Monomial v) v where + var x = Monomial $ Map.singleton x 1 + +instance Ord v => Vars (Monomial v) v where + vars mm = Map.keysSet (mindicesMap mm) + +mone :: Monomial v +mone = Monomial $ Map.empty + +mfromIndices :: Ord v => [(v, Integer)] -> Monomial v +mfromIndices xs + | any (\(_,e) -> 0>e) xs = error "mfromIndices: negative exponent" + | otherwise = Monomial $ Map.fromListWith (+) [(x,e) | (x,e) <- xs, e > 0] + +mfromIndicesMap :: Ord v => Map v Integer -> Monomial v +mfromIndicesMap m + | any (\(_,e) -> 0>e) (Map.toList m) = error "mfromIndicesMap: negative exponent" + | otherwise = mfromIndicesMap' m + +mfromIndicesMap' :: Ord v => Map v Integer -> Monomial v +mfromIndicesMap' m = Monomial $ Map.filter (>0) m + +mindices :: Ord v => Monomial v -> [(v, Integer)] +mindices = Map.toAscList . mindicesMap + +mmult :: Ord v => Monomial v -> Monomial v -> Monomial v +mmult (Monomial xs1) (Monomial xs2) = mfromIndicesMap' $ Map.unionWith (+) xs1 xs2 + +mpow :: Ord v => Monomial v -> Integer -> Monomial v +mpow _ 0 = mone +mpow m 1 = m +mpow (Monomial xs) e + | 0 > e = error "mpow: negative exponent" + | otherwise = Monomial $ Map.map (e*) xs + +mdivides :: Ord v => Monomial v -> Monomial v -> Bool +mdivides (Monomial xs1) (Monomial xs2) = Map.isSubmapOfBy (<=) xs1 xs2 + +mdiv :: Ord v => Monomial v -> Monomial v -> Monomial v +mdiv (Monomial xs1) (Monomial xs2) = Monomial $ Map.differenceWith f xs1 xs2 + where + f m n + | m <= n = Nothing + | otherwise = Just (m - n) + +mderiv :: Ord v => Monomial v -> v -> (Integer, Monomial v) +mderiv (Monomial xs) x + | n==0 = (0, mone) + | otherwise = (n, Monomial $ Map.update f x xs) + where + n = Map.findWithDefault 0 x xs + f m + | m <= 1 = Nothing + | otherwise = Just $! m - 1 + +mintegral :: Ord v => Monomial v -> v -> (Rational, Monomial v) +mintegral (Monomial xs) x = + (1 % fromIntegral (n + 1), Monomial $ Map.insert x (n+1) xs) + where + n = Map.findWithDefault 0 x xs + +mlcm :: Ord v => Monomial v -> Monomial v -> Monomial v +mlcm (Monomial m1) (Monomial m2) = Monomial $ Map.unionWith max m1 m2 + +mgcd :: Ord v => Monomial v -> Monomial v -> Monomial v +mgcd (Monomial m1) (Monomial m2) = Monomial $ Map.intersectionWith min m1 m2 + +mcoprime :: Ord v => Monomial v -> Monomial v -> Bool +mcoprime m1 m2 = mgcd m1 m2 == mone + +{-------------------------------------------------------------------- + Monomial Order +--------------------------------------------------------------------} + +type MonomialOrder v = Monomial v -> Monomial v -> Ordering + +-- | Lexicographic order +lex :: Ord v => MonomialOrder v +lex xs1 xs2 = go (mindices xs1) (mindices xs2) + where + go [] [] = EQ + go [] _ = LT -- = compare 0 n2 + go _ [] = GT -- = compare n1 0 + go ((x1,n1):xs1) ((x2,n2):xs2) = + case compare x1 x2 of + LT -> GT -- = compare n1 0 + GT -> LT -- = compare 0 n2 + EQ -> compare n1 n2 `mappend` go xs1 xs2 + +-- | Reverse lexicographic order. +-- +-- Note that revlex is NOT a monomial order. +revlex :: Ord v => Monomial v -> Monomial v -> Ordering +revlex xs1 xs2 = go (Map.toDescList (mindicesMap xs1)) (Map.toDescList (mindicesMap xs2)) + where + go [] [] = EQ + go [] _ = GT -- = cmp 0 n2 + go _ [] = LT -- = cmp n1 0 + go ((x1,n1):xs1) ((x2,n2):xs2) = + case compare x1 x2 of + LT -> GT -- = cmp 0 n2 + GT -> LT -- = cmp n1 0 + EQ -> cmp n1 n2 `mappend` go xs1 xs2 + cmp n1 n2 = compare n2 n1 + +-- | Graded lexicographic order +grlex :: Ord v => MonomialOrder v +grlex = (compare `on` deg) `mappend` lex + +-- | Graded reverse lexicographic order +grevlex :: Ord v => MonomialOrder v +grevlex = (compare `on` deg) `mappend` revlex diff --git a/src/Data/Polynomial/Factorization/FiniteField.hs b/src/Data/Polynomial/Factorization/FiniteField.hs --- a/src/Data/Polynomial/Factorization/FiniteField.hs +++ b/src/Data/Polynomial/Factorization/FiniteField.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------------- -- | @@ -8,7 +8,7 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (ScopedTypeVariables, BangPatterns) +-- Portability : non-portable (ScopedTypeVariables, BangPatterns, TypeSynonymInstances, FlexibleInstances) -- -- Factoriation of polynomial over a finite field. -- @@ -34,13 +34,21 @@ import Data.List import Data.Set (Set) import qualified Data.Set as Set -import Data.Polynomial -import qualified Data.Polynomial.GBasis as GB +import Data.Polynomial.Base (Polynomial, UPolynomial, X (..), MonomialOrder) +import qualified Data.Polynomial.Base as P +import qualified Data.Polynomial.GroebnerBasis as GB +import qualified TypeLevel.Number.Nat as TL +instance TL.Nat p => P.Factor (UPolynomial (PrimeField p)) where + factor = factor + +instance TL.Nat p => P.SQFree (UPolynomial (PrimeField p)) where + sqfree = sqfree + factor :: forall k. (Ord k, FiniteField k) => UPolynomial k -> [(UPolynomial k, Integer)] factor f = do (g,n) <- sqfree f - if deg g > 0 + if P.deg g > 0 then do h <- berlekamp g return (h,n) @@ -51,9 +59,9 @@ sqfree :: forall k. (Eq k, FiniteField k) => UPolynomial k -> [(UPolynomial k, Integer)] sqfree f | c == 1 = sqfree' f - | otherwise = (constant c, 1) : sqfree' (mapCoeff (/c) f) + | otherwise = (P.constant c, 1) : sqfree' (P.mapCoeff (/c) f) where - (c,_) = leadingTerm grlex f + c = P.lc ucmp f sqfree' :: forall k. (Eq k, FiniteField k) => UPolynomial k -> [(UPolynomial k, Integer)] sqfree' 0 = [] @@ -62,9 +70,9 @@ | otherwise = go 1 c0 w0 [] where p = char (undefined :: k) - g = deriv f X - c0 = polyGCD f g - w0 = polyDiv f c0 + g = P.deriv f X + c0 = P.gcd f g + w0 = P.div f c0 go !i c w !result | w == 1 = if c == 1 @@ -72,18 +80,21 @@ else result ++ [(h, n*p) | (h,n) <- sqfree' (polyPthRoot c)] | otherwise = go (i+1) c' w' result' where - y = polyGCD w c - z = w `polyDiv` y - c' = c `polyDiv` y + y = P.gcd w c + z = w `P.div` y + c' = c `P.div` y w' = y result' = [(z,i) | z /= 1] ++ result +ucmp :: MonomialOrder X +ucmp = P.grlex + polyPthRoot :: forall k. (Eq k, FiniteField k) => UPolynomial k -> UPolynomial k -polyPthRoot f = assert (deriv f X == 0) $ - fromTerms [(pthRoot c, g mm) | (c,mm) <- terms f] +polyPthRoot f = assert (P.deriv f X == 0) $ + P.fromTerms [(pthRoot c, g mm) | (c,mm) <- P.terms f] where p = char (undefined :: k) - g mm = mmFromList [(X, deg mm `div` p)] + g mm = P.var X `P.mpow` (P.deg mm `div` p) -- | Berlekamp algorithm for polynomial factorization. -- @@ -99,38 +110,40 @@ where func fi = Set.fromList $ hs2 ++ hs1 where - hs1 = [h | k <- allValues, let h = polyGCD fi (b - constant k), deg h > 0] - hs2 = if deg g > 0 then [g] else [] + hs1 = [h | k <- allValues, let h = P.gcd fi (b - P.constant k), P.deg h > 0] + hs2 = if P.deg g > 0 then [g] else [] where - g = fi `polyDiv` product hs1 + g = fi `P.div` product hs1 basis = basisOfBerlekampSubalgebra f r = length basis basisOfBerlekampSubalgebra :: forall k. (Ord k, FiniteField k) => UPolynomial k -> [UPolynomial k] basisOfBerlekampSubalgebra f = - sortBy (flip compare `on` deg) $ - map (associatedMonicPolynomial grlex) $ + sortBy (flip compare `on` P.deg) $ + map (P.toMonic ucmp) $ basis where q = order (undefined :: k) - d = deg f - x = var X + d = P.deg f + x = P.var X qs :: [UPolynomial k] - qs = [(x^(q*i)) `polyMod` f | i <- [0 .. d - 1]] + qs = [(x^(q*i)) `P.mod` f | i <- [0 .. d - 1]] - gb = GB.basis grlex [p3 | (p3,_) <- terms p2] + gb :: [Polynomial k Int] + gb = GB.basis P.grlex [p3 | (p3,_) <- P.terms p2] p1 :: Polynomial k Int - p1 = sum [var i * (subst qi (\X -> var (-1)) - (var (-1) ^ i)) | (i, qi) <- zip [0..] qs] + p1 = sum [P.var i * (P.subst qi (\X -> P.var (-1)) - (P.var (-1) ^ i)) | (i, qi) <- zip [0..] qs] p2 :: UPolynomial (Polynomial k Int) - p2 = toUPolynomialOf p1 (-1) + p2 = P.toUPolynomialOf p1 (-1) - es = [(i, reduce grlex (var i) gb) | i <- [0 .. fromIntegral d - 1]] - vs1 = [i | (i, gi_def) <- es, gi_def == var i] - vs2 = [(i, gi_def) | (i, gi_def) <- es, gi_def /= var i] + es = [(i, P.reduce P.grlex (P.var i) gb) | i <- [0 .. fromIntegral d - 1]] + vs1 = [i | (i, gi_def) <- es, gi_def == P.var i] + vs2 = [(i, gi_def) | (i, gi_def) <- es, gi_def /= P.var i] - basis = [ x^i + sum [constant (eval (delta i) gj_def) * x^j | (j, gj_def) <- vs2] | i <- vs1 ] + basis :: [UPolynomial k] + basis = [ x^i + sum [P.constant (P.eval (delta i) gj_def) * x^j | (j, gj_def) <- vs2] | i <- vs1 ] where delta i k | k==i = 1 diff --git a/src/Data/Polynomial/Factorization/Hensel.hs b/src/Data/Polynomial/Factorization/Hensel.hs new file mode 100644 --- /dev/null +++ b/src/Data/Polynomial/Factorization/Hensel.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE ScopedTypeVariables, BangPatterns, TemplateHaskell #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Polynomial.Factorization.Hensel +-- Copyright : (c) Masahiro Sakai 2013 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables, BangPatterns, TemplateHaskell) +-- +-- References: +-- +-- * +-- +-- * +-- +----------------------------------------------------------------------------- +module Data.Polynomial.Factorization.Hensel + ( hensel + ) where + +import Control.Exception (assert) +import Data.FiniteField +import Data.Polynomial.Base (UPolynomial, X (..)) +import qualified Data.Polynomial.Base as P +import qualified TypeLevel.Number.Nat as TL + +-- import Text.PrettyPrint.HughesPJClass + +hensel :: forall p. TL.Nat p => UPolynomial Integer -> [UPolynomial (PrimeField p)] -> Integer -> [UPolynomial Integer] +hensel f fs1 k + | k <= 0 = error "hensel; k <= 0" + | otherwise = assert precondition $ go 1 (map (P.mapCoeff Data.FiniteField.toInteger) fs1) + where + precondition = + P.mapCoeff fromInteger f == product fs1 && + P.deg f == P.deg (product fs1) + + p :: Integer + p = TL.toInt (undefined :: p) + + go :: Integer -> [UPolynomial Integer] -> [UPolynomial Integer] + go !i fs + | i==k = assert (check i fs) $ fs + | otherwise = assert (check i fs) $ go (i+1) (lift i fs) + + check :: Integer -> [UPolynomial Integer] -> Bool + check k fs = + and + [ P.mapCoeff (`mod` pk) f == P.mapCoeff (`mod` pk) (product fs) + , fs1 == map (P.mapCoeff fromInteger) fs + , and [P.deg fi1 == P.deg fik | (fi1, fik) <- zip fs1 fs] + ] + where + pk = p ^ k + + lift :: Integer -> [UPolynomial Integer] -> [UPolynomial Integer] + lift k fs = fs' + where + pk = p^k + pk1 = p^(k+1) + + -- f ≡ product fs + p^k h (mod p^(k+1)) + h :: UPolynomial Integer + h = P.mapCoeff (\c -> (c `mod` pk1) `div` pk) (f - product fs) + + hs :: [UPolynomial (PrimeField p)] + hs = prop_5_11 (map (P.mapCoeff fromInteger) fs) (P.mapCoeff fromInteger h) + + fs' :: [UPolynomial Integer] + fs' = [ P.mapCoeff (`mod` pk1) (fi + P.constant pk * P.mapCoeff Data.FiniteField.toInteger hi) + | (fi, hi) <- zip fs hs ] + +-- http://www14.in.tum.de/konferenzen/Jass07/courses/1/Bulwahn/Buhlwahn_Paper.pdf +test_hensel :: Bool +test_hensel = and + [ hensel f fs 2 == [x^(2::Int) + 5*x + 18, x + 5] + , hensel f fs 3 == [x^(2::Int) + 105*x + 43, x + 30] + , hensel f fs 4 == [x^(2::Int) + 605*x + 168, x + 30] + ] + where + x :: forall k. (Eq k, Num k) => UPolynomial k + x = P.var X + f :: UPolynomial Integer + f = x^(3::Int) + 10*x^(2::Int) - 432*x + 5040 + fs :: [UPolynomial $(primeField 5)] + fs = [x^(2::Int)+3, x] + +-- http://www.math.kobe-u.ac.jp/Asir/ca.pdf +prop_5_10 :: forall k. (Num k, Fractional k, Eq k) => [UPolynomial k] -> [UPolynomial k] +prop_5_10 fs = normalize (go fs) + where + check :: [UPolynomial k] -> [UPolynomial k] -> Bool + check es fs = sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] == 1 + + go :: [UPolynomial k] -> [UPolynomial k] + go [] = error "prop_5_10: empty list" + go [fi] = assert (check [1] [fi]) [1] + go fs@(fi : fs') = + case P.exgcd (product fs') fi of + (g,ei,v) -> + assert (g == 1) $ + let es' = go fs' + es = ei : map (v*) es' + in assert (check es fs) es + + normalize :: [UPolynomial k] -> [UPolynomial k] + normalize es = assert (check es2 fs) es2 + where + es2 = zipWith P.mod es fs + +test_prop_5_10 :: Bool +test_prop_5_10 = sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] == 1 + where + x :: UPolynomial Rational + x = P.var P.X + fs = [x, x+1, x+2] + es = prop_5_10 fs + +-- http://www.math.kobe-u.ac.jp/Asir/ca.pdf +prop_5_11 :: forall k. (Num k, Fractional k, Eq k, P.PrettyCoeff k, Ord k) => [UPolynomial k] -> UPolynomial k -> [UPolynomial k] +prop_5_11 fs g = + assert (P.deg g <= P.deg (product fs)) $ + assert (P.deg c <= 0) $ + assert (check es2 fs g) $ + es2 + where + es = map (g*) $ prop_5_10 fs + c = sum [ei `P.div` fi | (ei,fi) <- zip es fs] + es2 = case zipWith P.mod es fs of + e2' : es2' -> e2' + c * head fs : es2' + + check :: [UPolynomial k] -> [UPolynomial k] -> UPolynomial k -> Bool + check es fs g = + sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] == g && + and [P.deg ei <= P.deg fi | (ei,fi) <- zip es fs] + +test_prop_5_11 :: Bool +test_prop_5_11 = sum [ei * (product fs `P.div` fi) | (ei,fi) <- zip es fs] == g + where + x :: UPolynomial Rational + x = P.var P.X + fs = [x, x+1, x+2] + g = x^(2::Int) + 1 + es = prop_5_11 fs g diff --git a/src/Data/Polynomial/Factorization/Integer.hs b/src/Data/Polynomial/Factorization/Integer.hs --- a/src/Data/Polynomial/Factorization/Integer.hs +++ b/src/Data/Polynomial/Factorization/Integer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Polynomial.Factorization.Integer @@ -7,127 +7,14 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (BangPatterns) --- --- Factoriation of integer-coefficient polynomial using Kronecker's method. --- --- References: --- --- * +-- Portability : non-portable (TypeSynonymInstances, FlexibleInstances) -- ----------------------------------------------------------------------------- -module Data.Polynomial.Factorization.Integer - ( factor - ) where - -import Data.List -import Data.MultiSet (MultiSet) -import qualified Data.MultiSet as MultiSet -import Data.Numbers.Primes (primes) -import Data.Ratio -import Data.Polynomial -import qualified Data.Polynomial.Interpolation.Lagrange as Interpolation -import Util (isInteger) - -factor :: UPolynomial Integer -> [(UPolynomial Integer, Integer)] -factor 0 = [(0,1)] -factor 1 = [] -factor p | deg p == 0 = [(p,1)] -factor p = [(constant c, 1) | c /= 1] ++ [(q, fromIntegral m) | (q,m) <- MultiSet.toOccurList qs] - where - (c,qs) = normalize (cont p, factor' (pp p)) - -normalize :: (Integer, MultiSet (UPolynomial Integer)) -> (Integer, MultiSet (UPolynomial Integer)) -normalize (c,ps) = go (MultiSet.toOccurList ps) c MultiSet.empty - where - go [] !c !qs = (c, qs) - go ((p,m) : ps) !c !qs - | deg p == 0 = go ps (c * (coeff (var X) p) ^ m) qs - | fst (leadingTerm grlex p) < 0 = go ps (c * (-1)^m) (MultiSet.insertMany (-p) m qs) - | otherwise = go ps c (MultiSet.insertMany p m qs) - -factor' :: UPolynomial Integer -> MultiSet (UPolynomial Integer) -factor' p = go (MultiSet.singleton p) MultiSet.empty - where - go ps ret - | MultiSet.null ps = ret - | otherwise = - case factor2 p of - Nothing -> - go ps' (MultiSet.insertMany p m ret) - Just (q1,q2) -> - go (MultiSet.insertMany q1 m $ MultiSet.insertMany q2 m ps') ret - where - p = MultiSet.findMin ps - m = MultiSet.occur p ps - ps' = MultiSet.deleteAll p ps - -factor2 :: UPolynomial Integer -> Maybe (UPolynomial Integer, UPolynomial Integer) -factor2 p | p == var X = Nothing -factor2 p = - case find (\(_,yi) -> yi==0) vs of - Just (xi,_) -> - let q1 = x - constant xi - q2 = p' `polyDiv` mapCoeff fromInteger q1 - in Just (q1, toZ q2) - Nothing -> - let qs = map Interpolation.interpolate $ - sequence [[(fromInteger xi, fromInteger z) | z <- factors yi] | (xi,yi) <- vs] - zs = [ (q1,q2) - | q1 <- qs, deg q1 > 0, isUPolyZ q1 - , let (q2,r) = p' `polyDivMod` q1 - , r == 0, deg q2 > 0, isUPolyZ q2 - ] - in case zs of - [] -> Nothing - (q1,q2):_ -> Just (toZ q1, toZ q2) - where - n = (deg p `div` 2) - xs = take (fromIntegral n + 1) xvalues - vs = [(x, eval (\X -> x) p) | x <- xs] - x = var X - p' :: UPolynomial Rational - p' = mapCoeff fromInteger p - -isUPolyZ :: UPolynomial Rational -> Bool -isUPolyZ p = and [isInteger c | (c,_) <- terms p] - -toZ :: Ord v => Polynomial Rational v -> Polynomial Integer v -toZ p = fromTerms [(numerator (c * fromInteger s), xs) | (c,xs) <- terms p] - where - s = foldl' lcm 1 [denominator c | (c,_) <- terms p] - --- [0, 1, -1, 2, -2, 3, -3 ..] -xvalues :: [Integer] -xvalues = 0 : interleave [1,2..] [-1,-2..] - -interleave :: [a] -> [a] -> [a] -interleave xs [] = xs -interleave [] ys = ys -interleave (x:xs) ys = x : interleave ys xs - -factors :: Integer -> [Integer] -factors 0 = [] -factors x = xs ++ map negate xs - where - ps = primeFactors (abs x) - xs = map product $ sequence [take (n+1) (iterate (p*) 1) | (p,n) <- MultiSet.toOccurList ps] +module Data.Polynomial.Factorization.Integer () where -primeFactors :: Integer -> MultiSet Integer -primeFactors 0 = MultiSet.empty -primeFactors n = go n primes MultiSet.empty - where - go :: Integer -> [Integer] -> MultiSet Integer -> MultiSet Integer - go 1 !_ !result = result - go n (p:ps) !result - | p*p > n = MultiSet.insert n result - | otherwise = - case f p n of - (m,n') -> go n' ps (MultiSet.insertMany p m result) +-- import Data.Polynomial.Factorization.Kronecker +import qualified Data.Polynomial.Base as P +import Data.Polynomial.Factorization.Zassenhaus - f :: Integer -> Integer -> (Int, Integer) - f p = go2 0 - where - go2 !m !n - | n `mod` p == 0 = go2 (m+1) (n `div` p) - | otherwise = (m, n) +instance P.Factor (P.UPolynomial Integer) where + factor = factor diff --git a/src/Data/Polynomial/Factorization/Kronecker.hs b/src/Data/Polynomial/Factorization/Kronecker.hs new file mode 100644 --- /dev/null +++ b/src/Data/Polynomial/Factorization/Kronecker.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE BangPatterns #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Polynomial.Factorization.Kronecker +-- Copyright : (c) Masahiro Sakai 2012-2013 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (BangPatterns) +-- +-- Factoriation of integer-coefficient polynomial using Kronecker's method. +-- +-- References: +-- +-- * +-- +----------------------------------------------------------------------------- +module Data.Polynomial.Factorization.Kronecker + ( factor + ) where + +import Data.List +import Data.MultiSet (MultiSet) +import qualified Data.MultiSet as MultiSet +import Data.Numbers.Primes (primes) +import Data.Ratio +import Data.Polynomial.Base (Polynomial, UPolynomial, X (..)) +import qualified Data.Polynomial.Base as P +import qualified Data.Polynomial.Interpolation.Lagrange as Interpolation +import Util (isInteger) + +factor :: UPolynomial Integer -> [(UPolynomial Integer, Integer)] +factor 0 = [(0,1)] +factor 1 = [] +factor p | P.deg p == 0 = [(p,1)] +factor p = [(P.constant c, 1) | c /= 1] ++ [(q, fromIntegral m) | (q,m) <- MultiSet.toOccurList qs] + where + (c,qs) = normalize (P.cont p, factor' (P.pp p)) + +normalize :: (Integer, MultiSet (UPolynomial Integer)) -> (Integer, MultiSet (UPolynomial Integer)) +normalize (c,ps) = go (MultiSet.toOccurList ps) c MultiSet.empty + where + go [] !c !qs = (c, qs) + go ((p,m) : ps) !c !qs + | P.deg p == 0 = go ps (c * (P.coeff (P.var X) p) ^ m) qs + | P.lc P.grlex p < 0 = go ps (c * (-1)^m) (MultiSet.insertMany (-p) m qs) + | otherwise = go ps c (MultiSet.insertMany p m qs) + +factor' :: UPolynomial Integer -> MultiSet (UPolynomial Integer) +factor' p = go (MultiSet.singleton p) MultiSet.empty + where + go ps ret + | MultiSet.null ps = ret + | otherwise = + case factor2 p of + Nothing -> + go ps' (MultiSet.insertMany p m ret) + Just (q1,q2) -> + go (MultiSet.insertMany q1 m $ MultiSet.insertMany q2 m ps') ret + where + p = MultiSet.findMin ps + m = MultiSet.occur p ps + ps' = MultiSet.deleteAll p ps + +factor2 :: UPolynomial Integer -> Maybe (UPolynomial Integer, UPolynomial Integer) +factor2 p | p == P.var X = Nothing +factor2 p = + case find (\(_,yi) -> yi==0) vs of + Just (xi,_) -> + let q1 = x - P.constant xi + q2 = p' `P.div` P.mapCoeff fromInteger q1 + in Just (q1, toZ q2) + Nothing -> + let qs = map Interpolation.interpolate $ + sequence [[(fromInteger xi, fromInteger z) | z <- factors yi] | (xi,yi) <- vs] + zs = [ (q1,q2) + | q1 <- qs, P.deg q1 > 0, isUPolyZ q1 + , let (q2,r) = p' `P.divMod` q1 + , r == 0, P.deg q2 > 0, isUPolyZ q2 + ] + in case zs of + [] -> Nothing + (q1,q2):_ -> Just (toZ q1, toZ q2) + where + n = P.deg p `div` 2 + xs = take (fromIntegral n + 1) xvalues + vs = [(x, P.eval (\X -> x) p) | x <- xs] + x = P.var X + p' :: UPolynomial Rational + p' = P.mapCoeff fromInteger p + +isUPolyZ :: UPolynomial Rational -> Bool +isUPolyZ p = and [isInteger c | (c,_) <- P.terms p] + +toZ :: Ord v => Polynomial Rational v -> Polynomial Integer v +toZ = P.mapCoeff numerator . P.pp + +-- [0, 1, -1, 2, -2, 3, -3 ..] +xvalues :: [Integer] +xvalues = 0 : interleave [1,2..] [-1,-2..] + +interleave :: [a] -> [a] -> [a] +interleave xs [] = xs +interleave [] ys = ys +interleave (x:xs) ys = x : interleave ys xs + +factors :: Integer -> [Integer] +factors 0 = [] +factors x = xs ++ map negate xs + where + ps = primeFactors (abs x) + xs = map product $ sequence [take (n+1) (iterate (p*) 1) | (p,n) <- MultiSet.toOccurList ps] + +primeFactors :: Integer -> MultiSet Integer +primeFactors 0 = MultiSet.empty +primeFactors n = go n primes MultiSet.empty + where + go :: Integer -> [Integer] -> MultiSet Integer -> MultiSet Integer + go 1 !_ !result = result + go n (p:ps) !result + | p*p > n = MultiSet.insert n result + | otherwise = + case f p n of + (m,n') -> go n' ps (MultiSet.insertMany p m result) + + f :: Integer -> Integer -> (Int, Integer) + f p = go2 0 + where + go2 !m !n + | n `mod` p == 0 = go2 (m+1) (n `div` p) + | otherwise = (m, n) diff --git a/src/Data/Polynomial/Factorization/Rational.hs b/src/Data/Polynomial/Factorization/Rational.hs --- a/src/Data/Polynomial/Factorization/Rational.hs +++ b/src/Data/Polynomial/Factorization/Rational.hs @@ -1,18 +1,16 @@ -module Data.Polynomial.Factorization.Rational - ( factor - ) where +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +module Data.Polynomial.Factorization.Rational () where import Data.List (foldl') -import Data.Polynomial -import qualified Data.Polynomial.Factorization.Integer as FactorZ +import Data.Polynomial.Base (UPolynomial) +import qualified Data.Polynomial.Base as P +import Data.Polynomial.Factorization.Integer () import Data.Ratio -factor :: UPolynomial Rational -> [(UPolynomial Rational, Integer)] -factor 0 = [(0,1)] -factor p = [(constant c, 1) | c /= 1] ++ qs2 - where - s = foldl' lcm 1 [denominator c | (c,_) <- terms p] - p' = mapCoeff (\c -> numerator (c * fromInteger s)) p - qs = FactorZ.factor p' - qs2 = [(mapCoeff fromInteger q, m) | (q,m) <- qs, deg q > 0] - c = toRational (product [(coeff mmOne q)^m | (q,m) <- qs, deg q == 0]) / toRational s +instance P.Factor (UPolynomial Rational) where + factor 0 = [(0,1)] + factor p = [(P.constant c, 1) | c /= 1] ++ qs2 + where + qs = P.factor $ P.mapCoeff numerator $ P.pp p + qs2 = [(P.mapCoeff fromInteger q, m) | (q,m) <- qs, P.deg q > 0] + c = toRational (product [(P.coeff P.mone q)^m | (q,m) <- qs, P.deg q == 0]) * P.cont p diff --git a/src/Data/Polynomial/Factorization/SquareFree.hs b/src/Data/Polynomial/Factorization/SquareFree.hs --- a/src/Data/Polynomial/Factorization/SquareFree.hs +++ b/src/Data/Polynomial/Factorization/SquareFree.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Polynomial.Factorization.SquareFree @@ -7,9 +7,7 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (BangPatterns) --- --- Square-free decomposition of univariate polynomials over a field of characteristic 0. +-- Portability : non-portable (BangPatterns, TypeSynonymInstances, FlexibleInstances) -- -- References: -- @@ -17,24 +15,26 @@ -- ----------------------------------------------------------------------------- module Data.Polynomial.Factorization.SquareFree - ( sqfree + ( sqfreeChar0 ) where import Control.Exception -import Data.Polynomial +import Data.Polynomial.Base (UPolynomial, X (..)) +import qualified Data.Polynomial.Base as P +import Data.Ratio -- | Square-free decomposition of univariate polynomials over a field of characteristic 0. -sqfree :: (Eq k, Fractional k) => UPolynomial k -> [(UPolynomial k, Integer)] -sqfree 0 = [] -sqfree p = assert (product [q^m | (q,m) <- result] == p) $ result +sqfreeChar0 :: (Eq k, Fractional k) => UPolynomial k -> [(UPolynomial k, Integer)] +sqfreeChar0 0 = [] +sqfreeChar0 p = assert (product [q^m | (q,m) <- result] == p) $ result where - result = go p (p `polyDiv` polyGCD p (deriv p X)) 0 [] + result = go p (p `P.div` P.gcd p (P.deriv p X)) 0 [] go p flat !m result - | deg flat <= 0 = [(p,1) | p /= 1] ++ reverse result - | otherwise = go p' flat' m' ((flat `polyDiv` flat', m') : result) + | P.deg flat <= 0 = [(p,1) | p /= 1] ++ reverse result + | otherwise = go p' flat' m' ((flat `P.div` flat', m') : result) where (p',n) = f p flat - flat' = polyGCD p' flat + flat' = P.gcd p' flat m' = m + n f :: (Eq k, Fractional k) => UPolynomial k -> UPolynomial k -> (UPolynomial k, Integer) @@ -42,6 +42,21 @@ where result@(q, m) = go 0 p1 go !m p = - case p `polyDivMod` p2 of + case p `P.divMod` p2 of (q, 0) -> go (m+1) q _ -> (p, m) + + +instance P.SQFree (UPolynomial Rational) where + sqfree = sqfreeChar0 + +instance P.SQFree (UPolynomial Integer) where + sqfree 0 = [(0,1)] + sqfree f = go 1 [] (P.sqfree (P.mapCoeff fromIntegral f)) + where + go !u ys [] = + assert (denominator u == 1) $ + [(P.constant (numerator u), 1) | u /= 1] ++ ys + go !u ys ((g,n):xs) + | P.deg g <= 0 = go (u * P.coeff P.mone g) ys xs + | otherwise = go (u * (P.cont g)^n) ((P.mapCoeff numerator (P.pp g), n) : ys) xs diff --git a/src/Data/Polynomial/Factorization/Zassenhaus.hs b/src/Data/Polynomial/Factorization/Zassenhaus.hs new file mode 100644 --- /dev/null +++ b/src/Data/Polynomial/Factorization/Zassenhaus.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wall #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Polynomial.Factorization.Zassenhaus +-- Copyright : (c) Masahiro Sakai 2012-2013 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (BangPatterns, ScopedTypeVariables) +-- +-- Factoriation of integer-coefficient polynomial using Zassenhaus algorithm. +-- +-- References: +-- +-- * +-- +----------------------------------------------------------------------------- +module Data.Polynomial.Factorization.Zassenhaus + ( factor + ) where + +import Control.Monad +import Control.Monad.ST +import Control.Exception (assert) +import Data.List +import Data.Maybe +import Data.Numbers.Primes (primes) +import Data.Ratio +import Data.STRef + +import Data.Polynomial.Base (UPolynomial, X (..)) +import qualified Data.Polynomial.Base as P +import Data.Polynomial.Factorization.FiniteField () +import Data.Polynomial.Factorization.SquareFree () +import qualified Data.Polynomial.Factorization.Hensel as Hensel + +import qualified TypeLevel.Number.Nat as TL +import Data.FiniteField + +-- import Text.PrettyPrint.HughesPJClass + +factor :: UPolynomial Integer -> [(UPolynomial Integer, Integer)] +factor f = [(h,n) | (g,n) <- P.sqfree f, h <- if P.deg g > 0 then zassenhaus g else return g] + +zassenhaus :: UPolynomial Integer -> [UPolynomial Integer] +zassenhaus f = fromJust $ msum [TL.withNat zassenhausWithP p | p <- primes] + where + zassenhausWithP :: forall p. TL.Nat p => p -> Maybe [UPolynomial Integer] + zassenhausWithP _ = do + let f_mod_p :: UPolynomial (PrimeField p) + f_mod_p = P.mapCoeff fromInteger f + guard $ P.deg f == P.deg f_mod_p -- 主係数を割り切らないことと同値 + guard $ P.isSquareFree f_mod_p + let fs :: [UPolynomial (PrimeField p)] + fs = [assert (n==1) fi | (fi,n) <- P.factor f_mod_p] + return $ lift f fs + +{- +Suppose @g@ is a factor of @f@. + +From Landau-Mignotte inequality, + @sum [abs c | (c,_) <- mapCoeff ((lc f / lc g) *) $ terms g] <= 2^(deg g) * norm2 f@ holds. + +This together with @deg g <= deg f@ implies + @all [- 2^(deg f) * norm2 f <= c <= 2^(deg f) * norm2 f | (c,_) <- terms ((lc f / lc g) * g)]@. + +Choose smallest @k@ such that @p^k / 2 > 2^(deg f) * norm2 f@, so that + @all [- (p^k)/2 < c < (p^k)/2 | (c,_) <- terms ((lc f / lc g) * g)]@. + +Then it call @search@ to look for actual factorization. +-} +lift :: forall p. TL.Nat p => UPolynomial Integer -> [UPolynomial (PrimeField p)] -> [UPolynomial Integer] +lift f [_] = [f] +lift f fs = search pk f (Hensel.hensel f fs k) + where + p = TL.toInt (undefined :: p) + k, pk :: Integer + (k,pk) = head [(k,pk) | k <- [1,2..], let pk = p^k, pk^(2::Int) > (2^(P.deg f + 1))^(2::Int) * norm2sq f] + +search :: Integer -> UPolynomial Integer -> [UPolynomial Integer] -> [UPolynomial Integer] +search pk f0 fs0 = runST $ do + let a = P.lc P.grlex f0 + m = length fs0 + + fRef <- newSTRef f0 + fsRef <- newSTRef fs0 + retRef <- newSTRef [] + + forM_ [1 .. m `div` 2] $ \l -> do + fs <- readSTRef fsRef + forM_ (comb fs l) $ \s -> do + {- + A factor @g@ of @f@ must satisfy @(lc f / lc g) * g ≡ product s (mod p^k)@ for some @s@. + So we construct a candidate of @(lc f / lc g) * g@ from @product s@. + -} + let g0 = product s + -- @g1@ is a candidate of @(lc f / lc g) * g@ + g1 :: UPolynomial Rational + g1 = P.mapCoeff conv g0 + conv :: Integer -> Rational + conv b = b3 + where + b1 = (a % P.lc P.grlex g0) * fromIntegral b + -- @b1 ≡ b2 (mod p^k)@ and @0 <= b2 < p^k@ + b2 = b1 - (fromIntegral (floor (b1 / pk') :: Integer) * pk') + -- @b1 ≡ b2 ≡ b3 (mod p^k)@ and @-(p^k)/2 <= b3 <= (p^k)/2@ + b3 = if pk'/2 < b2 then b2 - pk' else b2 + pk' = fromIntegral pk + + f <- readSTRef fRef + let f1 = P.mapCoeff fromInteger f + + when (P.deg g1 > 0 && g1 `P.divides` f1) $ do + let g2 = P.mapCoeff numerator $ P.pp g1 + -- we choose leading coefficient to be positive. + g :: UPolynomial Integer + g = if P.lc P.grlex g2 < 0 then - g2 else g2 + writeSTRef fRef $! f `div'` g + modifySTRef retRef (g :) + modifySTRef fsRef (\\ s) + + f <- readSTRef fRef + ret <- readSTRef retRef + if f==1 + then return ret + else return $ f : ret + +-- |f|^2 +norm2sq :: Num a => UPolynomial a -> a +norm2sq f = sum [c^(2::Int) | (c,_) <- P.terms f] + +div' :: UPolynomial Integer -> UPolynomial Integer -> UPolynomial Integer +div' f1 f2 = assert (and [denominator c == 1 | (c,_) <- P.terms g3]) g4 + where + g1, g2 :: UPolynomial Rational + g1 = P.mapCoeff fromInteger f1 + g2 = P.mapCoeff fromInteger f2 + g3 = g1 `P.div` g2 + g4 = P.mapCoeff numerator g3 + +comb :: [a] -> Int -> [[a]] +comb _ 0 = [[]] +comb [] _ = [] +comb (x:xs) n = [x:ys | ys <- comb xs (n-1)] ++ comb xs n + +-- --------------------------------------------------------------------------- + +test_zassenhaus :: [UPolynomial Integer] +test_zassenhaus = zassenhaus f + where + x = P.var X + f = x^(4::Int) + 4 + +test_zassenhaus2 :: [UPolynomial Integer] +test_zassenhaus2 = zassenhaus f + where + x = P.var X + f = x^(9::Int) - 15*x^(6::Int) - 87*x^(3::Int) - 125 + +test_foo :: [(UPolynomial Integer, Integer)] +test_foo = actual + where + x :: UPolynomial Integer + x = P.var X + f = - (x^(5::Int) + x^(4::Int) + x^(2::Int) + x + 2) + actual = factor f + expected = [(-1,1), (x^(2::Int)+x+1,1), (x^(3::Int)-x+2,1)] + +-- --------------------------------------------------------------------------- diff --git a/src/Data/Polynomial/GBasis.hs b/src/Data/Polynomial/GBasis.hs deleted file mode 100644 --- a/src/Data/Polynomial/GBasis.hs +++ /dev/null @@ -1,150 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : Data.Polynomial.GBasis --- Copyright : (c) Masahiro Sakai 2012-2013 --- License : BSD-style --- --- Maintainer : masahiro.sakai@gmail.com --- Stability : provisional --- Portability : non-portable (ScopedTypeVariables) --- --- Gröbner basis --- --- References: --- --- * Monomial order --- --- * Gröbner basis --- --- * グレブナー基底 --- --- * Gröbner Bases and Buchberger’s Algorithm --- --- * Docon --- ------------------------------------------------------------------------------ - -module Data.Polynomial.GBasis - ( - -- * Options - Options (..) - , Strategy (..) - , defaultOptions - - -- * Gröbner basis computation - , basis - , basis' - , spolynomial - , reduceGBasis - ) where - -import qualified Data.Set as Set -import qualified Data.Heap as H -- http://hackage.haskell.org/package/heaps -import Data.Polynomial - -data Options - = Options - { optStrategy :: Strategy - } - -defaultOptions :: Options -defaultOptions = - Options - { optStrategy = NormalStrategy - } - -data Strategy - = NormalStrategy - | SugarStrategy -- ^ sugar strategy (not implemented yet) - deriving (Eq, Ord, Show, Read, Bounded, Enum) - -spolynomial - :: (Eq k, Fractional k, Ord v) - => MonomialOrder v -> Polynomial k v -> Polynomial k v -> Polynomial k v -spolynomial cmp f g = - fromMonomial ((1,xs) `monomialDiv` (c1,xs1)) * f - - fromMonomial ((1,xs) `monomialDiv` (c2,xs2)) * g - where - xs = mmLCM xs1 xs2 - (c1, xs1) = leadingTerm cmp f - (c2, xs2) = leadingTerm cmp g - -basis - :: forall k v. (Eq k, Fractional k, Ord k, Ord v) - => MonomialOrder v - -> [Polynomial k v] - -> [Polynomial k v] -basis = basis' defaultOptions - -basis' - :: forall k v. (Eq k, Fractional k, Ord k, Ord v) - => Options - -> MonomialOrder v - -> [Polynomial k v] - -> [Polynomial k v] -basis' opt cmp fs = - reduceGBasis cmp $ go fs (H.fromList [item cmp fi fj | (fi,fj) <- pairs fs, checkGCD fi fj]) - where - go :: [Polynomial k v] -> H.Heap (Item k v) -> [Polynomial k v] - go gs h | H.null h = gs - go gs h - | r == 0 = go gs h' - | otherwise = go (r:gs) (H.union h' (H.fromList [item cmp r g | g <- gs, checkGCD fi fj])) - where - Just (i, h') = H.viewMin h - fi = iFst i - fj = iSnd i - spoly = spolynomial cmp fi fj - r = reduce cmp spoly gs - - -- gcdが1となる組は選ばなくて良い - checkGCD fi fj = mmGCD mm1 mm2 /= mmOne - where - (_, mm1) = leadingTerm cmp fi - (_, mm2) = leadingTerm cmp fj - -reduceGBasis - :: forall k v. (Eq k, Ord k, Fractional k, Ord v) - => MonomialOrder v -> [Polynomial k v] -> [Polynomial k v] -reduceGBasis cmp ps = Set.toList $ Set.fromList $ go ps [] - where - go [] qs = qs - go (p:ps) qs - | q == 0 = go ps qs - | otherwise = go ps (constant (1/c) * q : qs) - where - q = reduce cmp p (ps++qs) - (c,_) = leadingTerm cmp q - -{-------------------------------------------------------------------- - Item ---------------------------------------------------------------------} - -data Item k v - = Item - { iFst :: Polynomial k v - , iSnd :: Polynomial k v - , iCmp :: MonomialOrder v - , iLCM :: MonicMonomial v - } - -item :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> Polynomial k v -> Item k v -item cmp f g = Item f g cmp (mmLCM mm1 mm2) - where - (_, mm1) = leadingTerm cmp f - (_, mm2) = leadingTerm cmp g - -instance Ord v => Ord (Item k v) where - a `compare` b = iCmp a (iLCM a) (iLCM b) - -instance Ord v => Eq (Item k v) where - a == b = compare a b == EQ - -{-------------------------------------------------------------------- - Utilities ---------------------------------------------------------------------} - -pairs :: [a] -> [(a,a)] -pairs [] = [] -pairs (x:xs) = [(x,y) | y <- xs] ++ pairs xs diff --git a/src/Data/Polynomial/GroebnerBasis.hs b/src/Data/Polynomial/GroebnerBasis.hs new file mode 100644 --- /dev/null +++ b/src/Data/Polynomial/GroebnerBasis.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Polynomial.GroebnerBasis +-- Copyright : (c) Masahiro Sakai 2012-2013 +-- License : BSD-style +-- +-- Maintainer : masahiro.sakai@gmail.com +-- Stability : provisional +-- Portability : non-portable (ScopedTypeVariables) +-- +-- Gröbner basis +-- +-- References: +-- +-- * Monomial order +-- +-- * Gröbner basis +-- +-- * グレブナー基底 +-- +-- * Gröbner Bases and Buchberger’s Algorithm +-- +-- * Docon +-- +----------------------------------------------------------------------------- + +module Data.Polynomial.GroebnerBasis + ( + -- * Options + Options (..) + , Strategy (..) + , defaultOptions + + -- * Gröbner basis computation + , basis + , basis' + , spolynomial + , reduceGBasis + ) where + +import qualified Data.Set as Set +import qualified Data.Heap as H -- http://hackage.haskell.org/package/heaps +import Data.Polynomial.Base (Polynomial, Monomial, MonomialOrder) +import qualified Data.Polynomial.Base as P + +data Options + = Options + { optStrategy :: Strategy + } + +defaultOptions :: Options +defaultOptions = + Options + { optStrategy = NormalStrategy + } + +data Strategy + = NormalStrategy + | SugarStrategy -- ^ sugar strategy (not implemented yet) + deriving (Eq, Ord, Show, Read, Bounded, Enum) + +spolynomial + :: (Eq k, Fractional k, Ord v) + => MonomialOrder v -> Polynomial k v -> Polynomial k v -> Polynomial k v +spolynomial cmp f g = + P.fromTerm ((1,xs) `P.tdiv` lt1) * f + - P.fromTerm ((1,xs) `P.tdiv` lt2) * g + where + xs = P.mlcm xs1 xs2 + lt1@(c1, xs1) = P.lt cmp f + lt2@(c2, xs2) = P.lt cmp g + +basis + :: forall k v. (Eq k, Fractional k, Ord k, Ord v) + => MonomialOrder v + -> [Polynomial k v] + -> [Polynomial k v] +basis = basis' defaultOptions + +basis' + :: forall k v. (Eq k, Fractional k, Ord k, Ord v) + => Options + -> MonomialOrder v + -> [Polynomial k v] + -> [Polynomial k v] +basis' opt cmp fs = + reduceGBasis cmp $ go fs (H.fromList [item cmp fi fj | (fi,fj) <- pairs fs, checkGCD fi fj]) + where + go :: [Polynomial k v] -> H.Heap (Item k v) -> [Polynomial k v] + go gs h | H.null h = gs + go gs h + | r == 0 = go gs h' + | otherwise = go (r:gs) (H.union h' (H.fromList [item cmp r g | g <- gs, checkGCD r g])) + where + Just (i, h') = H.viewMin h + fi = iFst i + fj = iSnd i + spoly = spolynomial cmp fi fj + r = P.reduce cmp spoly gs + + -- gcdが1となる組は選ばなくて良い + checkGCD fi fj = not $ P.mcoprime (P.lm cmp fi) (P.lm cmp fj) + +reduceGBasis + :: forall k v. (Eq k, Ord k, Fractional k, Ord v) + => MonomialOrder v -> [Polynomial k v] -> [Polynomial k v] +reduceGBasis cmp ps = Set.toList $ Set.fromList $ go ps [] + where + go [] qs = qs + go (p:ps) qs + | q == 0 = go ps qs + | otherwise = go ps (P.toMonic cmp q : qs) + where + q = P.reduce cmp p (ps++qs) + +{-------------------------------------------------------------------- + Item +--------------------------------------------------------------------} + +data Item k v + = Item + { iFst :: Polynomial k v + , iSnd :: Polynomial k v + , iCmp :: MonomialOrder v + , iLCM :: Monomial v + } + +item :: (Eq k, Num k, Ord v) => MonomialOrder v -> Polynomial k v -> Polynomial k v -> Item k v +item cmp f g = Item f g cmp (P.mlcm (P.lm cmp f) (P.lm cmp g)) + +instance Ord v => Ord (Item k v) where + a `compare` b = iCmp a (iLCM a) (iLCM b) + +instance Ord v => Eq (Item k v) where + a == b = compare a b == EQ + +{-------------------------------------------------------------------- + Utilities +--------------------------------------------------------------------} + +pairs :: [a] -> [(a,a)] +pairs [] = [] +pairs (x:xs) = [(x,y) | y <- xs] ++ pairs xs diff --git a/src/Data/Polynomial/Interpolation/Lagrange.hs b/src/Data/Polynomial/Interpolation/Lagrange.hs --- a/src/Data/Polynomial/Interpolation/Lagrange.hs +++ b/src/Data/Polynomial/Interpolation/Lagrange.hs @@ -3,11 +3,12 @@ ( interpolate ) where -import Data.Polynomial +import Data.Polynomial (UPolynomial, X (..)) +import qualified Data.Polynomial as P interpolate :: (Eq k, Fractional k) => [(k,k)] -> UPolynomial k interpolate zs = sum $ do (xj,yj) <- zs - let lj x = product [constant (1 / (xj - xm)) * (x - constant xm) | (xm,_) <- zs, xj /= xm] - let x = var X - return $ constant yj * lj x + let lj x = product [P.constant (1 / (xj - xm)) * (x - P.constant xm) | (xm,_) <- zs, xj /= xm] + let x = P.var X + return $ P.constant yj * lj x diff --git a/src/Data/Polynomial/RootSeparation/Graeffe.hs b/src/Data/Polynomial/RootSeparation/Graeffe.hs --- a/src/Data/Polynomial/RootSeparation/Graeffe.hs +++ b/src/Data/Polynomial/RootSeparation/Graeffe.hs @@ -25,7 +25,8 @@ import Control.Exception import qualified Data.IntMap as IM -import Data.Polynomial +import Data.Polynomial (UPolynomial, X (..)) +import qualified Data.Polynomial as P data NthRoot = NthRoot !Integer !Rational deriving (Show) @@ -33,9 +34,9 @@ graeffesMethod :: UPolynomial Rational -> Int -> [NthRoot] graeffesMethod p v = xs !! (v - 1) where - xs = map (uncurry g) $ zip [1..] (tail $ iterate f $ associatedMonicPolynomial grlex p) + xs = map (uncurry g) $ zip [1..] (tail $ iterate f $ P.toMonic P.grlex p) - n = deg p + n = P.deg p g :: Int -> UPolynomial Rational -> [NthRoot] g v p = do @@ -43,22 +44,22 @@ let yi = if i == 1 then - (b i) else - (b i / b (i-1)) return $ NthRoot (2 ^ fromIntegral v) yi where - bs = IM.fromList [(fromInteger i, b) | (b,ys) <- terms p, let i = n - deg ys, i /= 0] + bs = IM.fromList [(fromInteger i, b) | (b,ys) <- P.terms p, let i = n - P.deg ys, i /= 0] b i = IM.findWithDefault 0 i bs f :: UPolynomial Rational -> UPolynomial Rational -f p = (-1) ^ (deg p) * - fromTerms [ (c, mmFromList [assert (e `mod` 2 == 0) (x, e `div` 2) | (x,e) <- mmToList xs]) - | (c,xs) <- terms (p * subst p (\_ -> - var X)) ] +f p = (-1) ^ (P.deg p) * + P.fromTerms [ (c, assert (P.deg xs `mod` 2 == 0) (P.var X `P.mpow` (P.deg xs `div` 2))) + | (c, xs) <- P.terms (p * P.subst p (\X -> - P.var X)) ] f' :: UPolynomial Rational -> UPolynomial Rational -f' p = fromTerms [(b k, mmFromList [(X, n - k)]) | k <- [0..n]] +f' p = P.fromTerms [(b k, P.var X `P.mpow` (n - k)) | k <- [0..n]] where - n = deg p + n = P.deg p a :: Integer -> Rational a k - | n >= k = coeff (mmFromList [(X, n - k)]) p + | n >= k = P.coeff (P.var X `P.mpow` (n - k)) p | otherwise = 0 b :: Integer -> Rational @@ -66,10 +67,10 @@ test v = graeffesMethod p v where - x = var X + x = P.var X p = x^2 - 2 test2 v = graeffesMethod p v where - x = var X + x = P.var X p = x^5 - 3*x - 1 diff --git a/src/Data/Polynomial/RootSeparation/Sturm.hs b/src/Data/Polynomial/RootSeparation/Sturm.hs --- a/src/Data/Polynomial/RootSeparation/Sturm.hs +++ b/src/Data/Polynomial/RootSeparation/Sturm.hs @@ -34,7 +34,8 @@ ) where import Data.Maybe -import Data.Polynomial +import Data.Polynomial (UPolynomial, X (..)) +import qualified Data.Polynomial as P import qualified Data.Interval as Interval import Data.Interval (Interval, EndPoint (..), (<..<=), (<=..<=)) @@ -46,10 +47,10 @@ sturmChain p = p0 : p1 : go p0 p1 where p0 = p - p1 = deriv p X + p1 = P.deriv p P.X go p q = if r==0 then [] else r : go q r where - r = - (p `polyMod` q) + r = - (p `P.mod` q) -- | The number of distinct real roots of @p@ in a given interval numRoots @@ -70,12 +71,12 @@ case (Interval.lowerBound ival2, Interval.upperBound ival2) of (Finite lb, Finite ub) -> (if lb==ub then 0 else (n lb - n ub)) + - (if lb `Interval.member` ival2 && isRootOf lb p then 1 else 0) + - (if ub `Interval.notMember` ival2 && isRootOf ub p then -1 else 0) + (if lb `Interval.member` ival2 && lb `P.isRootOf` p then 1 else 0) + + (if ub `Interval.notMember` ival2 && ub `P.isRootOf` p then -1 else 0) _ -> error "numRoots'': should not happen" where ival2 = boundInterval p ival - n x = countSignChanges [eval (\X -> x) q | q <- chain] + n x = countSignChanges [P.eval (\X -> x) q | q <- chain] countSignChanges :: [Rational] -> Int countSignChanges rs = countChanges xs @@ -100,8 +101,8 @@ where m = if p==0 then 0 - else max 1 (sum [abs (c/s) | (c,_) <- terms p] - 1) - (s,_) = leadingTerm grlex p + else max 1 (sum [abs (c/s) | (c,_) <- P.terms p] - 1) + s = P.lc P.grlex p boundInterval :: UPolynomial Rational -> Interval Rational -> Interval Rational boundInterval p ival = Interval.intersection ival (Finite lb <=..<= Finite ub) @@ -119,10 +120,10 @@ separate' :: SturmChain -> [Interval Rational] separate' chain@(p:_) = f (bounds p) where - n x = countSignChanges [eval (\X -> x) q | q <- chain] + n x = countSignChanges [P.eval (\X -> x) q | q <- chain] f (lb,ub) = - if lb `isRootOf` p + if lb `P.isRootOf` p then Interval.singleton lb : g (lb,ub) else g (lb,ub) diff --git a/src/Data/Sign.hs b/src/Data/Sign.hs --- a/src/Data/Sign.hs +++ b/src/Data/Sign.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Sign @@ -7,7 +7,7 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (DeriveDataTypeable) +-- Portability : non-portable (FlexibleInstances, DeriveDataTypeable, CPP) -- -- Algebra of Signs. -- @@ -16,17 +16,22 @@ ( -- * Algebra of Sign Sign (..) - , signNegate - , signMul - , signRecip - , signDiv - , signPow + , negate + , mult + , recip + , div + , pow , signOf - , showSign + , symbol ) where -import Algebra.Enumerable (Enumerable (..)) -- from lattices package +import Prelude hiding (negate, recip, div) +import Algebra.Enumerable (Enumerable (..), universeBounded) -- from lattices package +import qualified Algebra.Lattice as L -- from lattices package import Control.DeepSeq +import Data.Hashable +import Data.Set (Set) +import qualified Data.Set as Set import Data.Typeable import Data.Data import qualified Numeric.Algebra as Alg @@ -36,52 +41,54 @@ instance NFData Sign +instance Hashable Sign where hashWithSalt = hashUsing fromEnum + instance Enumerable Sign where - universe = [Neg .. Pos] + universe = universeBounded instance Alg.Multiplicative Sign where - (*) = signMul - pow1p = signPow + (*) = mult + pow1p s n = pow s (1+n) instance Alg.Commutative Sign instance Alg.Unital Sign where one = Pos - pow = signPow + pow = pow instance Alg.Division Sign where - recip = signRecip - (/) = signDiv - (\\) = flip signDiv - (^) = signPow + recip = recip + (/) = div + (\\) = flip div + (^) = pow -signNegate :: Sign -> Sign -signNegate Neg = Pos -signNegate Zero = Zero -signNegate Pos = Neg +negate :: Sign -> Sign +negate Neg = Pos +negate Zero = Zero +negate Pos = Neg -signMul :: Sign -> Sign -> Sign -signMul Pos s = s -signMul s Pos = s -signMul Neg s = signNegate s -signMul s Neg = signNegate s -signMul _ _ = Zero +mult :: Sign -> Sign -> Sign +mult Pos s = s +mult s Pos = s +mult Neg s = negate s +mult s Neg = negate s +mult _ _ = Zero -signRecip :: Sign -> Sign -signRecip Pos = Pos -signRecip Zero = error "signRecip: division by Zero" -signRecip Neg = Neg +recip :: Sign -> Sign +recip Pos = Pos +recip Zero = error "Data.Sign.recip: division by Zero" +recip Neg = Neg -signDiv :: Sign -> Sign -> Sign -signDiv s Pos = s -signDiv _ Zero = error "signDiv: division by Zero" -signDiv s Neg = signNegate s +div :: Sign -> Sign -> Sign +div s Pos = s +div _ Zero = error "Data.Sign.div: division by Zero" +div s Neg = negate s -signPow :: Integral x => Sign -> x -> Sign -signPow _ 0 = Pos -signPow Pos _ = Pos -signPow Zero _ = Zero -signPow Neg n = if even n then Pos else Neg +pow :: Integral x => Sign -> x -> Sign +pow _ 0 = Pos +pow Pos _ = Pos +pow Zero _ = Zero +pow Neg n = if even n then Pos else Neg signOf :: Real a => a -> Sign signOf r = @@ -90,8 +97,45 @@ EQ -> Zero GT -> Pos -showSign :: Sign -> String -showSign Pos = "+" -showSign Neg = "-" -showSign Zero = "0" +symbol :: Sign -> String +symbol Pos = "+" +symbol Neg = "-" +symbol Zero = "0" + +instance L.MeetSemiLattice (Set Sign) where + meet = Set.intersection + +instance L.Lattice (Set Sign) + +instance L.BoundedMeetSemiLattice (Set Sign) where + top = Set.fromList universe + +instance L.BoundedLattice (Set Sign) + +#if !MIN_VERSION_hashable(1,2,0) +-- Copied from hashable-1.2.0.7: +-- Copyright : (c) Milan Straka 2010 +-- (c) Johan Tibell 2011 +-- (c) Bryan O'Sullivan 2011, 2012 + +-- | Transform a value into a 'Hashable' value, then hash the +-- transformed value using the given salt. +-- +-- This is a useful shorthand in cases where a type can easily be +-- mapped to another type that is already an instance of 'Hashable'. +-- Example: +-- +-- > data Foo = Foo | Bar +-- > deriving (Enum) +-- > +-- > instance Hashable Foo where +-- > hashWithSalt = hashUsing fromEnum +hashUsing :: (Hashable b) => + (a -> b) -- ^ Transformation function. + -> Int -- ^ Salt. + -> a -- ^ Value to transform. + -> Int +hashUsing f salt x = hashWithSalt salt (f x) +{-# INLINE hashUsing #-} +#endif diff --git a/src/Data/Var.hs b/src/Data/Var.hs --- a/src/Data/Var.hs +++ b/src/Data/Var.hs @@ -17,8 +17,9 @@ , Model ) where -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS +import Data.IntMap (IntMap) +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import Data.Ratio -- --------------------------------------------------------------------------- @@ -27,17 +28,17 @@ type Var = Int -- | Set of variables -type VarSet = IS.IntSet +type VarSet = IntSet -- | Map from variables -type VarMap = IM.IntMap +type VarMap = IntMap -- | collecting free variables class Variables a where vars :: a -> VarSet instance Variables a => Variables [a] where - vars = IS.unions . map vars + vars = IntSet.unions . map vars -- | A @Model@ is a map from variables to values. type Model r = VarMap r diff --git a/src/SAT.hs b/src/SAT.hs --- a/src/SAT.hs +++ b/src/SAT.hs @@ -1,5 +1,10 @@ {-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-} -{-# LANGUAGE BangPatterns, DoRec, ScopedTypeVariables, CPP, DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns, ScopedTypeVariables, CPP, DeriveDataTypeable #-} +#if __GLASGOW_HASKELL__ < 706 +{-# LANGUAGE DoRec #-} +#else +{-# LANGUAGE RecursiveDo #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : SAT @@ -8,7 +13,7 @@ -- -- Maintainer : masahiro.sakai@gmail.com -- Stability : provisional --- Portability : non-portable (BangPatterns, DoRec, ScopedTypeVariables, CPP, DeriveDataTypeable) +-- Portability : non-portable (BangPatterns, RecursiveDo, ScopedTypeVariables, CPP, DeriveDataTypeable) -- -- A CDCL SAT solver. -- diff --git a/src/SAT/PBO/UnsatBased.hs b/src/SAT/PBO/UnsatBased.hs --- a/src/SAT/PBO/UnsatBased.hs +++ b/src/SAT/PBO/UnsatBased.hs @@ -19,7 +19,8 @@ ) where import Control.Monad -import qualified Data.IntMap as IM +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap import qualified SAT as SAT import qualified SAT.Types as SAT @@ -53,13 +54,13 @@ } solveWBO :: SAT.Solver -> [(SAT.Lit, Integer)] -> Options -> IO (Maybe (SAT.Model, Integer)) -solveWBO solver sels0 opt = loop 0 (IM.fromList sels0) +solveWBO solver sels0 opt = loop 0 (IntMap.fromList sels0) where - loop :: Integer -> IM.IntMap Integer -> IO (Maybe (SAT.Model, Integer)) + loop :: Integer -> IntMap Integer -> IO (Maybe (SAT.Model, Integer)) loop !lb sels = do optUpdateLB opt lb - ret <- SAT.solveWith solver (IM.keys sels) + ret <- SAT.solveWith solver (IntMap.keys sels) if ret then do m <- SAT.model solver @@ -71,7 +72,7 @@ case core of [] -> return Nothing _ -> do - let !min_c = minimum [sels IM.! sel | sel <- core] + let !min_c = minimum [sels IntMap.! sel | sel <- core] !lb' = lb + min_c xs <- forM core $ \sel -> do @@ -80,13 +81,13 @@ SAT.addExactly solver (map snd xs) 1 SAT.addClause solver [-l | l <- core] -- optional constraint but sometimes useful - ys <- liftM IM.unions $ forM xs $ \(sel, r) -> do + ys <- liftM IntMap.unions $ forM xs $ \(sel, r) -> do sel' <- SAT.newVar solver SAT.addClause solver [-sel', r, sel] - let c = sels IM.! sel + let c = sels IntMap.! sel if c > min_c - then return $ IM.fromList [(sel', min_c), (sel, c - min_c)] - else return $ IM.singleton sel' min_c - let sels' = IM.union ys (IM.difference sels (IM.fromList [(sel, ()) | sel <- core])) + then return $ IntMap.fromList [(sel', min_c), (sel, c - min_c)] + else return $ IntMap.singleton sel' min_c + let sels' = IntMap.union ys (IntMap.difference sels (IntMap.fromList [(sel, ()) | sel <- core])) loop lb' sels' diff --git a/src/SAT/TseitinEncoder.hs b/src/SAT/TseitinEncoder.hs --- a/src/SAT/TseitinEncoder.hs +++ b/src/SAT/TseitinEncoder.hs @@ -50,8 +50,10 @@ import Control.Monad import Data.IORef +import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.IntSet as IS +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import qualified SAT as SAT -- | Arbitrary formula not restricted to CNF @@ -69,7 +71,7 @@ Encoder { encSolver :: SAT.Solver , encUsePB :: IORef Bool - , encConjTable :: !(IORef (Map.Map IS.IntSet SAT.Lit)) + , encConjTable :: !(IORef (Map IntSet SAT.Lit)) } -- | Create a @Encoder@ instance. @@ -161,7 +163,7 @@ encodeConj :: Encoder -> [SAT.Lit] -> IO SAT.Lit encodeConj _ [l] = return l encodeConj encoder ls = do - let ls2 = IS.fromList ls + let ls2 = IntSet.fromList ls table <- readIORef (encConjTable encoder) case Map.lookup ls2 table of Just l -> return l diff --git a/src/SAT/Types.hs b/src/SAT/Types.hs --- a/src/SAT/Types.hs +++ b/src/SAT/Types.hs @@ -46,15 +46,16 @@ import Data.Array.Unboxed import Data.Ord import Data.List -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Set as Set +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet -- | Variable is represented as positive integers (DIMACS format). type Var = Int -type VarSet = IS.IntSet -type VarMap = IM.IntMap +type VarSet = IntSet +type VarMap = IntMap {-# INLINE validVar #-} validVar :: Var -> Bool @@ -71,8 +72,8 @@ litUndef :: Lit litUndef = 0 -type LitSet = IS.IntSet -type LitMap = IM.IntMap +type LitSet = IntSet +type LitMap = IntMap {-# INLINE validLit #-} validLit :: Lit -> Bool @@ -114,22 +115,22 @@ -- -- 'Nothing' if the clause is trivially true. normalizeClause :: Clause -> Maybe Clause -normalizeClause lits = assert (IS.size ys `mod` 2 == 0) $ - if IS.null ys - then Just (IS.toList xs) +normalizeClause lits = assert (IntSet.size ys `mod` 2 == 0) $ + if IntSet.null ys + then Just (IntSet.toList xs) else Nothing where - xs = IS.fromList lits - ys = xs `IS.intersection` (IS.map litNot xs) + xs = IntSet.fromList lits + ys = xs `IntSet.intersection` (IntSet.map litNot xs) normalizeAtLeast :: ([Lit],Int) -> ([Lit],Int) -normalizeAtLeast (lits,n) = assert (IS.size ys `mod` 2 == 0) $ - (IS.toList lits', n') +normalizeAtLeast (lits,n) = assert (IntSet.size ys `mod` 2 == 0) $ + (IntSet.toList lits', n') where - xs = IS.fromList lits - ys = xs `IS.intersection` (IS.map litNot xs) - lits' = xs `IS.difference` ys - n' = n - (IS.size ys `div` 2) + xs = IntSet.fromList lits + ys = xs `IntSet.intersection` (IntSet.map litNot xs) + lits' = xs `IntSet.difference` ys + n' = n - (IntSet.size ys `div` 2) -- | normalizing PB term of the form /c1 x1 + c2 x2 ... cn xn + c/ into -- /d1 x1 + d2 x2 ... dm xm + d/ where d1,...,dm ≥ 1. @@ -139,15 +140,15 @@ -- 同じ変数が複数回現れないように、一度全部 @v@ に統一。 step1 :: ([(Integer,Lit)], Integer) -> ([(Integer,Lit)], Integer) step1 (xs,n) = - case loop (IM.empty,n) xs of - (ys,n') -> ([(c,v) | (v,c) <- IM.toList ys], n') + case loop (IntMap.empty,n) xs of + (ys,n') -> ([(c,v) | (v,c) <- IntMap.toList ys], n') where loop :: (VarMap Integer, Integer) -> [(Integer,Lit)] -> (VarMap Integer, Integer) loop (ys,m) [] = (ys,m) loop (ys,m) ((c,l):zs) = if litPolarity l - then loop (IM.insertWith (+) l c ys, m) zs - else loop (IM.insertWith (+) (litNot l) (negate c) ys, m+c) zs + then loop (IntMap.insertWith (+) l c ys, m) zs + else loop (IntMap.insertWith (+) (litNot l) (negate c) ys, m+c) zs -- 係数が0のものも取り除き、係数が負のリテラルを反転することで、 -- 係数が正になるようにする。 diff --git a/src/Text/GurobiSol.hs b/src/Text/GurobiSol.hs --- a/src/Text/GurobiSol.hs +++ b/src/Text/GurobiSol.hs @@ -3,10 +3,11 @@ , render ) where +import Data.Map (Map) import qualified Data.Map as Map import Data.Ratio -type Model = Map.Map String Double +type Model = Map String Double render :: Model -> Maybe Double -> String render m obj = unlines $ ls1 ++ ls2 diff --git a/src/Text/LPFile.hs b/src/Text/LPFile.hs --- a/src/Text/LPFile.hs +++ b/src/Text/LPFile.hs @@ -56,7 +56,9 @@ import Data.List import Data.Maybe import Data.Ratio +import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) import qualified Data.Set as Set import Data.OptDir import Text.ParserCombinators.Parsec hiding (label) @@ -68,11 +70,11 @@ -- | Problem data LP = LP - { variables :: Set.Set Var + { variables :: Set Var , dir :: OptDir , objectiveFunction :: ObjectiveFunction , constraints :: [Constraint] - , varInfo :: Map.Map Var VarInfo + , varInfo :: Map Var VarInfo , sos :: [SOS] } deriving (Show, Eq, Ord) @@ -155,7 +157,7 @@ type SOS = (Maybe Label, SOSType, [(Var, Rational)]) class Variables a where - vars :: a -> Set.Set Var + vars :: a -> Set Var instance Variables a => Variables [a] where vars = Set.unions . map vars @@ -199,12 +201,12 @@ intersectBounds :: Bounds -> Bounds -> Bounds intersectBounds (lb1,ub1) (lb2,ub2) = (max lb1 lb2, min ub1 ub2) -integerVariables :: LP -> Set.Set Var +integerVariables :: LP -> Set Var integerVariables lp = Map.keysSet $ Map.filter p (varInfo lp) where p VarInfo{ varType = vt } = vt == IntegerVariable -semiContinuousVariables :: LP -> Set.Set Var +semiContinuousVariables :: LP -> Set Var semiContinuousVariables lp = Map.keysSet $ Map.filter p (varInfo lp) where p VarInfo{ varType = vt } = vt == SemiContinuousVariable @@ -259,7 +261,7 @@ tok $ char ':' return name -reserved :: Set.Set String +reserved :: Set String reserved = Set.fromList [ "bound", "bounds" , "gen", "general", "generals" @@ -400,7 +402,7 @@ type Bounds2 = (Maybe BoundExpr, Maybe BoundExpr) -boundsSection :: Parser (Map.Map Var Bounds) +boundsSection :: Parser (Map Var Bounds) boundsSection = do tok $ string' "bound" >> optional (char' 's') liftM (Map.map g . Map.fromListWith f) $ many (try bound) @@ -740,7 +742,7 @@ -- --------------------------------------------------------------------------- {- -compileExpr :: Expr -> Maybe (Map.Map Var Rational) +compileExpr :: Expr -> Maybe (Map Var Rational) compileExpr e = do xs <- forM e $ \(Term c vs) -> case vs of diff --git a/src/Text/MPSFile.hs b/src/Text/MPSFile.hs --- a/src/Text/MPSFile.hs +++ b/src/Text/MPSFile.hs @@ -29,7 +29,9 @@ import Control.Monad import Data.Maybe +import Data.Set (Set) import qualified Data.Set as Set +import Data.Map (Map) import qualified Data.Map as Map import Data.Ratio @@ -359,12 +361,12 @@ newline' return (op, name) -colsSection :: Parser (Map.Map Column (Map.Map Row Rational), Set.Set Column) +colsSection :: Parser (Map Column (Map Row Rational), Set Column) colsSection = do try $ stringLn "COLUMNS" body False Map.empty Set.empty where - body :: Bool -> Map.Map Column (Map.Map Row Rational) -> Set.Set Column -> Parser (Map.Map Column (Map.Map Row Rational), Set.Set Column) + body :: Bool -> Map Column (Map Row Rational) -> Set Column -> Parser (Map Column (Map Row Rational), Set Column) body isInt rs ivs = msum [ do isInt' <- try intMarker body isInt' rs ivs @@ -386,7 +388,7 @@ newline' return b - entry :: Parser (Column, Map.Map Row Rational) + entry :: Parser (Column, Map Row Rational) entry = do spaces1' col <- ident @@ -397,13 +399,13 @@ Nothing -> return (col, rv1) Just rv2 -> return (col, Map.union rv1 rv2) -rowAndVal :: Parser (Map.Map Row Rational) +rowAndVal :: Parser (Map Row Rational) rowAndVal = do row <- ident val <- number return $ Map.singleton row val -rhsSection :: Parser (Map.Map Row Rational) +rhsSection :: Parser (Map Row Rational) rhsSection = do try $ stringLn "RHS" liftM Map.unions $ many entry @@ -418,7 +420,7 @@ Nothing -> return rv1 Just rv2 -> return $ Map.union rv1 rv2 -rangesSection :: Parser (Map.Map Row Rational) +rangesSection :: Parser (Map Row Rational) rangesSection = do try $ stringLn "RANGES" liftM Map.unions $ many entry @@ -519,7 +521,7 @@ newline' return $ LPFile.Term val [col1, col2] -indicatorsSection :: Parser (Map.Map Row (Column, Rational)) +indicatorsSection :: Parser (Map Row (Column, Rational)) indicatorsSection = do try $ stringLn "INDICATORS" liftM Map.fromList $ many entry diff --git a/src/Text/SDPFile.hs b/src/Text/SDPFile.hs --- a/src/Text/SDPFile.hs +++ b/src/Text/SDPFile.hs @@ -47,8 +47,9 @@ import Control.Monad import Data.List (intersperse) import Data.Ratio +import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.IntMap as IM +import qualified Data.IntMap as IntMap import Text.ParserCombinators.Parsec -- --------------------------------------------------------------------------- @@ -65,7 +66,7 @@ type Matrix = [Block] -type Block = Map.Map (Int,Int) Rational +type Block = Map (Int,Int) Rational -- | the number of primal variables (mDim) mDim :: Problem -> Int @@ -187,12 +188,12 @@ pSparseMatrices :: Int -> [Int] -> Parser [Matrix] pSparseMatrices m bs = do xs <- many pLine - let t = IM.unionsWith (IM.unionWith Map.union) - [ IM.singleton matno (IM.singleton blkno (Map.fromList [((i,j),e),((j,i),e)])) + let t = IntMap.unionsWith (IntMap.unionWith Map.union) + [ IntMap.singleton matno (IntMap.singleton blkno (Map.fromList [((i,j),e),((j,i),e)])) | (matno,blkno,i,j,e) <- xs ] return $ - [ [IM.findWithDefault Map.empty blkno mat | blkno <- [1 .. length bs]] - | matno <- [0..m], let mat = IM.findWithDefault IM.empty matno t + [ [IntMap.findWithDefault Map.empty blkno mat | blkno <- [1 .. length bs]] + | matno <- [0..m], let mat = IntMap.findWithDefault IntMap.empty matno t ] where diff --git a/src/Util.hs b/src/Util.hs --- a/src/Util.hs +++ b/src/Util.hs @@ -17,6 +17,7 @@ import Control.Monad import Data.Ratio +import Data.Set (Set) import qualified Data.Set as Set -- | Combining two @Maybe@ values using given function. @@ -58,7 +59,7 @@ else liftM ("." ++ ) $ loop Set.empty b return $ s1 ++ s2 ++ s3 where - loop :: Set.Set Rational -> Rational -> Maybe String + loop :: Set Rational -> Rational -> Maybe String loop _ 0 = return "" loop rs r | r `Set.member` rs = mzero diff --git a/src/maxsatverify.hs b/src/maxsatverify.hs new file mode 100644 --- /dev/null +++ b/src/maxsatverify.hs @@ -0,0 +1,42 @@ +module Main where + +import Control.Monad +import Data.Array.IArray +import Data.IORef +import System.Environment +import Text.Printf +import qualified Text.MaxSAT as MaxSAT +import SAT.Types + +main :: IO () +main = do + [problemFile, modelFile] <- getArgs + Right wcnf <- MaxSAT.parseWCNFFile problemFile + model <- liftM readModel (readFile modelFile) + costRef <- newIORef 0 + forM_ (MaxSAT.clauses wcnf) $ \(w,c) -> + unless (eval model c) $ + if w == MaxSAT.topCost wcnf + then printf "violated hard constraint: %s\n" (show c) + else do + tc <- readIORef costRef + writeIORef costRef $! tc + w + printf "total cost = %d\n" =<< readIORef costRef + +eval :: Model -> Clause -> Bool +eval m lits = or [evalLit m lit | lit <- lits] + +readModel :: String -> Model +readModel s = array (1, maximum (0 : map fst ls2)) ls2 + where + ls = lines s + ls2 = do + l <- ls + case l of + 'v':xs -> do + w <- words xs + case w of + '-':ys -> return (read ys, False) + ys -> return (read ys, True) + _ -> mzero + diff --git a/test/TestAReal.hs b/test/TestAReal.hs --- a/test/TestAReal.hs +++ b/test/TestAReal.hs @@ -9,7 +9,8 @@ import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 -import Data.Polynomial +import Data.Polynomial (UPolynomial, X (..)) +import qualified Data.Polynomial as P import Data.AlgebraicNumber.Real import Data.AlgebraicNumber.Root import qualified Data.Interval as Interval @@ -26,13 +27,13 @@ sqrt2 :: AReal [neg_sqrt2, sqrt2] = realRoots (x^2 - 2) where - x = var X + x = P.var X -- ±√3 sqrt3 :: AReal [neg_sqrt3, sqrt3] = realRoots (x^2 - 3) where - x = var X + x = P.var X {-------------------------------------------------------------------- root manipulation @@ -40,88 +41,88 @@ case_rootAdd_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 where - x = var X + x = P.var X p :: UPolynomial Rational p = rootAdd (x^2 - 2) (x^2 - 3) valP :: Double - valP = eval (\X -> sqrt 2 + sqrt 3) $ mapCoeff fromRational p + valP = P.eval (\X -> sqrt 2 + sqrt 3) $ P.mapCoeff fromRational p -- bug? sample_rootAdd = p where - x = var X + x = P.var X p :: UPolynomial Rational p = rootAdd (x^2 - 2) (x^6 + 6*x^3 - 2*x^2 + 9) case_rootSub_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 where - x = var X + x = P.var X p :: UPolynomial Rational p = rootAdd (x^2 - 2) (rootScale (-1) (x^2 - 3)) valP :: Double - valP = eval (\X -> sqrt 2 - sqrt 3) $ mapCoeff fromRational p + valP = P.eval (\X -> sqrt 2 - sqrt 3) $ P.mapCoeff fromRational p case_rootMul_sqrt2_sqrt3 = assertBool "" $ abs valP <= 0.0001 where - x = var X + x = P.var X p :: UPolynomial Rational p = rootMul (x^2 - 2) (x^2 - 3) valP :: Double - valP = eval (\X -> sqrt 2 * sqrt 3) $ mapCoeff fromRational p + valP = P.eval (\X -> sqrt 2 * sqrt 3) $ P.mapCoeff fromRational p case_rootNegate_test1 = assertBool "" $ abs valP <= 0.0001 where - x = var X + x = P.var X p :: UPolynomial Rational p = rootScale (-1) (x^3 - 3) valP :: Double - valP = eval (\X -> - (3 ** (1/3))) $ mapCoeff fromRational p + valP = P.eval (\X -> - (3 ** (1/3))) $ P.mapCoeff fromRational p case_rootNegate_test2 = rootScale (-1) p @?= normalizePoly q where x :: UPolynomial Rational - x = var X + x = P.var X p = x^3 - 3 q = x^3 + 3 case_rootNegate_test3 = rootScale (-1) p @?= normalizePoly q where x :: UPolynomial Rational - x = var X + x = P.var X p = (x-2)*(x-3)*(x-4) q = (x+2)*(x+3)*(x+4) case_rootScale = rootScale 2 p @?= normalizePoly q where x :: UPolynomial Rational - x = var X + x = P.var X p = (x-2)*(x-3)*(x-4) q = (x-4)*(x-6)*(x-8) case_rootScale_zero = rootScale 0 p @?= normalizePoly q where x :: UPolynomial Rational - x = var X + x = P.var X p = (x-2)*(x-3)*(x-4) q = x case_rootRecip = assertBool "" $ abs valP <= 0.0001 where - x = var X + x = P.var X p :: UPolynomial Rational p = rootRecip (x^3 - 3) valP :: Double - valP = eval (\X -> 1 / (3 ** (1/3))) $ mapCoeff fromRational p + valP = P.eval (\X -> 1 / (3 ** (1/3))) $ P.mapCoeff fromRational p {-------------------------------------------------------------------- algebraic reals @@ -132,19 +133,19 @@ case_realRoots_nonminimal = realRoots ((x^2 - 1) * (x - 3)) @?= [-1,1,3] where - x = var X + x = P.var X case_realRoots_minus_one = realRoots (x^2 + 1) @?= [] where - x = var X + x = P.var X case_realRoots_two = length (realRoots (x^2 - 2)) @?= 2 where - x = var X + x = P.var X case_realRoots_multipleRoots = length (realRoots (x^2 + 2*x + 1)) @?= 1 where - x = var X + x = P.var X case_eq = sqrt2*sqrt2 - 2 @?= 0 @@ -182,7 +183,7 @@ case_toRational = toRational r @?= 3/2 where - x = var X + x = P.var X [r] = realRoots (2*x - 3) case_toRational_error = do @@ -195,17 +196,17 @@ case_simpARealPoly = simpARealPoly p @?= q where x :: forall k. (Num k, Eq k) => UPolynomial k - x = var X - p = x^3 - constant sqrt2 * x + 3 + x = P.var X + p = x^3 - P.constant sqrt2 * x + 3 q = x^6 + 6*x^3 - 2*x^2 + 9 -case_deg_sqrt2 = deg sqrt2 @?= 2 +case_deg_sqrt2 = P.deg sqrt2 @?= 2 -case_deg_neg_sqrt2 = deg neg_sqrt2 @?= 2 +case_deg_neg_sqrt2 = P.deg neg_sqrt2 @?= 2 -case_deg_sqrt2_minus_sqrt2 = deg (sqrt2 - sqrt2) @?= 1 +case_deg_sqrt2_minus_sqrt2 = P.deg (sqrt2 - sqrt2) @?= 1 -case_deg_sqrt2_times_sqrt2 = deg (sqrt2 * sqrt2) @?= 1 +case_deg_sqrt2_times_sqrt2 = P.deg (sqrt2 * sqrt2) @?= 1 case_isAlgebraicInteger_sqrt2 = isAlgebraicInteger sqrt2 @?= True diff --git a/test/TestAReal2.hs b/test/TestAReal2.hs --- a/test/TestAReal2.hs +++ b/test/TestAReal2.hs @@ -9,7 +9,8 @@ import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 -import Data.Polynomial +import Data.Polynomial (UPolynomial, X (..)) +import qualified Data.Polynomial as P import Data.AlgebraicNumber.Real import Control.Monad @@ -77,7 +78,7 @@ samples :: [AReal] samples = [0, 1, -1, 2, -2] ++ concatMap realRoots ps where - x = var () + x = P.var X ps = [x^2 - 2, x^2 - 3 {- , x^3 - 2, x^6 + 6*x^3 - 2*x^2 + 9 -}] ------------------------------------------------------------------------ diff --git a/test/TestCongruenceClosure.hs b/test/TestCongruenceClosure.hs new file mode 100644 --- /dev/null +++ b/test/TestCongruenceClosure.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +import Test.HUnit hiding (Test) +import Test.Framework.TH +import Test.Framework.Providers.HUnit + +import Algorithm.CongruenceClosure + +------------------------------------------------------------------------ +-- Test cases + +case_1 :: IO () +case_1 = do + solver <- newSolver + a <- newVar solver + b <- newVar solver + c <- newVar solver + d <- newVar solver + + merge solver (FTConst a, c) + ret <- areCongruent solver (FTApp a b) (FTApp c d) + ret @?= False + + merge solver (FTConst b, d) + ret <- areCongruent solver (FTApp a b) (FTApp c d) + ret @?= True + +------------------------------------------------------------------------ +-- Test harness + +main :: IO () +main = $(defaultMainGenerator) diff --git a/test/TestContiTraverso.hs b/test/TestContiTraverso.hs --- a/test/TestContiTraverso.hs +++ b/test/TestContiTraverso.hs @@ -17,11 +17,12 @@ import Data.ArithRel import qualified Data.LA as LA import Data.OptDir -import Data.Polynomial +import Data.Polynomial (Polynomial) +import qualified Data.Polynomial as P -- http://madscientist.jp/~ikegami/articles/IntroSequencePolynomial.html -- optimum is (3,2,0) -case_ikegami = solve grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) +case_ikegami = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) where vs = [1..3] [x,y,z] = map LA.var vs @@ -33,7 +34,7 @@ ] obj = x ^+^ 2*^y ^+^ 3*^z -case_ikegami' = solve' grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) +case_ikegami' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,3),(2,2),(3,0)]) where vs@[x,y,z] = [1..3] cs = [ (LA.fromTerms [(2,x),(2,y),(2,z)], 10) @@ -43,7 +44,7 @@ -- http://posso.dm.unipi.it/users/traverso/conti-traverso-ip.ps -- optimum is (39, 75, 1, 8, 122) -disabled_case_test1 = solve grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) +disabled_case_test1 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) where vs = [1..5] vs2@[x1,x2,x3,x4,x5] = map LA.var vs @@ -54,7 +55,7 @@ [ v .>=. LA.constant 0 | v <- vs2 ] obj = x1 ^+^ x2 ^+^ x3 ^+^ x4 ^+^ x5 -disabled_case_test1' = solve' grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) +disabled_case_test1' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,39), (2,75), (3,1), (4,8), (5,122)]) where vs@[x1,x2,x3,x4,x5] = [1..5] cs = [ (LA.fromTerms [(2, x1), ( 5, x2), (-3, x3), ( 1,x4), (-2, x5)], 214) @@ -64,7 +65,7 @@ obj = LA.fromTerms [(1,x1),(1,x2),(1,x3),(1,x4),(1,x5)] -- optimum is (0,2,2) -case_test2 = solve grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) +case_test2 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) where vs = [1..3] vs2@[x1,x2,x3] = map LA.var vs @@ -72,14 +73,14 @@ [ v .>=. LA.constant 0 | v <- vs2 ] obj = 2*^x1 ^+^ x2 -case_test2' = solve' grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) +case_test2' = solve' P.grlex (IS.fromList vs) obj cs @?= Just (IM.fromList [(1,0),(2,2),(3,2)]) where vs@[x1,x2,x3] = [1..3] cs = [ (LA.fromTerms [(2, x1), (3, x2), (-1, x3)], 4) ] obj = LA.fromTerms [(2,x1),(1,x2)] -- infeasible -case_test3 = solve grlex (IS.fromList vs) OptMin obj cs @?= Nothing +case_test3 = solve P.grlex (IS.fromList vs) OptMin obj cs @?= Nothing where vs = [1..3] vs2@[x1,x2,x3] = map LA.var vs @@ -87,7 +88,7 @@ [ v .>=. LA.constant 0 | v <- vs2 ] obj = x1 -case_test3' = solve' grlex (IS.fromList vs) obj cs @?= Nothing +case_test3' = solve' P.grlex (IS.fromList vs) obj cs @?= Nothing where vs@[x1,x2,x3] = [1..3] cs = [ (LA.fromTerms [(2, x1), (2, x2), (2, x3)], 3) ] diff --git a/test/TestPolynomial.hs b/test/TestPolynomial.hs --- a/test/TestPolynomial.hs +++ b/test/TestPolynomial.hs @@ -15,12 +15,11 @@ import Test.Framework.Providers.QuickCheck2 import Text.PrettyPrint.HughesPJClass -import Data.Polynomial -import qualified Data.Polynomial.GBasis as GB +import Data.Polynomial (Polynomial, Term, Monomial, UPolynomial, UTerm, UMonomial, X (..)) +import qualified Data.Polynomial as P +import qualified Data.Polynomial.GroebnerBasis as GB import Data.Polynomial.RootSeparation.Sturm import qualified Data.Polynomial.Factorization.FiniteField as FactorFF -import qualified Data.Polynomial.Factorization.Integer as FactorZ -import qualified Data.Polynomial.Factorization.Rational as FactorQ import qualified Data.Polynomial.Interpolation.Lagrange as LagrangeInterpolation import qualified Data.Interval as Interval import Data.Interval (Interval, EndPoint (..), (<=..<=), (<..<=), (<=..<), (<..<)) @@ -42,11 +41,11 @@ prop_plus_unitL = forAll polynomials $ \a -> - constant 0 + a == a + P.constant 0 + a == a prop_plus_unitR = forAll polynomials $ \a -> - a + constant 0 == a + a + P.constant 0 == a prop_prod_comm = forAll polynomials $ \a -> @@ -61,11 +60,11 @@ prop_prod_unitL = forAll polynomials $ \a -> - constant 1 * a == a + P.constant 1 * a == a prop_prod_unitR = forAll polynomials $ \a -> - a * constant 1 == a + a * P.constant 1 == a prop_distL = forAll polynomials $ \a -> @@ -87,38 +86,38 @@ forAll polynomials $ \a -> negate (negate a) == a -prop_polyMDivMod = +prop_divModMP = forAll polynomials $ \g -> forAll (replicateM 3 polynomials) $ \fs -> all (0/=) fs ==> - let (qs, r) = polyMDivMod lex g fs + let (qs, r) = P.divModMP P.lex g fs in sum (zipWith (*) fs qs) + r == g case_prettyShow_test1 = prettyShow p @?= "-x1^2*x2 + 3*x1 - 2*x2" where p :: Polynomial Rational Int - p = - (var 1)^2 * var 2 + 3 * var 1 - 2 * var 2 + p = - (P.var 1)^2 * P.var 2 + 3 * P.var 1 - 2 * P.var 2 case_prettyShow_test2 = prettyShow p @?= "(x0 + 1)*x" where p :: UPolynomial (Polynomial Rational Int) - p = constant (var (0::Int) + 1) * var X + p = P.constant (P.var (0::Int) + 1) * P.var X case_prettyShow_test3 = prettyShow p @?= "(-1)*x" where p :: UPolynomial (Polynomial Rational Int) - p = constant (-1) * var X + p = P.constant (-1) * P.var X case_prettyShow_test4 = prettyShow p @?= "x^2 - (1/2)" where p :: UPolynomial Rational - p = (var X)^2 - constant (1/2) + p = (P.var X)^2 - P.constant (1/2) -case_deg_0 = assertBool "" $ (deg p < 0) +case_deg_0 = assertBool "" $ (P.deg p < 0) where p :: UPolynomial Rational p = 0 @@ -127,125 +126,162 @@ Univalent polynomials --------------------------------------------------------------------} -prop_polyDivMod = +prop_divMod = forAll upolynomials $ \a -> forAll upolynomials $ \b -> b /= 0 ==> - let (q,r) = polyDivMod a b - in a == q*b + r && (r==0 || deg b > deg r) + let (q,r) = P.divMod a b + in a == q*b + r && (r==0 || P.deg b > P.deg r) -case_polyDivMod_1 = g*q + r @?= f +case_divMod_1 = g*q + r @?= f where x :: UPolynomial Rational - x = var X + x = P.var X f = x^3 + x^2 + x g = x^2 + 1 - (q,r) = f `polyDivMod` g + (q,r) = f `P.divMod` g -prop_polyGCD_divisible = +prop_gcd_divisible = forAll upolynomials $ \a -> forAll upolynomials $ \b -> (a /= 0 && b /= 0) ==> - let c = polyGCD a b - in a `polyMod` c == 0 && b `polyMod` c == 0 + let c = P.gcd a b + in a `P.mod` c == 0 && b `P.mod` c == 0 -prop_polyGCD_comm = +prop_gcd_comm = forAll upolynomials $ \a -> forAll upolynomials $ \b -> - polyGCD a b == polyGCD b a + P.gcd a b == P.gcd b a -prop_polyGCD_euclid = +prop_gcd_euclid = forAll upolynomials $ \p -> forAll upolynomials $ \q -> forAll upolynomials $ \r -> (p /= 0 && q /= 0 && r /= 0) ==> - polyGCD p q == polyGCD p (q + p*r) + P.gcd p q == P.gcd p (q + p*r) -case_polyGCD_1 = polyGCD f1 f2 @?= 1 +case_gcd_1 = P.gcd f1 f2 @?= 1 where x :: UPolynomial Rational - x = var X + x = P.var X f1 = x^3 + x^2 + x f2 = x^2 + 1 +prop_exgcd = + forAll upolynomials $ \a -> + forAll upolynomials $ \b -> + let (g,u,v) = P.exgcd a b + in a*u + b*v == g -- Bśzout's identity + +case_exgcd_1 = P.exgcd p q @?= (expected_g, expected_u, expected_v) + where + x :: UPolynomial Rational + x = P.var X + p = x^4 - 3*x^3 + x^2 - x + 1 + q = 2*x^3 - x^2 + x + 3 + expected_g = 1 + expected_u = P.constant (94/2219) * x^2 + P.constant (9/317) * x + P.constant (404/2219) + expected_v = P.constant (-47/2219) * x^3 + P.constant (86/2219) * x^2 - P.constant (88/2219) * x + P.constant (605/2219) + eqUpToInvElem :: UPolynomial Integer -> UPolynomial Integer -> Bool eqUpToInvElem 0 0 = True eqUpToInvElem _ 0 = False eqUpToInvElem a b = - case mapCoeff fromInteger a `polyDivMod` mapCoeff fromInteger b of - (q,r) -> r == 0 && deg q <= 0 + case P.mapCoeff fromInteger a `P.divMod` P.mapCoeff fromInteger b of + (q,r) -> r == 0 && P.deg q <= 0 -prop_polyGCD'_comm = +prop_gcd'_comm = forAll upolynomialsZ $ \a -> forAll upolynomialsZ $ \b -> - polyGCD' a b `eqUpToInvElem` polyGCD' b a + P.gcd' a b `eqUpToInvElem` P.gcd' b a -prop_polyGCD'_euclid = +prop_gcd'_euclid = forAll upolynomialsZ $ \p -> forAll upolynomialsZ $ \q -> forAll upolynomialsZ $ \r -> (p /= 0 && q /= 0 && r /= 0) ==> - polyGCD' p q `eqUpToInvElem` polyGCD' p (q + p*r) + P.gcd' p q `eqUpToInvElem` P.gcd' p (q + p*r) -case_polyGCD'_1 = eqUpToInvElem (polyGCD' f1 f2) 1 @?= True +case_gcd'_1 = eqUpToInvElem (P.gcd' f1 f2) 1 @?= True where x :: UPolynomial Integer - x = var X + x = P.var X f1 = x^3 + x^2 + x f2 = x^2 + 1 -prop_polyLCM_divisible = +prop_lcm_divisible = forAll upolynomials $ \a -> forAll upolynomials $ \b -> (a /= 0 && b /= 0) ==> - let c = polyLCM a b - in c `polyMod` a == 0 && c `polyMod` b == 0 + let c = P.lcm a b + in c `P.mod` a == 0 && c `P.mod` b == 0 -prop_polyLCM_comm = +prop_lcm_comm = forAll upolynomials $ \a -> forAll upolynomials $ \b -> - polyLCM a b == polyLCM b a + P.lcm a b == P.lcm b a prop_deriv_integral = forAll upolynomials $ \a -> - deriv (integral a x) x == a + P.deriv (P.integral a x) x == a where x = X prop_integral_deriv = forAll upolynomials $ \a -> - deg (integral (deriv a x) x - a) <= 0 + P.deg (P.integral (P.deriv a x) x - a) <= 0 where x = X prop_pp_cont = forAll polynomials $ \p -> - cont (pp p) == 1 + P.cont (P.pp p) == 1 prop_cont_prod = forAll polynomials $ \p -> forAll polynomials $ \q -> (p /= 0 && q /= 0) ==> - cont (p*q) == cont p * cont q + P.cont (p*q) == P.cont p * P.cont q case_cont_pp_Integer = do - cont p @?= 5 - pp p @?= (-2*x^2 + x + 1) + P.cont p @?= 5 + P.pp p @?= (-2*x^2 + x + 1) where - x = var X + x = P.var X p :: UPolynomial Integer p = -10*x^2 + 5*x + 5 case_cont_pp_Rational = do - cont p @?= 1/6 - pp p @?= (2*x^5 + 21*x^2 + 12*x + 6) + P.cont p @?= 1/6 + P.pp p @?= (2*x^5 + 21*x^2 + 12*x + 6) where - x = var X + x = P.var X p :: UPolynomial Rational - p = constant (1/3) * x^5 + constant (7/2) * x^2 + 2 * x + 1 + p = P.constant (1/3) * x^5 + P.constant (7/2) * x^2 + 2 * x + 1 +prop_pdivMod = + forAll upolynomialsZ $ \f -> + forAll upolynomialsZ $ \g -> + g /= 0 ==> + let (b,q,r) = f `P.pdivMod` g + in P.constant b * f == q*g + r && P.deg r < P.deg g + +prop_pdiv = + forAll upolynomialsZ $ \f -> + forAll upolynomialsZ $ \g -> + g /= 0 ==> + let (_,q,_) = f `P.pdivMod` g + in f `P.pdiv` g == q + +prop_pmod = + forAll upolynomialsZ $ \f -> + forAll upolynomialsZ $ \g -> + g /= 0 ==> + let (_,_,r) = f `P.pdivMod` g + in f `P.pmod` g == r + {-------------------------------------------------------------------- - Monomial + Term --------------------------------------------------------------------} {-------------------------------------------------------------------- @@ -255,127 +291,127 @@ prop_degreeOfProduct = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - deg (a `mmProd` b) == deg a + deg b + P.deg (a `P.mmult` b) == P.deg a + P.deg b -prop_degreeOfOne = - deg mmOne == 0 +prop_degreeOfUnit = + P.deg P.mone == 0 -prop_mmProd_unitL = +prop_mmult_unitL = forAll monicMonomials $ \a -> - mmOne `mmProd` a == a + P.mone `P.mmult` a == a -prop_mmProd_unitR = +prop_mmult_unitR = forAll monicMonomials $ \a -> - a `mmProd` mmOne == a + a `P.mmult` P.mone == a -prop_mmProd_comm = +prop_mmult_comm = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - a `mmProd` b == b `mmProd` a + a `P.mmult` b == b `P.mmult` a -prop_mmProd_assoc = +prop_mmult_assoc = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> forAll monicMonomials $ \c -> - a `mmProd` (b `mmProd` c) == (a `mmProd` b) `mmProd` c + a `P.mmult` (b `P.mmult` c) == (a `P.mmult` b) `P.mmult` c -prop_mmProd_Divisible = +prop_mmult_Divisible = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - let c = a `mmProd` b - in mmDivisible c a && mmDivisible c b + let c = a `P.mmult` b + in a `P.mdivides` c && b `P.mdivides` c -prop_mmProd_Div = +prop_mmult_Div = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - let c = a `mmProd` b - in c `mmDiv` a == b && c `mmDiv` b == a + let c = a `P.mmult` b + in c `P.mdiv` a == b && c `P.mdiv` b == a -case_mmDeriv = mmDeriv p 1 @?= (2, q) +case_mderiv = P.mderiv p 1 @?= (2, q) where - p = mmFromList [(1,2),(2,4)] - q = mmFromList [(1,1),(2,4)] + p = P.mfromIndices [(1,2),(2,4)] + q = P.mfromIndices [(1,1),(2,4)] -- lcm (x1^2 * x2^4) (x1^3 * x2^1) = x1^3 * x2^4 -case_mmLCM = mmLCM p1 p2 @?= mmFromList [(1,3),(2,4)] +case_mlcm = P.mlcm p1 p2 @?= P.mfromIndices [(1,3),(2,4)] where - p1 = mmFromList [(1,2),(2,4)] - p2 = mmFromList [(1,3),(2,1)] + p1 = P.mfromIndices [(1,2),(2,4)] + p2 = P.mfromIndices [(1,3),(2,1)] -- gcd (x1^2 * x2^4) (x2^1 * x3^2) = x2 -case_mmGCD = mmGCD p1 p2 @?= mmFromList [(2,1)] +case_mgcd = P.mgcd p1 p2 @?= P.mfromIndices [(2,1)] where - p1 = mmFromList [(1,2),(2,4)] - p2 = mmFromList [(2,1),(3,2)] + p1 = P.mfromIndices [(1,2),(2,4)] + p2 = P.mfromIndices [(2,1),(3,2)] -prop_mmLCM_divisible = +prop_mlcm_divisible = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - let c = mmLCM a b - in c `mmDivisible` a && c `mmDivisible` b + let c = P.mlcm a b + in a `P.mdivides` c && b `P.mdivides` c -prop_mmGCD_divisible = +prop_mgcd_divisible = forAll monicMonomials $ \a -> forAll monicMonomials $ \b -> - let c = mmGCD a b - in a `mmDivisible` c && b `mmDivisible` c + let c = P.mgcd a b + in c `P.mdivides` a && c `P.mdivides` b {-------------------------------------------------------------------- Monomial Order --------------------------------------------------------------------} -- http://en.wikipedia.org/wiki/Monomial_order -case_lex = sortBy lex [a,b,c,d] @?= [b,a,d,c] +case_lex = sortBy P.lex [a,b,c,d] @?= [b,a,d,c] where x = 1 y = 2 z = 3 - a = mmFromList [(x,1),(y,2),(z,1)] - b = mmFromList [(z,2)] - c = mmFromList [(x,3)] - d = mmFromList [(x,2),(z,2)] + a = P.mfromIndices [(x,1),(y,2),(z,1)] + b = P.mfromIndices [(z,2)] + c = P.mfromIndices [(x,3)] + d = P.mfromIndices [(x,2),(z,2)] -- http://en.wikipedia.org/wiki/Monomial_order -case_grlex = sortBy grlex [a,b,c,d] @?= [b,c,a,d] +case_grlex = sortBy P.grlex [a,b,c,d] @?= [b,c,a,d] where x = 1 y = 2 z = 3 - a = mmFromList [(x,1),(y,2),(z,1)] - b = mmFromList [(z,2)] - c = mmFromList [(x,3)] - d = mmFromList [(x,2),(z,2)] + a = P.mfromIndices [(x,1),(y,2),(z,1)] + b = P.mfromIndices [(z,2)] + c = P.mfromIndices [(x,3)] + d = P.mfromIndices [(x,2),(z,2)] -- http://en.wikipedia.org/wiki/Monomial_order -case_grevlex = sortBy grevlex [a,b,c,d] @?= [b,c,d,a] +case_grevlex = sortBy P.grevlex [a,b,c,d] @?= [b,c,d,a] where x = 1 y = 2 z = 3 - a = mmFromList [(x,1),(y,2),(z,1)] - b = mmFromList [(z,2)] - c = mmFromList [(x,3)] - d = mmFromList [(x,2),(z,2)] + a = P.mfromIndices [(x,1),(y,2),(z,1)] + b = P.mfromIndices [(z,2)] + c = P.mfromIndices [(x,3)] + d = P.mfromIndices [(x,2),(z,2)] -prop_refl_lex = propRefl lex -prop_refl_grlex = propRefl grlex -prop_refl_grevlex = propRefl grevlex +prop_refl_lex = propRefl P.lex +prop_refl_grlex = propRefl P.grlex +prop_refl_grevlex = propRefl P.grevlex -prop_trans_lex = propTrans lex -prop_trans_grlex = propTrans grlex -prop_trans_grevlex = propTrans grevlex +prop_trans_lex = propTrans P.lex +prop_trans_grlex = propTrans P.grlex +prop_trans_grevlex = propTrans P.grevlex -prop_sym_lex = propSym lex -prop_sym_grlex = propSym grlex -prop_sym_grevlex = propSym grevlex +prop_sym_lex = propSym P.lex +prop_sym_grlex = propSym P.grlex +prop_sym_grevlex = propSym P.grevlex -prop_monomial_order_property1_lex = monomialOrderProp1 lex -prop_monomial_order_property1_grlex = monomialOrderProp1 grlex -prop_monomial_order_property1_grevlex = monomialOrderProp1 grevlex +prop_monomial_order_property1_lex = monomialOrderProp1 P.lex +prop_monomial_order_property1_grlex = monomialOrderProp1 P.grlex +prop_monomial_order_property1_grevlex = monomialOrderProp1 P.grevlex -prop_monomial_order_property2_lex = monomialOrderProp2 lex -prop_monomial_order_property2_grlex = monomialOrderProp2 grlex -prop_monomial_order_property2_grevlex = monomialOrderProp2 grevlex +prop_monomial_order_property2_lex = monomialOrderProp2 P.lex +prop_monomial_order_property2_grlex = monomialOrderProp2 P.grlex +prop_monomial_order_property2_grevlex = monomialOrderProp2 P.grevlex propRefl cmp = forAll monicMonomials $ \a -> cmp a a == EQ @@ -402,11 +438,11 @@ let r = cmp a b in cmp a b /= EQ ==> forAll monicMonomials $ \c -> - cmp (a `mmProd` c) (b `mmProd` c) == r + cmp (a `P.mmult` c) (b `P.mmult` c) == r monomialOrderProp2 cmp = forAll monicMonomials $ \a -> - a /= mmOne ==> cmp mmOne a == LT + a /= P.mone ==> cmp P.mone a == LT {-------------------------------------------------------------------- Gröbner basis @@ -414,10 +450,10 @@ -- http://math.rice.edu/~cbruun/vigre/vigreHW6.pdf -- Example 1 -case_spolynomial = GB.spolynomial grlex f g @?= - x^3*y^3 - constant (1/3) * y^3 + x^2 +case_spolynomial = GB.spolynomial P.grlex f g @?= - x^3*y^3 - P.constant (1/3) * y^3 + x^2 where - x = var 1 - y = var 2 + x = P.var 1 + y = P.var 2 f, g :: Polynomial Rational Int f = x^3*y^2 - x^2*y^3 + x g = 3*x^4*y + y^2 @@ -427,46 +463,46 @@ -- Exercise 1 case_buchberger1 = Set.fromList gb @?= Set.fromList expected where - gb = GB.basis lex [x^2-y, x^3-z] + gb = GB.basis P.lex [x^2-y, x^3-z] expected = [y^3 - z^2, x^2 - y, x*z - y^2, x*y - z] x :: Polynomial Rational Int - x = var 1 - y = var 2 - z = var 3 + x = P.var 1 + y = P.var 2 + z = P.var 3 -- http://math.rice.edu/~cbruun/vigre/vigreHW6.pdf -- Exercise 2 case_buchberger2 = Set.fromList gb @?= Set.fromList expected where - gb = GB.basis grlex [x^3-2*x*y, x^2*y-2*y^2+x] - expected = [x^2, x*y, y^2 - constant (1/2) * x] + gb = GB.basis P.grlex [x^3-2*x*y, x^2*y-2*y^2+x] + expected = [x^2, x*y, y^2 - P.constant (1/2) * x] x :: Polynomial Rational Int - x = var 1 - y = var 2 + x = P.var 1 + y = P.var 2 -- http://www.iisdavinci.it/jeometry/buchberger.html case_buchberger3 = Set.fromList gb @?= Set.fromList expected where - gb = GB.basis lex [x^2+2*x*y^2, x*y+2*y^3-1] - expected = [x, y^3 - constant (1/2)] + gb = GB.basis P.lex [x^2+2*x*y^2, x*y+2*y^3-1] + expected = [x, y^3 - P.constant (1/2)] x :: Polynomial Rational Int - x = var 1 - y = var 2 + x = P.var 1 + y = P.var 2 -- http://www.orcca.on.ca/~reid/NewWeb/DetResDes/node4.html -- 時間がかかるので自動実行されるテストケースには含めていない disabled_case_buchberger4 = Set.fromList gb @?= Set.fromList expected where x :: Polynomial Rational Int - x = var 1 - y = var 2 - z = var 3 + x = P.var 1 + y = P.var 2 + z = P.var 3 - gb = GB.basis lex [x^2+y*z-2, x*z+y^2-3, x*y+z^2-5] + gb = GB.basis P.lex [x^2+y*z-2, x*z+y^2-3, x*y+z^2-5] - expected = GB.reduceGBasis lex $ + expected = GB.reduceGBasis P.lex $ [ 8*z^8-100*z^6+438*z^4-760*z^2+361 , 361*y+8*z^7+52*z^5-740*z^3+1425*z , 361*x-88*z^7+872*z^5-2690*z^3+2375*z @@ -484,11 +520,11 @@ -- Seven Trees in One -- http://arxiv.org/abs/math/9405205 -case_Seven_Trees_in_One = reduce lex (x^7 - x) gb @?= 0 +case_Seven_Trees_in_One = P.reduce P.lex (x^7 - x) gb @?= 0 where x :: Polynomial Rational Int - x = var 1 - gb = GB.basis lex [x-(x^2 + 1)] + x = P.var 1 + gb = GB.basis P.lex [x-(x^2 + 1)] -- Non-linear loop invariant generation using Gröbner bases -- http://portal.acm.org/citation.cfm?id=964028 @@ -500,33 +536,33 @@ -- a normal form 0. case_sankaranarayanan04nonlinear = do Set.fromList gb @?= Set.fromList [f', g, h] - reduce lex (x^2 - y^2) gb @?= 0 + P.reduce P.lex (x^2 - y^2) gb @?= 0 where x :: Polynomial Rational Int - x = var 1 - y = var 2 - z = var 3 + x = P.var 1 + y = P.var 2 + z = P.var 3 f = x^2 - y g = y - z h = x + z f' = z^2 - z - gb = GB.basis lex [f, g, h] + gb = GB.basis P.lex [f, g, h] {-------------------------------------------------------------------- Generators --------------------------------------------------------------------} -monicMonomials :: Gen (MonicMonomial Int) +monicMonomials :: Gen (Monomial Int) monicMonomials = do size <- choose (0, 3) xs <- replicateM size $ do v <- choose (-5, 5) e <- liftM ((+1) . abs) arbitrary - return $ mmFromList [(v,e)] - return $ foldl mmProd mmOne xs + return $ P.var v `P.mpow` e + return $ foldl' P.mmult P.mone xs -monomials :: Gen (Monomial Rational Int) -monomials = do +genTerms :: Gen (Term Rational Int) +genTerms = do m <- monicMonomials c <- arbitrary return (c,m) @@ -534,19 +570,19 @@ polynomials :: Gen (Polynomial Rational Int) polynomials = do size <- choose (0, 5) - xs <- replicateM size monomials - return $ sum $ map fromMonomial xs + xs <- replicateM size genTerms + return $ sum $ map P.fromTerm xs -umonicMonomials :: Gen (MonicMonomial X) +umonicMonomials :: Gen UMonomial umonicMonomials = do size <- choose (0, 3) xs <- replicateM size $ do e <- choose (1, 4) - return $ mmFromList [(X,e)] - return $ foldl mmProd mmOne xs + return $ P.var X `P.mpow` e + return $ foldl' P.mmult P.mone xs -umonomials :: Gen (Monomial Rational X) -umonomials = do +genUTerms :: Gen (UTerm Rational) +genUTerms = do m <- umonicMonomials c <- arbitrary return (c,m) @@ -554,11 +590,11 @@ upolynomials :: Gen (UPolynomial Rational) upolynomials = do size <- choose (0, 5) - xs <- replicateM size umonomials - return $ sum $ map fromMonomial xs + xs <- replicateM size genUTerms + return $ sum $ map P.fromTerm xs -umonomialsZ :: Gen (Monomial Integer X) -umonomialsZ = do +genUTermsZ :: Gen (UTerm Integer) +genUTermsZ = do m <- umonicMonomials c <- arbitrary return (c,m) @@ -566,19 +602,19 @@ upolynomialsZ :: Gen (UPolynomial Integer) upolynomialsZ = do size <- choose (0, 5) - xs <- replicateM size umonomialsZ - return $ sum $ map fromMonomial xs + xs <- replicateM size genUTermsZ + return $ sum $ map P.fromTerm xs ------------------------------------------------------------------------ -- http://mathworld.wolfram.com/SturmFunction.html case_sturmChain = sturmChain p0 @?= chain where - x = var X + x = P.var X p0 = x^5 - 3*x - 1 p1 = 5*x^4 - 3 - p2 = constant (1/5) * (12*x + 5) - p3 = constant (59083 / 20736) + p2 = P.constant (1/5) * (12*x + 5) + p3 = P.constant (59083 / 20736) chain = [p0, p1, p2, p3] -- http://mathworld.wolfram.com/SturmFunction.html @@ -591,7 +627,7 @@ , numRoots p (Finite 1 <=..<= Finite (1.5)) @?= 1 ] where - x = var X + x = P.var X p = x^5 - 3*x - 1 -- check interpretation of intervals @@ -603,7 +639,7 @@ , numRoots p (Finite 1 <..<= Finite 2) @?= 1 ] where - x = var X + x = P.var X p = x^2 - 4 case_separate = do @@ -612,16 +648,16 @@ forM_ (filter (v/=) vals) $ \v2 -> do Interval.member v2 ival @?= False where - x = var X + x = P.var X p = x^5 - 3*x - 1 intervals = separate p vals = [-1.21465, -0.334734, 1.38879] ------------------------------------------------------------------------ -case_factorZ_zero = FactorZ.factor 0 @?= [(0,1)] -case_factorZ_one = FactorZ.factor 1 @?= [] -case_factorZ_two = FactorZ.factor 2 @?= [(2,1)] +case_factorZ_zero = P.factor (0::UPolynomial Integer) @?= [(0,1)] +case_factorZ_one = P.factor (1::UPolynomial Integer) @?= [] +case_factorZ_two = P.factor (2::UPolynomial Integer) @?= [(2,1)] -- http://en.wikipedia.org/wiki/Factorization_of_polynomials case_factorZ_test1 = do @@ -629,9 +665,9 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial Integer - x = var X + x = P.var X f = 2*(x^5 + x^4 + x^2 + x + 2) - actual = FactorZ.factor f + actual = P.factor f expected = [(2,1), (x^2+x+1,1), (x^3-x+2,1)] case_factorZ_test2 = do @@ -639,14 +675,14 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial Integer - x = var X + x = P.var X f = - (x^5 + x^4 + x^2 + x + 2) - actual = FactorZ.factor f + actual = P.factor f expected = [(-1,1), (x^2+x+1,1), (x^3-x+2,1)] -case_factorQ_zero = FactorQ.factor 0 @?= [(0,1)] -case_factorQ_one = FactorQ.factor 1 @?= [] -case_factorQ_two = FactorQ.factor 2 @?= [(2,1)] +case_factorQ_zero = P.factor (0::UPolynomial Rational) @?= [(0,1)] +case_factorQ_one = P.factor (1::UPolynomial Rational) @?= [] +case_factorQ_two = P.factor (2::UPolynomial Rational) @?= [(2,1)] -- http://en.wikipedia.org/wiki/Factorization_of_polynomials case_factorQ_test1 = do @@ -654,9 +690,9 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial Rational - x = var X + x = P.var X f = 2*(x^5 + x^4 + x^2 + x + 2) - actual = FactorQ.factor f + actual = P.factor f expected = [(2, 1), (x^2+x+1, 1), (x^3-x+2, 1)] case_factorQ_test2 = do @@ -664,9 +700,9 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial Rational - x = var X + x = P.var X f = - (x^5 + x^4 + x^2 + x + 2) - actual = FactorQ.factor f + actual = P.factor f expected = [(-1,1), (x^2+x+1,1), (x^3-x+2,1)] -- http://en.wikipedia.org/wiki/Factorization_of_polynomials_over_a_finite_field_and_irreducibility_tests @@ -675,9 +711,9 @@ product [f^n | (f,n) <- actual] @?= f where x :: UPolynomial $(FF.primeField 3) - x = var X + x = P.var X f = x^11 + 2*x^9 + 2*x^8 + x^6 + x^5 + 2*x^3 + 2*x^2 + 1 - actual = FactorFF.sqfree f + actual = P.sqfree f expected = [(x+1, 1), (x^2+1, 3), (x+2, 4)] {- @@ -694,9 +730,9 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial $(FF.primeField 5) - x = var X + x = P.var X f = x^100 - x^200 - actual = FactorFF.factor f + actual = P.factor f expected = (4,1) : [(1*x+1,25), (1*x+3,25), (1*x+2,25), (1*x+4,25), (1*x,100)] {- @@ -713,7 +749,7 @@ product actual @?= f where x :: UPolynomial $(FF.primeField 2) - x = var X + x = P.var X f = 1 + x + x^2 + x^6 + x^7 + x^8 + x^12 actual = FactorFF.berlekamp f expected = [1*x^5+1*x^3+1*x^2+1*x+1, 1*x^7+1*x^5+1*x^4+1*x^3+1] @@ -732,9 +768,9 @@ product [g^n | (g,n) <- actual] @?= f where x :: UPolynomial $(FF.primeField 7) - x = var X + x = P.var X f = 1 - x^100 - actual = FactorFF.factor f + actual = P.factor f expected = (6,1) : [(1*x+1,1), (1*x+6,1), (1*x^2+1,1), (1*x^4+2*x^3+5*x^2+2*x+1,1), (1*x^4+5*x^3+5*x^2+5*x+1,1), (1*x^4+5*x^3+3*x^2+2*x+1,1), (1*x^4+2*x^3+3*x^2+5*x+1,1), (1*x^4+1*x^3+1*x^2+6*x+1,1), (1*x^4+1*x^3+5*x^2+1*x+1,1), (1*x^4+2*x^3+4*x^2+2*x+1,1), (1*x^4+3*x^3+6*x^2+4*x+1,1), (1*x^4+3*x^3+3*x+1,1), (1*x^4+5*x^3+2*x+1,1), (1*x^4+3*x^3+3*x^2+3*x+1,1), (1*x^4+6*x^3+5*x^2+6*x+1,1), (1*x^4+6*x^3+1*x^2+1*x+1,1), (1*x^4+4*x^3+3*x^2+4*x+1,1), (1*x^4+6*x^3+1*x^2+6*x+1,1), (1*x^4+4*x^3+4*x+1,1), (1*x^4+2*x^3+1*x^2+5*x+1,1), (1*x^4+5*x^3+4*x^2+5*x+1,1), (1*x^4+4*x^3+4*x^2+3*x+1,1), (1*x^4+5*x^3+1*x^2+2*x+1,1), (1*x^4+1*x^3+1*x^2+1*x+1,1), (1*x^4+3*x^3+4*x^2+4*x+1,1), (1*x^4+2*x^3+5*x+1,1), (1*x^4+4*x^3+6*x^2+3*x+1,1)] {- @@ -751,7 +787,7 @@ product actual @?= f where x :: UPolynomial $(FF.primeField 13) - x = var X + x = P.var X f = 8 + 2*x + 8*x^2 + 10*x^3 + 10*x^4 + x^6 +x^8 actual = FactorFF.berlekamp f expected = [1*x+3, 1*x^3+8*x^2+4*x+12, 1*x^4+2*x^3+3*x^2+4*x+6] @@ -770,55 +806,70 @@ -- product actual @?= f -- where -- x :: UPolynomial $(FF.primeField 31991) --- x = var X +-- x = P.var X -- f = 2 + x + x^2 + x^3 + x^4 + x^5 -- actual = FactorFF.berlekamp f -- expected = [1*x+13077, 1*x^4+18915*x^3+2958*x^2+27345*x+4834] -case_basisOfBerlekampSubalgebra_1 = sequence_ [(g ^ (5::Int)) `polyMod` f @?= g | g <- basis] +case_basisOfBerlekampSubalgebra_1 = sequence_ [(g ^ (5::Int)) `P.mod` f @?= g | g <- basis] where x :: UPolynomial $(FF.primeField 5) - x = var X - f = associatedMonicPolynomial grlex $ x^100 - x^200 + x = P.var X + f = P.toMonic P.grlex $ x^100 - x^200 basis = FactorFF.basisOfBerlekampSubalgebra f -case_basisOfBerlekampSubalgebra_2 = sequence_ [(g ^ (2::Int)) `polyMod` f @?= g | g <- basis] +case_basisOfBerlekampSubalgebra_2 = sequence_ [(g ^ (2::Int)) `P.mod` f @?= g | g <- basis] where x :: UPolynomial $(FF.primeField 2) - x = var X + x = P.var X f = 1 + x + x^2 + x^6 + x^7 + x^8 + x^12 basis = FactorFF.basisOfBerlekampSubalgebra f -case_basisOfBerlekampSubalgebra_3 = sequence_ [(g ^ (2::Int)) `polyMod` f @?= g | g <- basis] +case_basisOfBerlekampSubalgebra_3 = sequence_ [(g ^ (2::Int)) `P.mod` f @?= g | g <- basis] where x :: UPolynomial $(FF.primeField 2) - x = var X - f = associatedMonicPolynomial grlex $ 1 - x^100 + x = P.var X + f = P.toMonic P.grlex $ 1 - x^100 basis = FactorFF.basisOfBerlekampSubalgebra f -case_basisOfBerlekampSubalgebra_4 = sequence_ [(g ^ (13::Int)) `polyMod` f @?= g | g <- basis] +case_basisOfBerlekampSubalgebra_4 = sequence_ [(g ^ (13::Int)) `P.mod` f @?= g | g <- basis] where x :: UPolynomial $(FF.primeField 13) - x = var X + x = P.var X f = 8 + 2*x + 8*x^2 + 10*x^3 + 10*x^4 + x^6 +x^8 basis = FactorFF.basisOfBerlekampSubalgebra f --- case_basisOfBerlekampSubalgebra_5 = sequence_ [(g ^ (31991::Int)) `polyMod` f @?= g | g <- basis] +-- case_basisOfBerlekampSubalgebra_5 = sequence_ [(g ^ (31991::Int)) `P.mod` f @?= g | g <- basis] -- where -- x :: UPolynomial $(FF.primeField 31991) --- x = var X +-- x = P.var X -- f = 2 + x + x^2 + x^3 + x^4 + x^5 -- basis = FactorFF.basisOfBerlekampSubalgebra f +case_sqfree_Integer = actual @?= expected + where + x :: UPolynomial Integer + x = P.var X + actual = P.sqfree (x^(2::Int) + 2*x + 1) + expected = [(x + 1, 2)] + +case_sqfree_Rational = actual @?= expected + where + x :: UPolynomial Rational + x = P.var X + actual = P.sqfree (x^(2::Int) + 2*x + 1) + expected = [(x + 1, 2)] + + ------------------------------------------------------------------------ -- http://en.wikipedia.org/wiki/Lagrange_polynomial case_Lagrange_interpolation_1 = p @?= q where x :: UPolynomial Rational - x = var X + x = P.var X p = LagrangeInterpolation.interpolate [ (1, 1) , (2, 4) @@ -830,7 +881,7 @@ case_Lagrange_interpolation_2 = p @?= q where x :: UPolynomial Rational - x = var X + x = P.var X p = LagrangeInterpolation.interpolate [ (1, 1) , (2, 8) diff --git a/test/TestQE.hs b/test/TestQE.hs --- a/test/TestQE.hs +++ b/test/TestQE.hs @@ -175,7 +175,7 @@ cs = map toPRel $ snd test2' toP :: LA.Expr Rational -> P.Polynomial Rational Int -toP e = P.fromTerms [(c, if x == LA.unitVar then P.mmOne else P.var x) | (c,x) <- LA.terms e] +toP e = P.fromTerms [(c, if x == LA.unitVar then P.mone else P.var x) | (c,x) <- LA.terms e] toPRel :: LA.Atom Rational -> Rel (P.Polynomial Rational Int) toPRel (Rel lhs op rhs) = Rel (toP lhs) op (toP rhs) diff --git a/toysat/toysat.hs b/toysat/toysat.hs --- a/toysat/toysat.hs +++ b/toysat/toysat.hs @@ -282,33 +282,44 @@ endWC <- getCurrentTime putCommentLine $ printf "total CPU time = %.3fs" (fromIntegral (endCPU - startCPU) / 10^(12::Int) :: Double) putCommentLine $ printf "total wall clock time = %.3fs" (realToFrac (endWC `diffUTCTime` startWC) :: Double) + printGCStat +printGCStat :: IO () #if defined(__GLASGOW_HASKELL__) && MIN_VERSION_base(4,5,0) - stat <- Stats.getGCStats - putCommentLine "GCStats:" - putCommentLine $ printf " bytesAllocated = %d" $ Stats.bytesAllocated stat - putCommentLine $ printf " numGcs = %d" $ Stats.numGcs stat - putCommentLine $ printf " maxBytesUsed = %d" $ Stats.maxBytesUsed stat - putCommentLine $ printf " numByteUsageSamples = %d" $ Stats.numByteUsageSamples stat - putCommentLine $ printf " cumulativeBytesUsed = %d" $ Stats.cumulativeBytesUsed stat - putCommentLine $ printf " bytesCopied = %d" $ Stats.bytesCopied stat - putCommentLine $ printf " currentBytesUsed = %d" $ Stats.currentBytesUsed stat - putCommentLine $ printf " currentBytesSlop = %d" $ Stats.currentBytesSlop stat - putCommentLine $ printf " maxBytesSlop = %d" $ Stats.maxBytesSlop stat - putCommentLine $ printf " peakMegabytesAllocated = %d" $ Stats.peakMegabytesAllocated stat - putCommentLine $ printf " mutatorCpuSeconds = %5.2f" $ Stats.mutatorCpuSeconds stat - putCommentLine $ printf " mutatorWallSeconds = %5.2f" $ Stats.mutatorWallSeconds stat - putCommentLine $ printf " gcCpuSeconds = %5.2f" $ Stats.gcCpuSeconds stat - putCommentLine $ printf " gcWallSeconds = %5.2f" $ Stats.gcWallSeconds stat - putCommentLine $ printf " cpuSeconds = %5.2f" $ Stats.cpuSeconds stat - putCommentLine $ printf " wallSeconds = %5.2f" $ Stats.wallSeconds stat +printGCStat = do #if MIN_VERSION_base(4,6,0) - putCommentLine $ printf " parTotBytesCopied = %d" $ Stats.parTotBytesCopied stat + b <- Stats.getGCStatsEnabled + when b $ do #else - putCommentLine $ printf " parAvgBytesCopied = %d" $ Stats.parAvgBytesCopied stat + do #endif - putCommentLine $ printf " parMaxBytesCopied = %d" $ Stats.parMaxBytesCopied stat + stat <- Stats.getGCStats + putCommentLine "GCStats:" + putCommentLine $ printf " bytesAllocated = %d" $ Stats.bytesAllocated stat + putCommentLine $ printf " numGcs = %d" $ Stats.numGcs stat + putCommentLine $ printf " maxBytesUsed = %d" $ Stats.maxBytesUsed stat + putCommentLine $ printf " numByteUsageSamples = %d" $ Stats.numByteUsageSamples stat + putCommentLine $ printf " cumulativeBytesUsed = %d" $ Stats.cumulativeBytesUsed stat + putCommentLine $ printf " bytesCopied = %d" $ Stats.bytesCopied stat + putCommentLine $ printf " currentBytesUsed = %d" $ Stats.currentBytesUsed stat + putCommentLine $ printf " currentBytesSlop = %d" $ Stats.currentBytesSlop stat + putCommentLine $ printf " maxBytesSlop = %d" $ Stats.maxBytesSlop stat + putCommentLine $ printf " peakMegabytesAllocated = %d" $ Stats.peakMegabytesAllocated stat + putCommentLine $ printf " mutatorCpuSeconds = %5.2f" $ Stats.mutatorCpuSeconds stat + putCommentLine $ printf " mutatorWallSeconds = %5.2f" $ Stats.mutatorWallSeconds stat + putCommentLine $ printf " gcCpuSeconds = %5.2f" $ Stats.gcCpuSeconds stat + putCommentLine $ printf " gcWallSeconds = %5.2f" $ Stats.gcWallSeconds stat + putCommentLine $ printf " cpuSeconds = %5.2f" $ Stats.cpuSeconds stat + putCommentLine $ printf " wallSeconds = %5.2f" $ Stats.wallSeconds stat +#if MIN_VERSION_base(4,6,0) + putCommentLine $ printf " parTotBytesCopied = %d" $ Stats.parTotBytesCopied stat +#else + putCommentLine $ printf " parAvgBytesCopied = %d" $ Stats.parAvgBytesCopied stat #endif + putCommentLine $ printf " parMaxBytesCopied = %d" $ Stats.parMaxBytesCopied stat +#else +printGCStat = return () +#endif showHelp :: Handle -> IO () showHelp h = hPutStrLn h (usageInfo header options) @@ -343,6 +354,18 @@ putStrLn s hFlush stdout +putSLine :: String -> IO () +putSLine s = do + putStr "s " + putStrLn s + hFlush stdout + +putOLine :: String -> IO () +putOLine s = do + putStr "o " + putStrLn s + hFlush stdout + newSolver :: Options -> IO SAT.Solver newSolver opts = do solver <- SAT.newSolver @@ -380,8 +403,7 @@ forM_ (DIMACS.clauses cnf) $ \clause -> SAT.addClause solver (elems clause) result <- SAT.solve solver - putStrLn $ "s " ++ (if result then "SATISFIABLE" else "UNSATISFIABLE") - hFlush stdout + putSLine $ if result then "SATISFIABLE" else "UNSATISFIABLE" when result $ do m <- SAT.model solver satPrintModel stdout m (DIMACS.numVars cnf) @@ -428,8 +450,7 @@ else SAT.addClause solver (- (idx2sel ! idx) : clause) result <- SAT.solveWith solver (map (idx2sel !) [1..GCNF.lastGroupIndex gcnf]) - putStrLn $ "s " ++ (if result then "SATISFIABLE" else "UNSATISFIABLE") - hFlush stdout + putSLine $ if result then "SATISFIABLE" else "UNSATISFIABLE" if result then do m <- SAT.model solver @@ -489,8 +510,7 @@ case obj of Nothing -> do result <- SAT.solve solver - putStrLn $ "s " ++ (if result then "SATISFIABLE" else "UNSATISFIABLE") - hFlush stdout + putSLine $ if result then "SATISFIABLE" else "UNSATISFIABLE" when result $ do m <- SAT.model solver pbPrintModel stdout m n @@ -503,16 +523,13 @@ result <- try $ minimize opt solver obj'' $ \m val -> do writeIORef modelRef (Just m) - putStrLn $ "o " ++ show val - hFlush stdout + putOLine (show val) case result of Right Nothing -> do - putStrLn $ "s " ++ "UNSATISFIABLE" - hFlush stdout + putSLine "UNSATISFIABLE" Right (Just m) -> do - putStrLn $ "s " ++ "OPTIMUM FOUND" - hFlush stdout + putSLine "OPTIMUM FOUND" pbPrintModel stdout m n let objval = pbEval m obj'' writeSOLFile opt m (Just objval) n @@ -520,10 +537,9 @@ r <- readIORef modelRef case r of Nothing -> do - putStrLn $ "s " ++ "UNKNOWN" - hFlush stdout + putSLine "UNKNOWN" Just m -> do - putStrLn $ "s " ++ "SATISFIABLE" + putSLine "SATISFIABLE" pbPrintModel stdout m n let objval = pbEval m obj'' writeSOLFile opt m (Just objval) n @@ -601,16 +617,13 @@ modelRef <- newIORef Nothing result <- try $ minimize opt solver obj $ \m val -> do writeIORef modelRef (Just m) - putStrLn $ "o " ++ show val - hFlush stdout + putOLine (show val) case result of Right Nothing -> do - putStrLn $ "s " ++ "UNSATISFIABLE" - hFlush stdout + putSLine "UNSATISFIABLE" Right (Just m) -> do - putStrLn $ "s " ++ "OPTIMUM FOUND" - hFlush stdout + putSLine "OPTIMUM FOUND" if isMaxSat then maxsatPrintModel stdout m nvar else pbPrintModel stdout m nvar @@ -620,13 +633,12 @@ r <- readIORef modelRef case r of Just m | not isMaxSat -> do - putStrLn $ "s " ++ "SATISFIABLE" + putSLine "SATISFIABLE" pbPrintModel stdout m nvar let objval = pbEval m obj writeSOLFile opt m (Just objval) nvar _ -> do - putStrLn $ "s " ++ "UNKNOWN" - hFlush stdout + putSLine "UNKNOWN" throwIO e -- ------------------------------------------------------------------------ @@ -676,7 +688,7 @@ if not (Set.null nivs) then do putCommentLine $ "cannot handle non-integer variables: " ++ intercalate ", " (Set.toList nivs) - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" exitFailure else do enc <- Tseitin.newEncoder solver @@ -691,7 +703,7 @@ return (v,v2) _ -> do putCommentLine $ "cannot handle unbounded variable: " ++ v - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" exitFailure putCommentLine "Loading constraints" @@ -738,8 +750,7 @@ result <- try $ minimize opt solver obj3 $ \m val -> do writeIORef modelRef (Just m) - putStrLn $ "o " ++ showRational (optPrintRational opt) (fromIntegral (val + obj3_c) / fromIntegral d) - hFlush stdout + putOLine $ showRational (optPrintRational opt) (fromIntegral (val + obj3_c) / fromIntegral d) let printModel :: SAT.Model -> IO () printModel m = do @@ -762,20 +773,17 @@ case result of Right Nothing -> do - putStrLn $ "s " ++ "UNSATISFIABLE" - hFlush stdout + putSLine $ "UNSATISFIABLE" Right (Just m) -> do - putStrLn $ "s " ++ "OPTIMUM FOUND" - hFlush stdout + putSLine "OPTIMUM FOUND" printModel m Left (e :: SomeException) -> do r <- readIORef modelRef case r of Nothing -> do - putStrLn $ "s " ++ "UNKNOWN" - hFlush stdout + putSLine "UNKNOWN" Just m -> do - putStrLn $ "s " ++ "SATISFIABLE" + putSLine "SATISFIABLE" printModel m throwIO e where diff --git a/toysolver.cabal b/toysolver.cabal --- a/toysolver.cabal +++ b/toysolver.cabal @@ -1,5 +1,5 @@ Name: toysolver -Version: 0.0.5 +Version: 0.0.6 License: BSD3 License-File: COPYING Author: Masahiro Sakai (masahiro.sakai@gmail.com) @@ -16,6 +16,7 @@ src/TseitinEncode.hs src/Data/Polyhedron.hs src/pbverify.hs + src/maxsatverify.hs src/pigeonhole.hs src/Algorithm/Wang.hs samples/gcnf/*.cnf @@ -52,8 +53,8 @@ base >=4 && <5, containers >= 0.4.2, mtl, array, random, stm >=2.3, parsec, bytestring, filepath, deepseq, time, old-locale, primes, parse-dimacs, queue, heaps, unbounded-delays, lattices >=1.2.1.1, vector-space >=0.8.6, multiset, algebra, - prettyclass >=1.0.0, - OptDir, data-interval >=0.2.0, finite-field >=0.6.0 + prettyclass >=1.0.0, type-level-numbers >=0.1.1.0 && <0.2.0.0, hashable >=1.1.2.5 && <1.3.0.0, + OptDir, data-interval >=0.2.0, finite-field >=0.7.0 && <1.0.0 Default-Language: Haskell2010 Other-Extensions: BangPatterns @@ -115,10 +116,13 @@ Data.LBool Data.Polynomial Data.Polynomial.Factorization.FiniteField + Data.Polynomial.Factorization.Hensel Data.Polynomial.Factorization.Integer + Data.Polynomial.Factorization.Kronecker Data.Polynomial.Factorization.Rational Data.Polynomial.Factorization.SquareFree - Data.Polynomial.GBasis + Data.Polynomial.Factorization.Zassenhaus + Data.Polynomial.GroebnerBasis Data.Polynomial.Interpolation.Lagrange Data.Polynomial.RootSeparation.Graeffe Data.Polynomial.RootSeparation.Sturm @@ -145,6 +149,7 @@ Util Version Other-Modules: + Data.Polynomial.Base Data.IndexedPriorityQueue Data.SeqQueue Text.Util @@ -224,7 +229,7 @@ Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-is: TestPolynomial.hs - Build-depends: base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2,HUnit,QuickCheck >=2 && <3, data-interval >=0.2.0, finite-field >=0.6.0, prettyclass >=1.0.0 + Build-depends: base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2,HUnit,QuickCheck >=2 && <3, data-interval >=0.2.0, finite-field >=0.7.0 && <1.0.0, prettyclass >=1.0.0 Default-Language: Haskell2010 Other-Extensions: TemplateHaskell @@ -249,6 +254,14 @@ HS-Source-Dirs: test Main-is: TestContiTraverso.hs Build-depends: base >=4 && <5, containers, vector-space >=0.8.6, toysolver, OptDir, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2,HUnit,QuickCheck >=2 && <3 + Default-Language: Haskell2010 + Other-Extensions: TemplateHaskell + +Test-suite TestCongruenceClosure + Type: exitcode-stdio-1.0 + HS-Source-Dirs: test + Main-is: TestCongruenceClosure.hs + Build-depends: base >=4 && <5, containers, toysolver, test-framework,test-framework-th,test-framework-hunit,test-framework-quickcheck2,HUnit,QuickCheck >=2 && <3 Default-Language: Haskell2010 Other-Extensions: TemplateHaskell diff --git a/toysolver/toysolver.hs b/toysolver/toysolver.hs --- a/toysolver/toysolver.hs +++ b/toysolver/toysolver.hs @@ -22,9 +22,10 @@ import Data.Ratio import qualified Data.Version as V import qualified Data.Set as Set +import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet import System.Exit import System.Environment import System.FilePath @@ -111,7 +112,7 @@ :: String -> [Flag] -> LP.LP - -> (Map.Map String Rational -> IO ()) + -> (Map String Rational -> IO ()) -> IO () run solver opt lp printModel = do unless (Set.null (LP.semiContinuousVariables lp)) $ do @@ -127,7 +128,7 @@ vs = LP.variables lp vsAssoc = zip (Set.toList vs) [0..] nameToVar = Map.fromList vsAssoc - varToName = IM.fromList [(v,name) | (name,v) <- vsAssoc] + varToName = IntMap.fromList [(v,name) | (name,v) <- vsAssoc] compileE :: LP.Expr -> Expr Rational compileE = foldr (+) (Const 0) . map compileT @@ -161,23 +162,23 @@ | NoMIP `elem` opt = Set.empty | otherwise = LP.integerVariables lp - vs2 = IM.keysSet varToName - ivs2 = IS.fromList . map (nameToVar Map.!) . Set.toList $ ivs + vs2 = IntMap.keysSet varToName + ivs2 = IntSet.fromList . map (nameToVar Map.!) . Set.toList $ ivs solveByQE = case mapM LAFOL.fromFOLAtom (cs1 ++ cs2) of Nothing -> do - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" exitFailure Just cs -> case f vs2 cs ivs2 of Nothing -> do - putStrLn "s UNSATISFIABLE" + putSLine "UNSATISFIABLE" exitFailure Just m -> do - putStrLn $ "o " ++ showValue (FOL.evalExpr m obj) - putStrLn "s SATISFIABLE" - let m2 = Map.fromAscList [(v, m IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + putOLine $ showValue (FOL.evalExpr m obj) + putSLine "SATISFIABLE" + let m2 = Map.fromAscList [(v, m IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m2 where f = case solver of @@ -206,20 +207,20 @@ return (cs',obj') case m of Nothing -> do - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" exitFailure Just (cs',obj') -> case MIPSolverHL.optimize (LP.dir lp) obj' cs' ivs2 of MIPSolverHL.OptUnsat -> do - putStrLn "s UNSATISFIABLE" + putSLine "UNSATISFIABLE" exitFailure MIPSolverHL.Unbounded -> do - putStrLn "s UNBOUNDED" + putSLine "UNBOUNDED" exitFailure MIPSolverHL.Optimum r m -> do - putStrLn $ "o " ++ showValue r - putStrLn "s OPTIMUM FOUND" - let m2 = Map.fromAscList [(v, m IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + putOLine $ showValue r + putSLine "OPTIMUM FOUND" + let m2 = Map.fromAscList [(v, m IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m2 solveByMIP2 = do @@ -256,44 +257,43 @@ setNumCapabilities procs MIPSolver2.setNThread mip procs - let update m val = do - putStrLn $ "o " ++ showValue val + let update m val = putOLine $ showValue val ret <- MIPSolver2.optimize mip update case ret of Simplex2.Unsat -> do - putStrLn "s UNSATISFIABLE" + putSLine "UNSATISFIABLE" exitFailure Simplex2.Unbounded -> do - putStrLn "s UNBOUNDED" + putSLine "UNBOUNDED" m <- MIPSolver2.model mip - let m2 = Map.fromAscList [(v, m IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + let m2 = Map.fromAscList [(v, m IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m2 exitFailure Simplex2.Optimum -> do m <- MIPSolver2.model mip r <- MIPSolver2.getObjValue mip - putStrLn "s OPTIMUM FOUND" - let m2 = Map.fromAscList [(v, m IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + putSLine "OPTIMUM FOUND" + let m2 = Map.fromAscList [(v, m IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m2 solveByCAD - | not (IS.null ivs2) = do - putStrLn "s UNKNOWN" + | not (IntSet.null ivs2) = do + putSLine "UNKNOWN" putCommentLine "integer variables are not supported by CAD" exitFailure | otherwise = do let cs = map g $ cs1 ++ cs2 - vs3 = Set.fromAscList $ IS.toAscList vs2 + vs3 = Set.fromAscList $ IntSet.toAscList vs2 case CAD.solve vs3 cs of Nothing -> do - putStrLn "s UNSATISFIABLE" + putSLine "UNSATISFIABLE" exitFailure Just m -> do - let m2 = IM.map (\x -> AReal.approx x (2^^(-64::Int))) $ - IM.fromAscList $ Map.toAscList $ m - putStrLn $ "o " ++ showValue (FOL.evalExpr m2 obj) - putStrLn "s SATISFIABLE" - let m3 = Map.fromAscList [(v, m2 IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + let m2 = IntMap.map (\x -> AReal.approx x (2^^(-64::Int))) $ + IntMap.fromAscList $ Map.toAscList $ m + putOLine $ showValue (FOL.evalExpr m2 obj) + putSLine "SATISFIABLE" + let m3 = Map.fromAscList [(v, m2 IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m3 where g (Rel lhs rel rhs) = Rel (f lhs) rel (f rhs) @@ -307,11 +307,11 @@ | otherwise = P.mapCoeff (/ c) $ f e1 where p = f e2 - c = P.coeff P.mmOne p + c = P.coeff P.mone p solveByContiTraverso | not (vs `Set.isSubsetOf` ivs) = do - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" putCommentLine "continuous variables are not supported by Conti-Traverso algorithm" exitFailure | otherwise = do @@ -321,19 +321,19 @@ return (linObj, linCon) case tmp of Nothing -> do - putStrLn "s UNKNOWN" + putSLine "UNKNOWN" putCommentLine "non-linear expressions are not supported by Conti-Traverso algorithm" exitFailure Just (linObj, linCon) -> do case ContiTraverso.solve P.grlex vs2 (LP.dir lp) linObj linCon of Nothing -> do - putStrLn "s UNSATISFIABLE" + putSLine "UNSATISFIABLE" exitFailure Just m -> do - let m2 = IM.map fromInteger m - putStrLn $ "o " ++ showValue (FOL.evalExpr m2 obj) - putStrLn "s OPTIMUM FOUND" - let m3 = Map.fromAscList [(v, m2 IM.! (nameToVar Map.! v)) | v <- Set.toList vs] + let m2 = IntMap.map fromInteger m + putOLine $ showValue (FOL.evalExpr m2 obj) + putSLine "OPTIMUM FOUND" + let m3 = Map.fromAscList [(v, m2 IntMap.! (nameToVar Map.! v)) | v <- Set.toList vs] printModel m3 printRat :: Bool @@ -342,7 +342,7 @@ showValue :: Rational -> String showValue = showRational printRat -lpPrintModel :: Handle -> Bool -> Map.Map String Rational -> IO () +lpPrintModel :: Handle -> Bool -> Map String Rational -> IO () lpPrintModel h asRat m = do forM_ (Map.toList m) $ \(v, val) -> do printf "v %s = %s\n" v (showRational asRat val) @@ -354,6 +354,18 @@ putStrLn s hFlush stdout +putSLine :: String -> IO () +putSLine s = do + putStr "s " + putStrLn s + hFlush stdout + +putOLine :: String -> IO () +putOLine s = do + putStr "o " + putStrLn s + hFlush stdout + -- --------------------------------------------------------------------------- getSolver :: [Flag] -> String @@ -441,7 +453,7 @@ hPutStrLn stderr $ concat errs ++ usageInfo header options -- FIXME: 目的関数値を表示するように -writeSOLFileLP :: [Flag] -> Map.Map String Rational -> IO () +writeSOLFileLP :: [Flag] -> Map String Rational -> IO () writeSOLFileLP opt m = do forM_ [fname | WriteFile fname <- opt ] $ \fname -> do let m2 = Map.map fromRational m