{VERSION 6 0 "IBM INTEL NT" "6.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" 0 21 "" 0 1 0 0 0 1 0 0 0 0 2 0 0 0 0 1 }{CSTYLE "" -1 256 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 257 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 258 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 259 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 260 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 261 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 262 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 263 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 264 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 265 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 266 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 267 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 268 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 269 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 270 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 271 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 272 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 273 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 274 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 275 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 276 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 277 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 278 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 279 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 280 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 281 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 282 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 283 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 284 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 285 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 286 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 287 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 288 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 289 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 290 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 291 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 292 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 293 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 294 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 295 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 296 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 297 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 298 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 299 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 300 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 301 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 302 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 303 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 304 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 305 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 306 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 307 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 308 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 309 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 310 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 311 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 312 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 313 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 314 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 315 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 316 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 317 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 318 "Helvetica" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 319 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 320 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 321 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 322 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 323 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 324 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 325 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 326 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 327 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 328 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 329 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 330 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 331 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 332 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 333 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 334 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 335 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 336 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 337 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 338 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 339 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 340 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 341 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 342 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 343 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 344 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 345 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 346 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 347 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 348 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 349 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 350 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 351 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 352 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 353 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 354 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 355 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 356 "" 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 357 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 358 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 359 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 360 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 361 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 362 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 363 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 364 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 365 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 366 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 367 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 368 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 369 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 370 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 371 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 372 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 373 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 374 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 375 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 376 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 377 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 378 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 379 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 380 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 381 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 382 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 383 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 384 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 385 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 386 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 387 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 388 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 389 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 390 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 391 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 392 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 393 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 394 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 395 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 396 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 397 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 398 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 399 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 400 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 401 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 402 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 403 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 404 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 405 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 406 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 407 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 408 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 409 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 410 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 411 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 412 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 413 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 414 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 415 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 416 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 417 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 418 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 419 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 420 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 421 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 422 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 423 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 424 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 425 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 426 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 427 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 428 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 429 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 430 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 431 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 432 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 433 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 434 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 435 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 436 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 437 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 438 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 439 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 440 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 441 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 442 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 443 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 444 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 445 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 446 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 447 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 448 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 449 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 450 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 451 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 452 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 453 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 454 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 455 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 456 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 457 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 458 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 459 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 460 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 461 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 462 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 463 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 464 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 465 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 466 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 467 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 469 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 470 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 471 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 472 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 473 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 474 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 475 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 476 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 477 "" 1 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 478 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 479 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "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 "Norma l" -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_M9_05 .mws\n" }}{PARA 258 "" 0 "" {TEXT -1 62 "(Created: October 9, 2002)\n( Last revised: September 17, 2005)\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "################################################################ #############\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR TH E CLIFFORD, BIGEBRA, Cliplus, Octonion, GTP #\n#PACKAGES TO THE EX TENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE #\n# PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IM PLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ME RCHANTABILITY #\n#AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE R ISK AS TO THE QUALITY #\n#AND PERFORMANCE OF THE PROGRAM IS WITH YO U. SHOULD THE PROGRAM PROVE #\n#DEFECTIVE, YOU ASSUME THE COST O F 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) of all procedures in a Maple package \+ called 'CLIFFORD' (Version 8, Copyright 1995-2005 by Rafal Ablamowic z, Tennessee Technological University), and Bertfried Fauser, Univers it\"at Konstanz, for Maple 8. User will know which version he/she is u sing by using the 'version()' function." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use in dex 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); ##Cli fford product of p1,p2,...,pn in 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 expected 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); ## expo nential of p in Cl(K) up to order N" }}{PARA 0 "" 0 "" {TEXT -1 102 "c expQ[K](p,N); ## exponential of p in Cl(K) up to order N (here K is ex pected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 53 "climin poly[K](p); ## minimal polynomial of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponential 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 following 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); ##le ft 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 and m2 in Cl(K)" }}{PARA 0 "" 0 " " {TEXT -1 41 "reversion(p,K); ##reversion of p in Cl(K)" }}{PARA 0 " " 0 "" {TEXT -1 43 "cinv(p,K); ##Clifford 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(p 1,p2,K); ##right contraction of p1 by p2 w.r.t. diagonal entries in K " }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugation(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 multip le 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 nilpoten t 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 procedures such as 'reorder', 'wedg e', etc., have been substantially revised to improve efficiency and sp eed of the package. This work has been done together with Bertfried Fa user, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nTh is version includes \"Bigebra\" package that has been created together with Bertfried Fauser, Universit\"at Konstanz, Konstanz, Germany. Add itional help pages have been written and added to the database that ex plain 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 vari ables. They can be displayed with procedure CLIFFORD_ENV.\n\nThis pack age is made to run under Maple 8. It is available on a server of the Department of Mathematics, Tennessee Technological University, at: \+ \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " http ://math.tntech.edu/rafal/clifford/ " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 130 "In order to create a Maple file 'C lifford.m' containing the 'CLIFFORD' package, execute this worksheet. \n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 17 ">with(Clifford); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the p ackage has been loaded because a list with 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 Mathemati cs, 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@tntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-3569" }}{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, adfmatr ix, all_sigs, beta_minus, beta_plus, buildm, bygrade, c_conjug, cbasis , cdfmatrix, cexp, cexpQ, cinv, clibilinear, clicollect, clidata, clil inear, climinpoly, cliparse, cliremove, clisolve, clisort, cliterms, c mul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, commutingelements, conj ugation,ddfmatrix, diagonalize, displayid, extract, factoridempotent, \+ find1str, findbasis, gradeinv, init, isVahlenmatrix, isproduct, makeal iases, makeclibasmon, matKrepr, maxgrade, maxindex, mdfmatrix, minimal ideal, ord, permsign, pseudodet, q_conjug, qdisplay, qinv, qmul, qnorm , reorder, reversion, rmulm, rot3d, scalarpart, sexp, specify_constant s, spinorKbasis, spinorKrepr, squaremodf, subs_clipolynom, useproduct, vectorpart, version, wedge, wexp, rd_clibasmon, rd_climon, rd_clipoly nom;\n###################################\nlocal setup;\noption packag e, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'versio n' stores information about the current version of the package. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typic al use: version(); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1525 "version:= proc()\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\nprint(`++++++++++++ +++++++++++++++++++++++++++++++`);\nprint(`CLIFFORD - A Maple 9 Packag e for Clifford Algebras`); \nprint(`(Version 9 with global variable _p rolevel and \"Bigebra\" package)`);\nprint(`\"Bigebra\" package writte n with Bertfried Fauser, Universit\"at Konstanz`);\nprint(`Last revise d: September 17, 2005 (Source file: clifford_M9_05.mws)`);\nprint(`Cop yright 1995-2005 by Rafal Ablamowicz (*) and Bertfried Fauser ($)`);\n print(``);\nprint(`(*) Department of Mathematics, Box 5054`);\nprint(` Tennessee Technological University, Cookeville, TN 38505`);\nprint (` tel: USA (931) 372-3569, fax: USA (931) 372-6353`);\nprint(` \+ rablamowicz@tntech.edu`);\nprint(` http://math.tntech.edu/rafal/Cli ff9/`);\nprint(`($) Universit\"at Konstanz, Fachbereich Physik, Fach M 678`);\nprint(` 78457 Konstanz, Germany`);\nprint(` Bertfried.Fa user@uni-konstanz.de`);\nprint(` http://kaluza.physik.uni-konstanz. de/~fauser/`); \nprint(``);\nprint(`If you are a Clifford algebra pro, assign 'true' to '_prolevel' and see`);\nprint(`how much faster \+ your computations will be! But watch your syntax!`);\nprint(`Use 'usep roduct' to change value of _default_Clifford_product in Cl(B) from`); \nprint(`cmulRS when B is symbolic to cmulNUM when B is numeric. Type \+ ?cmul for help.`); \nprint(`++++++++This is CLIFFORD version 9, librar y file : Clifford.m++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_constants" } {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 originally \+ known constants are stored in a global, non-protected variable 'consta nts' and must be saved separately, if needed. This procedure is neede d when sorting or collecting multivariate Clifford polynomials contain ing expressions like 'aa*eiwej' in which 'aa' is intended to be a cons tant and 'eiwej' is intended to be a Clifford basis monomial with indi ces i and j. Before using " }{TEXT 281 7 "clisort" }{TEXT -1 4 " or \+ " }{TEXT 280 10 "clicollect" }{TEXT -1 350 " user should make any addi tional constants of length 2 or more known to Maple as shown below. I f these constants of length 2 or more are not defined as Maple constan ts, then some procedures might yield error messages (although an attem pt has been made to avoid this problem). Constants of length one are a utomatically 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 2278 "LC:=proc(x::\{ cliscalar,clibasmon,climon,clipolynom\},\n y::\{cliscalar,clib asmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lnam e,res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `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,sy mbol,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])\},nume ric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third argum ent in LC. See ?LC for more help.\" \n end if;\nelse\n error \"tw o or three arguments expected in LC. See ?LC for more help.\"\n end if ;\n################################\n if type(x,clibasmon) then\n \+ if type(y,clibasmon) then\n lst1:=Clifford:-extract(x,'integers') ;\n lst2:=Clifford:-extract(y,'integers');\n N1:=nops(lst1); N2:=nops(lst2);\n if N1>N2 then return 0 end if;\n if N1=0 t hen return y end if;\n if N1=1 then \n res:=`+`(seq(coB*n ameB[lst1[1],lst2[j]]*_CLIENV[_QDEF_PREFACTOR]^(j-1)*\n \+ makeclibasmon([op(subs(lst2[j]=NULL,lst2))]),j=1..N2));\n \+ return reorder(res) \n else\n res:=\nprocname(makecli basmon(lst1[1..-2]),procname(makeclibasmon([lst1[-1]]),y,lname),lname) ;\n return reorder(res)\n end if;\n elif type(y,clim on) then\n term,cf:=selectremove(type,y,clibasmon);\n ret urn expand(cf*procname(x,term,lname))\n elif type(y,clipolynom) t hen\n return add(procname(x,i,lname),i=[op(y)])\n elif ty pe(y,cliscalar) then \n return displayid(scalarpart(x)*y)\n \+ end if; \n elif type(x,climon) then\n term,cf:=selectremove(typ e,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 Cl ifford numbers\",x,y;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 19. Procedure " }{TEXT 299 3 "LCQ" }{TEXT -1 270 " is a special ver sion of 'LC' and gives left contraction in the orthogonal Clifford alg ebra Cl(Q) of the quadratic form Q defined via the symmetric part g of B as Q(x) = g(x, x) = B(x, x). It can accept name as a third optiona l argument or a numeric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Grenoble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e 1 + 2*e2, e1we3 + b*e2we3);\nLCQ(e1 + 2*e2, e1we3 + b*e2we3,K); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1796 "LCQ:=proc(x::\{cliscalar,clibasmo n,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climon,clip olynom\}) \n local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\n options `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fau ser. 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],\{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(sel ect(type,\{op(args[3])\},numeric));\n nameB:=op(remove(type,\{op (args[3])\},numeric));\n lname:=args[3]:\n else \n erro r \"wrong type of third argument in LCQ. See ?LCQ for more help.\" \n \+ end if;\nelse\n error \"two or three arguments expected in LCQ. S ee ?LCQ for more help.\"\nend if;\n################################\nS xy:=remove(type,map(op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(C lifford:-extract,Sxy,'integers'));\nsymbxy:=remove(type,Sxy,posint);\n if symbxy <> \{\} then \n return 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:=linalg[coldim](evalm(lname)):\n if m>N \+ then \n error \"input contains index larger than size of bilinear form %1\",lname \n end if;\nend if:\nif type(lname,\{name,symbol,ar ray,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return LC(x,y ,linalg[diag](L))\nelif \n 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,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 contract ion between any multivector u and a multivector v, i.e., multivector u acts on the multivector v from the right. This procedure is now bili near in both arguments. It can 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*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2281 "RC:=proc(x::\{cliscalar,clibasmon,climon,clipoly nom\},\n y::\{cliscalar,clibasmon,climon,clipolynom\})\n loca l N1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,nameB;\n global _CLIENV,B ;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: September 1 7, 2005`;\n#############################################\nif nargs=2 t hen\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 the n\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB: =1:\n nameB:=args[3];\n lname:=args[3];\n elif type(arg s[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 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.\"\nend if;\n################################\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n lst1 :=Clifford:-extract(x,'integers');\n lst2:=Clifford:-extract(y,'i ntegers');\n N1:=nops(lst1);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 t hen \n res:=`+`(seq(coB*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 els e\n res:=procname(procname(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:=selectremove(type,y,clibasmon);\n return ex pand(cf*procname(x,term,lname))\n elif type(y,clipolynom) then\n \+ return add(procname(x,i,lname),i=[op(y)])\n elif type(y,cliscala r) then return reorder(x)*y \n end if;\n elif type(x,climon) then \n term,cf:=selectremove(type,x,clibasmon);\n return expand(cf*p rocname(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 r eturn displayid(x*scalarpart(y))\n end if;\nerror \"Got input %1 and %2 but can only process constants and Clifford numbers\",x,y\nend pro c:\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 thi rd optional argument such as K or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1801 "RCQ:=proc(x::\{cliscalar,clibasmon,climon,cl ipolynom\},\n y::\{cliscalar,clibasmon,climon,clipolynom\}) \+ \n local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `C opyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: September 17, 2005`;\n## ########################################### \nif nargs=2 then\n co B:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if t ype(args[3],\{name,symbol,matrix,array\}) then\n coB:=1:\n \+ nameB:=args[3];\n lname:=args[3];\n elif type(args[3],`&*`(n umeric,\{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 \"wron g type of third argument in RCQ. See ?RCQ for more help.\" \n end i f;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ \+ for more help.\"\nend if;\n################################\nSxy:=remo ve(type,map(op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford: -extract,Sxy,'integers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbx y <> \{\} then \n return RC(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:=linalg[coldim](evalm(lname)):\n if m>N then \n \+ error \"input contains index larger than size of bilinear for m %1\",lname \n end if:\nend if:\nif type(lname,\{name,symbol,array, matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return RC(x,y,lin alg[diag](L))\nelif \n type(lname,`&*`(numeric,\{name,symbol,array,m atrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n na meB:=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. Proced ure " }{TEXT 303 8 "gradeinv" }{TEXT -1 133 " is the grade involution \+ in the Clifford algebra,i.e., it reverses signs of odd elements and le aves signs of even elements unchanged." }}{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:=pro c(a1::\{matrix,cliscalar,clibasmon,climon,clipolynom\}) global _CLIENV ;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: September 1 7, 2005`;\n#############################################\nif type(a1,m atrix) then return map(procname,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR]:=-1 end if;\nif type(a1,clibasmon) the n return (_CLIENV[_QDEF_PREFACTOR])^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 "wedg e" }{TEXT -1 1306 " product of any number of Clifford polynomials. Th e infix form of this associative multiplication is `&w`. Thus, e1 &w \+ e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, w edge multiplication may be applied to matrices with entries in a Cliff ord algebra or in an exterior algebra.\n\nNew feature: When the dimens ion 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 o utput of the procedure does not include terms of grade higher than the dimension of the vector space in case symbolic indices are used. \n\n The default value of this global variable is 9 and it it set by the in itialization file when Clifford is loaded.\n\nWhen the procedure is in voked, it checks whether the bilinear form B has been defined. If yes, the procedure checks whether the size of B is less than the current v alue of dim_V. If again yes, a warning message is issued by the proced ure and the value of dim_V is reduced. If the size of B is larger than the current value of dim_V, no warning message is issued and the valu e of dim_V is increased to linalg[coldim](B).\n\nThe warning message \+ can be supressed by addign 'false' to a global parameter _warnings_fla g whose default value is set to true by the Clifford initialization fi le." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e4 + e1we2); wedge(e2 + 2*e1, e3, e4) ; (e2 + 2*e1) &w (e3 + 2*); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3063 "wedge:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::\{cliscalar,clibasmon,climon,clipolynom\}) \nlocal ii,kk,w edge2,pi,p1,p2,i1,i2,i12,n12,maxindexflag,expr,maxin;\nglobal dim_V,B, _warnings_flag;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: 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)\ne nd if;\nif type(B,matrix) then\n if linalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < dim_V then\n dim_V:=linalg[coldim ](B);\n if _warnings_flag then\nprintf(\"Warning, since B has \+ been (re-)assigned, value of dim_V has been reduced by 'wedge' to %g\\ n\",dim_V);\n end if;\n elif linalg[coldim](B)>dim_V then\n \+ dim_V:=linalg[coldim](B);\n end if;\n end if;\n end if; \+ \nif not type(dim_V,Range(0,10)) or \n not type(dim_V,posint) then\n error \"value of dim_V must be a positive 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:\nend if:\nif maxindexflag then \n error \"argument(s) contain(s) index larger then current value of d im_V which is now %1. To complete computation, increase value of dim_V or assign square matrix of size at least %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(Cliffo rd:-extract(args[1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(arg s[2]))\};n2:=nops(i2):\n if args[1]=Id then \n if n2>dim_V then ret urn 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 i 1:=\{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 <> \{\} then return 0 end if;\n if symbi ndexflag and nops(i1)+nops(i2) > dim_V then return 0 end if;\nreturn r eorder(cat(args[1],\"w\",args[2]));\nend proc:\n################\nif n args=1 then return args\nelif nargs=2 then p1:=displayid(a1):\n \+ p2:=displayid(a2):\n expr:=clibilinear(p1, p2,wedge2);\n if hastype(expr,trig) then \n \+ return clicollect(map(combine,clicollect(expr),trig))\n \+ else \n return reorder(expr)\n \+ end if;\nelse expr:=procname(procname(a1,a2),args[3..nargs ]):\n if hastype(expr,trig) then \n return clicollect(map(c ombine,clicollect(expr),trig))\n else \n return reorder(exp r)\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:-setup)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " compu tes sign of a permutation that sorts 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::list) local newbas,ss,a,n12,s12,L1 ,L2,N,f,dummy_set,K,x;\noptions `Copyright (c) 1995-2005 by Rafal Abla mowicz and Bertfried Fauser. All rights 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(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)),o p(sort(s12))];\n################## new\nf:=proc() end proc:\nfor ss fr om 1 to N do\n f(L2[ss]):=L1[ss];\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; \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. 2 6. Procedure " }{TEXT 309 7 "cmulNUM" }{TEXT -1 148 " calculates Cliff ord product between any two Clifford monomials using the recursivelyCh evalley's definition of the Clifford 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 vector and u is any element in the alg ebra, wedge(x,u) = x &w u denotes the wedge or exterior product betwe en x and u, and LC(x, u) denotes the left contraction of u by x. This \+ procedure is now bilinear in both arguments. The infix form is availa ble e.g., e1 &c e2. This procedure works in Clifford algebras in dime nsions up to and including 9. Multiplication 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 third argument of type name or a numeric \+ multiple of a name. Then it computes Clifford product in Cl(K)." }} {PARA 258 "" 0 "" {TEXT -1 221 "\nThis version can take index as a way of passing a parameter. The index could be of type `&*`(numeric,\{na me,symbol,array,matrix\}) or of type \{name,symbol,array,matrix\}.\n \nWhen the bilinear form B is symbolic, 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,nameB,a12;global B:\n options `Copyr ight (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\n description `Last revised: September 17, 2005`;\n#### #########################################\n###This is additional code \+ for Maple 6 version:\n#############################################\ni f hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clieval,[a1,a2 ]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12[2],procname,l name))\nend if: \n#################################################### ##################################\n### old name cmul2B: this procedur e computes recursively Clifford product of any two #\n### cliscalars, \+ clibasmons, climons, and clipolynoms 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 retur n a2 end if:\n L:=Clifford:-extract(a1,'integers');\n N:=nops(L):\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,a rray,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric)) ;\n nameB:=op(select(type,\{op(lname)\},name));\n else\n erro r \"third argument is of unexpected type\"\n end if;\n ############# ###\n if N=0 then return coeff(a1,Id)*a2\n elif N=1 then\n L2:=Cl ifford:-extract(a2,'integers'):\n return reorder(simplify(makecliba smon([L[1],op(L2)])\n +add((-1)^(i-1)*coB*nameB[L[1],L2[i]]*makecl ibasmon(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,l name):\n S:=clibilinear(x1,p2,procname,lname);\n return simplify (S-coB*nameB[op(L)]*a2)\n end if;\n x:=cat(e,L[-1]);\n p1:=substrin g(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]]*\nprocnam e(makeclibasmon(subs(L[-i]=NULL,L[1..-2])),a2,lname),i=2..N); \n retu rn reorder(simplify(S))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 266 19 " No. 27. Procedure " }{TEXT 310 6 "cmulRS" }{TEXT 311 114 " computes C lifford product using Rota-Stein cliffordization technique. It can acc ept now -K in place of the name.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4904 "cmulRS:=proc(a1,a2,lname)\nlocal max_grade,L1,N1,L2,N2,genPS,fun 1,fun2,srt,cup,pList1,PN1,\n pList2,PN2,pSgn1,pSgn2,a,i,j,m,n,res ,pos1,pos2,F1,F2,coB,nameB,a12;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\n###This is additional code for Maple 6 version:\n### ##########################################\nif hastype(\{a1,a2\},clipr od) then\n a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-c liexpand(clibilinear(a12[1],a12[2],procname,lname))\nend if: \n####### ###################################################################### #############\n### This procedure computes Clifford product of any two cliscalars, clibasmons, climons, #\n### and clipolynoms in Clifford a lgebras Cl(lname) using Rota-Sten cliffordization #\n### Procedu re cmulRS modified by Rafal to accept -K, or -B for lname. \+ #\n########################################################### ###############################\n if nargs<>3 then error \"exactly th ree 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 followi ng 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(ln ame,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(sel ect(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(lna me)\},name));\n else\n error \"third argument is of unexpected ty pe\"\n end if;\n ################\n L1:=Clifford:-extract(a1,'integ ers');\n N1:=nops(L1);\n L2:=Clifford:-extract(a2,'integers');\n N2 :=nops(L2);\n if N1=1 then \n return reorder(simplify(makeclibasmo n([L1[1],op(L2)])\n +add((-1)^(i-1)*coB*nameB[L1[1],L2[i]]*makeclib asmon(subs(L2[i]=NULL,L2)),i=1..N2)))\n end if;\n if N2=1 then \n \+ return reorder(simplify(makeclibasmon([op(L1),L2[1]])\n +add((-1)^ (i-1)*coB*nameB[L1[-i],L2[1]]*makeclibasmon(subs(L1[-i]=NULL,L1)),i=1. .N1)))\n end if;\n#### genPS ; generate a power set of 1..N, option r emember\n genPS:=proc(N)\n local a,i,plst;\n option remember; \+ \n a:=[seq(i,i=1..N)]:\n plst:=[a]:\n for i in a do\n pl st:=[op(subs(i=NULL,plst)),op(plst)]:\n end do:\n end proc:\n#### \+ prepare combinatorics for L1:\n fun1:=proc(a1) a1 end proc:\n for i \+ from 1 to N1 do\n fun1(i):=L1[i];\n end do:\n#### here is the old \+ code for the poweset \n# a:=[seq(i,i=1..N1)]:\n# pList1:=[a]:\n# fo r i in a do\n# pList1 := [op(subs(i = NULL,pList1)), op(pList1)]:\n # end do:\n####\npList1:=genPS(N1); \n PN1:=nops(pList1)+1; ## add ed 1 here\n pList1:=sort(pList1,(a,b)->evalb(nops(a)<=nops(b)));\n p Sgn1 :=[seq((-1)^(add(pList1[i][m]-m,m=1..nops(pList1[i]))),i=1..PN1-1 )];\n#### prepare combinatorics for L2:\n fun2:=proc(a2) a2 end proc: \n for i from 1 to N2 do\n fun2(i):=L2[i];\n end do:\n#### here i s 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(p List2)]:\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(pList2[i][m]-m,m=1..nops(pList2[i]))),i=1 ..PN2-1)];\n#### cup tangle of the rota-stein sausage tangle\n cup:=p roc(lst1,lst2,coB,nameB)\n local i;\n if nops(lst1)<>nops(lst2) \+ then return 0 end if;\n if lst1=[] then return 1 end if;\n if no ps(lst1)=1 then return coB*nameB[lst1[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-St ein Tangle : cliffordization \+ #\n## compose only such terms which are potentially non zero in the \+ cup(..) tangle #\n#################################################### ###############################\n max_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n pos1:=0:\n for j from 0 to N1 do # f or all j-vectors of pList1\n F1:=N1!/((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grade-j) do # for all i-vectors of pList2\n \+ # which do not exceed max_grad e (others are zero)\n F2:=N2!/((N2-i)!*i!);\n for n from 1 to F1 d o\n for m from 1 to F2 do \n res:=res+\n pSgn1[pos1+n]*p Sgn2[pos2+m]*\n cup(map(fun1,pList1[PN1-pos1-n]),map(fun2,pLis t2[pos2+m]),coB,nameB)*\n makeclibasmon([op(map(fun1,pList1[po s1+n])),op(map(fun2,pList2[PN2-pos2-m]))])\n end do:\n end \+ do:\n pos2:=pos2+F2;\n end do:\n pos1:=pos1+F1;\n end do: \nre turn reorder(res); ## note that cmulRS INCLUDES already reorder !!\nen d 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 Cli fford product." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 559 "cmulgen:=proc() global _default_Clifford_product,_warnings_flag;\nopt ions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: September 17, 200 5`;\n#############################################\nif _default_Cliffo rd_product <> 'cmulgen' then\n return _default_Clifford_product(args )\nelse \n if _warnings_flag then\n WARNING(\"to assign Clifford p roduct, execute 'useproduct' with argument cmulRS, cmulNUM, or cmul_us er_defined first\");\n end if;\n return 'cmulgen'(args);\n end if ; \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 268 25 "No. 29. Wrapper funct ion " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clifford product giv en by cmulNUM, cmulRS, or other procedure such as 'cmulgen'.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1380 "cmul:=proc() local lname;\noption s `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last 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]) then return 0 end if;\n if nargs <= 1 then return args end if;\n if nargs = 2 then\n##################### #####################################\n### Speed-wise it makes no diff erence whether cmulgen or #\n### _default_Clifford_product is used in \+ the following. # #################################################### ######\n return clicollect(clibilinear(eval(args[1]),eval(args[2]),cm ulgen,lname)); \n end if;\n###### <=== do NOT use 'procname' in the n ext line this will not work\n######################################### #################\n### Speed-wise it makes no difference whether cmulg en or #\n### _default_Clifford_product is used in the following. # ## ########################################################\nif not type( _default_Clifford_product,procedure) then \n error \"global variable _default_Clifford_product must be assigned a procedure so that 'cmul' could proceed beyond this point. Sorry. For help see ?cmul.\" \nend i f;\n return procname(clibilinear(eval(args[1]),eval(args[2]),cmulg en,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` correctly uses -K for index. Whe n K has been assigned a matrix, use\n&c[''K''](e1,e2) and &c[''-K''](e 1,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;\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################# ######################\n### Works when &c[''K''] or &c[''-K''] is ente red and K is a matrix\n#######################################\nflagde c:=true:\nif type(op(procname),procedure) then\n if type([args],list list) then\n if type(op(args),array) then\n WARNING(\"enc lose index in double quotes as in &c[''B''] or &c[''-B''] when B has b een assigned a matrix to avoid the following:\");\n return 'pro cname(args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n \+ lname:=`B`:\n ARGS:=[args]:\n flagdec:=false:\n end i f;\nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname, `&*`(numeric,name)) then\n coB:=op(select(type,\{op(lname)\},n umeric));\n nameB:=op(select(type,\{op(lname)\},name));\n \+ else\n coB:=1:\n nameB:=lname:\n end if;\n fl agdec:=false:\n end if;\n#######################################\ndeci ndex:=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(select(type,\{op(nameB)\},n umeric));\n nameB:=op(select(type,\{op(nameB)\},name));\n \+ end if;\n elif type(op(args),`&*`(numeric,function)) then\n n ameB:=\{op(op(args))\}:\n coB:=op(select(type,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],list) then\n ARGS:=args ;\n coB:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot \+ determine arguments and/or index from arguments\"\n end if;\nreturn co B,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;\n if NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op(AR GS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to sele ct which procedure is used to compute Clifford product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1259 "useproduct:=proc(name::\{s ymbol,name\})\nlocal wstr;\nglobal _default_Clifford_product; #,cmulge n;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September \+ 17, 2005`;\n#############################################\n########### ########################################################\n###This proc edure uses global variable _default_Clifford_product #\n############# ###################################################### \nif not member (name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defined\}) then \n WARNING (\"expecting one of the following Clifford products: cmulRS, cmulNUM, \+ cmulgen, or cmul_user_defined\") \nend if;\nif member(name,\{cmul_user _defined\}) and not type(name,procedure) then\n WARNING(\"no computa tions with cmul can be peformed yet since cmul_user_defined has not be en defined as procedure. Select cmulRS, cmulNUM, or a new procedure as argument to useproduct.\");\n _default_Clifford_product:=name;\nret urn NULL;\nend if;\n################################\n_default_Cliffor d_product:=name; #change value of _default_Clifford_product \n######## ########################\nwstr:=cat(\"cmul will use \",name,\"; for he lp see pages ?cmul, ?Clifford:-intro, or ?\",name);\nWARNING(wstr);\ne nd 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 'cmul' and '&c'. It give s the Clifford multiplication in the Clifford algebra 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' de scribed below in (32), this multiplication can also be applied to matr ices with entries in a Clifford algebra.\n\nThis procedure can now acc ept an optional index which could be K or -K. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Proposed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Thanks!" }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 158 "Typical use: cm ulQ(e1 + e2 + 2*Id, e3we4 + e6); or (e1 + e2) &cQ (2*e2we3 + e4); or & cQ(e1, e2, e3); \n cmulQ(e1we2+e2,e3+e4,e5-Pi*I d); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1425 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\n########## ##########################\nif type(op(procname),procedure) then\n \+ lname:=`B`;\nelse\n lname:=op(procname);\nend if;\n################ ####################\nif member(0,[args]) then return 0 end if;\n##### ###############################\nSxy:=map(op,map(cliterms,\{args\})); \nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbxy:=remove( type,Sxy,posint);\nif symbxy <> \{\} then \n return cmul[lname](args ) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y have ma xindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldim](eva lm(lname)):\n if m>N then \n error \"input contains index large r than size of bilinear form %1\",lname \n end if:\nend if:\n####### #########################\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return cmul[linalg[diag](L )](args);\nelif \n type(lname,`&*`(numeric,\{name,symbol,array,matri x\})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n nameB: =op(select(type,\{op(lname)\},\{name,symbol,array,matrix\}));\n L:=s eq(coB*nameB[ii,ii],ii=1..m);\n return cmul[linalg[diag](L)](args); \+ \nelse\n error \"index of unexpected type has been found in cmulQ\" \nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 272 29 "No. 33. Ampers and version of " }{TEXT 322 5 "cmulQ" }{TEXT 323 222 ". This version c an 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. Procedure " }{TEXT 324 10 " scalarpart" }{TEXT -1 137 " computes the scalar part of the given Clif ford polynomial. For example, scalarpart(e1 + e2we3) = 0 but scalarp art(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 "scalarpart:=proc(a::\{clisca lar,clibasmon,climon,clipolynom\}) local a1,p; \noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\na1:=simplify(a):\nif type(a1,cliscal ar) then return a1 end if;\np:=clicollect(a1):\nreturn coeff(p,Id);\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 35. Procedure " } {TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes the k-vector part o f the given Clifford polynomial u where k is a nonnegative integer. Fo r 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) equal s 2*Id while scalarpart(2*Id + e1we2) = 2. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "Typical use: vectorpart (e1 + e2we3 + e3, 1); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 572 "vecto rpart:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\},a2::nonnegint ) \nlocal a1,p,K;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: September 17, 2005`;\n########################################### ##\na1:=simplify(a):\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. Proc edure " }{TEXT 326 4 "cexp" }{TEXT -1 236 " computes Clifford exponent ial of a Clifford number in Cl(B) up to the order specified by the se cond argument which is a nonnegative integer n. It n = 0 then this pro cedure 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(e1we2*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 "cexp:=proc(p::\{numeric,cliscalar,clibasmon,climo n,clipolynom\},N::nonnegint) \nlocal pp,k,ans,ans1,ans2,lname,coB,name B;\noptions `Copyright (c) 1995-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 th en\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB :=1:\n nameB:=args[3];\n lname:=args[3];\n elif type(ar gs[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 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 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:=scalarp art(p);\n return ((add(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(d isplayid(p)):\nif N=0 then return Id \n elif N=1 then return Id+pp; \+ \n else \n ans1:=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 of a Clifford number in Cl(Q) up to the order spe cified by the second argument which is a nonnegative integer n. It n \+ = 0 then this procedure returns 'Id'. This procedure can also accept \+ an optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "Typical use: cexpQ(e1we2*t, 3); o r cexpQ((e1 + 2*e1we2)*t, 4);\n cexpQ(e1we2*t, 3,K ); or cexpQ((e1 + 2*e1we2)*t, 4,K);\n cexpQ(Id+2*e 1we3,4); or cexpQ(e1 + 2*e1we2, 4,-K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1375 "cexpQ:=proc(p::\{numeric,cliscalar,clibasmon,climon ,clipolynom\},N::nonnegint) \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB ;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: September 1 7, 2005`;\n#############################################\nif nargs=2 t hen\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 the n\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB: =1:\n nameB:=args[3];\n lname:=args[3];\n elif type(arg s[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 third argument in cexpQ. See ?cexpQ for more hel p.\" \n end if;\nelse\n error \"two or three arguments expected i n 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:=sca larpart(p);\n return add(pp^k/k!,k=0..N)*Id \nend if;\npp:=clisort(d isplayid(p)):\nif N=0 then return Id \n elif N=1 then return Id+pp; \+ \n else \n ans1:=cexpQ(pp,N-1,lname);\n ans2:=cexp Q(pp,N-2,lname);\n ans:=ans1+cmulQ[lname](((ans1-ans2)*(N-1)!) ,pp)/N!;\n return ans;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Procedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponential of a Clifford number u up to the o rder specified by the second argument 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,c libasmon,climon,clipolynom\},N::nonnegative) \nlocal pp,power,cu,i;\no ptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: September 17, 2 005`;\n#############################################\n if nargs<>2 th en error \"two parameters are needed in 'wexp'\" end if;\n pp:=expand (p);\n if N=0 then return 1 elif\n N=1 then return 1+clisort(pp) \+ end if;\n power:=pp;\n cu:=1+pp;\n for i from 2 to N do\n power :=wedge(power,pp);\n cu:=cu + power/i!;\n end do;\n return subs( Id=1,clicollect(clisort(cu)));\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " }{TEXT 329 9 "reversion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in it s argument and it is always a Clifford algebra anti-automorphism. Whe n the antisymmetric part of B is not zero, 'reversion' does not preser ve 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 third optional argument such as B or -B." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 53 "Typic al 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,flagind exed;\n global _scalartypes,B;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif hastype([args[1]],cliprod) then \n er ror \"in order to handle 'type/cliprod', load in package Cliplus\" \n \+ end if;\n############################\nif type(a1,cliscalar) then retu rn a1 end if;\n############################\nif nargs=1 then\n lnam e:=`B`;\n flagindexed:=false:\nelif nargs=2 and type(args[2],\{symb ol,name,array,matrix,`&*`(algebraic,name)\}) then\n lname:=args[2]; \n flagindexed:=true:\nelse error \"only one or two arguments are e xpected\"\nend if;\n############################\n### Auxiliary functi on that converts wedges to Clifford products: wedge ->> Clifford produ ct\n############################\nwtp:=proc(a1,lname) local ind,i,arg, rdmon,eq1,ans; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then r eturn (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 member(length(a1),\{5,8,11,14,17,20,23,26 \}) \n then return a1 \nend if;\nrdmon:=reorder(a1):\nind:=Clif ford:-extract(a1,'integers'):\ni:='i':\narg:=[seq(cat(e,op(ind[i])),i= 1..nops(ind))];\neq1:=cat(op(arg))=simplify(eval(cmul[lname](op(arg))) );\nif a1=rdmon then ans:=simplify(solve(eq1,a1)) \n else a ns:=-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 produc ts to wedge: Clifford products ->> wedge\n############################ \nptw:=proc(a1,lname) local i,arg,revarg; global _scalartypes; \nif ty pe(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,symbol) and not member(length(a1),\{2,4,6, 8,10,12,14,16,18\})\n then return a1 \n end if;\ni:='i':\narg:= [seq(cat(e,substring(a1,2*i..2*i)),i=1..(length(a1)/2))];\nrevarg:=[se q(arg[nops(arg)-i],i=0..(nops(arg)-1))];\nreturn expand(eval(cmul[lnam e](op(revarg))))\nend proc:\n##############################\n### Now t he 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 t he Clifford algebra. It is linear in its argument. Note that 'conjuga tion' is defined as a composition of 'reversion' and 'gradeinv'. Henc e, it does not preserve the multivector gradation when the antisymmetr ic part of B is non-zero. It can now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjugation(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 825 "conjugation:= proc(a1::algebraic) local lname;global B;\noptions `Copyright (c) 1995 -2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif nargs=1 then\n lname:=`B`;\nelif nar gs=2 and type(args[2],\n \{symbol,name,array,matrix,`&*`(numeric, \{symbol,name,array,matrix\})\}) then\n lname:=args[2];\nelse error \"only one or two arguments are expected\"\nend if;\n################ ###########\nif type(a1,matrix) then return map(procname,a1,lname) eli f\n type(a1,cliscalar) then return a1 elif\n type(a1,\{clibasmon,c limon,clipolynom\}) then\n return eval(gradeinv(reversion(a1,ln ame)))\nelse \n error \"wrong input type: input must be of type clis calar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if;\nend pro c:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 41. Procedure " }{TEXT 331 8 "c_conjug" }{TEXT -1 72 " calculates c omplex 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 Clifford algebra and `I` is the imagina ry unit, i.e., I = sqrt(-1). This procedure 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:=proc(a1::algebraic) local ba,co,terms ,t,i;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Septemb er 17, 2005`;\n#############################################\nif type( a1,matrix) then return map(procname,a1) elif\n type(a1,cliscalar) th en return conjugate(a1) elif\n type(a1,\{clibasmon,climon,clipolynom \}) then\n t:='t':\n ba:=cliterms(a1);\n co:=[coe ffs(a1,ba,'t')];\n terms:=[t];i:='i':\n return clisort(a dd(conjugate(co[i])*terms[i],i=1..nops(co)))\n else \nerror \"wrong \+ input type: input must be of type cliscalar, clibasmon, climon, clipol ynom, or 'matrix'\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 42. Procedure " }{TEXT 332 6 "buildm" }{TEXT -1 863 " build s a matrix for the given element u of the Clifford algebra Cl(B) in th e left- or right-regular representation, or under Lie or automorphism \+ action with respect to an ordered basis specified by the user. The el ement p is entered as the first argument and the basis in the form of \+ a list is specified as the second argument, e.g., buildm(u, basis). I t is also possible to specify options 'left', 'right', 'Lie', 'auto', \+ 'false, and 'true'. For example, one can find the left-regular represe ntation of the algebra on itself or, when Cl(B) is simple and isomorph ic to a ring of real matrices, one can find matrices representing Clif ford polynomials in a real basis of a minimal ideal. However, there a re new procedures below specifically designed for finding spinor repre sentations of Clifford algebras in terms of real, complex, and quatern ionic matrices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuildm(e1, [Id, e1, e2, e1we2]); bui ldm(e1, [Id, e1, e2, e1we2], 'right'); buildm(e1, [Id, e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2],'false'); buildm(e1we2+e2, [I d, e1, e2, e1we2], 'true'); buildm(e1, [Id, e1, e2, e1we2], 'Lie','fal se'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2969 "buildm:=proc(a1:: \{cliscalar,clibasmon,climon,clipolynom\},\n a2::list(\{cl iscalar,clibasmon,climon,clipolynom\}))\nlocal A,L,N,a11,xm,i,j,Lbasis ,neq,vars,sys,sol,nontrivial,a33,flag;\noptions `Copyright (c) 1995-20 05 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: September 17, 2005`;\n###################### #######################\nflag:=true:\nif nargs=2 then a33:='left' end \+ if;\nif nargs=3 then \n if member(args[3],\{'true','false'\}) then f lag:=args[3];\n a33:='left ';\n elif member(args[3],\{'left','right','Lie','auto'\}) \n \+ then a33:=args[3]\n else error \"thir d optional argument must be 'left', 'right', 'Lie', 'auto', 'true', 'f alse'\"\n end if; \nend if;\nif nargs=4 then\n if member(args[3], \{'left','right','Lie','auto'\}) and member(args[4],\{'false','true'\} ) then\n a33:=args[3]; \n flag:=args[4];\n else \n \+ error \"third optional argument must be 'left', 'right', 'Lie', ' auto', and the fourth optional argument must be 'false' or 'true'\"\n \+ end if;\nend if;\nif nargs>4 then error \"too many arguments. See ?b uildm for more help.\" end if;\n###################################### ###########\nif flag then \nA:=linalg[genmatrix](args[2],cbasis(maxind ex(args[2])));\nif linalg[rank](A) < nops(args[2]) then \n error \"e lements of the list %1 are linearly dependent. Apply 'findbasis' to th is list first.\",a2 \nend if;\nend if;\n###local procedure\nnontrivial :=proc(S::\{set(\{relation,algebraic\}),list(\{relation,algebraic\})\} ) \nlocal istrivial;\nprintlevel:=2:\nistrivial:=proc(x) if type(x,rel ation) 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='lef t' 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='righ t' then \n for i from 1 to N do \n eq||i:=cl icollect(expand(cmul(L[i],a1)-add(xm[j,i]*L[j],j=1..N)))\n end do; \nelif a33='Lie' then\n for i from 1 to N do\n eq||i:=clic ollect(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 fr om 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 erro r \"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 t o N do \n for j from 1 to nops(Lbasis) do \n neq[i,j]:=coeff (eq||i,Lbasis[j])=0 \nend do;\nend do;\nvars:=convert(evalm(xm),set):s ys:=map(op,\{entries(neq)\});\nsys:=nontrivial(sys): #eliminate trivia l equations\nsol:=solve(sys,vars);\nif sol=NULL then \n error \"no m atrix represents %1 in the basis %2 under 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 vector space spanned by a set of Clifford polynomials entered as a list. The procedure is used, fo r example, when finding a basis for a spinor space S considered as a \+ minimal left or right ideal in Cl(B) generated by a primitive idempote nt f. To speed up computations, it is advisable to a standard Clifford basis for Cl(B) in the form of a list of basis monomials as the secon d argument. If only one list is specified, 'findbasis' determines a s uitable Clifford basis itself but it takes twice as much time then sin ce it creates a Clifford basis by using 'cbasis(maxindex)' where 'maxi ndex' is the maximum index found among the elements of the list." }} {PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use: findbasis([2*e1+e2,e2+e1 we2,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 _p rolevel;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Ber tfried Fauser. All rights reserved.`;\ndescription `Last revised: Sept ember 17, 2005`;\n#############################################\nif ev alb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{cliba smon,climon,clipolynom\})) or \n type(a1,set(\{c libasmon,climon,clipolynom\}))) then\nerror \"argument of type list/se t(\{clibasmon,climon, or clipolynom\}) was expected\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,climon,clipolynom\})) or \+ \n type(a1, set(\{clibasmon,climon,clipolynom\}))) and \n \+ (type(a2,list(clibasmon)) or type(a2,set(clibasmon)))) or nar gs>2 then\nerror \"arguments of type list/set(\{clibasmon,climon,clipo lynom\}) and list/set(clibasmon) were expected\" \nend if;\nend if;\ni f nops(a1)=1 then return a1 end if;\n#L:=sort(map(displayid,convert(a1 ,list)),bygrade):\nL:=map(displayid,convert(a1,list)): ####NO SORT\nif nargs=2 then clibasis:=sort(convert(a2,list),bygrade) else \n cliba sis:=sort(convert(`union`(op(map(cliterms,L))),list),bygrade);\nend if ;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[rank](M):m:=linalg[row dim](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](lina lg[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 "mini malideal" }{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 prim itive idempotent in Cl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 151 "The first argument of the procedure is an ordered list of basis monomials sorted bygrade, e.g., a Clifford b asis 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 'bygrade' is a new proc edure in this package described below. The output from the procedure \+ 'cbasis' is already sorted that way." }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argument is the idempot ent f. If the idempotent f is the same as the one stored under clidat a()[4] then 'minimalideal' uses the generators of S stored under cli data()[5] to generate the real basis and it returns the stored list c lidata()[5] as the second list in its ouput. If f does not equal cli data()[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 values of B have been specifi ed.\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 of S written as expanded Cl ifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 106 "(2) the second list contains basis monomials from the standard basis in Cl(B) which generate the " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by multiplying 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 ordered lists.\n\nTypic al use: minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(I d+e3),'left');\n minimalideal([Id,e1,e2,e3,e1we 2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'right');\n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2248 "minimalideal:=proc(a1,a2,a3) \n local L,gens,m,flag1,f,flag_left,data,SB,g,SBgens,pq,p,q,l,ni,realdim, dimoverK,cb,N,bel; \nglobal B,_shortcut_in_minimalideal,_prolevel;\nop tions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: September 17, 20 05`;\n#############################################\nif not type(B,dia gmatrix) then \n error \"bilinear form B has not been assigned a mat rix or is not diagonal\" \nend if; \nif not _prolevel then\n if not \+ type(a1,list(\{clibasmon,climon,clipolynom\})) then\n error \+ \"first argument must of type list(\{clibasmon,climon,clipolynom\})\" \+ \n elif not type(a2,'primitiveidemp') then \n error \"second argument must be a primitive idempotent\" \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 end if;\ng:='g':\nL:=sort (a1,bygrade):\nif _shortcut_in_minimalideal then\n m:=maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 then\n data:=clidata ():\n if eval(eval(data[4]))=eval(f) or eval(eval(data[4]))=grade inv(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,a 3];\n end if;\n end if;\nend if; \n#If can't use the shortcu t, perform necessary computations.\npq:=Bsignature():\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:=ni \nend if;\ngens:=cli data()[5]: #put elements from clidata()[5] first in L\nL:=remove(membe r,L,gens):\nL:=[op(gens),op(L)]:\nSB:=[f]:SBgens:=[Id]:cb:=remove(memb er,L,[Id]); \nfor g in cb while nops(SB) < realdim do\n N:=nops(SB) :\n if flag_left then bel:=cmulQ(g,f) else bel:=cmulQ(f,g) end if; \+ \n SB:=findbasis([op(SB),bel]); \n if nops(SB)>N then SBgens:=[ op(SBgens),g] end if;\nend do:\nreturn [SB,SBgens,a3];\nend proc:\n" } }{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedure " }{TEXT 335 6 "Kfi eld" }{TEXT -1 340 " computes a basis for a field K. The field K is t he field of the spinor space S = Cl(B)f or S = fCl(B) of the given Cli fford algebra Cl(B). It is isomorphic to the reals, or to the comple xes, 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 signatur e 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 the same as the outp ut from the procedure 'minimalideal'. The second argument is the idem potent 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 leaves only those whos e square modulo f is either +1 or -1. It returns those elements as th e first list in its output. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 200 "If the primitive idempotent f is the \+ same as the one stored under clidata()[4] and if the generators 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 generato rs of K stored under clidata()[6] and returns them as 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 contains generator s (Clifford basis monomials) of the elements in the first list. Eleme nts of the two lists are in one-to-one relationship. " }}{PARA 258 " " 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[diag](1,-1):cliba sis:=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:=pr oc(a1::list(\{list,string,symbol\}),a2::clipolynom) \nlocal SB,gens,f, ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,dimen,Kbasis,Kgens ,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_prolevel;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: September 17, 2005`;\n#### #########################################\n#### Local procedure needed only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f,mi,clibas,clib as2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:=max(op(map(maxi ndex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\nif type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n clibas: =remove(member,clibas,gens):\n clibas:=[op(gens),o p(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 rem ove(member,clibas2,[x,y]) do\n if member(cmul(x,f),\{Kbasis[2],-K basis[2]\}) then \n if member(cmul(y,f),\{Kbasis[3],-Kbasis[3] \}) then\n if member(cmul(z,f),\{Kbasis[4],-Kbasis[4]\}) th en \n if type([x,y,z],'purequatbasis') then 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') then \n erro r \"second argument must be a primitive idempotent\"\n end if;\nend \+ if;\n##############################################\nSB:=a1[1]:gens:=a 1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n######################### #####################\nif not member(f,SB) then \n error \"idempoten t entered %1 is not a member of the first list\",f \nend if;\n###new l ine 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:=clidata():\nfield:= data[1]:\nif field = 'real' then return [[f],[Id]] \nelif field = 'com plex' then \n if _shortcut_in_Kfield then\n f_from_d ata:=eval(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 Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nops(Kgens))] \nend if;\nre turn ([Kbasis,Kgens]) \nend if;\nend if;\n############################ #####################################\n#Do this when shortcut can't be used when field = 'complex'\n######################################## #########################\nKdim:=2:\nKbasis:=[f]:Kgens:=[Id]:\nn:=nops (gens):\nfor i from 1 to n while nops(Kbasis) < Kdim do\n if cmul( gens[i],gens[i])=-Id then\n expr:=cmul(f,gens[i],f);\n \+ if expr<>0 then Kbasis:=[op(Kbasis),SB[i]];\n \+ Kgens:=[op(Kgens),gens[i]] \n end if;\n end if:\nend do;\nreturn [Kbasis,Kgens];\n######################################## #######################\nelif field = 'quaternionic' then \n dimen :=linalg[coldim](B):\n if dimen=2 then Kbasis:=[op(SB)];\n \+ Kgens:=[op(gens)];\n return [Kbasis,K gens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) then\n if _s hortcut_in_Kfield then\n f_from_data:=eval(eval(data[4])) :\n fg:=gradeinv(f): \n if member(f_from_da ta,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif flag3 then Kbasis:= [f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nops(Kgens))] \n end if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\nend if;\n########## ######################################################\n#Do this when \+ shortcut can't be used and field = 'quaternionic'\n################### #############################################\nKdim:=4:\nKbasis:=[f]:K gens:=[Id]:\nn:=nops(gens):\nfor i from 1 to n while nops(Kbasis) < Kd im do\n if cmul(gens[i],gens[i])=-Id then\n expr:=cmul(f, gens[i],f);\n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]];\n \+ Kgens:=[op(Kgens),gens[i]] \n end i f;\n end if:\nend do;\n############################\n ijk:=T4(K basis);\n############################\n Kgens:=[Id,op(ijk)]:\nif f lag3 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 help.\" \nend if;\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. Procedure " } {TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spinor basis for S =Cl(B)f or S=fCl(B) over a field K where K is isomorphic to the reals , or to the complexes, or to the quaternions according to whether (p-q ) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (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 ordered list SBgens containing generators of a real basis in a minimal ideal Cl(B)f or fC l(B) (it doesn't matter whether the ideal was left or right). These g enerators are found by the procedure 'minimalideal' and are returned b y it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the primitive 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 argu ment is a list FBgens of generators that generate the field K; these g enerators are returned as a second list by the procedure 'Kfield'." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The \+ fourth argument is either 'left' or 'right' depending whether we deal \+ with the left minimal ideal Cl(B)f or the right minimal 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 respectively clidata() [5], clidata()[4], and clidata()[6] in that order, i.e., SBgens=clid ata()[5], f=clidata()[4], and FBgens=clidata()[6], then the procedur e finds previously computed generators of S over K which are stored as clidata()[7]. These generators are then used to compute the K-basis \+ for S=Cl(B)f or S=fCl(B) depending whether the fourth argument is 'lef t' 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 fi rst list is an ordered list of Clifford polynomials which give a basis in Cl(B)f or fCl(B) (depending on what was the fourth argument in th e procedure);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 178 "(2) the second list is an ordered list of generators ove r f which give the elements in the first list. There is a one-to-one \+ correspodence between the elements of the two lists." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 "(3) the third ele ment in the output is either 'left' or 'right' and it matches the four th argument in the input to the procedure. That element is to remind \+ the user that the basis returned as the first list is for the left or \+ right ideal respectively. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 334 "Typical use: dim:=2:B:=linalg[diag](1, -1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n SBgens:=sb asis[2];FBgens:=fbasis[2];\n spinorKbasis(SBge ns,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2866 "spinorKb asis:=\nproc(a1::list,a2::\{clibasmon,climon,clipolynom\},a3::list,a4: :\{string,symbol\}) \nlocal flag,flag_left,Kdim,f,SBgens,SB,FBgens,g,S BKbasis,SBKgens,data,i,poss,m,p; \nglobal B,_shortcut_in_spinorKbasis, _prolevel;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nif \+ not type(B,matrix) then \n error \"matrix must be assigned to B\" \n end if;\nif not _prolevel then\n if not type(a2,'idempotent') then \+ \n error \"second argument must be an idempotent\" elif\n not m ember(a4,\{'left','right',\"left\",\"right\"\}) then \n error \"t he fourth argument must be 'left', or 'right'\"\n end if;\nend if;\n SBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens then return [[f], [Id],a4] end if;\nif a4='left' or a4=\"left\" then flag_left:=true els e flag_left:=false end if;\ndata:=clidata():\nif _shortcut_in_spinorKb asis then\n if eval(f)=eval(data[4]) and SBgens=data[5] and FBgen s=data[6] then\n SBKgens:=data[7];\n SBKbasis:=[]:\n g: ='g':\n if flag_left then SBKbasis:=[seq(cmulQ(g,f),g=SBKgens)]\n else SBKbasis:=[seq(cmulQ(f,g),g=SBKgens)]\n e nd if; \n return [SBKbasis,SBKgens,a4];\n end if;\nend if; \+ \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif flag_left then SB:=[seq(cmul Q(g,f),g=SBgens)] \n else SB:=[seq(cmulQ(f,g),g=SBgens)]\n end if;\nif Kdim=1 then return [SB,SBgens,a4] end if;\nm:=max(op(map(m axindex,SBgens)));\nposs:=cbasis(m);\nSBKgens:=[Id]:\ng:='g':\nif flag _left then SB:=remove(member,SB,[seq(cmul(f,g),g=FBgens)])\n \+ else SB:=remove(member,SB,[seq(cmul(g,f),g=FBgens)])\nend if;\nposs :=remove(member,poss,FBgens);\nfor g in poss while nops(SB)>0 do\n \+ if flag_left then \n for i from 1 to Kdim do p[i]:=cmul(g,f,FBge ns[i]) end do;\n else \n for i from 1 to Kdim do p[i]:=cmul(F Bgens[i],f,g) end do;\n end if; \n for i from 1 to Kdim do\n flag[1,i]:=member(p[i],SB): \n flag[2,i]:=member(-p[ i],SB):\n end do;\n if Kdim=2 then \n if (flag[1,1] or \+ flag[2,1]) and (flag[1,2] or flag[2,2]) then\n SB:=remove(mem ber,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]) a nd\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 S BKgens:=[op(SBKgens),g]\n end if:\n end if;\n if flag[1,1] \+ then SBKbasis:=[op(SBKbasis),p[1]] else\n SBKbasi s:=[op(SBKbasis),-p[1]] \n end if;\n end do;\ng:='g':\nif flag_l eft then SBKbasis:=[seq(cmul(g,f),g=SBKgens)] else\n \+ SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend if;\nreturn [SBKbasis,SBKgen s,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes the square of a basis element u in a left or right minimal ideal Cl(B)f or fCl(B) ent ered as the first argument modulo a primitive idempotent f entered a s the second argument. The procedure doesn't check whether f is primi tive or not. Thus, the procedure returns 1 or -1 depending whether cm ul(u,u) = f or cmul(u,u) = -f. The procedure returns 0 if u is a nil potent 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:=proc(a1::\{clibasmon,climon,clipolynom\} ,a2::idempotent) \nlocal p;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: September 17, 2005`;\n######################## #####################\nif nargs<>2 then \n error \"two arguments nee ded of type clibasmon, or climon, or clipolynom, and 'idempotent'\" \n end 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 expan d(p-a2)=0 then return 1 elif\n expand(p+a2)=0 then return -1 elif\n \+ (p=0 or type(a1,nilpotent)) then return 0 else \n error \"e ither element %1 is not a basis element or it does not belong to the s pinor space Cl(Q)f (or fCl(Q))\",a1 \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48. Procedure " }{TEXT 338 8 "RHnumber" } {TEXT -1 76 " gives the Radon-Hurwitz number for any integer.\n\nTypic al use: RHnumber(2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 506 "RHnumber :=proc(a1::integer)\noptions `Copyright (c) 1995-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: 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 r eturn RHnumber(a1-8)+4 elif\n a1<0 then return RHnumber(a1+8)-4 else \n error \"wrong value of the argument. See ?RHnumber for more help. \" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 49. \+ Procedure " }{TEXT 339 7 "clidata" }{TEXT -1 304 " returns a list cont aining basic information about the orthogonal Clifford algebra Cl(Q) o f the given bilinear form B (assumed to have been diagonalized). The \+ procedure must be called with B, or with a signature of B given as a l ist [p,q], or simply as clidata() (currently defined B will then be us ed)." }}{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 representation of Cl(Q) is over the field K of the reals, \+ complexes, or quaternions;\n" }}{PARA 258 "" 0 "" {TEXT -1 305 "(b) t he second entry is the dimension of the spinor representation over the field K;\n\n(c) the third entry is 'simple' or 'semisimple' depending on the structure of the algebra;\n\n(d) the fourth entry is a primiti ve idempotent f which may be used to generate a left or right minim al 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 they could be easily recognized as Clifford p roducts of simpler projection operators. The number of factors in the se 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 ge nerate Cl(Q)f and fCl(Q).\n\n(f) the sixth entry is a list of basis mo nomials ordered by grade which give a basis for K (this is in terms of these monomials that matrices representing Clifford polynomials will \+ be written by the procedure 'spinorKrepr').\n" }}{PARA 258 "" 0 "" {TEXT -1 92 "(g) the seventh entry is a list of basis monomials ordere d by grade which generate S over K." }}{PARA 258 "" 0 "" {TEXT -1 139 "\nIf the procedure is called as 'clidata()' then it returns informati on about the Clifford algebra 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() lo cal a1,clidata2;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=0 then a1:=`B` else a1:=args end if:\nif not type (a1,\{list(nonnegint),matrix\}) then\n WARNING(\"to find out about C lifford algebra Cl_\{p,q\} try clidata([p,q]) or enter ?clidata for mo re 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 t he procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata 2" }{TEXT -1 0 "" }{MPLTEXT 1 0 16602 ":=proc(a1::\{list(nonnegint),ma trix\})\nlocal SBgens,FBgens,SBKgens,p,q,l,ni,K,dimoverK,dimoverR,numf act,struct,primidemp;\nglobal B;\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and 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 depending on [p,q]\n#dimoverK = dimension of spinor represe ntation over the field K\n#dimoverR = dimension of spinor representati on over the reals R\n#numfact = number of idempotent factors in any pr imitive idempotent\n#SBgens = basis monomials generating Cl(Q)f and fC l(Q) over R\n#FBgens = basis monomials providing a basis for K\n#SBKge ns = basis monomials generating Cl(Q)f and fCl(Q) over K \n#p = number of +1 in the diagonal form Q of B\n#q = number of -1 in the diagonal \+ form Q of B\n#struct = structure of Cl(Q) is 'simple' or 'semisimple' \n#primidemp = primitive idempotent f to generate Cl(B)f or fCl(B)\nif nargs=0 then\n###new line instead of >>>not assigned(B)<<<\nif not ty pe(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(nonnegi nt)) 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 els e \n error \"wrong argument types in 'clidata'\" \n end if;\n if type(args[1],list(nonnegint)) and (p>9 or q>9) then\n error \"p a nd 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'; dimove rR:=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:='qu aternionic'; dimoverR:=4*ni; dimoverK:=ni \nend if;\nnumfact:=q-RHnumb er(q-p);\nif modp((p-q) = 1,4) then struct:='semisimple' \n else str uct:='simple' \nend if;\nprimidemp:=table():SBgens:=table():FBgens:=ta ble():SBKgens:=table():\n#########################>>>DATA<<<########## #######################\n#Real, simple (13 cases)\nprimidemp[[0,0]]:=I d; #real numbers\nSBgens[[0,0]]:=[Id];\nFBgens[[0,0]]:=[Id];\nSBKgens [[0,0]]:=SBgens[[0,0]];\n\nprimidemp[[1,1]]:=(1/2)*(Id+e1we2);\nSBgens [[1,1]]:=[Id,e1];\nFBgens[[1,1]]:=[Id];\nSBKgens[[1,1]]:=SBgens[[1,1]] ;\n\nprimidemp[[2,0]]:=(1/2)*(Id+e1);\nSBgens[[2,0]]:=[Id,e2];\nFBgens [[2,0]]:=[Id];\nSBKgens[[2,0]]:=SBgens[[2,0]];\n\nprimidemp[[2,2]]:=\n ''cmulQ''((1/2)*(Id+e1we3),(1/2)*(Id+e2we4));\nSBgens[[2,2]]:=[Id,e1,e 2,e1we2];\nFBgens[[2,2]]:=[Id];\nSBKgens[[2,2]]:=SBgens[[2,2]];\n\npri midemp[[3,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we4));\nSBgens[[3 ,1]]:=[Id,e2,e3,e2we3];\nFBgens[[3,1]]:=[Id];\nSBKgens[[3,1]]:=SBgens[ [3,1]];\n\nprimidemp[[0,6]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id +e3we4we5),(1/2)*(Id+e1we4we6));\nSBgens[[0,6]]:=[Id,e1,e2,e3,e4,e5,e6 ,e1we5];\nFBgens[[0,6]]:=[Id];\nSBKgens[[0,6]]:=SBgens[[0,6]];\n\nprim idemp[[3,3]]