{VERSION 6 0 "IBM INTEL NT" "6.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" 0 21 "" 0 1 0 0 0 1 0 0 0 0 2 0 0 0 0 1 }{CSTYLE "" -1 256 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 257 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 258 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 259 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 260 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 261 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 262 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 263 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 264 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 265 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 266 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 267 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 268 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 269 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 270 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 271 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 272 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 273 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 274 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 275 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 276 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 277 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 278 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 279 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 280 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 281 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 282 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 283 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 284 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 285 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 286 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 287 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 288 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 289 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 290 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 291 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 292 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 293 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 294 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 295 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 296 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 297 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 298 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 299 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 300 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 301 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 302 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 303 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 304 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 305 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 306 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 307 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 308 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 309 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 310 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 311 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 312 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 313 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 314 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 315 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 316 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 317 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 318 "Helvetica" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 319 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 320 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 321 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 322 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 323 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 324 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 325 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 326 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 327 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 328 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 329 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 330 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 331 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 332 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 333 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 334 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 335 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 336 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 337 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 338 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 339 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 340 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 341 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 342 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 343 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 344 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 345 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 346 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 347 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 348 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 349 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 350 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 351 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 352 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 353 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 354 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 355 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 356 "" 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 357 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 358 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 359 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 360 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 361 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 362 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 363 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 364 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 365 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 366 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 367 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 368 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 369 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 370 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 371 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 372 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 373 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 374 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 375 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 376 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 377 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 378 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 379 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 380 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 381 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 382 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 383 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 384 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 385 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 386 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 387 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 388 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 389 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 390 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 391 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 392 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 393 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 394 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 395 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 396 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 397 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 398 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 399 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 400 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 401 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 402 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 403 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 404 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 405 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 406 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 407 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 408 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 409 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 410 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 411 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 412 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 413 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 414 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 415 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 416 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 417 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 418 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 419 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 420 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 421 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 422 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 423 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 424 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 425 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 426 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 427 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 428 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 429 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 430 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 431 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 432 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 433 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 434 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 435 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 436 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 437 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 438 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 439 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 440 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 441 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 442 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 443 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 444 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 445 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 446 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 447 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 448 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 449 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 450 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 451 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 452 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 453 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 454 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 455 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 456 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 457 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 458 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 459 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 460 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 461 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 462 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 463 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 464 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 465 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 466 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 467 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 469 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 470 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 471 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 472 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 473 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 474 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 475 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 476 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 477 "" 1 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 478 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 479 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Warning" -1 7 1 {CSTYLE "" -1 -1 "Courier" 1 10 0 0 255 1 2 2 2 2 2 1 1 1 3 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Maple Output" -1 12 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 255 1 2 1 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 2" -1 257 1 {CSTYLE "" -1 -1 "Times" 1 12 255 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Normal" -1 258 1 {CSTYLE "" -1 -1 "Helve tica" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 } } {SECT 0 {EXCHG {PARA 258 "" 0 "" {TEXT -1 29 "\nThis is clifford_M11_0 8.mws\n" }}{PARA 258 "" 0 "" {TEXT -1 29 "(Created: December 20, 2007) \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "########################### ##################################################\n# \+ #\n#DISCLAIM ER: #\n # \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Oct onion, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AN D/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANT Y OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIM ITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS F OR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND \+ PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE \+ #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n################################################ #############################\n" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 324 "This is a listing (without examples) o f all procedures in a Maple package called 'CLIFFORD' (Version 11, Co pyright 1995-2008 by Rafal Ablamowicz, Tennessee Technological Univer sity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 11. Us er will know which version he/she is using by using the 'version()' fu nction." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use index such as K or -K:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 66 "cmul[K](p1,p2,. ..,pn); ##Clifford product of p1,p2,...,pn in Cl(K)" }}{PARA 0 "" 0 " " {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p 1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is e xpected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 126 "&cQ[ K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K \+ is expected to be a diagonal matrix), ampersand form" }}{PARA 0 "" 0 " " {TEXT -1 56 "cexp[K](p,N); ## exponential of p in Cl(K) up to order \+ N" }}{PARA 0 "" 0 "" {TEXT -1 102 "cexpQ[K](p,N); ## exponential of p \+ in Cl(K) up to order N (here K is expected to be a diagonal matrix)" } }{PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## minimal polynomial \+ of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponen tial of p in Cl(K) up to order N modulo the minimal polynomial of p" } }{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 278 96 "The fol lowing procedures can use name K or a numeric multiple of a name as an optional argument:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT -1 106 "LC(p1,p2,K); ##left contraction of p2 by p1 w.r.t. K\n RC(p1,p2,K); ##right contraction of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 a nd m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "reversion(p,K); ##rever sion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Cliffo rd inverse of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p2,K); ##left contraction of p2 by p1 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p1,p2,K); ##right contraction of p1 by p2 w .r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugatio n(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing procedures can pass on \+ name or a numeric multiple of a name via a list:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 121 "type([p,K],nilpotent); # # checks if p is nilpotent in Cl(K)\ntype([p,K],idempotent); ## checks if p is idempotent in Cl(K)" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 580 "\nProcedures that define types: `type/ climon`, `type/clipolynom`, `type/climatrix` as well as other procedur es such as 'reorder', 'wedge', etc., have been substantially revised t o improve efficiency and speed of the package. This work has been done together with Bertfried Fauser, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nThis version includes \"Bigebra\" package tha t has been created together with Bertfried Fauser, Universit\"at Konst anz, Konstanz, Germany. Additional help pages have been written and ad ded to the database that explain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 302 "An additional feature in this version is an ability to display and change environmental variables. They can be displayed with proced ure CLIFFORD_ENV.\n\nThis package is made to run under Maple 11. It i s available on a server of the Department of Mathematics, Tennessee \+ Technological University, at: \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " \+ http://math.tntech.edu/rafal/clifford/ " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 130 "In \+ order to create a Maple file 'Clifford.m' containing the 'CLIFFORD' pa ckage, execute this worksheet.\n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">with(Cliff ord); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been loaded because a list wi th Clifford procedures will be displayed on the screen. To check the \+ current version of the package, at the Maple prompt type " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 ">version( ) ;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 " Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 " Department of Mathematics, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 " Tennessee Technological University " }}{PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 " }}{PARA 258 "" 0 "" {TEXT -1 24 "rablamowicz@t ntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-356 9" }}{PARA 258 "" 0 "" {TEXT -1 23 "fax: USA (931) 372-6353" }}{PARA 0 "" 0 "" {TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "restart :\nunprotect('Clifford','e','qi','qj','qk','Id','w');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module()\n########################### ########\nexport `&m`, Bsignature, CLIFFORD_ENV, Kfield, LC, LCQ, RC, \+ RCQ, RHnumber, adfmatrix, all_sigs, beta_minus, beta_plus, buildm, byg rade, c_conjug, cbasis, cdfmatrix, cexp, cexpQ, cinv, clibilinear, cli collect, clidata, clilinear, climinpoly, cliparse, cliremove, clisolve , clisort, cliterms, cmul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, c ommutingelements, conjugation,ddfmatrix, diagonalize, displayid, extra ct, factoridempotent, find1str, findbasis, gradeinv, init, isVahlenmat rix, isproduct, makealiases, makeclibasmon, matKrepr, maxgrade, maxind ex, mdfmatrix, minimalideal, ord, permsign, pseudodet, q_conjug, qdisp lay, qinv, qmul, qnorm, reorder, reversion, rmulm, rot3d, scalarpart, \+ sexp, specify_constants, spinorKbasis, spinorKrepr, squaremodf, subs_c lipolynom, useproduct, vectorpart, version, wedge, wexp, rd_clibasmon, rd_climon, rd_clipolynom;\n###################################\nlocal setup;\noption package, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'version' stores information about the current version of the package. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typical use: version(); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1522 "version:= proc()\noptio ns `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: December 20, 2007`; \nprint(`+++++++++++++++++++++++++++++++++++++++++++`);\nprint(`CLIFFO RD - A Maple 11 Package for Clifford Algebras with \"Bigebra\"`); \npr int(`(Version 10 with environmental variables given by CLIFFORD_ENV()) `);\nprint(`Last revised: December 20, 2007 (Source file: clifford_M11 _08.mws)`);\nprint(`Copyright 1995-2008 by Rafal Ablamowicz (*) and Be rtfried Fauser ($)`);\nprint(``);\nprint(`(*) Department of Mathematic s, Box 5054`);\nprint(` Tennessee Technological University, Cookevi lle, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax: USA (931) 3 72-6353`);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://ma th.tntech.edu/rafal/Cliff8/`);\nprint(`($) Universit\"at Konstanz, Fac hbereich Physik, Fach M678`);\nprint(` 78457 Konstanz, Germany`);\n print(` Bertfried.Fauser@uni-konstanz.de`);\nprint(` http://kalu za.physik.uni-konstanz.de/~fauser/`); \nprint(``);\nprint(`If you are a Clifford algebra pro, assign 'true' to '_prolevel' and see`);\n print(`how much faster your computations will be! But watch your synta x!`);\nprint(`Use 'useproduct' to change value of _default_Clifford_pr oduct in Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmulNUM wh en B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_ENV() t o see current values of environmental variables.`); \nprint(`+++++++++ +++This is CLIFFORD version 11++++++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_con stants" }{TEXT -1 503 " allows user to specify any new symbolic consta nts, e.g., a, b, c, B, e.t.c, which are to be known to Maple. The or iginally known constants are stored in a global, non-protected variabl e 'constants' and must be saved separately, if needed. This procedure is needed when sorting or collecting multivariate Clifford polynomial s containing expressions like 'aa*eiwej' in which 'aa' is intended to \+ be a constant and 'eiwej' is intended to be a Clifford basis monomial \+ with indices i and j. Before using " }{TEXT 281 7 "clisort" }{TEXT -1 4 " or " }{TEXT 280 10 "clicollect" }{TEXT -1 350 " user should mak e any additional constants of length 2 or more known to Maple as shown below. If these constants of length 2 or more are not defined as Map le constants, then some procedures might yield error messages (althoug h an attempt has been made to avoid this problem). Constants of length one are automatically assumed to be Maple constants. " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: spe cify_constants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have b een added for the Reader's convenience in the sequence of input variab les as in the above example. These spaces are not needed or required b y Maple." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 372 "specify_constants:=proc(a1::anything) global constan ts;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2007`;\n#############################################\nconstants:= op(\{constants,args\});\nprintf(\"Maple now knows the following consta nt(s): %q\\n\",constants);\nreturn NULL;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 21 "No. 3. The procedure " }{TEXT 283 6 "cbasis" }{TEXT -1 793 " writes a canonical basis for a Clifford algebra Cl(B) over a \+ vector space V endowed with a bilinear form B. The dimension of V is \+ specified by a Maple global variable 'dim' where 1 <= dim <= 9. This \+ procedure can be used with one or two arguments as, for example, in cb asis(4) or cbasis(4, 2). In the first case, it returns a list of all \+ basis elements in the Clifford algebra Cl(4). In the second case, it r eturns a list of basis elements in the 2-vector subspace of Cl(4). Bel ow, 'Id' stands for the algebra unit element and 'w' denotes wedge/ext erior product in the Clifford algebra. An option 'even' allows one to \+ create a basis in the even subalgebra of the given Clifford algebra as in cbasis(3, 'even'). In fact, 'even' can be replaced with any name \+ which evaluates to a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1876 "cbasis:=proc(a1::nonnegint,a2::\{string,symbol,nonnegint\})\nloc al i,k,X,XX,YY,L,Leven,Lodd,bas,nxt,ind,start; global choose,e;\noptio ns `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`,remember;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\nif a1>9 then \n error \"first argument must be between 0 and 9 inclusive but rec eived %1 instead\",a1 \nend if;\nif a1=0 and nargs=1 then return [Id] \+ end if;\nif nargs=2 and type(a2,\{string,symbol\}) then do\n L:=proc name(a1):\n Leven:=[Id]:Lodd:=[]:\n if nops(L) > 1 then\n for i \+ from 2 to nops(L) do\n if type(length(L[i]),odd) then Leven:=[op (Leven),L[i]] else\n Lodd:=[op(L odd),L[i]]\n end if \n end do \n end if; \nif args[2]='even' then return Leven \n elif args[2]='odd' then return Lodd\n else e rror \"second argument must be an integer or a string 'even' or 'odd' \+ but received %1 instead\",args[2]\nend if\nend do \nend if;\nfor k fro m 0 to a1 do \n X[k]:=combinat[choose]([seq(i,i=1..a1)],k) \nend do ;\nif not nargs = 1 and not nargs = 2 then \n error \"one or two arg uments are needed as input but received %0 instead\",args\nelif nargs \+ = 1 then XX:=[seq(op(X[k]),k=0..a1)] \nelse if not a2 >= 0 or not a2 < = a1 then \n error \"second argument must satisfy: 0 <= 'a2' <= %1 but received %2 instead\",a1,a2 \nelse XX:=X[a2] \nend if \nend if;\nYY: =array(1..nops(XX),[]);start:=1:\nif XX[1] = [] then \n YY[1]:=Id; \+ \n start:=2 \nend if;\nfor k from start to nops(XX) do\n ind:=XX[ k][1];\n if ind=10 then \n bas:=e||0 else bas:=e||ind \n e nd if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if in d=10 then nxt:=e||0 else nxt:=e||ind end if:\n bas:=cat(bas,\"w\", nxt): \n end do;\nYY[k]:=bas;\nend do:\nYY:=convert(YY,list);\npr otect(op(YY)); #protect basis monomials\nreturn YY\nend proc:\n " }} {PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1s tr" }{TEXT -1 327 " finds all locations of the first string of length \+ one in the second string of length at least one. It returns a set of t hese positions. If the first string is not found then it returns \{0 \}. This procedure is primarily for internal use in 'type/clibasmon' a nd 'cliparse'. \nTypical use: find1str(e,e1we2we3); find1str(w,e1we2); " }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 663 "find1str :=proc(a1::symbol,a2::symbol) local ns,p,p1,ap,le2;\nglobal _prolevel; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`,remember;\ndescription `Last revised: Dec ember 20, 2007`;\n#############################################\nle2:= length(a2):\nif _prolevel=false then\nif length(a1) <> 1 or le2<1 then \n error \"first string must be of length 1 but received %1 instead \",a1 \nend if;\nend if;\np:=SearchText(a1,a2):\nap:=\{p\}:p1:=p:\nwh ile p<>0 and p10 then p1:=p1+p;\n ap:=ap union \{p1\} \n end if;\nend do;\nreturn ap\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 5. Function " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " checks user's input for correct spelling of basis monomials. Wh en unable to decide if the given input is correct, it tells the user t o check spelling or define the given string as a Maple constant. If th e spelling is correct, it returns true; if it is not correct, it retur ns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1 ,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1180 "cliparse:=proc(a1::any thing) local x,S1,S2,p,S;\nglobal _prolevel,_scalartypes;\noptions `Co pyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: December 20, 2007`;\n#### #########################################\nif _prolevel then return tr ue end if;\nif type(a1,_scalartypes) then return true end if;\np:=remo ve(type,a1,_scalartypes):S1:=\{op(p)\}:\nfor x in S1 do \n if type( x,_scalartypes) or type(x,clibasmon) then S1:=S1 minus \{x\} end if;\n end do; \nS2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartype s) or type(x,clibasmon) then S2:=S2 minus \{x\} end if;\nend do;\nS:=r emove(hastype,map(op,\{op(expand(p))\}),\{op(_scalartypes),clibasmon\} );\nfor x in S do \n if find1str(e,x)=\{0\} and x<>'Id' then S:=S m inus \{x\} end if;\nend do;\nif S=\{\} then return true end if;\nS1:=s elect(type,S,procedure):\nif S1 <> \{\} then\n error \"procedure nam e %1 that has been found in input is not allowed as a symbolic coeffic ient\",op(S1)\nend if;\nif nops(S)=1 then \n error \"check spelling \+ of %1 or define it as a constant or an alias\",op(S)\nelse \n error \+ \"check spelling of %1 or define them as constants or aliases\",op(S) \+ \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Functi on " }{TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered \+ Clifford scalar with the scalar times the unit element 'Id'. It may al so be applied to matrices with Clifford algebra entries.\n\nTypical us e: displayid(e1+2*Pi);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "displa yid:=proc(a1::\{array,matrix,algebraic\}) local KK,p;\noptions `Copyri ght (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n######## #####################################\nKK:=proc() if type(args[1],clis calar) then return args[1]*Id \n elif hastype(args[1],clibas mon) then return args[1] \n end if \nend proc:\nif type(a1, \{array,matrix\}) then return map(procname,a1) end if;\np:=expand(a1): \nif type(p,\{`*`,cliscalar,clibasmon,climon\}) then return KK(p) \nel if type(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " } {TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis eleme nts in the given Clifford polynomial.\n\nNOTE: 'cliterms' also works w ith terms of type cliprod and it finds correctly terms involving such \+ expressions. \n\nTypical use: cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1020 "cliterms:= proc(a1::anything) local S1,S2,S3 ,x,p,Cliplusflag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: December 20, 2007`;\n############################################ #\nCliplusflag:=assigned(Cliplus):\nif hastype(a1,cliprod) and not Cli plusflag and _warnings_flag then \n WARNING(`argument to 'cliterms' \+ contains type cliprod. Load 'Cliplus' to extend functionality of CLIF FORD. Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,clipr od\}) then return \{a1\} end if;\np:=displayid(simplify(a1)):\nif hast ype(p,cliprod) then \n S1:=remove(type,\{op(p)\},cliscalar);\n S2: =select(hastype,S1,\{clibasmon,climon,cliprod\});\n S3:=\{\}:\n wh ile not S2=\{\} do\n S3:=S3 union select(type,S2,\{clibasmon,c liprod\});\n S2:=select(hastype,map(op,remove(type,S2,\{clibas mon,cliprod\})),\{clibasmon,cliprod\});\n end do;\nreturn S3\nend if ;\nx:='x':\nS1:=remove(type,\{op(p)\},cliscalar);\nreturn \{seq(select (hastype,x,clibasmon),x=S1)\}\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " }{TEXT 288 11 "clibilinear" }{TEXT -1 360 " \+ makes any procedure K specified as the third argument bilinear with re spect to Clifford scalars in the first two arguments. The first two ar guments are of the type clipolynom, i.e., Clifford polynomials. The th ird argument is a string or a procedure.\nIt can handle terms involvin g elements of type cliprod.\n\nTypical use: clibilinear(e1+2*e2we3,Id+ 2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 923 "clibilinear:=proc (a1,a2,a3::\{procedure,name,symbol,matrix,array\}) \n loca l tail,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1,co2;\noptions `Copyright \+ (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: December 20, 2007`;\n############ #################################\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1):\np2:=clicollect(a2):\n t ail:=args[4..-1];\n if type(p1,\{climon,cliprod\}) then S1:=[p1] else S1:=[op(p1)] end if:\n if type(p2,\{climon,cliprod\}) then S2:=[p2] \+ else S2:=[op(p2)] end if:\n S12:=[seq(seq([x,y],x=S1),y=S2)];#this li st will be huge for long polynomials\n res:=0:\n for x in S12 do \n \+ cli1:=select(type,x[1],\{cliprod,clibasmon\}):\n cli2:=select(ty pe,x[2],\{cliprod,clibasmon\}):\n co1:=coeff(x[1],cli1):\n co2:= coeff(x[2],cli2):\n res:=res+co1*co2*a3(cli1,cli2,tail):\n end do: \n return res;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 9. \+ Procedure " }{TEXT 289 9 "clilinear" }{TEXT -1 336 " makes any procedu re K specified as the second argument linear with respect to Clifford \+ scalars (elements of type cliscalar). It can now distribute over Cliff ord polynomials with elements of `type/cliprod`. Any additional parame ters are passed on to the procedure entered as the second argument.\nT ypical use: clilinear(a*e1+2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "clilinear:=proc(a1::\{symbol,cliscalar,clibasmon,cli mon,clipolynom\},a2::\{name,procedure\}) \nlocal tail,p1,S1,res,x,cli1 ,co1;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\ntail:=arg s[3..-1];\nif type(a1,cliscalar) then return a1*a2(Id,tail) end if;\np 1:=displayid(a1):\nif type(p1,climon) then S1:=[p1] else S1:=[op(p1)] \+ end if:\nres:=0:\nfor x in S1 do\n cli1:=select(hastype,x,\{clibasm on,cliprod\}):\n co1:=coeff(x,cli1); \nres:=res+co1*a2(cli1,tail): \nend do:\nreturn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 10. Procedure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the gi ven multivariate Clifford polynomial with respect to the Clifford inde tereminates found in the expression via the procedure 'cliterms'. It p uts scalar coefficients of the type cliscalar in front of the Clifford basis monomials. It may also be applied to matrices with entries in a Clifford algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 40 "Typical use: clisort(2*e1we2 - e1*b); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 440 "clisort:=proc(p::algebraic) local L,N;\n options `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: December 20, 2 007`;\n#############################################\nif type(p,matrix ) then return map(procname,p) end if;\nif type(eval(p),\{climon,clipol ynom\}) or hastype(eval(p),cliprod) then\n L:=cliterms(expand(displa yid(p)));\n return sort(p,L);\nend if:\nreturn p\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " }{TEXT 291 10 "cli collect" }{TEXT -1 382 " reorders monomial terms in standard order and then collects them in a multivariate Clifford polynomial. It may also be applied to matrices with entries in a Clifford algebra. It will si mplify 6 + 7*Id to 13*Id. It collects now terms of type cliprod, if p resent.\n\nNOTE: 'clicollect' also works with terms of type cliprod an d it collects correctly terms involving such expressions. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use : clicollect(e1 + a*e1 - e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 497 "clicollect:=proc(a1::algebraic) local p,L; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2007`;\n########### ##################################\nif type(a1,matrix) then return map (procname,a1) end if;\np:=expand(a1):\nif type(p,cliscalar) then retur n p*Id\nelif type(p,clipolynom) then \n L:=cliterms(p);\n retu rn map(simplify,collect(displayid(p),L,'distributed'))\nelse return ar gs[1] \nend if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. \+ The procedure " }{TEXT 292 3 "ord" }{TEXT -1 319 " returns an ordered list of positions in a monomial, e.g., e1we2, where vector indices \+ are found. Then, nops(ord(e1we2)) can be used to find the order of th e monomial. Note that for consistency we have ord(Id) = ord(numeric) \+ = ord(numeric*Id) = ord(cliscalar)=[] where cliscalar is any object of the type cliscalar." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 35 "This procedure is for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 387 "ord:=proc(a1) local v,k;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2007`;\n#############################################\nif \+ type(a1,cliscalar) then return [] end if;\nv:=select(type,a1,clibasmon );\nif v = Id then return [] end if;\nk:='k':\nreturn [seq(2+3*k,k=0.. ((length(v)+1)/3-1))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "N o. 13. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes o ne symbol 'ei' from the location specified by the procedure 'ord'. \n( NOTE: procedure 'ord' specifies location of the index 'i' in 'ei'.) T his procedure is primarily for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 579 "cliremove:=proc(p::posin t,s::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 199 5-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ,remember;\ndescription `Last revised: December 20, 2007`;\n########## ###################################\nif not _prolevel then\n if s=Id then error \"second argument must be Grassmann basis monomial of rank >= 1\" end if;\nend if;\nS2:=substring(s,(p+2)..length(s));\nS1:=subs tring(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n el if S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure " } {TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomial ( or a constant times a monomial) and it returns them as a list of strin gs. If necessary, they can be returned as a list of integers if optio n 'integers' is selected (in fact, any name which evaluates to a strin g may be used as the option). Indices could be now integers, letters, or they could be mixed. Note that extract(Id) = [] and extract(numeri c) = extract(numeric*Id) = [] results in no vector indices. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typic al use: extract(2*e1we2); or extract(e2we3, \"integers\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 732 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 20, 20 07`;\n#############################################\nif type(a1,clisca lar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n t ype(a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nelse \+ \n error \"wrong argument: %1\",a1 \nend if;\nif v = Id then return \+ [] end if;\ninds:=map(convert,remove(member,StringTools:-Explode(v),\{ \"e\",\"w\"\}),symbol);\nif nargs=1 then return inds \n elif type(a2 ,symbol) then \n return map(parse,inds)\n else error \"wrong option or number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 19 "No. 15. Procedure " }{TEXT 295 7 "reorder" } {TEXT -1 330 " reorders Clifford monomials in the given Clifford polyn omial using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e 1we2 - 2*e1we2we5. If any one of the indices of the monomial is a lett er, e.g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reor der now can order monomials and polynomials with symbolic coefficients , e.g. reorder(ejwei) = -eiwej, using the lexicographic order. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typic al use: reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1076 "reorder:=proc(a1::algeb raic) \n local L1,L2,N,newbas,f,a,x,K,dummy_set,n12,s12,ss;\n \+ global B,dim_V;\noptions `Copyright (c) 1995-2008 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2007`;\n###################################### #######\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) e nd if; \nL1:=Clifford:-extract(a1);\nN:=nops(L1);\nif N>9 then error \+ \"detected basis monomial of grade higher than 9 in the input\" end if ;\nif N=0 or N=1 then return a1 end if;\nn12,s12:=selectremove(member, L1,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n#s12:=remove(member,L1, \{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\nL2:=[op(sort(n12)),op(sort( s12))];\nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[s s];\nend do:\ndummy_set:=convert(L1,set):\nK:=0:\nwhile dummy_set <> \+ \{\} do\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n while f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set minus \+ \{x\};\n K:=K+1;\n end do:\nend do:\nnewbas:=cat(e||(op(L2[1..-2 ]))||w,e,L2[-1]):\nreturn (-1)^K*newbas\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 16. Defining a useful function " }{TEXT 296 8 "m axindex" }{TEXT -1 226 " which finds the greatest index in the given C lifford polynomial or in the given list or set of Clifford monomials. \+ It returns 0 for a Clifford scalar (an element of type cliscalar).\n\n Typical use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 813 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: December 20, 2007`;\n############### ##############################\nif type(a1,cliscalar) or a1=Id then re turn 0 elif\n type(a1,list) then return max(op(convert(map(procname, a1),set))) elif\n type(a1,set) then return max(op(map(procname,a1))) else \n mons:=cliterms(a1);\n inds:=map(op,map(Clifford:-extract, mons,'integers'));\n symbinds:=remove(type,inds,integer);\n if sym binds = \{\} then\n if inds=\{\} then return 0 else return max(op (inds)) end if;\n else\n error \"cannot determine maximum index because input contains symbolic index or indices\"\n end if;\n end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining a useful function " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which finds the maximum grade in the given Clifford polynomial. It returns 0 for a Clifford scalar (an element of type cliscalar).\n\nTypical use: max grade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 400 "max grade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\no ptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 07`;\n#############################################\nif type(eval(a1), cliscalar) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nretu rn max(op(map(nops,map(Clifford:-extract,S))))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 18. Procedure " }{TEXT 298 2 "LC" } {TEXT -1 233 " defines a left contraction between any multivector u an d a multivector v, i.e., multivector u acts on the multivector v from \+ the left. This procedure is now bilinear in both arguments. It can a ccept third argument such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: LC(e1 + 2*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2317 "LC:=proc(x1::\{c liscalar,clibasmon,climon,clipolynom\},\n y1::\{cliscalar,clib asmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lnam e,res,coB,nameB,x,y;\n global _CLIENV,B;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\n################## ###########################\nif nargs=2 then\n coB:=1:\n nameB:= `B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name ,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in LC. See ?LC for more help.\" \n end if;\nelse\n error \+ \"two or three arguments expected in LC. See ?LC for more help.\"\n en d if;\n################################\nx,y:=expand(x1),expand(y1): # #NEW\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n \+ lst1:=Clifford:-extract(x,'integers');\n lst2:=Clifford:-extrac t(y,'integers');\n N1:=nops(lst1);N2:=nops(lst2);\n if N1>N2 then return 0 end if;\n if N1=0 then return y end if;\n if \+ N1=1 then \n res:=`+`(seq(coB*nameB[lst1[1],lst2[j]]*_CLIENV[_ QDEF_PREFACTOR]^(j-1)*\n makeclibasmon([op(su bs(lst2[j]=NULL,lst2))]),j=1..N2));\n return reorder(res) \n \+ else\n res:=\nprocname(makeclibasmon(lst1[1..-2]),procname(ma keclibasmon([lst1[-1]]),y,lname),lname);\n return reorder(res) \n end if;\n elif type(y,climon) then\n term,cf:=select remove(type,y,clibasmon);\n return expand(cf*procname(x,term,l name))\n elif type(y,clipolynom) then\n return add(procna me(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) then \n \+ return displayid(scalarpart(x)*y)\n end if; \n elif type(x,clim on) then\n term,cf:=selectremove(type,x,clibasmon);\n return exp and(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n re turn add(procname(i,y,lname),i=[op(x)])\n elif type(x,cliscalar) then \n return x*reorder(y)\n end if;\nerror \"Got input %1 and %2 bu t LC can only process constants and Clifford numbers\",x,y;\nend proc: \n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 19. Procedure " }{TEXT 299 3 "LCQ" }{TEXT -1 270 " is a special version of 'LC' and gives left cont raction in the orthogonal Clifford algebra Cl(Q) of the quadratic form Q defined via the symmetric part g of B as Q(x) = g(x, x) = B(x, x). \+ It can accept name as a third optional argument or a numeric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Grenob le, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLCQ(e 1 + 2*e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1795 "LCQ:=proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ y::\{cliscalar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m ,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-200 8 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2007`;\n######################## #####################\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \+ \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symb ol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n \+ lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,ma trix,array\})) then\n coB:=op(select(type,\{op(args[3])\},numeri c));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third argumen t in LCQ. See ?LCQ for more help.\" \n end if;\nelse\n error \"tw o or three arguments expected in LCQ. See ?LCQ for more help.\"\nend i f;\n################################\nSxy:=remove(type,map(op,\{op(x), op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers' ));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n ret urn LC(x,y,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=li nalg[coldim](evalm(lname)):\n if m>N then \n error \"input cont ains index larger than size of bilinear form %1\",lname \n end if;\n end if:\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(l name[ii,ii],ii=1..m);\n return LC(x,y,linalg[diag](L))\nelif \n ty pe(lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op( select(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},\{name,symbol,array,matrix\}));\n L:=seq(coB*nameB[ii,ii],ii= 1..m);\n return LC(x,y,linalg[diag](L))\n end if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 20. Procedure " }{TEXT 300 2 "RC" }{TEXT -1 241 " defines a right contraction between any multivector u \+ and a multivector v, i.e., multivector u acts on the multivector v fro m the right. This procedure is now bilinear in both arguments. It ca n accept third optional argument like B or -B." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 258 46 "Typical use: RC(e1 + 2*e 2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2280 "RC:=pr oc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clisca lar,clibasmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,ter m,lname,res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\n################## ###########################\nif nargs=2 then\n coB:=1:\n nameB:= `B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name ,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in RC. See ?RC for more help.\" \n end if;\nelse\n error \+ \"two or three arguments expected in RC. See ?RC for more help.\"\nend if;\n################################\n if type(x,clibasmon) then\n \+ if type(y,clibasmon) then\n lst1:=Clifford:-extract(x,'integer s');\n lst2:=Clifford:-extract(y,'integers');\n N1:=nops(lst 1);N2:=nops(lst2);\n if N2>N1 then return 0 end if;\n if N2= 0 then return x end if;\n if N2=1 then \n res:=`+`(seq(co B*nameB[lst1[-i],lst2[1]]*_CLIENV[_QDEF_PREFACTOR]^(i-1)*\n \+ makeclibasmon([op(subs(lst1[-i]=NULL,lst1))]),i=1..N1));\n \+ return reorder(res) \n else\n res:=procname(proc name(x,makeclibasmon([lst2[1]]),lname),\n \+ makeclibasmon(lst2[2..-1]),lname);\n return reorder(res) \n end if;\n elif type(y,climon) then\n term,cf:=selectre move(type,y,clibasmon);\n return expand(cf*procname(x,term,lname) )\n elif type(y,clipolynom) then\n return add(procname(x,i,lna me),i=[op(y)])\n elif type(y,cliscalar) then return reorder(x)*y \n end if;\n elif type(x,climon) then\n term,cf:=selectremove(ty pe,x,clibasmon);\n return expand(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n return add(procname(i,y,lname),i=[op(x)] )\n elif type(x,cliscalar) then \n return displayid(x*scalarpart(y ))\n end if;\nerror \"Got input %1 and %2 but can only process const ants and Clifford numbers\",x,y\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 259 18 "No. 21. Procedure " }{TEXT 301 3 "RCQ" }{TEXT 302 85 ": Right \+ contraction in Cl(Q). It can accept third optional argument such as K \+ or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1800 "RCQ:=p roc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clis calar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m,Sxy,symbxy, lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2008 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2007`;\n#################################### ######### \nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname :=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,a rray\}) then\n coB:=1:\n nameB:=args[3];\n lname:=ar gs[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array \})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=arg s[3]:\n else \n error \"wrong type of third argument in RCQ. \+ See ?RCQ for more help.\" \n end if;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ for more help.\"\nend if;\n###### ##########################\nSxy:=remove(type,map(op,\{op(x),op(y)\}),c liscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbx y:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return RC(x,y ,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y h ave maxindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldi m](evalm(lname)):\n if m>N then \n error \"input contains i ndex larger than size of bilinear form %1\",lname \n end if:\nend if :\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(lname[i i,ii],ii=1..m);\n return RC(x,y,linalg[diag](L))\nelif \n type(lna me,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(select (type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(lname)\} ,\{name,symbol,array,matrix\}));\n L:=seq(coB*nameB[ii,ii],ii=1..m); \n return RC(x,y,linalg[diag](L))\n end if;\nend proc:" }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " }{TEXT 303 8 "gradeinv" } {TEXT -1 133 " is the grade involution in the Clifford algebra,i.e., i t reverses signs of odd elements and leaves signs of even elements unc hanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typical use: gradeinv(e1 + e1we2 - 4*e3we4); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 553 "gradeinv:=proc(a1::\{matrix,cliscalar,clibas mon,climon,clipolynom\}) global _CLIENV;\noptions `Copyright (c) 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\nif type(a1,matrix) then return map(procname ,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR]: =-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFACT OR])^maxgrade(a1)*a1 \n else return clilinear(a1, procname) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 23. Define the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " product of any number of Clifford polynomials. The infix form of this associative m ultiplication is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the \+ procedure 'rmulm' described below, wedge multiplication may be applied to matrices with entries in a Clifford algebra or in an exterior alge bra.\n\nNew feature: When the dimension of the vector space is known, \+ either from the size of the matrix B or from the global parameter dim_ V that can be set by the user, the output of the procedure does not in clude terms of grade higher than the dimension of the vector space in \+ case symbolic indices are used. \n\nThe default value of this global v ariable is 9 and it it set by the initialization file when Clifford is loaded.\n\nWhen the procedure is invoked, it checks whether the bilin ear form B has been defined. If yes, the procedure checks whether the \+ size of B is less than the current value of dim_V. If again yes, a war ning message is issued by the procedure and the value of dim_V is redu ced. If the size of B is larger than the current value of dim_V, no wa rning message is issued and the value of dim_V is increased to linalg [coldim](B).\n\nThe warning message can be supressed by addign 'false' to a global parameter _warnings_flag whose default value is set to tr ue by the Clifford initialization file." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e4 + e1we2); wedge(e2 + 2*e1, e3, e4); (e2 + 2*e1) &w (e3 + 2*); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3062 "wedge:=proc(a1::\{cliscalar,cliba smon,climon,clipolynom\},\n a2::\{cliscalar,clibasmon,climo n,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12,maxindexfl ag,expr,maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: December 20, 2007`;\n############### ##############################\nkk:='kk':\nif member(0,[args]) then re turn 0 \nelif \n remove(type,\{args\},cliscalar)=\{\} then return pr oduct(args[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then\n if li nalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < dim_V then \n dim_V:=linalg[coldim](B);\n if _warnings_flag then \nprintf(\"Warning, since B has been (re-)assigned, value of dim_V has been reduced by 'wedge' to %g\\n\",dim_V);\n end if;\n elif linalg[coldim](B)>dim_V then\n dim_V:=linalg[coldim](B);\n \+ end if;\n end if;\n end if; \nif not type(dim_V,Range(0,10)) or \n \+ not type(dim_V,posint) then\n error \"value of dim_V must be a pos itive integer between 1 and 9, inclusive, but current value of dim_V i s %1\",dim_V\nend if;\n################\ni12:=\{\}:\nfor ii from 1 to \+ nargs do\n pi:=args[ii]: \n i12:=i12 union map(op,map(Clifford:- extract,cliterms(pi),'integers')):\nend do;\nn12:= select(member,i12, \{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{\} then\n maxin:=max(op(n12)); \n maxindexflag:=evalb(maxin > dim_V);\nelse maxindexflag:=false:\n end if:\nif maxindexflag then \n error \"argument(s) contain(s) inde x larger then current value of dim_V which is now %1. To complete comp utation, increase value of dim_V or assign square matrix of size at le ast %2 by %3 to bilinear form B\",dim_V,maxin,maxin\nend if;\n######## ########\nwedge2:=proc() local expr,i1,i2,n1,n2,i12,s12,symbindexflag; global dim_V;\n i1:=\{op(Clifford:-extract(args[1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(args[2]))\};n2:=nops(i2):\n if args[1]=Id \+ then \n if n2>dim_V then return 0 else return args[2] end if;\n end if;\n if args[2]=Id then \n if n1>dim_V then return 0 else return \+ args[1] end if;\n end if;\n i1:=\{op(Clifford:-extract(args[1]))\}; \n i2:=\{op(Clifford:-extract(args[2]))\};\n i12:=i1 union i2;\n \+ s12:= remove(member,i12,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n \+ symbindexflag:=evalb(not s12=\{\}):\n if i1 intersect i2 <> \{\} th en return 0 end if;\n if symbindexflag and nops(i1)+nops(i2) > dim_V then return 0 end if;\nreturn reorder(cat(args[1],\"w\",args[2]));\ne nd proc:\n################\nif nargs=1 then return args\nelif nargs=2 \+ then p1:=displayid(a1):\n p2:=displayid(a2):\n \+ expr:=clibilinear(p1,p2,wedge2);\n if hast ype(expr,trig) then \n return clicollect(map(combi ne,clicollect(expr),trig))\n else \n \+ return reorder(expr)\n end if;\nelse expr:=procna me(procname(a1,a2),args[3..nargs]):\n if hastype(expr,trig) then \+ \n return clicollect(map(combine,clicollect(expr),trig))\n \+ else \n return reorder(expr)\n end if;\nend if;\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampersand version of " } {TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford:-setu p)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " computes sign of a permutation that sort s a list of indices.\n\nTypical use: permsign([1,3,2]); permsign([j,1, i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 881 "permsign:=proc(L::li st) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `Copyr ight (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: December 20, 2007`;\n####### ######################################\nL1:=L:\nN:=nops(L1):\nif N=1 t hen return 1 end if:\n################## new\nn12,s12:=selectremove(me mber,L1,\{1,2,3,4,5,6,7,8,9\});\n#s12:=remove(member,L1,\{1,2,3,4,5,6, 7,8,9\});\nL2:=[op(sort(n12)),op(sort(s12))];\n################## new \nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss];\nen d do;\ndummy_set:=convert(L1,set);\nK:=0:\nwhile dummy_set <> \{\} do \n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n while f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set minus \{x\};\n K:=K+1;\n end do:\nend do;\n#newbas:=cat(e.(op(L2[1..-2])).w,e, L2[-1]):\n#return ((-1)^K*newbas);\nreturn (-1)^K;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 26. Procedure " }{TEXT 309 7 "cmulN UM" }{TEXT -1 148 " calculates Clifford product between any two Cliffo rd monomials using the recursivelyChevalley's definition of the Cliffo rd product: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 93 " \+ xu = wedge(x, u) + LC(x, u) = x &w u + LC(x, u) " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 477 "where x is a ve ctor and u is any element in the algebra, wedge(x,u) = x &w u denotes \+ the wedge or exterior product between x and u, and LC(x, u) denotes t he left contraction of u by x. This procedure is now bilinear in both \+ arguments. The infix form is available e.g., e1 &c e2. This procedur e works in Clifford algebras in dimensions up to and including 9. Mul tiplication of matrices with entries in a Clifford algebra can be done with a procedure 'rmulm' described below." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure requires thir d argument of type name or a numeric multiple of a name. Then it compu tes Clifford product in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nTh is version can take index as a way of passing a parameter. The index \+ could be of type `&*`(numeric,\{name,symbol,array,matrix\}) or of type \{name,symbol,array,matrix\}.\n\nWhen the bilinear form B is symboli c, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 264 55 "Typical use: cmulNUM(e1,e3we4,B); cmulNUM(e1,e3we4,-K); " }{TEXT 265 3 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2254 "cmulNUM:= proc(a1,a2,lname) \n local L,N,L2,x,x1,x2,S,i,ii,T1,T2,K,p1,p2,coB,na meB,a12;global B:\n options `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n description `Last \+ revised: December 20, 2007`;\n######################################## #####\n###This is additional code for Maple 6 version:\n############## ###############################\nif hastype(\{a1,a2\},cliprod) then\n \+ a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-cliexpand(cl ibilinear(a12[1],a12[2],procname,lname))\nend if: \n################## ####################################################################\n ### old name cmul2B: this procedure computes recursively Clifford prod uct of any two #\n### cliscalars, clibasmons, climons, and clipolynoms in Clifford algebras Cl(lname) #\n################################## ####################################################\n if nargs<>3 th en error \"exactly three arguments are needed\" end if:\n if has(0,ma p(simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` then return a 1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-extract (a1,'integers');\n N:=nops(L):\n ################\n ##### The follo wing will allow for lname to be -B, for example:\n if type(lname,\{na me,symbol,array,matrix\}) then\n coB,nameB:=1,lname:\n elif type( lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(s elect(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(l name)\},name));\n else\n error \"third argument is of unexpected \+ type\"\n end if;\n ################\n if N=0 then return coeff(a1,I d)*a2\n elif N=1 then\n L2:=Clifford:-extract(a2,'integers'):\n \+ return reorder(simplify(makeclibasmon([L[1],op(L2)])\n +add((-1)^ (i-1)*coB*nameB[L[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..no ps(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:=substring(a 1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1,p2,pro cname,lname);\n return simplify(S-coB*nameB[op(L)]*a2)\n end if;\n x:=cat(e,L[-1]);\n p1:=substring(a1,1..(3*N-4));\n p2:=procname(x, a2,lname):\n S:=clibilinear(p1,p2,procname,lname)\n -add((-1)^(i )*coB*nameB[L[-i],L[-1]]*\nprocname(makeclibasmon(subs(L[-i]=NULL,L[1. .-2])),a2,lname),i=2..N); \n return reorder(simplify(S))\nend proc:\n " }}{PARA 0 "" 0 "" {TEXT 266 19 "No. 27. Procedure " }{TEXT 310 6 "c mulRS" }{TEXT 311 114 " computes Clifford product using Rota-Stein cli ffordization technique. It can accept now -K in place of the name.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4903 "cmulRS:=proc(a1,a2,lname)\nloca l max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n pLi st2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a12;\nopti ons `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007` ;\n#############################################\n###This is additiona l code for Maple 6 version:\n######################################### ####\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clieval ,[a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12[2],pro cname,lname))\nend if: \n############################################# #############################################\n### This procedure comp utes Clifford product of any two cliscalars, clibasmons, climons, #\n# ## and clipolynoms in Clifford algebras Cl(lname) using Rota-Sten clif fordization #\n### Procedure cmulRS modified by Rafal to accept \+ -K, or -B for lname. #\n########################### ###############################################################\n if \+ nargs<>3 then error \"exactly three arguments are needed\" end if:\n \+ if has(0,map(simplify,[a1,a2])) then return 0 end if;\n if a1 = `Id` \+ then return a2 end if;\n if a2 = `Id` then return a1 end if;\n ##### ###########\n ##### The following will allow for lname to be -B, for \+ example:\n if type(lname,\{name,symbol,array,matrix\}) then\n coB ,nameB:=1,lname:\n elif type(lname,`&*`(numeric,\{name,symbol,array,m atrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n error \"th ird argument is of unexpected type\"\n end if;\n ################\n \+ L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Cliffor d:-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \n retu rn reorder(simplify(makeclibasmon([L1[1],op(L2)])\n +add((-1)^(i-1) *coB*nameB[L1[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..N2))) \n end if;\n if N2=1 then \n return reorder(simplify(makeclibasmo n([op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*makecli basmon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; gener ate a power set of 1..N, option remember\n genPS:=proc(N)\n local \+ a,i,plst;\n option remember; \n a:=[seq(i,i=1..N)]:\n plst:=[ a]:\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op(plst)]: \n end do:\n end proc:\n#### prepare combinatorics for L1:\n fun1 :=proc(a1) a1 end proc:\n for i from 1 to N1 do\n fun1(i):=L1[i]; \n end do:\n#### here is the old code for the poweset \n# a:=[seq(i, i=1..N1)]:\n# pList1:=[a]:\n# for i in a do\n# pList1 := [op(subs (i = NULL,pList1)), op(pList1)]:\n# end do:\n####\npList1:=genPS(N1); \n PN1:=nops(pList1)+1; ## added 1 here\n pList1:=sort(pList1,(a, b)->evalb(nops(a)<=nops(b)));\n pSgn1 :=[seq((-1)^(add(pList1[i][m]-m ,m=1..nops(pList1[i]))),i=1..PN1-1)];\n#### prepare combinatorics for \+ L2:\n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n fun2( i):=L2[i];\n end do:\n#### here is the old code for the poweset \n# \+ a:=[seq(i,i=1..N2)]:\n# pList2:=[a]:\n# for i in a do\n# pList2 : = [op(subs(i = NULL,pList2)), op(pList2)]:\n# end do:\n####\npList2:= genPS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:=sort(pL ist2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pList2[ i][m]-m,m=1..nops(pList2[i]))),i=1..PN2-1)];\n#### cup tangle of the r ota-stein sausage tangle\n cup:=proc(lst1,lst2,coB,nameB)\n local \+ i;\n if nops(lst1)<>nops(lst2) then return 0 end if;\n if lst1=[ ] then return 1 end if;\n if nops(lst1)=1 then return coB*nameB[lst 1[1],lst2[1]] end if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],lst2[i]]* cup(lst1[1..-2],subs(lst2[i]=NULL,lst2),coB,nameB)\n \+ ,i=1..nops(lst2))\n end p roc:\n################################################################ ################### \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms whic h are potentially non zero in the cup(..) tangle #\n################## #################################################################\n m ax_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n pos1 :=0:\n for j from 0 to N1 do # for all j-vectors of pList1\n F1:=N1 !/((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grade-j) do \+ # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N2!/((N2- i)!*i!);\n for n from 1 to F1 do\n for m from 1 to F2 do \n r es:=res+\n pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup(map(fun1 ,pList1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n ma keclibasmon([op(map(fun1,pList1[pos1+n])),op(map(fun2,pList2[PN2-pos2- m]))])\n end do:\n end do:\n pos2:=pos2+F2;\n end do:\n pos1:=pos1+F1;\n end do: \nreturn reorder(res); ## note that cmul RS INCLUDES already reorder !!\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 267 19 "No. 28. Procedure " }{TEXT 312 7 "cmulgen" }{TEXT 313 47 " is just a place holder for a Clifford product." }{TEXT -1 1 "\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 558 "cmulgen:=proc() global _default_Cl ifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2008 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: December 20, 2007`;\n############################### ##############\nif _default_Clifford_product <> 'cmulgen' then\n ret urn _default_Clifford_product(args)\nelse \n if _warnings_flag then \n WARNING(\"to assign Clifford product, execute 'useproduct' with a rgument cmulRS, cmulNUM, or cmul_user_defined first\");\n end if;\n return 'cmulgen'(args);\n end if; \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 268 25 "No. 29. Wrapper function " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clifford product given by cmulNUM, cmulRS, or other p rocedure such as 'cmulgen'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1379 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2008 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2007`;\n#################################### #########\n if type(op(procname),procedure) then\n lname:=`B`;\n \+ else\n lname:=op(procname);\n end if;\n if member(0,[args]) then return 0 end if;\n if nargs <=1 then return args end if;\n if nargs = 2 then\n########################################################## \n### Speed-wise it makes no difference whether cmulgen or #\n### _def ault_Clifford_product is used in the following. # ################### #######################################\n return clicollect(clibiline ar(eval(args[1]),eval(args[2]),cmulgen,lname)); \n end if;\n###### <= == do NOT use 'procname' in the next line this will not work\n######## ##################################################\n### Speed-wise it \+ makes no difference whether cmulgen or #\n### _default_Clifford_produc t is used in the following. # ####################################### ###################\nif not type(_default_Clifford_product,procedure) \+ then \n error \"global variable _default_Clifford_product must be as signed a procedure so that 'cmul' could proceed beyond this point. Sor ry. For help see ?cmul.\" \nend if;\n return procname(clibilinear( eval(args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of " }{TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctl y uses -K for index. When K has been assigned a matrix, use\n&c[''K''] (e1,e2) and &c[''-K''](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1, e2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 2305 "`&m`:=proc() local NP,ARGS,coB,nameB,lname ,decindex,flagdec;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: December 20, 2007`;\n########################################### ##\n#######################################\n### Works when &c[''K''] \+ or &c[''-K''] is entered and K is a matrix\n########################## #############\nflagdec:=true:\nif type(op(procname),procedure) then\n \+ if type([args],listlist) then\n if type(op(args),array) then\n \+ WARNING(\"enclose index in double quotes as in &c[''B''] or &c [''-B''] when B has been assigned a matrix to avoid the following:\"); \n return 'procname(args)';\n end if;\n else coB:=1:\n \+ nameB:=`B`:\n lname:=`B`:\n ARGS:=[args]:\n flag dec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args]; \n if type(lname,`&*`(numeric,name)) then\n coB:=op(select (type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},name));\n else\n coB:=1:\n nameB:=lname:\n \+ end if;\n flagdec:=false:\n end if;\n######################## ###############\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif t ype([args],listlist) then\n if type(op(args),function) then\n A RGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args))); \n if type(nameB,`&*`(numeric,name)) then\n coB:=op(selec t(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(n ameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,fu nction)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(ty pe,nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \+ \"unable to determine index or wrong index, use name in double quotes \+ as in &c[''B''] or &c[''-B'']\"\n end if;\nelif\n type([args],lis t) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nel se\n error \"cannot determine arguments and/or index from arguments \"\n end if;\nreturn coB,nameB,[ARGS];\nend proc:\n################### ##################\nif flagdec then \n coB,nameB,ARGS:=decindex(args );\n lname:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) \+ then return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn \+ cmul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to select which procedure is used to compute Cliffor d product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1258 "u seproduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_C lifford_product; #,cmulgen;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: December 20, 2007`;\n################################## ###########\n######################################################### ##########\n###This procedure uses global variable _default_Clifford_p roduct #\n########################################################### ######## \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defin ed\}) then \n WARNING(\"expecting one of the following Clifford pro ducts: cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\nif member(name,\{cmul_user_defined\}) and not type(name,procedure) then \n WARNING(\"no computations with cmul can be peformed yet since cmu l_user_defined has not been defined as procedure. Select cmulRS, cmulN UM, or a new procedure as argument to useproduct.\");\n _default_Cli fford_product:=name;\nreturn NULL;\nend if;\n######################### #######\n_default_Clifford_product:=name; #change value of _default_Cl ifford_product \n################################\nwstr:=cat(\"cmul wi ll use \",name,\"; for help see pages ?cmul, ?Clifford:-intro, or ?\", name);\nWARNING(wstr);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 " No. 32. Procedure " }{TEXT 320 5 "cmulQ" }{TEXT -1 20 " and its infix \+ form " }{TEXT 321 3 "&cQ" }{TEXT -1 514 " is a special version of 'cmu l' and '&c'. It gives the Clifford multiplication in the Clifford alg ebra of the quadratic form Q related to the symmetric part g of B as Q (x) = g(x, x) = B(x, x) where B = g + A (A is the alternating part of \+ B). Like 'cmul', it works now in all dimensions 1 through 9. Via the procedure 'rmulm' described below in (32), this multiplication can al so be applied to matrices with entries in a Clifford algebra.\n\nThis \+ procedure can now accept an optional index which could be K or -K. " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Prop osed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Tha nks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 158 "Typical use: cmulQ(e1 + e2 + 2*Id, e3we4 + e6); or (e1 + e2) &cQ \+ (2*e2we3 + e4); or &cQ(e1, e2, e3); \n cmulQ(e1 we2+e2,e3+e4,e5-Pi*Id); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1424 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2008 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n####################################### ######\n####################################\nif type(op(procname),pro cedure) then\n lname:=`B`;\nelse\n lname:=op(procname);\nend if; \n####################################\nif member(0,[args]) then retur n 0 end if;\n####################################\nSxy:=map(op,map(cli terms,\{args\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers')); \nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return cmul[lname](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when bot h x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=l inalg[coldim](evalm(lname)):\n if m>N then \n error \"input con tains index larger than size of bilinear form %1\",lname \n end if: \nend if:\n################################\nif type(lname,\{name,symb ol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return c mul[linalg[diag](L)](args);\nelif \n type(lname,`&*`(numeric,\{name, symbol,array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},num eric));\n nameB:=op(select(type,\{op(lname)\},\{name,symbol,array,ma trix\}));\n L:=seq(coB*nameB[ii,ii],ii=1..m);\n return cmul[linalg [diag](L)](args); \nelse\n error \"index of unexpected type has bee n found in cmulQ\"\nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 272 29 "No. 33. Ampersand version of " }{TEXT 322 5 "cmulQ" }{TEXT 323 222 ". This version can accept index B and -B. When B has been defined as matrix, use\n&cQ[''B''](e1,e2) and &cQ[''-B''](e1,e2) . Otherwise, use &cQ[B](e1,e2), &cQ[-B](e1,e2) or &cQ(e1,e2). \n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 34. Procedu re " }{TEXT 324 10 "scalarpart" }{TEXT -1 137 " computes the scalar pa rt of the given Clifford polynomial. For example, scalarpart(e1 + e2 we3) = 0 but scalarpart(2*Id + e2we3) = 2. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: scalarpart (2*Id + e1 + e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 376 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\na1:=simplify(a ):\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1):\n return coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes t he k-vector part of the given Clifford polynomial u where k is a nonne gative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. W hen k = 0 then the procedure returns the scalar part of u times 'Id', \+ e.g., vectorpart(2*Id + 3*e2we3, 0) = 2*Id. Note that vectorpart(2*Id + e1we2, 0) equals 2*Id while scalarpart(2*Id + e1we2) = 2. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "Typic al use: vectorpart(e1 + e2we3 + e3, 1); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 597 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2007`;\n#################### #########################\na1:=expand(simplify(a)): #expand is needed \nif maxgrade(a1) < a2 then return 0 end if;\n K:=proc() if maxgrade (args[1])=a2 then true else false end if end proc:\nif type(a1,`+`) th en p:=select(K,a1) elif\n maxgrade(a1)<>a2 then p:=NULL else \n p: =a1 \nend if;\nif p=NULL then return 0 else return p end if;\nend proc :\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 36. Procedure " }{TEXT 326 4 "cexp" }{TEXT -1 236 " computes Clifford exponential of a Clifford n umber in Cl(B) up to the order specified by the second argument which is a nonnegative integer n. It n = 0 then this procedure returns 'Id' . It can accept another argument such as B or -B. " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 185 "Typical use: cexp(e1 we2*t, 3);cexp(e1we2*t, 3,K);\n cexp((e1 + e1we2)* t, 4); cexp((e1 + e1we2)*t, 4,-K); \n cexp(e1we2, \+ 3); cexp(e1 + e1we2, 4,K);\n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 1360 "cexp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::no nnegint) \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyrig ht (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2007`;\n######### ####################################\nif nargs=2 then\n coB:=1:\n \+ nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[ 3],\{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=a rgs[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{ name,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(arg s[3])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numer ic));\n lname:=args[3]:\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nels e\n error \"two or three arguments expected in cexp. See ?cexp for m ore help.\"\nend if;\n################################\nk:='k':\nif ty pe(p,\{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\n if evalb(vectorpart(p,0)=p) then \n pp:=scalarpart(p);\n return (( add(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n elif N=1 then return Id+pp; \n else \n an s1:=cexp(pp,N-1,lname);\n ans2:=cexp(pp,N-2,lname);\n ans: =ans1+cmul[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nen d if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure " }{TEXT 327 5 "cexpQ" }{TEXT -1 257 " computes Clifford exponential \+ of a Clifford number in Cl(Q) up to the order specified by the second argument which is a nonnegative integer n. It n = 0 then this procedu re returns 'Id'. This procedure can also accept an optional argument \+ such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 210 "Typical use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2 )*t, 4);\n cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e 1we2)*t, 4,K);\n cexpQ(Id+2*e1we3,4); or cexpQ(e1 \+ + 2*e1we2, 4,-K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1374 "cexpQ:=pro c(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \+ \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 19 95-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2007`;\n################## ###########################\nif nargs=2 then\n coB:=1:\n nameB:= `B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name ,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symb ol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\},n umeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third ar gument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n e rror \"two or three arguments expected in cexpQ. See ?cexpQ for more h elp.\"\nend if;\n################################\nk:='k':\nif type(p, \{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\nif ev alb(vectorpart(p,0)=p) then \n pp:=scalarpart(p);\n return add(pp^ k/k!,k=0..N)*Id \nend if;\npp:=clisort(displayid(p)):\nif N=0 then ret urn Id \n elif N=1 then return Id+pp; \n else \n ans1:=c expQ(pp,N-1,lname);\n ans2:=cexpQ(pp,N-2,lname);\n ans :=ans1+cmulQ[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return ans; \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Proce dure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponenti al of a Clifford number u up to the order specified by the second arg ument which is a nonnegative integer n. It returns 'Id' when n = 0. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "T ypical use: wexp(e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 611 "wexp:= proc(p::\{cliscalar,clibasmon,climon,clipolynom\},N::n onnegative) \nlocal pp,power,cu,i;\noptions `Copyright (c) 1995-2008 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: December 20, 2007`;\n########################### ##################\n if nargs<>2 then error \"two parameters are need ed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then return 1 elif \n N=1 then return 1+clisort(pp) end if;\n power:=pp;\n cu:=1+pp ;\n for i from 2 to N do\n power:=wedge(power,pp);\n cu:=cu + power/i!;\n end do;\n return subs(Id=1,clicollect(clisort(cu)));\n \+ end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " } {TEXT 329 9 "reversion" }{TEXT -1 411 " calculates reversion in the Cl ifford algebra. It is linear in its argument and it is always a Cliffo rd algebra anti-automorphism. When the antisymmetric part of B is not zero, 'reversion' does not preserve the multilinear structure of the \+ algebra because it mixes grades, i.e., it does not preserve the gradat ion of the exterior algebra. This procedure can now take a third opti onal argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 53 "Typical use: reversion(2*e1we2 + 4*Id - e3we4we5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2640 "reversion:=pro c(a1::\{cliscalar,clibasmon,climon,clipolynom,matrix\}) \n l ocal ind,expr,wtp,ptw,lname,flagindexed;\n global _scalartyp es,B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2007`;\n#############################################\nif hastyp e([args[1]],cliprod) then \n error \"in order to handle 'type/clipro d', load in package Cliplus\" \n end if;\n############################ \nif type(a1,cliscalar) then return a1 end if;\n###################### ######\nif nargs=1 then\n lname:=`B`;\n flagindexed:=false:\neli f nargs=2 and type(args[2],\{symbol,name,array,matrix,`&*`(algebraic,n ame)\}) then\n lname:=args[2];\n flagindexed:=true:\nelse error \+ \"only one or two arguments are expected\"\nend if;\n################# ###########\n### Auxiliary function that converts wedges to Clifford p roducts: wedge ->> Clifford product\n############################\nwtp :=proc(a1,lname) local ind,i,arg,rdmon,eq1,ans; global _scalartypes; \+ \nif type(a1,\{`+`,`*`\}) then return (map(wtp,a1,lname)) \n elif t ype(a1,_scalartypes) then return a1\n elif type(a1,symbol) and Searc hText(w,a1)=0 then return a1\n elif type(a1,symbol) and not member(l ength(a1),\{5,8,11,14,17,20,23,26\}) \n then return a1 \nend if ;\nrdmon:=reorder(a1):\nind:=Clifford:-extract(a1,'integers'):\ni:='i' :\narg:=[seq(cat(e,op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(arg))=si mplify(eval(cmul[lname](op(arg))));\nif a1=rdmon then ans:=simplify(so lve(eq1,a1)) \n else ans:=-simplify(solve(-eq1,-rdmon)) \+ \nend if;\nif nops(ind) < 4 then return ans else return wtp(ans,lname) end if;\nend proc:\n############################\n### Auxiliary funct ion that converts Clifford products to wedge: Clifford products ->> we dge\n############################\nptw:=proc(a1,lname) local i,arg,rev arg; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then return (map(p tw,a1,lname)) \n elif type(a1,_scalartypes) then return a1 \n elif type(a1,symbol) and SearchText(e,a1)=0 then return a1 \n elif type( a1,symbol) and length(a1)=2 then return a1 \n elif type(a1,symbol) a nd not member(length(a1),\{2,4,6,8,10,12,14,16,18\})\n then ret urn a1 \n end if;\ni:='i':\narg:=[seq(cat(e,substring(a1,2*i..2*i)),i= 1..(length(a1)/2))];\nrevarg:=[seq(arg[nops(arg)-i],i=0..(nops(arg)-1) )];\nreturn expand(eval(cmul[lname](op(revarg))))\nend proc:\n######## ######################\n### Now the actual function:\n################ ##############\nif type(a1,matrix) then return map(reversion,a1,lname) end if;\nexpr:=ptw(expand(wtp(a1,lname)),lname);\nexpr:=expand(displa yid(expr)):\nreturn clisort(expr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40. Procedure " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates conjugation in the Clifford algebra. It is linear \+ in its argument. Note that 'conjugation' is defined as a composition \+ of 'reversion' and 'gradeinv'. Hence, it does not preserve the multiv ector gradation when the antisymmetric part of B is non-zero. It can \+ now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjugatio n(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 824 "conjugation:=proc(a1::algebraic) local lname;globa l B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\nif nargs=1 then\n lname:=`B`;\nelif nargs=2 and type(args[2],\n \{symbol, name,array,matrix,`&*`(numeric,\{symbol,name,array,matrix\})\}) then\n lname:=args[2];\nelse error \"only one or two arguments are expect ed\"\nend if;\n###########################\nif type(a1,matrix) then re turn map(procname,a1,lname) elif\n type(a1,cliscalar) then return a1 elif\n type(a1,\{clibasmon,climon,clipolynom\}) then\n retur n eval(gradeinv(reversion(a1,lname)))\nelse \n error \"wrong input t ype: input must be of type cliscalar, clibasmon, climon, clipolynom, o r 'matrix'\" \nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c_con jug" }{TEXT -1 72 " calculates complex conjugate in a complexified Cli fford algebra; thus, " }}{PARA 258 "" 0 "" {TEXT -1 80 " \+ c_conjug(u) = c_conjug(a + I*b) = a - I*b " }} {PARA 258 "" 0 "" {TEXT -1 140 "where a and b are in the real Clifford algebra and `I` is the imaginary unit, i.e., I = sqrt(-1). This proce dure is linear in its argument. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 51 "Typical use: c_conjug((1 + 2*I)*e1 - 3* I*e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 698 "c_conjug:=proc(a1 ::algebraic) local ba,co,terms,t,i;\noptions `Copyright (c) 1995-2008 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: December 20, 2007`;\n########################## ###################\nif type(a1,matrix) then return map(procname,a1) e lif\n type(a1,cliscalar) then return conjugate(a1) elif\n type(a1, \{clibasmon,climon,clipolynom\}) then\n t:='t':\n ba:=cl iterms(a1);\n co:=[coeffs(a1,ba,'t')];\n terms:=[t];i:=' i':\n return clisort(add(conjugate(co[i])*terms[i],i=1..nops(co )))\n else \nerror \"wrong input type: input must be of type cliscal ar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if;\nend proc: \n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 42. Procedure " }{TEXT 332 6 "buildm" }{TEXT -1 863 " builds a matrix for the given element u of th e Clifford algebra Cl(B) in the left- or right-regular representation, or under Lie or automorphism action with respect to an ordered basis \+ specified by the user. The element p is entered as the first argument and the basis in the form of a list is specified as the second argume nt, e.g., buildm(u, basis). It is also possible to specify options 'l eft', 'right', 'Lie', 'auto', 'false, and 'true'. For example, one can find the left-regular representation of the algebra on itself or, whe n Cl(B) is simple and isomorphic to a ring of real matrices, one can f ind matrices representing Clifford polynomials in a real basis of a mi nimal ideal. However, there are new procedures below specifically des igned for finding spinor representations of Clifford algebras in terms of real, complex, and quaternionic matrices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuild m(e1, [Id, e1, e2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'right'); \+ buildm(e1, [Id, e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2 ],'false'); buildm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm(e1, \+ [Id, e1, e2, e1we2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2968 "buildm:=proc(a1::\{cliscalar,clibasmon,climon,clipo lynom\},\n a2::list(\{cliscalar,clibasmon,climon,clipolyno m\}))\nlocal A,L,N,a11,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,f lag;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n#############################################\nflag:=true :\nif nargs=2 then a33:='left' end if;\nif nargs=3 then \n if member (args[3],\{'true','false'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left' ,'right','Lie','auto'\}) \n then a33:=args[3]\n else error \"third optional argument must be 'left', 'right', 'Lie', 'auto', 'true', 'false'\"\n end if; \nend if;\nif n args=4 then\n if member(args[3],\{'left','right','Lie','auto'\}) and member(args[4],\{'false','true'\}) then\n a33:=args[3]; \+ \n flag:=args[4];\n else \n error \"third optional argumen t must be 'left', 'right', 'Lie', 'auto', and the fourth optional argu ment must be 'false' or 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many arguments. See ?buildm for more help.\" end if;\n### ##############################################\nif flag then \nA:=lina lg[genmatrix](args[2],cbasis(maxindex(args[2])));\nif linalg[rank](A) \+ < nops(args[2]) then \n error \"elements of the list %1 are linearly dependent. Apply 'findbasis' to this list first.\",a2 \nend if;\nend \+ if;\n###local procedure\nnontrivial:=proc(S::\{set(\{relation,algebrai c\}),list(\{relation,algebraic\})\}) \nlocal istrivial;\nprintlevel:=2 :\nistrivial:=proc(x) if type(x,relation) then evalb(x) else evalb(x=0 ) end if end;\nremove(istrivial,S)\nend proc:\n### \nL:=a2:N:=nops(L): xm:=array(1..N,1..N):\nif a33='left' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1. .N))) \n end do;\nelif a33='right' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(L[i],a1)-add(x m[j,i]*L[j],j=1..N)))\n end do;\nelif a33='Lie' then\n for i fr om 1 to N do\n eq||i:=clicollect(expand(cmul(L[i],a1)-cmul(a1, L[i])-add(xm[j,i]*L[j],j=1..N)))\n end do;\nelif a33='auto' then\n a11:=cinv(a1):\n for i from 1 to N do \n \+ eq||i:=clicollect(expand(cmul(cmul(a1,L[i]),a11)-add(xm[j,i]*L[j], j=1..N)))\n end do;\nelse error \"third optional argument must be \+ 'left', 'right', 'Lie', or 'auto'\"\nend if;\n######################## ##################################\nLbasis:=[op(`union` (seq(cliterms( L[i]),i=1..N)))];\nfor i from 1 to N do \n for j from 1 to nops(Lba sis) do \n neq[i,j]:=coeff(eq||i,Lbasis[j])=0 \nend do;\nend do ;\nvars:=convert(evalm(xm),set):sys:=map(op,\{entries(neq)\});\nsys:=n ontrivial(sys): #eliminate trivial equations\nsol:=solve(sys,vars);\ni f sol=NULL then \n error \"no matrix represents %1 in the basis %2 u nder the %3 action\",a1,a2,a33; \nend if;\nassign(sol);\nreturn evalm( xm);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 43. Procedure \+ " }{TEXT 333 9 "findbasis" }{TEXT -1 680 " finds a basis in a linear v ector space spanned by a set of Clifford polynomials entered as a list . The procedure is used, for example, when finding a basis for a spi nor space S considered as a minimal left or right ideal in Cl(B) gener ated by a primitive idempotent f. To speed up computations, it is advi sable to a standard Clifford basis for Cl(B) in the form of a list of \+ basis monomials as the second argument. If only one list is specified , 'findbasis' determines a suitable Clifford basis itself but it takes twice as much time then since it creates a Clifford basis by using 'c basis(maxindex)' where 'maxindex' is the maximum index found among the elements of the list." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use : findbasis([2*e1+e2,e2+e1we2,e1we2],[Id,e1,e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1478 "findbasis:=proc(a1,a2) local L,clibasis,M ,i,m,r,v,S; \nglobal _prolevel;\noptions `Copyright (c) 1995-2008 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: December 20, 2007`;\n############################## ###############\nif evalb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{clibasmon,climon,clipolynom\})) or \n \+ type(a1,set(\{clibasmon,climon,clipolynom\}))) then\nerror \"ar gument of type list/set(\{clibasmon,climon, or clipolynom\}) was expec ted\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,clim on,clipolynom\})) or \n type(a1, set(\{clibasmon,climon,cli polynom\}))) and \n (type(a2,list(clibasmon)) or type(a2,set (clibasmon)))) or nargs>2 then\nerror \"arguments of type list/set(\{c libasmon,climon,clipolynom\}) and list/set(clibasmon) were expected\" \+ \nend if;\nend if;\nif nops(a1)=1 then return a1 end if;\n#L:=sort(map (displayid,convert(a1,list)),bygrade):\nL:=map(displayid,convert(a1,li st)): ####NO SORT\nif nargs=2 then clibasis:=sort(convert(a2,list),byg rade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),li st),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[r ank](M):m:=linalg[rowdim](M):\nfor i from 1 to m do v[i]:=linalg[row]( M,i) end do;\nS:=[v[1]]:\nfor i from 2 to m while nops(S) < r do \n \+ if linalg[rank](linalg[stackmatrix](op(S),v[i]))=nops(S)+1 \n t hen S:=[op(S),v[i]] \n end if\nend do;\nreturn [seq(L[i],i=map(op,S ))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 44. Procedure \+ " }{TEXT 334 12 "minimalideal" }{TEXT -1 143 " calculates a real basis for a left S=Cl(B)f or right S=fCl(B) minimal ideal in the algebra Cl (B) where f is a primitive idempotent in Cl(B). " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "The first argument o f the procedure is an ordered list of basis monomials sorted bygrade, \+ e.g., a Clifford basis generated by the procedure 'cbasis'. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 198 "Note : to sort a list L by grade one may use sort(L, bygrade) where 'bygr ade' is a new procedure in this package described below. The output f rom the procedure 'cbasis' is already sorted that way." }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argu ment is the idempotent f. If the idempotent f is the same as the one \+ stored under clidata()[4] then 'minimalideal' uses the generators of S stored under clidata()[5] to generate the real basis and it returns the stored list clidata()[5] as the second list in its ouput. If f does not equal clidata()[4] then complete computations are performed but they may take longer. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 129 "It is assumed that the numerical value s of B have been specified.\n\nThe procedure returns a list consisting of two ordered lists: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 91 "(1) the first list contains the real basis o f S written as expanded Clifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 106 "(2) the second list co ntains basis monomials from the standard basis in Cl(B) which generate the " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by m ultiplying f on the left or on the right depending whether S=Cl(B)f \+ or S=fCl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT 257 260 "There is a one-to-one correspodence between the two o rdered lists.\n\nTypical use: minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2 we3,e1we2we3],(1/2)*(Id+e3),'left');\n minimali deal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'right'); \n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2247 "minimali deal:=proc(a1,a2,a3) \nlocal L,gens,m,flag1,f,flag_left,data,SB,g,SBge ns,pq,p,q,l,ni,realdim,dimoverK,cb,N,bel; \nglobal B,_shortcut_in_mini malideal,_prolevel;\noptions `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2007`;\n########################################## ###\nif not type(B,diagmatrix) then \n error \"bilinear form B has n ot been assigned a matrix or is not diagonal\" \nend if; \nif not _pro level then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) t hen\n error \"first argument must of type list(\{clibasmon,cl imon,clipolynom\})\" \n elif not type(a2,'primitiveidemp') then \+ \n error \"second argument must be a primitive idempoten t\" \n elif not member(a3,\{'left','right',\"left\",\"right \"\}) then\n error \"third argument must be 'left', or 'right'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\nif member (a3,\{'left',\"left\"\}) then flag_left:=true else flag_left:=false en d if;\ng:='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimalideal the n\n m:=maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 th en\n data:=clidata():\n if eval(eval(data[4]))=eval(f) or ev al(eval(data[4]))=gradeinv(f) then\n SBgens:=data[5]:\n \+ if flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n \+ return [SB,SBgens,a3];\n end if;\n end if;\nend if; \n#I f can't use the shortcut, perform necessary computations.\npq:=Bsignat ure():\np:=pq[1]:q:=pq[2]:\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member( (p-q) mod 8,\{0,1,2\}) then \n realdim:=2*ni; \n dimoverK:=2 *ni; \nelif member((p-q) mod 8,\{3,7\}) then \n realdim:=4*ni; \n dimoverK:=2*ni; \nelse\n realdim:=4*ni; \n dimoverK:=n i \nend if;\ngens:=clidata()[5]: #put elements from clidata()[5] first in L\nL:=remove(member,L,gens):\nL:=[op(gens),op(L)]:\nSB:=[f]:SBgens :=[Id]:cb:=remove(member,L,[Id]); \nfor g in cb while nops(SB) < reald im do\n N:=nops(SB):\n if flag_left then bel:=cmulQ(g,f) else be l:=cmulQ(f,g) end if; \n SB:=findbasis([op(SB),bel]); \n if nop s(SB)>N then SBgens:=[op(SBgens),g] end if;\nend do:\nreturn [SB,SBgen s,a3];\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedu re " }{TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis for a fiel d K. The field K is the field of the spinor space S = Cl(B)f or S = f Cl(B) of the given Clifford algebra Cl(B). It is isomorphic to the r eals, or to the complexes, or to the quaternions according to whether \+ (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 205 "Assuming that the bilinear form B has \+ been defined, the first argument of the procedure is expected to be th e same as the output from the procedure 'minimalideal'. The second ar gument is the idempotent f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 225 "The procedure eliminates from the list of basis elements in the real ideal space nilpotent elements and leav es only those whose square modulo f is either +1 or -1. It returns th ose elements as the first list in its output. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 200 "If the primitive idemp otent f is the same as the one stored under clidata()[4] and if the g enerators of the real basis in the minimal ideal S match those stored \+ under clidata()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses generators of K stored under clidata()[6] and returns them a s the second list in its ouput. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 178 "Thus, the second list in the output c ontains generators (Clifford basis monomials) of the elements in the f irst list. Elements of the two lists are in one-to-one relationship. \+ " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[d iag](1,-1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left'); \n \+ Kfield(sbasis,f);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4633 "Kfield:=proc(a1::list(\{list,string,symbol\}),a2::clipolynom) \n local SB,gens,f,ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,di men,Kbasis,Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_proleve l;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 2 0, 2007`;\n#############################################\n#### Local p rocedure needed only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f ,mi,clibas,clibas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:= max(op(map(maxindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\nif type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n \+ clibas:=remove(member,clibas,gens):\n clib as:=[op(gens),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \+ \n if evalb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \+ \nend do:\nfor x in clibas2 do \nfor y in remove(member,clibas2,[x]) d o\nfor z in remove(member,clibas2,[x,y]) do\n if member(cmul(x,f) ,\{Kbasis[2],-Kbasis[2]\}) then \n if member(cmul(y,f),\{Kbasi s[3],-Kbasis[3]\}) then\n if member(cmul(z,f),\{Kbasis[4],- Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') th en return [x,y,z]\n end if;\n end if;\n end if;\n end if;\nend do; \nend do;\nend do;\nend proc:\n####################################### #######\nif not _prolevel then\n if not type(a2,'primitiveidemp') th en \n error \"second argument must be a primitive idempotent\"\n \+ end if;\nend if;\n##############################################\nSB :=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n########## ####################################\nif not member(f,SB) then \n er ror \"idempotent entered %1 is not a member of the first list\",f \nen d if;\n###new line here instead of >>>not assigned(B)<<<\nif not type( B,matrix) then \n error \"matrix must be assigned to B\" \nend if;\n if side='right' then flag3:=true else flag3:=false end if;\ndata:=clid ata():\nfield:=data[1]:\nif field = 'real' then return [[f],[Id]] \nel if field = 'complex' then \n if _shortcut_in_Kfield then\n \+ f_from_data:=eval(eval(data[4])):\n fg:=gradeinv(f): \+ \n if member(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] \+ then Kgens: =data[6];\nif flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kge ns))]\n else Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nops(Kgens)) ] \nend if;\nreturn ([Kbasis,Kgens]) \nend if;\nend if;\n############# ####################################################\n#Do this when sh ortcut can't be used when field = 'complex'\n######################### ########################################\nKdim:=2:\nKbasis:=[f]:Kgens: =[Id]:\nn:=nops(gens):\nfor i from 1 to n while nops(Kbasis) < Kdim do \n if cmul(gens[i],gens[i])=-Id then\n expr:=cmul(f,gens[ i],f);\n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]];\n \+ Kgens:=[op(Kgens),gens[i]] \n end if;\n \+ end if:\nend do;\nreturn [Kbasis,Kgens];\n######################### ######################################\nelif field = 'quaternionic' th en \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:=[op( SB)];\n Kgens:=[op(gens)];\n r eturn [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) then\n if _shortcut_in_Kfield then\n f_from_data:=eval (eval(data[4])):\n fg:=gradeinv(f): \n if m ember(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif flag 3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..n ops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\nend \+ if;\n################################################################ \n#Do this when shortcut can't be used and field = 'quaternionic'\n### #############################################################\nKdim:=4 :\nKbasis:=[f]:Kgens:=[Id]:\nn:=nops(gens):\nfor i from 1 to n while n ops(Kbasis) < Kdim do\n if cmul(gens[i],gens[i])=-Id then\n \+ expr:=cmul(f,gens[i],f);\n if expr<>0 then Kbasis:=[op(Kba sis),SB[i]];\n Kgens:=[op(Kgens),gens[i]] \+ \n end if;\n end if:\nend do;\n########################### #\n ijk:=T4(Kbasis);\n############################\n Kgens:=[I d,op(ijk)]:\nif flag3 then Kbasis:=[f,seq(cmul(g,f),g=ijk)] else \n \+ Kbasis:=[f,seq(cmul(f,g),g=ijk)]\nend if;\nreturn [Kbasis,K gens]\nelse error \"wrong name of the field. See ?Kfield for more help .\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. \+ Procedure " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spino r basis for S=Cl(B)f or S=fCl(B) over a field K where K is isomorphic \+ to the reals, or to the complexes, or to the quaternions according to whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectivel y (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 276 "The first argument is an ordere d list SBgens containing generators of a real basis in a minimal ideal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was left or rig ht). These generators are found by the procedure 'minimalideal' and a re returned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the primiti ve idempotent f used to generate the minimal ideal Cl(B)f or fCl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 150 " The third argument is a list FBgens of generators that generate the fi eld K; these generators are returned as a second list by the procedure 'Kfield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The fourth argument is either 'left' or 'right' dependin g whether we deal with the left minimal ideal Cl(B)f or the right mini mal ideal Cl(B)f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 434 "If the first three arguments in the input match respe ctively clidata()[5], clidata()[4], and clidata()[6] in that order, \+ i.e., SBgens=clidata()[5], f=clidata()[4], and FBgens=clidata()[6], \+ then the procedure finds previously computed generators of S over K wh ich are stored as clidata()[7]. These generators are then used to com pute the K-basis for S=Cl(B)f or S=fCl(B) depending whether the fourth argument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Clifford polynomials \+ which give a basis in Cl(B)f or fCl(B) (depending on what was the fou rth argument in the procedure);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 178 "(2) the second list is an ordered list of generators over f which give the elements in the first list. Ther e is a one-to-one correspodence between the elements of the two lists. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 " (3) the third element in the output is either 'left' or 'right' and it matches the fourth argument in the input to the procedure. That elem ent is to remind the user that the basis returned as the first list is for the left or right ideal respectively. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 334 "Typical use: dim:=2:B: =linalg[diag](1,-1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]: \n sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n \+ SBgens:=sbasis[2];FBgens:=fbasis[2];\n s pinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2865 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmon,climon,clipolyno m\},a3::list,a4::\{string,symbol\}) \nlocal flag,flag_left,Kdim,f,SBge ns,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \nglobal B,_shortcut_ in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1995-2008 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2007`;\n################################### ##########\nif not type(B,matrix) then \n error \"matrix must be ass igned to B\" \nend if;\nif not _prolevel then\n if not type(a2,'idem potent') then \n error \"second argument must be an idempotent\" \+ elif\n not member(a4,\{'left','right',\"left\",\"right\"\}) then \n \+ error \"the fourth argument must be 'left', or 'right'\"\n end \+ if;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens the n return [[f],[Id],a4] end if;\nif a4='left' or a4=\"left\" then flag_ left:=true else flag_left:=false end if;\ndata:=clidata():\nif _shortc ut_in_spinorKbasis then\n if eval(f)=eval(data[4]) and SBgens=dat a[5] and FBgens=data[6] then\n SBKgens:=data[7];\n SBKbasis: =[]:\n g:='g':\n if flag_left then SBKbasis:=[seq(cmulQ(g,f) ,g=SBKgens)]\n else SBKbasis:=[seq(cmulQ(f,g),g=SBKg ens)]\n end if; \n return [SBKbasis,SBKgens,a4];\n end if;\nend if; \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] \n else SB:=[seq(cmulQ(f,g ),g=SBgens)]\nend if;\nif Kdim=1 then return [SB,SBgens,a4] end if;\nm :=max(op(map(maxindex,SBgens)));\nposs:=cbasis(m);\nSBKgens:=[Id]:\ng: ='g':\nif flag_left then SB:=remove(member,SB,[seq(cmul(f,g),g=FBgens) ])\n else SB:=remove(member,SB,[seq(cmul(g,f),g=FBgens)]) \nend if;\nposs:=remove(member,poss,FBgens);\nfor g in poss while nops (SB)>0 do\n if flag_left then \n for i from 1 to Kdim do p[i] :=cmul(g,f,FBgens[i]) end do;\n else \n for i from 1 to Kdim \+ do p[i]:=cmul(FBgens[i],f,g) end do;\n end if; \n for i from 1 to Kdim do\n flag[1,i]:=member(p[i],SB): \n flag[2 ,i]:=member(-p[i],SB):\n end do;\n if Kdim=2 then \n if (flag[1,1] or flag[2,1]) and (flag[1,2] or flag[2,2]) then\n \+ SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n SBKgens:=[o p(SBKgens),g]\n end if:\n else\n if (flag[1,1] or flag[2 ,1]) and \n (flag[1,2] or flag[2,2]) and\n (flag[1,3] \+ or flag[2,3]) and\n (flag[1,4] or flag[2,4])\n then\n \+ SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[3],p[4],-p[4] ]):\n SBKgens:=[op(SBKgens),g]\n end if:\n end if;\n \+ if flag[1,1] then SBKbasis:=[op(SBKbasis),p[1]] else\n \+ SBKbasis:=[op(SBKbasis),-p[1]] \n end if;\n end do;\ng:= 'g':\nif flag_left then SBKbasis:=[seq(cmul(g,f),g=SBKgens)] else\n \+ SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend if;\nreturn [ SBKbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No . 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes \+ the square of a basis element u in a left or right minimal ideal Cl(B) f or fCl(B) entered as the first argument modulo a primitive idempote nt f entered as the second argument. The procedure doesn't check whe ther f is primitive or not. Thus, the procedure returns 1 or -1 depen ding whether cmul(u,u) = f or cmul(u,u) = -f. The procedure returns \+ 0 if u is a nilpotent element." }}{PARA 258 "" 0 "" {TEXT -1 115 "\nTh is procedure is needed to identify/verify squares of the basis element s in the field K of the spinor ideal S. \n" }}{PARA 258 "" 0 "" {TEXT -1 54 "Typical use: squaremodf((1/2)*(Id+e1),(1/2)*(Id+e1);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 784 "squaremodf:=proc(a1::\{clibasmon ,climon,clipolynom\},a2::idempotent) \nlocal p;global B;\noptions `Cop yright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2007`;\n##### ########################################\nif nargs<>2 then \n error \+ \"two arguments needed of type clibasmon, or climon, or clipolynom, an d 'idempotent'\" \nend if;\nif a1=a2 then return 1 elif\n not type(B ,matrix) then error \"matrix must be assigned to B\" \nend if;\np:=cmu l(a1,a1):\nif expand(p-a2)=0 then return 1 elif\n expand(p+a2)=0 the n return -1 elif\n (p=0 or type(a1,nilpotent)) then return 0 else \+ \n error \"either element %1 is not a basis element or it does \+ not belong to the spinor space Cl(Q)f (or fCl(Q))\",a1 \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48. Procedure " }{TEXT 338 8 "RHnumber" }{TEXT -1 76 " gives the Radon-Hurwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 505 "RHnumber:=proc(a1::integer)\noptions `Copyright (c) \+ 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 20, 2007`;\n################ #############################\nif member(a1,\{0,1,2\}) then return a1 \+ elif\n a1=3 then return 2 elif\n member(a1,\{4,5,6,7\}) then retur n 3 elif\n a1>=8 then return RHnumber(a1-8)+4 elif\n a1<0 then ret urn RHnumber(a1+8)-4 else\n error \"wrong value of the argument. See ?RHnumber for more help.\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 49. Procedure " }{TEXT 339 7 "clidata" }{TEXT -1 304 " returns a list containing basic information about the orthogonal Clifford algebra Cl(Q) of the given bilinear form B (assumed to have \+ been diagonalized). The procedure must be called with B, or with a si gnature of B given as a list [p,q], or simply as clidata() (currently \+ defined B will then be used)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "It returns a list with the following e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 187 "(a) the first entry is the string 'real', 'complex', or 'quat ernionic' depending whether the spinor representation of Cl(Q) is over the field K of the reals, complexes, or quaternions;\n" }}{PARA 258 "" 0 "" {TEXT -1 305 "(b) the second entry is the dimension of the spi nor representation over the field K;\n\n(c) the third entry is 'simple ' or 'semisimple' depending on the structure of the algebra;\n\n(d) th e fourth entry is a primitive idempotent f which may be used to gene rate a left or right minimal ideal in the algebra." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 "NOTE: the idempoten ts are stored here in an unevaluated form so that they could be easily recognized as Clifford products of simpler projection operators. The number of factors in these products is determined by the value of q - RHnumber(q-p).\n\n(e) the fifth entry is a list of basis monomials \+ ordered by grade which generate Cl(Q)f and fCl(Q).\n\n(f) the sixth en try is a list of basis monomials ordered by grade which give a basis f or K (this is in terms of these monomials that matrices representing C lifford polynomials will be written by the procedure 'spinorKrepr').\n " }}{PARA 258 "" 0 "" {TEXT -1 92 "(g) the seventh entry is a list of \+ basis monomials ordered by grade which generate S over K." }}{PARA 258 "" 0 "" {TEXT -1 139 "\nIf the procedure is called as 'clidata()' \+ then it returns information about the Clifford algebra of the currentl y defined bilinear form B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 81 "Typical use: clidata(); clidata([2,3]); clida ta(B);clidata(linalg[diag](1,1,1));\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 474 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2007`;\n########### ##################################\nif nargs=0 then a1:=`B` else a1:=a rgs end if:\nif not type(a1,\{list(nonnegint),matrix\}) then\n WARNI NG(\"to find out about Clifford algebra Cl_\{p,q\} try clidata([p,q]) \+ or enter ?clidata for more help\");\n return ('procname(args)')\nend if;\n" }}{PARA 258 "" 0 "" {TEXT -1 76 "This is a data file that is r ead in when needed by the procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" }{MPLTEXT 1 0 16601 ":=proc(a 1::\{list(nonnegint),matrix\})\nlocal SBgens,FBgens,SBKgens,p,q,l,ni,K ,dimoverK,dimoverR,numfact,struct,primidemp;\nglobal B;\noptions `Copy right (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`,remember;\ndescription `Last revised: December 20, 2007` ;\n#############################################\n#K = field of spinor repesentation, it is R, C, or H depending on [p,q]\n#dimoverK = dimen sion of spinor representation over the field K\n#dimoverR = dimension \+ of spinor representation over the reals R\n#numfact = number of idempo tent factors in any primitive idempotent\n#SBgens = basis monomials ge nerating Cl(Q)f and fCl(Q) over R\n#FBgens = basis monomials providing a basis for K\n#SBKgens = basis monomials generating Cl(Q)f and fCl(Q ) over K \n#p = number of +1 in the diagonal form Q of B\n#q = number \+ of -1 in the diagonal form Q of B\n#struct = structure of Cl(Q) is 'si mple' or 'semisimple'\n#primidemp = primitive idempotent f to generate Cl(B)f or fCl(B)\nif nargs=0 then\n###new line instead of >>>not assi gned(B)<<<\nif not type(B,matrix) then \n error \"matrix must be ass igned to B\" else\n return clidata(B)\nend if;\nend if; \nif type (args[1],list(nonnegint)) then p:=args[1][1]:q:=args[1][2]: \n elif \+ type(args[1],matrix) then \n p:=Bsignature(args)[1]; q:=Bsignat ure(args)[2] \n else \n error \"wrong argument types in 'clid ata'\" \n end if;\nif type(args[1],list(nonnegint)) and (p>9 or q>9) then\n error \"p and q must satisfy 0 <= p,q <= 9\" \nend if;\nl:=f loor((p+q)/2);ni:=2^(l-1);\nif member((p-q) mod 8,\{0,1,2\}) then \n \+ K:='real'; dimoverR:=2*ni; dimoverK:=2*ni; \nelif member((p-q) mod 8,\{3,7\}) then \n K:='complex'; dimoverR:=2*2*ni; dimoverK:=2*n i; else\n K:='quaternionic'; dimoverR:=4*ni; dimoverK:=ni \nend i f;\nnumfact:=q-RHnumber(q-p);\nif modp((p-q) = 1,4) then struct:='semi simple' \n else struct:='simple' \nend if;\nprimidemp:=table():SBgen s:=table():FBgens:=table():SBKgens:=table():\n######################## #>>>DATA<<<#################################\n#Real, simple (13 cases) \nprimidemp[[0,0]]:=Id; #real numbers\nSBgens[[0,0]]:=[Id];\nFBgens[[ 0,0]]:=[Id];\nSBKgens[[0,0]]:=SBgens[[0,0]];\n\nprimidemp[[1,1]]:=(1/2 )*(Id+e1we2);\nSBgens[[1,1]]:=[Id,e1];\nFBgens[[1,1]]:=[Id];\nSBKgens[ [1,1]]:=SBgens[[1,1]];\n\nprimidemp[[2,0]]:=(1/2)*(Id+e1);\nSBgens[[2, 0]]:=[Id,e2];\nFBgens[[2,0]]:=[Id];\nSBKgens[[2,0]]:=SBgens[[2,0]];\n \nprimidemp[[2,2]]:=\n''cmulQ''((1/2)*(Id+e1we3),(1/2)*(Id+e2we4));\nS Bgens[[2,2]]:=[Id,e1,e2,e1we2];\nFBgens[[2,2]]:=[Id];\nSBKgens[[2,2]]: =SBgens[[2,2]];\n\nprimidemp[[3,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*( Id+e3we4));\nSBgens[[3,1]]:=[Id,e2,e3,e2we3];\nFBgens[[3,1]]:=[Id];\nS BKgens[[3,1]]:=SBg