{VERSION 5 0 "IBM INTEL NT" "5.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 "Error" -1 8 1 {CSTYLE "" -1 -1 "Courier" 1 10 255 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 "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 "Helvetica" 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 28 "\nThis is clifford_M8_07 .mws\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "(Created: September 17, 2005) \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 322 "This is a listing (without examples) o f all procedures in a Maple package called 'CLIFFORD' (Version 8, Cop yright 1995-2005 by Rafal Ablamowicz, Tennessee Technological Univers ity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 8. User will know which version he/she is using by using the 'version()' func tion." }}{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 i n Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p1, p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is exp ected 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 i n 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 o f p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponent ial 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 foll owing 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\nRC (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 an d m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "reversion(p,K); ##revers ion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Cliffor d 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 301 "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 8. It is available on a server of the Department of Mathematics, Tennessee T echnological 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 o rder to create a Maple file 'Clifford.m' containing the 'CLIFFORD' pac kage, 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 1520 "version:= proc()\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\nprint(`+++++++++++++++++++++++++++++++++++++++++++`);\nprint(`CLIFF ORD - A Maple 8 Package for Clifford Algebras with \"Bigebra\"`); \npr int(`(Version 8 with environmental variables given by CLIFFORD_ENV())` );\nprint(`Last revised: September 17, 2005 (Source file: clifford_M8_ 07.mws)`);\nprint(`Copyright 1995-2005 by Rafal Ablamowicz (*) and Ber tfried Fauser ($)`);\nprint(``);\nprint(`(*) Department of Mathematics , Box 5054`);\nprint(` Tennessee Technological University, Cookevil le, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax: USA (931) 37 2-6353`);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://mat h.tntech.edu/rafal/Cliff8/`);\nprint(`($) Universit\"at Konstanz, Fach bereich Physik, Fach M678`);\nprint(` 78457 Konstanz, Germany`);\np rint(` Bertfried.Fauser@uni-konstanz.de`);\nprint(` http://kaluz a.physik.uni-konstanz.de/~fauser/`); \nprint(``);\nprint(`If you \+ are a Clifford algebra pro, assign 'true' to '_prolevel' and see`);\np rint(`how much faster your computations will be! But watch your syntax !`);\nprint(`Use 'useproduct' to change value of _default_Clifford_pro duct in Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmulNUM whe n B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_ENV() to see current values of environmental variables.`); \nprint(`++++++++++ ++This is CLIFFORD version 8++++++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_constan ts" }{TEXT -1 503 " allows user to specify any new symbolic constants, e.g., a, b, c, B, e.t.c, which are to be known to Maple. The origin ally known constants are stored in a global, non-protected variable 'c onstants' and must be saved separately, if needed. This procedure is \+ needed when sorting or collecting multivariate Clifford polynomials co ntaining 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 make 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 Maple con stants, then some procedures might yield error messages (although an a ttempt has been made to avoid this problem). Constants of length one a re automatically assumed to be Maple constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: specify_co nstants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have been ad ded for the Reader's convenience in the sequence of input variables as in the above example. These spaces are not needed or required by Mapl e." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 373 "specify_constants:=proc(a1::anything) global constants;\noptions \+ `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n #############################################\nconstants:=op(\{constan ts,args\});\nprintf(\"Maple now knows the following constant(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 " wr ites a canonical basis for a Clifford algebra Cl(B) over a vector spac e V endowed with a bilinear form B. The dimension of V is specified b y a Maple global variable 'dim' where 1 <= dim <= 9. This procedure c an be used with one or two arguments as, for example, in cbasis(4) or \+ cbasis(4, 2). In the first case, it returns a list of all basis eleme nts in the Clifford algebra Cl(4). In the second case, it returns a li st of basis elements in the 2-vector subspace of Cl(4). Below, 'Id' st ands for the algebra unit element and 'w' denotes wedge/exterior produ ct in the Clifford algebra. An option 'even' allows one to create a ba sis in the even subalgebra of the given Clifford algebra as in cbasis( 3, 'even'). In fact, 'even' can be replaced with any name which evalu ates to a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1877 "cbasis:= proc(a1::nonnegint,a2::\{string,symbol,nonnegint\})\nlocal i,k,X,XX,YY ,L,Leven,Lodd,bas,nxt,ind,start; global choose,e;\noptions `Copyright \+ (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`,remember;\ndescription `Last revised: September 17, 2005`;\n## ###########################################\nif a1>9 then \n error \+ \"first argument must be between 0 and 9 inclusive but received %1 ins tead\",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:=procname(a1):\n \+ Leven:=[Id]:Lodd:=[]:\n if nops(L) > 1 then\n for i from 2 to no ps(L) do\n if type(length(L[i]),odd) then Leven:=[op(Leven),L[i] ] else\n Lodd:=[op(Lodd),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 error \"secon d 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 from 0 to a1 do \n X[k]:=combinat[choose]([seq(i,i=1..a1)],k) \nend do;\nif not na rgs = 1 and not nargs = 2 then \n error \"one or two arguments are n eeded 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..no ps(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 i f ind=10 then \n bas:=e||0 else bas:=e||ind \n end if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if ind=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);\nprotect(op(YY)) ; #protect basis monomials\nreturn YY\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1str" }{TEXT -1 327 " finds all locations of the first string of length one in the sec ond string of length at least one. It returns a set of these positions . If the first string is not found then it returns \{0\}. This proced ure is primarily for internal use in 'type/clibasmon' and 'cliparse'. \+ \nTypical use: find1str(e,e1we2we3); find1str(w,e1we2);" }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 664 "find1str:=proc(a1::sym bol,a2::symbol) local ns,p,p1,ap,le2;\nglobal _prolevel;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`,remember;\ndescription `Last revised: September 17, 200 5`;\n#############################################\nle2:=length(a2):\n if _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:\nwhile 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 " check s user's input for correct spelling of basis monomials. When unable t o decide if the given input is correct, it tells the user to check spe lling or define the given string as a Maple constant. If the spelling \+ is correct, it returns true; if it is not correct, it returns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1,2]);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1181 "cliparse:=proc(a1::anything) loca l x,S1,S2,p,S;\nglobal _prolevel,_scalartypes;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif _prolevel then return true end if; \nif type(a1,_scalartypes) then return true end if;\np:=remove(type,a1 ,_scalartypes):S1:=\{op(p)\}:\nfor x in S1 do \n if type(x,_scalart ypes) or type(x,clibasmon) then S1:=S1 minus \{x\} end if;\nend do; \n S2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartypes) or type (x,clibasmon) then S2:=S2 minus \{x\} end if;\nend do;\nS:=remove(hast ype,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 minus \{x\} end if;\nend do;\nif S=\{\} then return true end if;\nS1:=select(type ,S,procedure):\nif S1 <> \{\} then\n error \"procedure name %1 that \+ has been found in input is not allowed as a symbolic coefficient\",op( S1)\nend if;\nif nops(S)=1 then \n error \"check spelling of %1 or d efine it as a constant or an alias\",op(S)\nelse \n error \"check sp elling of %1 or define them as constants or aliases\",op(S) \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Function " } {TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered Cliffo rd scalar with the scalar times the unit element 'Id'. It may also be \+ applied to matrices with Clifford algebra entries.\n\nTypical use: dis playid(e1+2*Pi);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 623 "displayid:=p roc(a1::\{array,matrix,algebraic\}) local KK,p;\noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\nKK:=proc() if type(args[1],cliscalar ) then return args[1]*Id \n elif hastype(args[1],clibasmon) \+ then return args[1] \n end if \nend proc:\nif type(a1,\{arra y,matrix\}) then return map(procname,a1) end if;\np:=expand(a1):\nif t ype(p,\{`*`,cliscalar,clibasmon,climon\}) then return KK(p) \nelif typ e(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\nend pro c:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " }{TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis elements in the given Clifford polynomial.\n\nNOTE: 'cliterms' also works with terms \+ of type cliprod and it finds correctly terms involving such expression s. \n\nTypical use: cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1021 "cliterms:= proc(a1::anything) local S1,S2,S3,x,p,Cl iplusflag;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nCli plusflag:=assigned(Cliplus):\nif hastype(a1,cliprod) and not Cliplusfl ag and _warnings_flag then \n WARNING(`argument to 'cliterms' contai ns type cliprod. Load 'Cliplus' to extend functionality of CLIFFORD. \+ Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,cliprod\}) \+ then return \{a1\} end if;\np:=displayid(simplify(a1)):\nif hastype(p, cliprod) then \n S1:=remove(type,\{op(p)\},cliscalar);\n S2:=selec t(hastype,S1,\{clibasmon,climon,cliprod\});\n S3:=\{\}:\n while no t S2=\{\} do\n S3:=S3 union select(type,S2,\{clibasmon,cliprod \});\n S2:=select(hastype,map(op,remove(type,S2,\{clibasmon,cl iprod\})),\{clibasmon,cliprod\});\n end do;\nreturn S3\nend if;\nx:= 'x':\nS1:=remove(type,\{op(p)\},cliscalar);\nreturn \{seq(select(hasty pe,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 respect \+ to Clifford scalars in the first two arguments. The first two argument s are of the type clipolynom, i.e., Clifford polynomials. The third ar gument is a string or a procedure.\nIt can handle terms involving elem ents of type cliprod.\n\nTypical use: clibilinear(e1+2*e2we3,Id+2*e2+e 3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 924 "clibilinear:=proc(a1,a2 ,a3::\{procedure,name,symbol,matrix,array\}) \n local tail ,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1,co2;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1):\np2:=clicollect(a2):\n tail:= 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 list wi ll be huge for long polynomials\n res:=0:\n for x in S12 do \n cl i1:=select(type,x[1],\{cliprod,clibasmon\}):\n cli2:=select(type,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 r eturn res;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 9. Proce dure " }{TEXT 289 9 "clilinear" }{TEXT -1 336 " makes any procedure K \+ specified as the second argument linear with respect to Clifford scala rs (elements of type cliscalar). It can now distribute over Clifford p olynomials with elements of `type/cliprod`. Any additional parameters \+ are passed on to the procedure entered as the second argument.\nTypica l use: clilinear(a*e1+2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 623 "clilinear:=proc(a1::\{symbol,cliscalar,clibasmon,climon,clipolyno m\},a2::\{name,procedure\}) \nlocal tail,p1,S1,res,x,cli1,co1;\noption s `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: September 17, 2005`; \n#############################################\ntail:=args[3..-1];\ni f type(a1,cliscalar) then return a1*a2(Id,tail) end if;\np1:=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,\{clibasmon,cliprod\} ):\n co1:=coeff(x,cli1); \nres:=res+co1*a2(cli1,tail):\nend do:\nre turn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 10. Proced ure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the given multivari ate Clifford polynomial with respect to the Clifford indetereminates f ound in the expression via the procedure 'cliterms'. It puts scalar co efficients of the type cliscalar in front of the Clifford basis monomi als. It may also be applied to matrices with entries in a Clifford alg ebra. " }}{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 441 "clisort:=proc(p::algebraic) local L,N;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: September 17, 2005`;\n#### #########################################\nif type(p,matrix) then retu rn map(procname,p) end if;\nif type(eval(p),\{climon,clipolynom\}) or \+ hastype(eval(p),cliprod) then\n L:=cliterms(expand(displayid(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 "clicollect" } {TEXT -1 382 " reorders monomial terms in standard order and then coll ects them in a multivariate Clifford polynomial. It may also be applie d to matrices with entries in a Clifford algebra. It will simplify 6 + 7*Id to 13*Id. It collects now terms of type cliprod, if present.\n \nNOTE: 'clicollect' also works with terms of type cliprod and it coll ects correctly terms involving such expressions. " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: clicolle ct(e1 + a*e1 - e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 498 "clic ollect:=proc(a1::algebraic) local p,L; \noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\nif type(a1,matrix) then return map(procname, a1) end if;\np:=expand(a1):\nif type(p,cliscalar) then return p*Id\nel if type(p,clipolynom) then \n L:=cliterms(p);\n return map(sim plify,collect(displayid(p),L,'distributed'))\nelse return args[1] \nen d if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. The proce dure " }{TEXT 292 3 "ord" }{TEXT -1 319 " returns an ordered list of p ositions in a monomial, e.g., e1we2, where vector indices are found. Then, nops(ord(e1we2)) can be used to find the order of the monomial . Note that for consistency we have ord(Id) = ord(numeric) = ord(nume ric*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 388 "ord:=proc(a1) loca l v,k;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Septem ber 17, 2005`;\n#############################################\nif type (a1,cliscalar) then return [] end if;\nv:=select(type,a1,clibasmon);\n if v = Id then return [] end if;\nk:='k':\nreturn [seq(2+3*k,k=0..((le ngth(v)+1)/3-1))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 1 3. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes one s ymbol 'ei' from the location specified by the procedure 'ord'. \n(NOTE : procedure 'ord' specifies location of the index 'i' in 'ei'.) This \+ procedure is primarily for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 580 "cliremove:=proc(p::posint,s ::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,re member;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nif not _prolevel then\n if s=Id t hen error \"second argument must be Grassmann basis monomial of rank > = 1\" end if;\nend if;\nS2:=substring(s,(p+2)..length(s));\nS1:=substr ing(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n elif S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if;\n end 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 731 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 2, 200 2`;\n#############################################\nif type(a1,cliscal ar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n ty pe(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 1077 "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-2005 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: September 17, 2005`;\n##################################### ########\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) \+ end 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 814 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif type(a1,cliscalar) or a1=Id then r eturn 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 sy mbinds = \{\} then\n if inds=\{\} then return 0 else return max(o p(inds)) end if;\n else\n error \"cannot determine maximum inde x because input contains symbolic index or indices\"\n end if;\n en d if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining \+ a useful function " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which find s the maximum grade in the given Clifford polynomial. It returns 0 fo r a Clifford scalar (an element of type cliscalar).\n\nTypical use: ma xgrade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 401 "ma xgrade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\n options `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: September 17, \+ 2005`;\n#############################################\nif type(eval(a1 ),cliscalar) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nre turn 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 a nd 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 \+ accept 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 2318 "LC:=proc(x1:: \{cliscalar,clibasmon,climon,clipolynom\},\n y1::\{cliscalar,c libasmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,l name,res,coB,nameB,x,y;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif nargs=2 then\n coB:=1:\n nam eB:=`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, symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3]) \},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric)); \n lname:=args[3]:\n else \n error \"wrong type of thir d argument in LC. See ?LC for more help.\" \n end if;\nelse\n err or \"two or three arguments expected in LC. See ?LC for more help.\"\n end 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:-ext ract(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]]*_CLIEN V[_QDEF_PREFACTOR]^(j-1)*\n makeclibasmon([op (subs(lst2[j]=NULL,lst2))]),j=1..N2));\n return reorder(res) \+ \n else\n res:=\nprocname(makeclibasmon(lst1[1..-2]),procnam e(makeclibasmon([lst1[-1]]),y,lname),lname);\n return reorder( res)\n end if;\n elif type(y,climon) then\n term,cf:=se lectremove(type,y,clibasmon);\n return expand(cf*procname(x,te rm,lname))\n elif type(y,clipolynom) then\n return add(pr ocname(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, climon) then\n term,cf:=selectremove(type,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 x*reorder(y)\n end if;\nerror \"Got input %1 and % 2 but LC can only process constants and Clifford numbers\",x,y;\nend p roc:\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 lef t contraction in the orthogonal Clifford algebra Cl(Q) of the quadrati c 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 mu ltiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Gre noble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLC Q(e1 + 2*e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1796 "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 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\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 2281 "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-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif nargs=2 then\n coB:=1:\n nameB: =`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{nam e,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3]; \n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,sy mbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\} ,numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third \+ argument 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.\"\nen d if;\n################################\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n lst1:=Clifford:-extract(x,'intege rs');\n lst2:=Clifford:-extract(y,'integers');\n N1:=nops(ls t1);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(c oB*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(pro cname(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 1801 "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-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ########## \nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lnam e:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix, array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=a rgs[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 554 "gradeinv:=proc(a1::\{matrix,cliscalar,clibas mon,climon,clipolynom\}) global _CLIENV;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif type(a1,matrix) then return map(procnam e,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR] :=-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFAC TOR])^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 an y number of Clifford polynomials. The infix form of this associative \+ multiplication is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, wedge multiplication may be applie d to matrices with entries in a Clifford algebra or in an exterior alg ebra.\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 i nclude terms of grade higher than the dimension of the vector space in case symbolic indices are used. \n\nThe default value of this global \+ variable is 9 and it it set by the initialization file when Clifford i s loaded.\n\nWhen the procedure is invoked, it checks whether the bili near 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 wa rning message is issued by the procedure and the value of dim_V is red uced. If the size of B is larger than the current value of dim_V, no w arning message is issued and the value of dim_V is increased to linal g[coldim](B).\n\nThe warning message can be supressed by addign 'false ' to a global parameter _warnings_flag whose default value is set to t rue by the Clifford initialization file." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e 4 + e1we2); wedge(e2 + 2*e1, e3, e4); (e2 + 2*e1) &w (e3 + 2*); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3063 "wedge:=proc(a1::\{cliscalar,cli basmon,climon,clipolynom\},\n a2::\{cliscalar,clibasmon,cli mon,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12,maxindex flag,expr,maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Copyright ( c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nkk:='kk':\nif member(0,[args]) then return 0 \nelif \n remove(type,\{args\},cliscalar)=\{\} then return product(args[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then\n if linalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < dim_V th en\n dim_V:=linalg[coldim](B);\n if _warnings_flag the n\nprintf(\"Warning, since B has been (re-)assigned, value of dim_V ha s been reduced by 'wedge' to %g\\n\",dim_V);\n end if;\n eli f 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 po sitive integer between 1 and 9, inclusive, but current value of dim_V \+ is %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 882 "permsign:=proc(L::li st) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `Copyr ight (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: September 17, 2005`;\n###### #######################################\nL1:=L:\nN:=nops(L1):\nif N=1 \+ then return 1 end if:\n################## new\nn12,s12:=selectremove(m ember,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 2255 "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-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n description `Last \+ revised: September 17, 2005`;\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(c libilinear(a12[1],a12[2],procname,lname))\nend if: \n################# ##################################################################### \n### old name cmul2B: this procedure computes recursively Clifford pr oduct of any two #\n### cliscalars, clibasmons, climons, and clipolyno ms in Clifford algebras Cl(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 a2=`Id` then return a1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-extra ct(a1,'integers');\n N:=nops(L):\n ################\n ##### The fol lowing 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 typ e(lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op (select(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op (lname)\},name));\n else\n error \"third argument is of unexpecte d type\"\n end if;\n ################\n if N=0 then return coeff(a1 ,Id)*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.. nops(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:=substring (a1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1,p2,p rocname,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 "cmulRS" }{TEXT 311 114 " computes Clifford product using Rota-Stein c liffordization technique. It can accept now -K in place of the name.\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4904 "cmulRS:=proc(a1,a2,lname)\nlo cal max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n p List2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a12;\nop tions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: September 17, 20 05`;\n#############################################\n###This is additi onal code for Maple 6 version:\n###################################### #######\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clie val,[a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12[2], procname,lname))\nend if: \n########################################## ################################################\n### This procedure c omputes Clifford product of any two cliscalars, clibasmons, climons, # \n### and clipolynoms in Clifford algebras Cl(lname) using Rota-Sten c liffordization #\n### Procedure cmulRS modified by Rafal to acce pt -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,arr ay,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric)); \n nameB:=op(select(type,\{op(lname)\},name));\n else\n error \"third argument is of unexpected type\"\n end if;\n ############## ##\n L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Cl ifford:-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \n \+ return 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..N 2)))\n end if;\n if N2=1 then \n return reorder(simplify(makeclib asmon([op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*mak eclibasmon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; g enerate a power set of 1..N, option remember\n genPS:=proc(N)\n lo cal a,i,plst;\n option remember; \n a:=[seq(i,i=1..N)]:\n pls t:=[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 f un1:=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(su bs(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 fo r L2:\n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n fun 2(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( pList2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pList 2[i][m]-m,m=1..nops(pList2[i]))),i=1..PN2-1)];\n#### cup tangle of the rota-stein sausage tangle\n cup:=proc(lst1,lst2,coB,nameB)\n loca l 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[l st1[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 proc:\n############################################################## ##################### \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms wh ich are potentially non zero in the cup(..) tangle #\n################ ###################################################################\n \+ max_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n po s1:=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) d o # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N2!/((N 2-i)!*i!);\n for n from 1 to F1 do\n for m from 1 to F2 do \n \+ res:=res+\n pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup(map(fu n1,pList1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n \+ makeclibasmon([op(map(fun1,pList1[pos1+n])),op(map(fun2,pList2[PN2-pos 2-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 cm ulRS 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 559 "cmulgen:=proc() global _default_ Clifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: September 17, 2005`;\n############################ #################\nif _default_Clifford_product <> 'cmulgen' then\n \+ return _default_Clifford_product(args)\nelse \n if _warnings_flag th en\n WARNING(\"to assign Clifford product, execute 'useproduct' with argument 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 1380 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\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]) the n return 0 end if;\n if nargs <=1 then return args end if;\n if narg s = 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 2306 "`&m`:=proc() local NP,ARGS,coB,nameB,lname ,decindex,flagdec;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: September 17, 2005`;\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 fla gdec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args] ;\n if type(lname,`&*`(numeric,name)) then\n coB:=op(selec t(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(l name)\},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 \+ type([args],listlist) then\n if type(op(args),function) then\n \+ ARGS:=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 1259 "u seproduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_C lifford_product; #,cmulgen;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: September 17, 2005`;\n################################# ############\n######################################################## ###########\n###This procedure uses global variable _default_Clifford_ product #\n########################################################## ######### \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defi ned\}) then \n WARNING(\"expecting one of the following Clifford pr oducts: cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\ni f 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 1425 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2005 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n###################################### #######\n####################################\nif type(op(procname),pr ocedure) then\n lname:=`B`;\nelse\n lname:=op(procname);\nend if ;\n####################################\nif member(0,[args]) then retu rn 0 end if;\n####################################\nSxy:=map(op,map(cl iterms,\{args\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers')) ;\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n retur n cmul[lname](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when bo th x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:= linalg[coldim](evalm(lname)):\n if m>N then \n error \"input co ntains 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 377 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\na1:=simplify( a):\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1): \nreturn coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes the k-vector part of the given Clifford polynomial u where k is a non negative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. \+ When 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 593 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 19, 2004`;\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,`+`) then 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 "c exp" }{TEXT -1 236 " computes Clifford exponential of a Clifford numbe r 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(e1we 2*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 1361 "c exp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::nonn egint) \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: September 17, 2005`;\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:=ar gs[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{n ame,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args [3])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeri c));\n lname:=args[3]:\n else \n error \"wrong type of \+ third argument in cexp. See ?cexp for more help.\" \n end if;\nelse \n error \"two or three arguments expected in cexp. See ?cexp for mo re help.\"\nend if;\n################################\nk:='k':\nif typ e(p,\{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\ni f evalb(vectorpart(p,0)=p) then \n pp:=scalarpart(p);\n return ((a dd(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 ans 1:=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;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure \+ " }{TEXT 327 5 "cexpQ" }{TEXT -1 257 " computes Clifford exponential o f 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 procedur e returns 'Id'. This procedure can also accept an optional argument s uch 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 1375 "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-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif nargs=2 then\n coB:=1:\n nameB: =`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{nam e,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3]; \n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,sy mbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\} ,numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third \+ argument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n \+ error \"two or three arguments expected in cexpQ. See ?cexpQ for more help.\"\nend if;\n################################\nk:='k':\nif type( p,\{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\nif \+ evalb(vectorpart(p,0)=p) then \n pp:=scalarpart(p);\n return add(p p^k/k!,k=0..N)*Id \nend if;\npp:=clisort(displayid(p)):\nif N=0 then r eturn Id \n elif N=1 then return Id+pp; \n else \n ans1: =cexpQ(pp,N-1,lname);\n ans2:=cexpQ(pp,N-2,lname);\n a ns:=ans1+cmulQ[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return an s;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Pro cedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponen tial of a Clifford number u up to the order specified by the second a rgument which is a nonnegative integer n. It returns 'Id' when n = 0. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "Typical use: wexp(e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 612 "wexp:= proc(p::\{cliscalar,clibasmon,climon,clipolyn om\},N::nonnegative) \nlocal pp,power,cu,i;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\n if nargs<>2 then error \"two parameter s are needed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then retu rn 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. Proced ure " }{TEXT 329 9 "reversion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in its argument and it is always a Clifford 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 gradation of the exterior algebra. This procedure can now take a thi rd optional 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 2641 "reversion :=proc(a1::\{cliscalar,clibasmon,climon,clipolynom,matrix\}) \n \+ local ind,expr,wtp,ptw,lname,flagindexed;\n global _scal artypes,B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nif \+ hastype([args[1]],cliprod) then \n error \"in order to handle 'type/ cliprod', 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 :\nelif nargs=2 and type(args[2],\{symbol,name,array,matrix,`&*`(algeb raic,name)\}) 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 Clif ford products: wedge ->> Clifford product\n########################### #\nwtp:=proc(a1,lname) local ind,i,arg,rdmon,eq1,ans; global _scalarty pes; \nif type(a1,\{`+`,`*`\}) then return (map(wtp,a1,lname)) \n \+ elif type(a1,_scalartypes) then return a1\n elif type(a1,symbol) and SearchText(w,a1)=0 then return a1\n elif type(a1,symbol) and not me mber(length(a1),\{5,8,11,14,17,20,23,26\}) \n then return a1 \n end if;\nrdmon:=reorder(a1):\nind:=Clifford:-extract(a1,'integers'):\n i:='i':\narg:=[seq(cat(e,op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(ar g))=simplify(eval(cmul[lname](op(arg))));\nif a1=rdmon then ans:=simpl ify(solve(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 function that converts Clifford products to wedge: Clifford products \+ ->> wedge\n############################\nptw:=proc(a1,lname) local i,a rg,revarg; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then return \+ (map(ptw,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,sym bol) and not member(length(a1),\{2,4,6,8,10,12,14,16,18\})\n th en return 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(a rg)-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( displayid(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 l inear in its argument. Note that 'conjugation' is defined as a compos ition of 'reversion' and 'gradeinv'. Hence, it does not preserve the \+ multivector gradation when the antisymmetric part of B is non-zero. I t can now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjuga tion(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 825 "conjugation:=proc(a1::algebraic) local lname;gl obal B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Septe mber 17, 2005`;\n#############################################\nif nar gs=1 then\n lname:=`B`;\nelif nargs=2 and type(args[2],\n \{sym bol,name,array,matrix,`&*`(numeric,\{symbol,name,array,matrix\})\}) th en\n lname:=args[2];\nelse error \"only one or two arguments are ex pected\"\nend if;\n###########################\nif type(a1,matrix) the n return map(procname,a1,lname) elif\n type(a1,cliscalar) then retur n a1 elif\n type(a1,\{clibasmon,climon,clipolynom\}) then\n r eturn eval(gradeinv(reversion(a1,lname)))\nelse \n error \"wrong inp ut type: input must be of type cliscalar, clibasmon, climon, clipolyno m, or 'matrix'\" \nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c _conjug" }{TEXT -1 72 " calculates complex conjugate in a complexified Clifford 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 Clif ford algebra and `I` is the imaginary unit, i.e., I = sqrt(-1). This p rocedure 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 699 "c_conjug:=pro c(a1::algebraic) local ba,co,terms,t,i;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\nif type(a1,matrix) then return map(procname, a1) elif\n type(a1,cliscalar) then return conjugate(a1) elif\n typ e(a1,\{clibasmon,climon,clipolynom\}) then\n t:='t':\n b a:=cliterms(a1);\n co:=[coeffs(a1,ba,'t')];\n terms:=[t] ;i:='i':\n return clisort(add(conjugate(co[i])*terms[i],i=1..no ps(co)))\n else \nerror \"wrong input type: input must be of type cl iscalar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if;\nend p roc:\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 the Clifford algebra Cl(B) in the left- or right-regular represent ation, or under Lie or automorphism action with respect to an ordered \+ basis specified by the user. The element p is entered as the first ar gument and the basis in the form of a list is specified as the second \+ argument, e.g., buildm(u, basis). It is also possible to specify opti ons 'left', 'right', 'Lie', 'auto', 'false, and 'true'. For example, o ne can find the left-regular representation of the algebra on itself o r, when Cl(B) is simple and isomorphic to a ring of real matrices, one can find matrices representing Clifford polynomials in a real basis o f a minimal ideal. However, there are new procedures below specifical ly designed 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\n buildm(e1, [Id, e1, e2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'righ t'); 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 2969 "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-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\n#############################################\nflag:=tru e:\nif nargs=2 then a33:='left' end if;\nif nargs=3 then \n if membe r(args[3],\{'true','false'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left ','right','Lie','auto'\}) \n the n a33:=args[3]\n else error \"third optional argument must be 'left' , 'right', 'Lie', 'auto', 'true', 'false'\"\n end if; \nend if;\nif \+ nargs=4 then\n if member(args[3],\{'left','right','Lie','auto'\}) an d 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 1479 "findbasis:=proc(a1,a2) local L,clibasis,M ,i,m,r,v,S; \nglobal _prolevel;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nif evalb(_prolevel=false) then\n if nargs=1 and no t (type(a1,list(\{clibasmon,climon,clipolynom\})) or \n \+ type(a1,set(\{clibasmon,climon,clipolynom\}))) then\nerror \"a rgument of type list/set(\{clibasmon,climon, or clipolynom\}) was expe cted\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,cli mon,clipolynom\})) or \n type(a1, set(\{clibasmon,climon,cl ipolynom\}))) and \n (type(a2,list(clibasmon)) or type(a2,se t(clibasmon)))) or nargs>2 then\nerror \"arguments of type list/set(\{ clibasmon,climon,clipolynom\}) and list/set(clibasmon) were expected\" \nend if;\nend if;\nif nops(a1)=1 then return a1 end if;\n#L:=sort(ma p(displayid,convert(a1,list)),bygrade):\nL:=map(displayid,convert(a1,l ist)): ####NO SORT\nif nargs=2 then clibasis:=sort(convert(a2,list),by grade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),l ist),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[ rank](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 \+ then 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 2248 "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-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: September 17, 2005`;\n######################################### ####\nif not type(B,diagmatrix) then \n error \"bilinear form B has \+ not been assigned a matrix or is not diagonal\" \nend if; \nif not _pr olevel then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) \+ then\n error \"first argument must of type list(\{clibasmon,c limon,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 4634 "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-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September \+ 17, 2005`;\n#############################################\n#### Local \+ procedure 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));\ni f type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n \+ clibas:=remove(member,clibas,gens):\n cli bas:=[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]) \+ do\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),\{Kbas is[3],-Kbasis[3]\}) then\n if member(cmul(z,f),\{Kbasis[4], -Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') t hen 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') t hen \n error \"second argument must be a primitive idempotent\"\n end if;\nend if;\n##############################################\nS B:=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n######### #####################################\nif not member(f,SB) then \n e rror \"idempotent entered %1 is not a member of the first list\",f \ne nd 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; \nif side='right' then flag3:=true else flag3:=false end if;\ndata:=cl idata():\nfield:=data[1]:\nif field = 'real' then return [[f],[Id]] \n elif 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 Kgen s:=data[6];\nif flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(K gens))]\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 \+ shortcut can't be used when field = 'complex'\n####################### ##########################################\nKdim:=2:\nKbasis:=[f]:Kgen s:=[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,gen s[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' then \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:=[ op(SB)];\n Kgens:=[op(gens)];\n \+ return [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) the n\n if _shortcut_in_Kfield then\n f_from_data:=e val(eval(data[4])):\n fg:=gradeinv(f): \n i f member(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif f lag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2 ..nops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\ne nd 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 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(K basis),SB[i]];\n Kgens:=[op(Kgens),gens[i]] \+ \n end if;\n end if:\nend do;\n########################## ##\n ijk:=T4(Kbasis);\n############################\n Kgens:=[ Id,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, Kgens]\nelse error \"wrong name of the field. See ?Kfield for more hel p.\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. Procedure " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spin or 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 t o whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respective ly (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 ord ered list SBgens containing generators of a real basis in a minimal id eal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was left or \+ right). These generators are found by the procedure 'minimalideal' an d are returned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the prim itive 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 t he field K; these generators are returned as a second list by the proc edure 'Kfield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 143 "The fourth argument is either 'left' or 'right' depend ing whether we deal with the left minimal ideal Cl(B)f or the right mi nimal 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 res pectively 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 \+ which are stored as clidata()[7]. These generators are then used to c ompute the K-basis for S=Cl(B)f or S=fCl(B) depending whether the four th argument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three \+ elements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Clifford polyno mials which give a basis in Cl(B)f or fCl(B) (depending on what was t he fourth 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. \+ There is a one-to-one correspodence between the elements of the two l ists." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 "(3) the third element in the output is either 'left' or 'right' a nd it matches the fourth argument in the input to the procedure. That element is to remind the user that the basis returned as the first li st 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 \+ spinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2866 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmon,climo n,clipolynom\},a3::list,a4::\{string,symbol\}) \nlocal flag,flag_left, Kdim,f,SBgens,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \nglobal B ,_shortcut_in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1995-200 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\n####################### ######################\nif not type(B,matrix) then \n error \"matrix must be assigned to B\" \nend if;\nif not _prolevel then\n if not t ype(a2,'idempotent') then \n error \"second argument must be an i dempotent\" 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 SBgen s=FBgens then 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 _shortcut_in_spinorKbasis then\n if eval(f)=eval(data[4]) a nd SBgens=data[5] and FBgens=data[6] then\n SBKgens:=data[7];\n \+ SBKbasis:=[]:\n g:='g':\n if flag_left then SBKbasis:=[s eq(cmulQ(g,f),g=SBKgens)]\n else SBKbasis:=[seq(cmul Q(f,g),g=SBKgens)]\n end if; \n return [SBKbasis,SBKgens, a4];\n end if;\nend if; \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif f lag_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,a 4] end if;\nm:=max(op(map(maxindex,SBgens)));\nposs:=cbasis(m);\nSBKge ns:=[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 pos s 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 fro m 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]) the n\n SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n \+ SBKgens:=[op(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 i f;\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 mini mal ideal Cl(B)f or fCl(B) entered as the first argument modulo a pri mitive idempotent f entered as the second argument. The procedure do esn't check whether f is primitive or not. Thus, the procedure return s 1 or -1 depending whether cmul(u,u) = f or cmul(u,u) = -f. The pro cedure returns 0 if u is a nilpotent element." }}{PARA 258 "" 0 "" {TEXT -1 115 "\nThis procedure is needed to identify/verify squares of the basis elements 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 785 "squaremodf:=pr oc(a1::\{clibasmon,climon,clipolynom\},a2::idempotent) \nlocal p;globa l B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\n#############################################\nif nargs< >2 then \n error \"two arguments needed of type clibasmon, or climon , or clipolynom, and '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:=cmul(a1,a1):\nif expand(p-a2)=0 then return 1 elif\n \+ expand(p+a2)=0 then return -1 elif\n (p=0 or type(a1,nilpotent)) t hen 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-H urwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 506 "RHnumber:=proc(a1::integer)\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\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 return 3 elif\n a1>=8 then return RHnumber(a1-8)+4 eli f\n a1<0 then return RHnumber(a1+8)-4 else\n error \"wrong value o f 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 a bout the orthogonal Clifford algebra Cl(Q) of the given bilinear form \+ B (assumed to have been diagonalized). The procedure must be called w ith B, or with a signature of B given as a list [p,q], or simply as cl idata() (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 elements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 187 "(a) the first entry is the string 'real', ' complex', or 'quaternionic' depending whether the spinor representatio n of Cl(Q) is over the field K of the reals, complexes, or quaternion s;\n" }}{PARA 258 "" 0 "" {TEXT -1 305 "(b) the second entry is the di mension of the spinor representation over the field K;\n\n(c) the thir d entry is 'simple' or 'semisimple' depending on the structure of the \+ algebra;\n\n(d) the fourth entry is a primitive idempotent f which m ay be used to generate a left or right minimal ideal in the algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 " NOTE: the idempotents are stored here in an unevaluated form so that t hey could be easily recognized as Clifford products of simpler project ion 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 entry is a list of basis monomials ordered by grade \+ which give a basis for K (this is in terms of these monomials that mat rices representing Clifford polynomials will be written by the procedu re '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 calle d as 'clidata()' then it returns information about the Clifford algebr a of the currently defined bilinear form B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 81 "Typical use: clidata(); clidata([2,3]); clidata(B);clidata(linalg[diag](1,1,1));\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 475 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\nif nargs=0 then a1:=`B` else a1:=args end if:\nif not type(a1,\{list(nonnegint), matrix\}) then\n WARNING(\"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 read in when needed by the procedure 'clidata'. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" } {MPLTEXT 1 0 16602 ":=proc(a1::\{list(nonnegint),matrix\})\nlocal SBge ns,FBgens,SBKgens,p,q,l,ni,K,dimoverK,dimoverR,numfact,struct,primidem p;\nglobal B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`,remember;\ndescription `Last revised: September 17, 2005`;\n###################################### #######\n#K = field of spinor repesentation, it is R, C, or H dependin g on [p,q]\n#dimoverK = dimension of spinor representation over the fi eld K\n#dimoverR = dimension of spinor representation over the reals R \n#numfact = number of idempotent factors in any primitive idempotent \n#SBgens = basis monomials generating Cl(Q)f and fCl(Q) over R\n#FBge ns = basis monomials providing a basis for K\n#SBKgens = basis monomia ls generating Cl(Q)f and fCl(Q) over K \n#p = number of +1 in the diag onal form Q of B\n#q = number of -1 in the diagonal form Q of B\n#stru ct = structure of Cl(Q) is 'simple' or 'semisimple'\n#primidemp = prim itive idempotent f to generate Cl(B)f or fCl(B)\nif nargs=0 then\n###n ew line instead of >>>not assigned(B)<<<\nif not type(B,matrix) then \+ \n error \"matrix must be assigned 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:=Bsignature(args)[2] \n else \n error \+ \"wrong argument types in 'clidata'\" \n end if;\nif type(args[1],li st(nonnegint)) and (p>9 or q>9) then\n error \"p and q must satisfy \+ 0 <= p,q <= 9\" \nend if;\nl:=floor((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*ni; else\n K:='quaternionic'; dimov erR:=4*ni; dimoverK:=ni \nend if;\nnumfact:=q-RHnumber(q-p);\nif modp( (p-q) = 1,4) then struct:='semisimple' \n else struct:='simple' \nen d if;\nprimidemp:=table():SBgens:=table():FBgens:=table():SBKgens:=tab le():\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];\nS BKgens[[2,0]]:=SBgens[[2,0]];\n\nprimidemp[[2,2]]:=\n''cmulQ''((1/2)*( Id+e1we3),(1/2)*(Id+e2we4));\nSBgens[[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,e 2we3];\nFBgens[[3,1]]:=[Id];\nSBKgens[[3,1]]:=SBgens[[3,1]];\n\nprimid emp[[0,6]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)* (Id+e1we4we6));