{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]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2)*(Id+e2we5),(1/2)*(Id+ e3we6));\nSBgens[[3,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFB gens[[3,3]]:=[Id];\nSBKgens[[3,3]]:=SBgens[[3,3]];\n\nprimidemp[[4,2]] :=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we5),(1/2)*(Id+e4we6));\nSBgen s[[4,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,2]]:=[I d];\nSBKgens[[4,2]]:=SBgens[[4,2]];\n\nprimidemp[[4,4]]:=\n''cmulQ''(( 1/2)*(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7),(1/2)*(Id+e4we8));\n SBgens[[4,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,e1w e2we3,\n e1we2we4,e1we3we4,e2we3we4,e1we2we3we4];\nFBgens[[4,4]]:=[Id] ;\nSBKgens[[4,4]]:=SBgens[[4,4]];\n\nprimidemp[[5,3]]:=\n''cmulQ''((1/ 2)*(Id+e1),(1/2)*(Id+e3we6),(1/2)*(Id+e4we7),(1/2)*(Id+e5we8));\nSBgen s[[5,3]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,e2we3we4 ,\ne2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[5,3]]:=[Id];\nSBK gens[[5,3]]:=SBgens[[5,3]];\n\nprimidemp[[8,0]]:=\n''cmulQ''((1/2)*(Id +e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7),\n (1/2)*( Id+e2we4we6we8));\nSBgens[[8,0]]:=[Id,e2,e3,e4,e5,e6,e7,e8,e2we3,e2we4 ,e2we5,e2we6,e2we7,\ne2we8,e3we8,e2we3we8];\nFBgens[[8,0]]:=[Id];\nSBK gens[[8,0]]:=SBgens[[8,0]];\n\nprimidemp[[1,7]]:=\n''cmulQ''((1/2)*(Id +e2we3we4),(1/2)*(Id+e4we5we6),(1/2)*(Id+e2we5we7),\n (1/2)*( Id+e1we8));\nSBgens[[1,7]]:=[Id,e1,e2,e3,e4,e5,e6,e7,e1we2,e1we3,e1we4 ,e1we5,e1we6,\ne1we7,e2we6,e1we2we6];\nFBgens[[1,7]]:=[Id];\nSBKgens[[ 1,7]]:=SBgens[[1,7]];\n\nprimidemp[[0,8]]:=\n''cmulQ''((1/2)*(Id+e1we2 we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n (1/2)*(Id+e3w e6we7));\nSBgens[[0,8]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3w e8,e4we8,e5we8,e6we8,e7we8];\nFBgens[[0,8]]:=[Id];\nSBKgens[[0,8]]:=SB gens[[0,8]];\n\n#Complex, simple (15 cases)\nprimidemp[[0,1]]:=Id; #c omplex numbers\nSBgens[[0,1]]:=[Id,e1];\nFBgens[[0,1]]:=[Id,e1];\nSBKg ens[[0,1]]:=[Id,e1];\n\nprimidemp[[1,2]]:=(1/2)*(Id+e1we3);\nSBgens[[1 ,2]]:=[Id,e1,e2,e1we2];\nFBgens[[1,2]]:=[Id,e2];\nSBKgens[[1,2]]:=[Id, e1];\n\nprimidemp[[3,0]]:=(1/2)*(Id+e1);\nSBgens[[3,0]]:=[Id,e2,e3,e2w e3];\nFBgens[[3,0]]:=[Id,e2we3];\nSBKgens[[3,0]]:=[Id,e2];\n\nprimidem p[[0,5]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5));\nSBgen s[[0,5]]:=[Id,e1,e2,e3,e4,e5,e1we4,e1we5];\nFBgens[[0,5]]:=[Id,e3];\nS BKgens[[0,5]]:=[Id,e1,e4,e1we4];\n\nprimidemp[[2,3]]:=\n''cmulQ''((1/2 )*(Id+e1we4),(1/2)*(Id+e2we5));\nSBgens[[2,3]]:=[Id,e1,e2,e3,e1we2,e1w e3,e2we3,e1we2we3];\nFBgens[[2,3]]:=[Id,e3];\nSBKgens[[2,3]]:=[Id,e1,e 2,e1we2];\n\nprimidemp[[4,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4w e5));\nSBgens[[4,1]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgen s[[4,1]]:=[Id,e2we3];\nSBKgens[[4,1]]:=[Id,e2,e4,e2we4];\n\nprimidemp[ [1,6]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e4we5we6),(1/2)*(Id+ e1we7));\nSBgens[[1,6]]:=[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5 ,e1we6,e2we5, e2we6,e1w e2we5,e1we2we6]; \nFBgens[[1,6]]:=[Id,e4];\nSBKgens[[1,6]]:=[Id,e1,e2, e5,e1we2,e1we5,e2we5,e1we2we5];\n\nprimidemp[[3,4]]:=\n''cmulQ''((1/2) *(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7));\nSBgens[[3,4]]:=[Id,e1 ,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,\n e1we2w e3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4]; \nFBgens[[3,4]]:=[Id,e4]; \nSBKgens[[3,4]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\n\nprimide mp[[5,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we6),(1/2)*(Id+e5we7) );\nSBgens[[5,2]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5 ,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e2we3we4we5]; \+ \nFBgens[[5,2]]:=[Id,e2we3];\nSBKgens[[5,2]]:=[Id,e2,e4,e5,e2we4,e2we5 ,e4we5,e2we4we5];\n\nprimidemp[[7,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2) *(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7));\nSBgens[[7,0]]:=[Id,e2,e3,e 4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,\n e4we6,e4we7 ,e2we4we6,e2we4we7]; \nFBgens[[7,0]]:=[Id,e2we3];\nSBKgens[[7,0]]:=[Id ,e2,e4,e6,e2we4,e2we6,e4we6,e2we4we6];\n\nprimidemp[[0,9]]:=\n''cmulQ' '((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n \+ (1/2)*(Id+e3we6we7));\nSBgens[[0,9]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e 8,e9,e1we8,e1we9,e2we8,e2we9,e3we8,e3we9,\n e4we8,e4we9,e5we8,e5we9,e6 we8,e6we9,e7we8,e7we9,e8we9,e1we8we9,\n e2we8we9,e3we8we9,e4we8we9,e5w e8we9,e6we8we9,e7we8we9];\nFBgens[[0,9]]:=[Id,e8we9];\nSBKgens[[0,9]]: =[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3we8,e4we8,\n \+ e5we8,e6we8,e7we8];\n\nprimidemp[[2,7]]:=\n''cmulQ''((1/2)*(Id+e3we4 we5),(1/2)*(Id+e5we6we7),(1/2)*(Id+e1we8),\n (1/2)*(Id+e2we9) );\nSBgens[[2,7]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e1we2,e1we3,e1we4,e1we5, e1we6,e1we7,e2we3,\n e2we4,e2we5,e2we6,e2we7,e3we6,e3we7,e1we2we3,e1we 2we4,e1we2we5,\n e1we2we6,e1we2we7,e1we3we6,e1we3we7,e2we3we6,e2we3we7 ,e1we2we3we6,\n e1we2we3we7];\nFBgens[[2,7]]:=[Id,e5];\nSBKgens[[2,7]] :=\n[Id,e1,e2,e3,e6,e1we2,e1we3,e1we6,e2we3,e2we6,e3we6,e1we2we3,e1we2 we6,e1we3we6,\n e2we3we6,e1we2we3we6];\n\nprimidemp[[4,5]]:=\n''cmulQ' '((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2)*(Id+e3we8),(1/2)*(Id+e4we9)) ;\nSBgens[[4,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,e2we3,e 2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1 we3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1we2we3we4,e1w e2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3we4we5];\nFBge ns[[4,5]]:=[Id,e5];\nSBKgens[[4,5]]:=\n[Id,e1,e2,e3,e4,e1we2,e1we3,e1w e4,e2we3,e2we4,e3we4,e1we2we3,e1we2we4,\n e1we3we4,e2we3we4,e1we2we3we 4];\n\nprimidemp[[6,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we7),(1 /2)*(Id+e5we8),(1/2)*(Id+e6we9));\nSBgens[[6,3]]:=\n[Id,e2,e3,e4,e5,e6 ,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5we6,e2we3w e4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e 3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3 we4we5we6,e2we3we4we5we6];\nFBgens[[6,3]]:=[Id,e2we3];\nSBKgens[[6,3]] :=\n[Id,e2,e4,e5,e6,e2we4,e2we5,e2we6,e4we5,e4we6,e5we6,e2we4we5,e2we4 we6,\n e2we5we6,e4we5we6,e2we4we5we6];\n\nprimidemp[[8,1]]:=\n''cmulQ' '((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7),\n \+ (1/2)*(Id+e8we9));\nSBgens[[8,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e2we 3,e2we4,e2we5,e2we6,e2we7,e2we8,e3we8,\n e4we6,e4we7,e4we8,e5we8,e6we8 ,e7we8,e2we3we8,e2we4we6,e2we4we7,\n e2we4we8,e2we5we8,e2we6we8,e2we7w e8,e4we6we8,e4we7we8,e2we4we6we8,\n e2we4we7we8];\nFBgens[[8,1]]:=[Id, e2we3];\nSBKgens[[8,1]]:=\n[Id,e2,e4,e6,e8,e2we4,e2we6,e2we8,e4we6,e4w e8,e6we8,e2we4we6,e2we4we8,\n e2we6we8,e4we6we8,e2we4we6we8];\n\n#Quat ernionic, simple (12 cases)\nprimidemp[[0,2]]:=Id; #quaternions\nSBgen s[[0,2]]:=[Id,e1,e2,e1we2];\nFBgens[[0,2]]:=[Id,e1,e2,e1we2];\nSBKgens [[0,2]]:=[Id];\n\nprimidemp[[0,4]]:=(1/2)*(Id+e1we2we3);\nSBgens[[0,4] ]:=[Id,e1,e2,e3,e4,e1we4,e2we4,e3we4];\nFBgens[[0,4]]:=[Id,e1,e1we3,e3 ];\nSBKgens[[0,4]]:=[Id,e4];\n\nprimidemp[[1,3]]:=(1/2)*(Id+e1we4);\nS Bgens[[1,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[1,3]] :=[Id,e2,e3,e2we3];\nSBKgens[[1,3]]:=[Id,e1];\n\nprimidemp[[4,0]]:=(1/ 2)*(Id+e1);\nSBgens[[4,0]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4]; \nFBgens[[4,0]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[4,0]]:=[Id,e2];\n\n primidemp[[1,5]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e1we6));\n SBgens[[1,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,e2we5,e3we5, \n e4we5,e1we2we5,e1we3we5,e1we4we5];\nFBgens[[1,5]]:=[ Id,e2,e2we4,e4];\nSBKgens[[1,5]]:=[Id,e1,e5,e1we5];\n\nprimidemp[[2,4] ]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6));\nSBgens[[2,4]]:=[Id ,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,\n e1w e2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4];\nFBgens[[2,4]]:=[Id,e3, e4,e3we4];\nSBKgens[[2,4]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[5,1]]:=\n' 'cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we6));\nSBgens[[5,1]]:=[Id,e2,e3,e4 ,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2w e3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[5,1]]:=[Id,e2we3,e2we4, e3we4];\nSBKgens[[5,1]]:=[Id,e2,e5,e2we5];\n\nprimidemp[[6,0]]:=\n''cm ulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5));\nSBgens[[6,0]]:=[Id,e2,e3 ,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,e4we6,\n e5we6, e2we3we6,e2we4we6,e2we5we6];\nFBgens[[6,0]]:=[Id,e2we3,e3we5,e2we5];\n SBKgens[[6,0]]:=[Id,e2,e6,e2we6];\n\nprimidemp[[2,6]]:=\n''cmulQ''((1/ 2)*(Id+e3we4we5),(1/2)*(Id+e1we7),(1/2)*(Id+e2we8));\nSBgens[[2,6]]:= \n[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5,e1we6,e2we3,e2we4,e2we 5,\n e2we6,e3we6,e4we6,e5we6,e1we2we3,e1we2we4,e1we2we5,e1we2we6,e1we3 we6,\n e1we4we6,e1we5we6,e2we3we6,e2we4we6,e2we5we6,e1we2we3we6,e1we2w e4we6,\n e1we2we5we6];\nFBgens[[2,6]]:=[Id,e3,e3we5,e5];\nSBKgens[[2,6 ]]:=[Id,e1,e2,e6,e1we2,e1we6,e2we6,e1we2we6];\n\nprimidemp[[3,5]]:=\n' 'cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2)*(Id+e3we8));\nSBgens[ [3,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,e2we3,e2we4,e2we5 ,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1we3we5,e1w e4we5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1we2we3we4,e1we2we3we5, \n e1we2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3we4we5];\nFBgens[[3,5]] :=[Id,e4,e5,e4we5];\nSBKgens[[3,5]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1 we2we3];\n\nprimidemp[[6,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we 7),(1/2)*(Id+e6we8));\nSBgens[[6,2]]:=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4 ,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5we6,e2we3we4,e2we3we5, e2we3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e3we5we6,e4we 5we6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3we4we5we6,e2 we3we4we5we6];\nFBgens[[6,2]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[6,2]] :=[Id,e2,e5,e6,e2we5,e2we6,e5we6,e2we5we6];\n\nprimidemp[[7,1]]:=\n''c mulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e7we8));\nSBgens [[7,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,e3we6,e 3we7,e4we6,\n e4we7,e5we6,e5we7,e6we7,e2we3we6,e2we3we7,e2we4we6,e2we4 we7,e2we5we6,\n e2we5we7,e2we6we7,e3we6we7,e4we6we7,e5we6we7,e2we3we6w e7,e2we4we6we7,\n e2we5we6we7];\nFBgens[[7,1]]:=[Id,e2we3,e3we5,e2we5] ;\nSBKgens[[7,1]]:=[Id,e2,e6,e7,e2we6,e2we7,e6we7,e2we6we7];\n\n#Real, semi-simple (8 cases)\nprimidemp[[1,0]]:=(1/2)*(Id+e1);\nSBgens[[1,0] ]:=[Id];\nFBgens[[1,0]]:=[Id];\nSBKgens[[1,0]]:=SBgens[[1,0]];\n\nprim idemp[[2,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3));\nSBgens[[2, 1]]:=[Id,e2];\nFBgens[[2,1]]:=[Id];\nSBKgens[[2,1]]:=SBgens[[2,1]];\n \nprimidemp[[3,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),(1/2)*( Id+e3we5));\nSBgens[[3,2]]:=[Id,e2,e3,e2we3];\nFBgens[[3,2]]:=[Id];\nS BKgens[[3,2]]:=SBgens[[3,2]];\n\nprimidemp[[0,7]]:= ''cmulQ''((1/2)*(I d+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n (1/2)* (Id+e3we6we7));\nSBgens[[0,7]]:=[Id,e1,e2,e3,e4,e5,e6,e7];\nFBgens[[0, 7]]:=[Id];\nSBKgens[[0,7]]:=SBgens[[0,7]];\n\nprimidemp[[4,3]]:=\n''cm ulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we5),(1/2)*(Id+e3we6),\n (1/2 )*(Id+e4we7));\nSBgens[[4,3]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4 ];\nFBgens[[4,3]]:=[Id];\nSBKgens[[4,3]]:=SBgens[[4,3]];\n\nprimidemp[ [9,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),1/2*(Id+e2we3 we6we7),\n (1/2)*(Id+e2we3we8we9),(1/2)*(Id+e2we4we6we8));\nS Bgens[[9,0]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2 we7,e2we8,e2we9];\nFBgens[[9,0]]:=[Id];\nSBKgens[[9,0]]:=SBgens[[9,0]] ;\n\nprimidemp[[5,4]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we6),(1/2 )*(Id+e3we7),\n (1/2)*(Id+e4we8),(1/2)*(Id+e5we9));\nSBgens[[ 5,4]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,e2we3we4, e 2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[5,4]]:=[Id];\nSBKgens [[5,4]]:=SBgens[[5,4]];\n\nprimidemp[[1,8]]:=\n''cmulQ''((1/2)*(Id+e1) ,(1/2)*(Id+e2we3we4we5),1/2*(Id+e2we3we6we7),\n (1/2)*(Id+e2w e3we8we9),(1/2)*(Id+e2we4we6we8));\nSBgens[[1,8]]:=[Id,e2,e3,e4,e5,e6, e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2we7,e2we8,e2we9];\nFBgens[[1,8]]:=[ Id];\nSBKgens[[1,8]]:=SBgens[[1,8]];\n\n#Complex, semi-simple - none\n \n#Quaternionic, semi-simple (5 cases)\nprimidemp[[0,3]]:=(1/2)*(Id+e1 we2we3);\nSBgens[[0,3]]:=[Id,e1,e2,e3];\nFBgens[[0,3]]:=[Id,e1,e2,e1we 2];\nSBKgens[[0,3]]:=[Id];\n\nprimidemp[[1,4]]:=\n''cmulQ''((1/2)*(Id+ e2we3we4),(1/2)*(Id+e1we5));\nSBgens[[1,4]]:=[Id,e1,e2,e3,e4,e1we2,e1w e3,e1we4];\nFBgens[[1,4]]:=[Id,e2,e3,e2we3];\nSBKgens[[1,4]]:=[Id,e1]; \n\nprimidemp[[5,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5) );\nSBgens[[5,0]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5];\nFBgens[[5,0]]: =[Id,e2we3,e3we5,e2we5];\nSBKgens[[5,0]]:=[Id,e2];\n\nprimidemp[[2,5]] :=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e1we6),(1/2)*(Id+e2we7)); \nSBgens[[2,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,\n \+ e2we3,e2we4,e2we5,e1we2we3,e1we2we4,e1we2we5];\nFBgens[[2,5]]: =[Id,e3,e3we5,e5];\nSBKgens[[2,5]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[6, 1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e6we7) );\nSBgens[[6,1]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,\n e4we6,e5we6,e2we3we6,e2we4we6,e2we5we6];\nFBgens[[6,1 ]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[6,1]]:=[Id,e2,e6,e2we6];\n\nprim idemp[[7,2]]:=''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we8),\n \+ (1/2)*(Id+e3we9),(1/2)*(Id+e4we5we6we7));\nSBgens[[7,2]]: =[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,\ne3we4,e3we5,e3w e6,e3we7,e4we5,e4we6,e4we7,e2we3we4,e2we3we5,e2we3we6,\ne2we3we7,e2we4 we5,e2we4we6,e2we4we7,e3we4we5,e3we4we6,e3we4we7,\ne2we3we4we5,e2we3we 4we6,e2we3we4we7];\nFBgens[[7,2]]:=[Id,e4we5,e5we7,e4we7];\nSBKgens[[7 ,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\n\nprimidemp[[3,6]]:= \n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),\n (1/2)*(Id+e3we5 ),(1/2)*(Id+e6we7we8we9));\nSBgens[[3,6]]:=[Id,e2,e3,e6,e7,e8,e9,e2we3 ,e2we6,e2we7,e2we8,e2we9,e3we6,e3we7,\ne3we8,e3we9,e6we7,e6we8,e6we9,e 2we3we6,e2we3we7,e2we3we8,e2we3we9,e2we6we7,\ne2we6we8,e2we6we9,e3we6w e7,e3we6we8,e3we6we9,e2we3we6we7,e2we3we6we8,\ne2we3we6we9];\nFBgens[[ 3,6]]:=[Id,e6we7,e7we9,e6we9];\nSBKgens[[3,6]]:=[Id,e2,e3,e6,e2we3,e2w e6,e3we6,e2we3we6];\n\nreturn ([K,dimoverK,struct,primidemp[[p,q]],\n \+ SBgens[[p,q]],FBgens[[p,q]],SBKgens[[p,q]]]);\nend proc:\n##### #############\nreturn clidata2(a1); #### <<< Return from 'clidata'\nen d proc: #### <<< End of 'clidata'\n" }}{PARA 258 "" 0 "" {TEXT -1 18 " No. 53. Procedure " }{TEXT 340 10 "Bsignature" }{TEXT -1 313 " finds t he signature of the form B assuming that B is a diagonal matrix or a \+ symmetric matrix. It returns a list L with two or three integers depen ding on whether B is non-degenerate or degenerate, that is, L=[p,q] or L=[p,q,d]. Here d = dim(rad B), and p (q) denotes number of +1 (-1) i n the diagonal form of B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 42 "Typical use: Bsignature(); Bsignature(B);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1291 "Bsignature:=proc() local curB,B diag,pos,neg,deg,i,L;global B;\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: September 17, 2005`;\n############################## ###############\nif nargs=0 then\n if not type(B,matrix) then\n \+ error \"square matric should be assigned to B first\"\n else cur B:=B \n end if;\nelif nargs=1 then\n if not type(evalm(args[1]), matrix) then\n error \"argument entered is not a matrix\"\n e lse curB:=evalm(args[1]) \n end if;\nelse error \"wrong number of \+ arguments. See ?Bsignature for more help.\" \nend if;\nBdiag:=diagonal ize(evalm(curB-(curB-linalg[transpose](curB))/2));\nif not type(Bdiag, diagmatrix) then \n error \"unable to diagonalize symmetric part of \+ the input\"\nend if;\nL:=map(signum,[seq(Bdiag[i,i],i=1..linalg[coldim ](Bdiag))]):\nif not type(L,list(integer)) then\n error \"unable to \+ determine signs of expressions %1\",L\nend if;\npos:=0:neg:=0:deg:=0: \nfor i from 1 to linalg[coldim](Bdiag) do\nif L[i]<>0 then\n if eva lf(L[i])>0 then pos:=pos+1 elif\n evalf(L[i])<0 then neg:=neg+1 e lse\n error \"unable to determine sign of %1\",Bdiag[i,i]\n end if;\nelse deg:=deg+1;\nend if;\nend do;\nif deg=0 then return [pos,ne g] else return [pos,neg,deg] end if;\nend proc:\n" }}{PARA 258 "" 0 " " {TEXT -1 157 "No. 51. Spinor representation of Cl(Q) in S=Cl(Q)f and S=fCl(Q) over the field K of the reals, complexes, or quaternions whe n Cl(Q) is simple.\nThe procedure " }{TEXT 341 11 "spinorKrepr" } {TEXT -1 183 " finds matrix representation of any Clifford polynomial \+ in a minimal left or right ideal in Cl(Q) generated by a primitive ide mpotent f. The procedure is invoked with four arguments:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(1) the fir st argument is an algebraic expression of type clipolynom;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "(2) the se cond argument is a list of generators of the minimal ideal S considere d as a K-vector space. For standard f equal to clidata()[4] these gen erators are stored under clidata()[6] for the given form B; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 241 "(3) the th ird argument is a list of basis elements spanning K. For standard f e qual to clidata()[4] these generators are stored under clidata()[5]. \+ Matrices computed by 'spinorKrepr' will be expressed in terms of these basis elements of K;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 111 "(4) the fourth argument is a one of the strings ' left' or 'right' depending whether the ideal is left or right." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard input is used, i.e., the second argument equals clidata()[7] and the third argument equals clidata()[5], the procedure tries to us e previously computed matrices representing 1-vectors. These matrices are stored as .m files with the names 'matrealL.m', 'matcompL.m', 'ma tquatL.m' for real, complex, and quaternionic matrices in the left-reg ular spinor representation. If the first argument entered belongs to C l(Q) whose 1-vector matrices have been previously computed, the proced ure calls 'matKrepr' which makes use of these pre-computed matrices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 470 "Ty pical use: dim:=4:B:=linalg[diag](1,-1,-1,-1):clibasis:=cbasis(dim):da ta:=clidata():\n f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n Kbasis:=spin orKbasis(sbasis[2],f,fbasis[2],'left');\n spino rKrepr(e1,Kbasis[1],fbasis[2],'left');\n spinor Krepr(2*e1+Id-3*e1we2we3,Kbasis[1],fbasis[2],'left');\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 5600 "spinorKrepr:=proc(a1::\{clibasmon,climon,cli polynom,numeric\},\n a2::list(\{clibasmon,climon,clip olynom\}),\n a3::list(\{clibasmon,climon,clipolynom\} ),\n a4::\{string,symbol\})\nlocal i,j,k,reprdim,r,a, FBgens,eq,hbasis,g,terms,sys,vars,sol,M,pqsig,pq,\n flag_left,dat a,Kbasis,f,v,pqmod8,n,expr,flag_simple;\nglobal B,_prolevel,_shortcut_ in_spinorKrepr,matrealL,matrealR,matcompL,matcompR,matquatL,matquatR; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif not type(B ,diagmatrix) then \n error \"bilinear form B must be defined as diag onal matrix\" \nelse pq:=Bsignature() \nend if;\n##################### #############\nif pq[1]-pq[2]=1 mod 4 then flag_simple:=false else fla g_simple:=true end if;\n##################################\nif maxinde x(a1) > linalg[coldim](B) then\n error \"maximum index %1 found in i nput is greater than the size %2 of the current bilinear form B\", max index(a1),linalg[coldim](B) \nend if;\n############################### ###\nhbasis:=a2:FBgens:=a3:reprdim:=nops(hbasis):n:=nops(FBgens):\n### ###############################\nif member(a4,\{'left',\"left\"\}) the n flag_left:=true elif\n member(a4,\{'right',\"right\"\}) then flag_ left:=false else\n error \"last argument expected to be 'left' or 'r ight' but received %1 instead\",a4\nend if; \n######################## ################################################\n#This procedure give s faithful representations when Cl(p,q) is simple\n#and unfaithful whe n Cl(p,q) is semi-simple. In order to get faithful\n#representations i n this last case, use 'matKrepr' or use this procedure\n#as shown in e xamples.\n############################################################ ############\n#if flag_simple then\nif a1=Id then return linalg[diag] (1$reprdim) elif\n a1=-Id then return linalg[diag](-1$reprdim) elif \n type(a1,numeric) then return linalg[diag](a1$reprdim) \nend if;\n ###################################################################### ##\n#when _shortcut_in_spinorKrepr is false, 'matKrepr' is not used\n# ###################################################################### #\nif _shortcut_in_spinorKrepr then\n pqmod8:=(pq[1]-pq[2]) mod 8:\n if member(pqmod8,\{0,1,2\}) and flag_left then \n #if not assi gned(matrealL) then readlib(matrealL) end if;\n pqsig:=map(op,[i ndices(matrealL)]) \n elif member(pqmod8,\{0,1,2\}) and not flag_lef t then\n #if not assigned(matrealR) then readlib(matrealR) end i f;\n pqsig:=map(op,[indices(matrealR)]) \n elif member(pqmod8, \{3,7\}) and flag_left then \n #if not assigned(matcompL) then re adlib(matcompL) end if;\n pqsig:=map(op,[indices(matcompL)]) \n \+ elif member(pqmod8,\{3,7\}) and not flag_left then\n #if not as signed(matcompR) then readlib(matcompR) end if;\n pqsig:=map(op, [indices(matcompR)]) \n elif member(pqmod8,\{4,5,6\}) and flag_left \+ then \n #if not assigned(matquatL) then readlib(matquatL) end if ;\n pqsig:=map(op,[indices(matquatL)]) \n elif member(pqmod8,\{ 4,5,6\}) and not flag_left then\n #if not assigned(matquatR) then readlib(matquatR) end if;\n pqsig:=map(op,[indices(matquatR)]) \+ \n end if;\n#####################################\n if member(pq,p qsig) then \n data:=clidata(pq):f:=eval(eval(data[4])):\n \+ g:='g': \n if flag_left then Kbasis:=[seq(cmulQ(g,f),g=da ta[7])] \n else Kbasis:=[seq(cmulQ(f,g),g=data[7])] \n end if; \n if hbasis=Kbasis then\n if FBgens=dat a[6] then return matKrepr(a1,a4) end if; \n end if;\n end i f;\nend if;\n#####################################\n#Continue finding \+ the matrix\n#####################################\na:='a':j:='j':k:='k ':\nif flag_left then\n expr:=add(add(a[j,k]*cmulQ(hbasis[j],FBgens[ k]),j=1..reprdim),k=1..n);\n for j from 1 to reprdim do r[j]:=add(a[ j,k] * FBgens[k],k=1..n) end do; \n for i from 1 to reprdim do\n \+ eq:=expand(cmulQ(a1,hbasis[i])-expr);\n terms:=cliterms(eq) ;\n eq:=clicollect(eq,terms);\n sys:=\{coeffs(eq,terms)\}: \n vars:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\};\n sol:= solve(sys,vars);\n if sol=NULL then \nerror \"unable to find mat rix due input error: check if the last argument matches the one previo usly used in 'spinorKbasis'\"\n end if; \n v[i]:=convert([ seq(subs(sol,r[j]),j=1..reprdim)],vector);\n end do:\nM:=linalg[tran spose](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\nreturn sub s(Id=1,evalm(M));\nelse \n expr:=add(add(a[j,k]*cmulQ(FBgens[k], hbasis[j]),j=1..reprdim),k=1..n);\n for j from 1 to reprdim do r[j]: =add(a[j,k] * FBgens[k],k=1..n) end do; \n for i from 1 to reprdim do \n eq:=expand(cmulQ(hbasis[i],a1)-expr);\n terms :=cliterms(eq);\n eq:=clicollect(eq,terms);\n sys:=\{coeff s(eq,terms)\}:\n vars:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\}; \n sol:=solve(sys,vars);\n if sol=NULL then \nerror \"unab le to find matrix due to input error: check if the last argument match es the one previously used in 'spinorKbasis'\"\n end if; \n \+ v[i]:=convert([seq(subs(sol,r[j]),j=1..reprdim)],vector);\n end do :\n################################################################### #########\n#The next line produces wrong results in some quat right ca ses:\n#M:=linalg[transpose](linalg[stackmatrix](seq(eval(v[i]),i=1..re prdim)));\n########################################################### #################\nM:=linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim) );\nreturn subs(Id=1,evalm(M));\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 52. Procedure " }{TEXT 342 5 "rmulm" }{TEXT -1 110 " extends the following multiplications to matrix entries: cmul , cmulQ, wedge, omul, `&r`, `&*`\n " }}{PARA 258 "" 0 " " {TEXT -1 271 "In this last case, the commutative multiplication `*` is applied to the matrix entries. It takes three arguments or four a rguments. If the fourth argument is used, it is either of type name/sy mbol/array/matrix or a numeric multiple of such type, for example, K o r -K. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 90 "To apply Clifford multiplication 'cmul[B]' to matrix entries en ter one of the following: " }}{PARA 258 "" 0 "" {TEXT -1 143 "rmulm(M 1, M2, cmul); rmulm(M1,M2,cmul,B);rmulm(M1,M2,cmul,K);rmulm(M1,M2,cmul ,-K);\n&cm(M1, M2); &cm[B](M1,M2);&cm[K](M1,M2);&cm[-K](M1,M2); \n" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply Clifford multiplication 'cmu lQ[B]' to matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 235 "rmulm(M1, M2, cmulQ); rmulm(M1,M2,cmulQ,B);rmulm(M1 ,M2,cmulQ,K);rmulm(M1,M2,cmulQ,-K);\n&cQm(M1, M2); &cQm[B](M1,M2);&cQm [K](M1,M2);&cQm[-K](M1,M2); \n\nTo apply wedge multiplication 'wedge ' to matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 60 "rmulm(M1, M2, `&w`); M1 &wm M2; rmulm(M1, M2, wedge) ; " }}{PARA 258 "" 0 "" {TEXT -1 113 "\nTo apply some generic possibl y non-commutative multiplication `&r` to matrix entries enter one of t he following:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmulm(M1, M2, `&r`); \+ M1 &rm M2; " }}{PARA 258 "" 0 "" {TEXT -1 98 "\nTo apply standard \+ commutative scalar multiplication to matrix entries enter one of the f ollowing:" }}{PARA 258 "" 0 "" {TEXT -1 39 "rmulm(M1, M2, `&*`); \+ M1 &* M2; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Similarly for matrices with quaternionic entries we have \+ as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply quaternionic multiplication 'qmul' to matrix ent ries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 72 "rmu lm(M1, M2, `&q`); M1 &qm M2; rmulm(M1,M2,qmul);\n\nTypical use: \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 73 " M1 := linalg[matrix](2, 2, [Id + e1we2, e2 + e3, e1 - e2, Id + e2we3]) ; " }}{PARA 258 "" 0 "" {TEXT -1 137 "M2 := linalg[matrix](2, 2, [Id \+ + e2we3, e3 + e4, e1 - e2, Id + e1we3]); \n\nM1 := linalg[matrix](2, \+ 2, [Id + 2*qi + 3*qj, qi, qi + qj]); " }}{PARA 258 "" 0 "" {TEXT -1 58 "M2 := linalg[matrix](2, 2, [Id + qi, qj, qk, Id - qi]); \n" }} {PARA 258 "> " 0 "" {MPLTEXT 1 0 7272 "rmulm:=proc(a1::\{list(matrix), dfmatrix,matrix,clipolynom,cliscalar,clibasmon,climon\},\n \+ a2::\{list(matrix),dfmatrix,matrix,clipolynom,cliscalar,clibasmon,clim on\},\n a3::\{name,function,procedure,symbol\}) \nlocal ar1 ,ar2,L,newL,m1,m2,r1,r2,c1,c2,i,j,k,M,reset_prolevel,coB,nameB,lname,t ail,out;\nglobal _prolevel, `&r`;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: September 17, 2005`;\n########################### ##################\n################################\nif has(0,map(sim plify,[a1,a2])) then return 0 end if;\n############################### # \nif nargs=3 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \+ \nelif nargs=4 then\n if type(eval(args[4]),\{name,symbol,matrix,ar ray\}) then\n coB:=1:\n nameB:=args[4];\n lname:=arg s[4];\n elif type(eval(args[4]),`&*`(numeric,\{name,symbol,matrix,a rray\})) then\n coB:=op(select(type,\{op(args[4])\},numeric));\n nameB:=op(remove(type,\{op(args[4])\},numeric));\n lname: =args[4]:\n else \n error \"wrong type of fourth argument %1 \+ in rmulm\",args[4] \n end if;\nelse\n error \"three or four argum ents expected in rmulm\"\nend if;\n################################\nt ail:=op(subsop(1=NULL,subsop(1=NULL,[args])));\n###################### ##########\n#return (a1,a2,a3,coB,nameB,lname,tail);\n################ ################\nif _prolevel then reset_prolevel:=true:\n \+ _prolevel:=false:\n else reset_prolevel:=false \nend if; \n################################\nif type(a 1,matrix) and not type(a1,\{dfmatrix,climatrix,cliscalar\}) and \n \+ type(a2,matrix) and not type(a2,\{dfmatrix,climatrix,cliscalar\})\nth en \n _prolevel:=reset_prolevel:\n return evalm(a1 &* a2) \n e nd if;\n################################\nif type(a1,list(matrix)) and type(a2,list(matrix)) then \n if nops(a1)<>nops(a2) then error \"re ceived lists of unequal lengths\" \n else\n i:='i':\n _pro level:=reset_prolevel:\n return [seq(procname(a1[i],a2[i],tail),i =1..nops(a1))]\n end if;\nend if;\n################################ \nif type(a1,dfmatrix) and type(a2,dfmatrix) then\n return cdfmatrix (procname(ddfmatrix(a1),ddfmatrix(a2),tail))\nend if;\n############### #################\nif type(a1,\{clipolynom,cliscalar,clibasmon,climon \}) then \n if type(a2,list(matrix)) then return (map2(procname,args )) \n elif type(a2,dfmatrix) then \n return subs(Id=1,convert (map2(procname,a1,ddfmatrix(a2),tail),dfmatrix))\n end if\nend if;\n ################################\nif type(a2,\{clipolynom,cliscalar,cl ibasmon,climon\}) then \n if type(a1,list(matrix)) then return map(p rocname,args) \n elif type(a1,dfmatrix) then \n return subs(I d=1,convert(map(procname,ddfmatrix(a1),a2,tail),dfmatrix))\n end if \nend if;\n################################\n#if not member(a3,\{`&*`, `&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) then \n# \+ error \"third argument must be one of the following: cmul, cmulQ, we dge, qmul, omul, &*, &r but received %1 instead\",a3 #\n#end if;\n#### ############################\nif member(a3,\{`&*`\}) and \n (type(a1 ,\{clibasmon,climon,clipolynom,climatrix\}) or\n type(a2,\{clibasmo n,climon,clipolynom,climatrix\})) then\nerror \"it makes no sense to a pply commutative multiplication &* to non-commuting elements %1 and %2 \",a1,a2 \nend if;\n################################\nar1:=evalm(a1):a r2:=evalm(a2):\nif not type(a1,matrix) and type(ar1,matrix) then \n \+ _prolevel:=reset_prolevel: \n return procname(ar1,a2,tail) \nend if;\nif not type(a2,matrix) and type(ar2,matrix) then \n \+ _prolevel:=reset_prolevel:\n return procname(a1,ar2,tail) \nend \+ if;\n################################################################# ###################\n##If both inputs are of type clipolynom, climon, \+ or clibasmon do the following:\n###################################### ##############################################\nif (type(evalm(a1),\{c libasmon,climon,clipolynom\}) \n and \n type(evalm(a2),\{clibasm on,climon,clipolynom\}))\nthen \n if member(a3,\{Cliplus:-climul,cm ul,cmulQ\}) then\n _prolevel:=reset_prolevel: \n return si mplify(reorder(a3[lname](a1,a2)))\n elif \n member(a3,\{wedge ,qmul,omul\}) then\n _prolevel:=reset_prolevel:\n if _warnin gs_flag and nargs=4 then\n WARNING(sprintf(\"ignoring fourth a rgument %a\",lname))\n end if; \n #return simplify(reord er(a3(a1,a2)))\n return eval('simplify'('reorder'(a3(a1,a2))));\n else\n _prolevel:=reset_prolevel: \n return simplify(a3 [lname](a1,a2)) \n end if;\nend if; \n############################# ##############\n##If m1 is a polynomial and m2 is a matrix:\n######### ##################################\nif type(evalm(a1),\{clibasmon,clim on,clipolynom,cliscalar\}) \n and \n type(a2,matrix)\n then \n \+ if member(a3,\{qmul\}) then \n m2:=map(eval,a2) \n else \+ \n m2:=a2 \n end if;\n L:=map(displayid,convert(m2,'mlis t'));\n newL:=[]:\n for i from 1 to nops(L) do newL:=[op(newL),a3[ lname](a1,L[i])] end do;\n if not member(a3,\{qmul\}) then\n _p rolevel:=reset_prolevel: \n return map(displayid,map(simplify,l inalg[matrix](linalg[rowdim](a2),linalg[coldim](a2),newL)))\n else \+ \n _prolevel:=reset_prolevel: \n return map(simplify,linal g[matrix](linalg[rowdim](a2),linalg[coldim](a2),newL))\nend if:\nend i f: \n#######################################\n#a2 is a polynomial and \+ a1 is a matrix\n#######################################\nif type(evalm (a2),\{clibasmon,climon,clipolynom,cliscalar\}) \nand \n type(a1,mat rix) \n then \n if member(a3,\{qmul\}) then \n m1:=map(ev al,a1) \n else \n m1:=a1 \n end if;\n L:=map(displa yid,convert(m1,'mlist'));\n newL:=[]:\nfor i from 1 to nops(L) do \+ newL:=[op(newL),a3[lname](L[i],a2)] end do;\nif not member(a3,\{qmul\} ) then\n _prolevel:=reset_prolevel:\n return map(simplify,linalg[m atrix](linalg[rowdim](a1),linalg[coldim](a1),newL))\nelse\n _proleve l:=reset_prolevel: \n return map(simplify,linalg[matrix](linalg[rowd im](a1),linalg[coldim](a1),newL))\nend if:\nend if: \n################ ######################################\n##If both inputs are of type m atrix, do the following:\n############################################ ##########\nif member(a3,\{qmul\}) then \n m1:=evalm(map(eval,a1));m2 :=evalm(map(eval,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \nend if; \nm1:=displayid(m1):m2:=displayid(m2):\nr1:=linalg[rowdim](m1):r2:=lin alg[rowdim](m2):\nc1:=linalg[coldim](m1):c2:=linalg[coldim](m2):\nif c 1 <> r2 then \n error \"matrices have incompatible dimensions and ca nnot be multiplied\" \nend if;\nM:=linalg[matrix](r1,c2,[]);\nk:='k': \nfor i from 1 to r1 do\nfor j from 1 to c2 do\nif a3=`&*` then \n M [i,j]:=sum(m1[i,k] * m2[k,j],k=1..c1) \nelse \n M[i,j]:=map(simplify ,add(a3[lname](m1[i,k],m2[k,j]),k=1..c1)) \nend if;\nod end do;\n_prol evel:=reset_prolevel:\nif member(a3,\{Cliplus:-climul,cmul,cmulQ,wedge \}) then \n return subs(Id=1,map(reorder,map(simplify,evalm(M)))) el se\n return subs(Id=1,map(simplify,evalm(M))) \nend if;\nif not memb er(a3,\{`&*`,`&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul \}) then \n error \"third argument must be one of the following: cmu l, cmulQ, wedge, qmul, omul, &*, &r but received %1 instead\",a3 end i f;\nreturn ;\nend proc:" }}{PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " } {TEXT 343 5 "`&cm`" }{TEXT 344 333 " denotes multiplication of matrice s when Clifford product of Cl(B) is applied to matrix entries. One can use index as in &cm[K](p1,p2), &cm[-K](p1,p2), or &cm(p1,p2), &cm(M1, M2. However, when K has been assigned a matrix, put K between double q uotes as in &cm[''K''](p1,p2), &cm[''-K''](p1,p2).\n(Has been moved to Clifford:-setup).\n " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 273 8 "N o. 54: " }{TEXT 345 6 "`&cQm`" }{TEXT 346 416 " denotes multiplication of matrices when Clifford product of Cl(Q) is applied to matrix entri es. One can use index as in &cQm[K](p1,p2), or &cQm[-K](p1,p2) provide d index has not been assigned a matrix. If K has been assigned a matri x, put K between double quotes as in &cQm[''K''](p1,p2), or &cQm[''-K' '](p1,p2). Procedure can also be used withouht the index as in &cQm(p1 ,p2).\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 274 8 "No. 55: " }{TEXT 347 5 "`&wm`" }{TEXT 348 131 " denotes multiplication of matrices when wedge/exterior product i s applied to matrix entries:\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 262 8 "No. 56: " }{TEXT 349 5 "`&qm`" }{TEXT 350 127 " denotes multiplication of matrices when quaternion product i s applied to matrix entries:\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 275 8 "No. 57: " }{TEXT 351 5 "`&om`" }{TEXT 352 154 " denotes multiplication of matrices when non-associative octo nionic multiplication is applied to the matrix entries.\n(Has been mov ed to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 263 8 "No. 58: " } {TEXT 353 5 "`&rm`" }{TEXT 354 217 " denotes multiplication of matrice s when a generic associative but possibly not commutative `&r` product is applied to matrix entries. It can take index. User needs to define procedue `&r` in a similar mannet to `&c`." }{TEXT -1 1 "\n" }{TEXT 479 37 "(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously computed matrices of basis 1-vectors to find a m atrix representation in a minimal left or right ideal of any Clifford \+ polynomial in the given Clifford algebra Cl(Q). Depending on the sign ature [p,q] of the quadratic form Q, these matrices are " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 119 "real if (p - q ) mod 8 is 0, 1, 2; \ncomplex if (p - q) mod 8 is 3 or 7; \nquatern ionic if (p - q) mod 8 is 4, 5, or 6." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 311 "The real matrices of 1-vectors in dimensions from 2 to 8 have been computed with the procedure 'spinorK repr' in minimal left ideals and stored in a form of a table called 'm atrealL' in Maple library. The indices of the table are given by the s ignature [p,q]. To see matrices in a specific signature [p,q], enter" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">ma trealL([p,q]);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(assuming, of course, that the matrices for this signatur e are real)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 359 "Similarly for complex matrices in dimensions from 3 to 7 which are stored in the file 'matcompL.m' and for quaternionic matric es in dimensions from 2 to 8 which are stored in the file 'matquatL.m' .\n\nSimilarly for matrices representing basis 1-vectors in right mini mal ideals; in this case corresponding files are: 'matrealR.m', 'matco mpR.m', and 'matquatR.m'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 316 "Matrices representing Clifford polynomials a re generally computed with 'matKrepr' much faster than with 'spinorKre pr' because the former is a linear procedure that uses matrix multipli cation 'rmulm' to compute matrices representing basis monomials.\n\nNO TE: This procedure can now handle semi-simple Clifford algebras." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 13 "Typic al use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices representin g 1-vectors in a left minimal ideal for the current form B enter:" }} {PARA 258 "" 0 "" {TEXT -1 12 ">matKrepr();" }}{PARA 258 "" 0 "" {TEXT -1 4 " " }}{PARA 258 "" 0 "" {TEXT -1 103 "to find a matrix r epresenting a Clifford polynomial p for the current B in a left minima l ideal enter:\n" }}{PARA 258 "" 0 "" {TEXT -1 36 ">matKrepr(p); \n>ma tKrepr(p,'left');\n" }}{PARA 0 "" 0 "" {TEXT 256 313 "to find a matrix representing a Clifford polynomial p for the current B in a right min imal ideal enter:\n\n>matKrepr(p,'right');\n\nto see matrices represen ting 1-vectors in a minimal left or right ideal when Q has the signatu re [p,q], enter:\n\n>matKrepr([p,q]);\n>matKrepr([p,q],'left');\n\nor \n\n>matKrepr([p,q],'right');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4868 "matKrepr:=proc() \nlocal mindex,B size,dim,ind,pq,pqsig,matdata,i,a1,a2,dimrepr,ans,pqmod8,pqmod4,matdat atable,\n m,flag_simple,k,L,t,co,x,reprmulm;\nglobal B,matrealL,m atcompL,matquatL,matrealR,matcompR,matquatR:\noptions `Copyright (c) 1 995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: September 17, 2005`;\n################ #############################\n#Checking argument types\nif not member (nargs,\{0,1,2\}) then \n error \"wrong number of arguments: expects 0, 1, or 2 argument(s)\" \nend if;\nif member(nargs,\{1,2\}) and not \+ type(args[1],\{list,clibasmon,climon,clipolynom\}) then\n error \"fi rst argument must be of type 'list', clibasmon, climon, or clipolynom \+ but received one of type %1\",whattype(args[1]) \nend if;\nif nargs=2 and not member(args[2],\{'left','right'\}) then \n error \"second a rgument, when used, must be 'left' or 'right', but received %1\",args[ 2] \nend if;\nif nargs<>0 then a1:=args[1] end if;\nif nargs=0 or typ e(a1,\{clibasmon,climon,clipolynom\}) then\n if not type(B,matrix) t hen \n error \"matrix must be assigned to B\"\n elif not type (B,'diagmatrix') then\n error \"bilinear form B must be diagonal \"\n else \n pq:=Bsignature();\n pqmod8:=(pq[1]-pq[2]) \+ mod 8;\n pqmod4:=(pq[1]-pq[2]) mod 4;\n flag_simple:=evalb (pqmod4<>1);\n end if;\nelif type(a1,list) then pq:=a1:pqmod8:=(pq[ 1]-pq[2]) mod 8 \nelse error \"wrong argument(s)\"\nend if;\n######### #####################################\nif type(a1,\{clibasmon,climon,c lipolynom\}) then\n mindex:=maxindex(a1):Bsize:=linalg[coldim](B):\n if mindex > Bsize then\n error \"input error: maximum index in your input %1 is greater than the size %2 of the currently defined bi linear form B\",mindex,Bsize \n end if;\nend if;\nif nargs=1 or narg s=0 then a2:='left' else a2:=args[2] end if;\n#read in appropriate dat a file: \nif member(pqmod8,\{0,1,2\}) then\n if a2='left' then \n #if not assigned(matrealL) then readlib(matrealL) end if;\n \+ matdatatable:=matrealL:\n else\n #if not assigned (matrealR) then readlib(matrealR) end if;\n matdatatable:=mat realR:\n end if;\nelif member(pqmod8,\{3,7\}) then\n if a2=' left' then\n #if not assigned(matcompL) then readlib(matcompL) end if;\n matdatatable:=matcompL:\n else \n #if not assigned(matcompR) then readlib(matcompR) end if;\n matd atatable:=matcompR:\n end if;\nelif member(pqmod8, \{4,5,6\}) the n\n if a2='left' then\n #if not assigned(matquatL) then r eadlib(matquatL) end if;\n matdatatable:=matquatL:\n els e\n #if not assigned(matquatR) then readlib(matquatR) end if; \n matdatatable:=matquatR:\n end if; \n else error \"wron g value of pqmod8: %1\",pqmod8 \nend if;\n############################ ###########\npqsig:=map(op,[indices(matdatatable)]);\nif not member(pq ,pqsig) then\n error \"matrices for signature %1 in %2 minimal ideal have not been computed yet\",pq,a2 \nend if;\n###################### #################\nmatdata:=matdatatable[pq]:\nif nargs=0 or type(a1,l ist) then \n return matdata\nend if;\n#Continue if the first element is a polynomial\ndim:=linalg[coldim](B):dimrepr:=linalg[coldim](rhs(m atdata[1]));\nif dim<>nops(matdata) then \n error \"size of B is dif ferent from the number of 1-matrices\"\nend if;\n##################### ###################\nreprmulm:=proc() \n if nargs=1 then return args \n elif nargs=2 then return subs(Id=1,rmulm(args,`cmulQ`)) \n els e return subs(Id=1,reprmulm(args[1..(nargs-2)],rmulm(args[nargs-1],arg s[nargs],`cmulQ`))) \n end if;\nend proc:\n######################## ################\nm:=array(1..nops(matdata)):\nfor i from 1 to nops(ma tdata) do m[i]:=rhs(matdata[i]) end do;\nif type(a1,clibasmon) then\n \+ ind:=Clifford:-extract(a1,'integers'): \n if a1='Id' then \n \+ if flag_simple then \n return linalg[diag](1$dimrepr) \n \+ else \n return convert([linalg[diag](1$dimrepr)$2],'dfmatrix ') \n end if;\n end if; \n if nops(ind)=1 then ind:=op(ind) :\n return subs(Id=1,evalm(m[ind])) \n else return subs(Id=1, reprmulm(seq(evalm(m[ind[i]]),i=1..nops(ind)))) \n end if:\nend if; \n#########################################\nans:=clilinear(a1,'K'):\n if flag_simple then \n return subs(Id=1,evalm(eval(subs(K=procname,a ns)))) \nend if;\nans:=eval(subs(K=procname,ans));\nif type(ans,`+`) t hen ans:=[op(ans)] elif\n type(ans,`*`) then ans:=[ans] else\n err or \"unexpected type in matKrepr\" \nend if;\nL:=select(type,ans,matri x);\nans:=remove(type,ans,matrix);\nk:='k':x:='x':\nfor t in ans do\n \+ m:=ddfmatrix(op(select(type,[op(t)],matrix)));\n co:=mul(x,x=rem ove(type,[op(t)],matrix));\n L:=[op(L),convert([seq(evalm(co*m[k]), k=1..2)],'dfmatrix')]\nend do:\nif nops(L)=1 then return L[1] end if; \nans:=L[1]:\nfor k from 2 to nops(L) do\nans:=adfmatrix(ans,L[k]) end do:\nreturn evalm(ans);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 25 "No. 60. Sorting function " }{TEXT 376 7 "bygrade" }{TEXT -1 789 ": it sorts a list of Clifford basis monomials, Clifford monomials, or C lifford polynomials. Basis monomials and Clifford monomials are sorted by grade; in case of a tie it sorts by lexicographic order based on t he basis monomials. However, basis monomials are put before Clifford m onomials. If any of the elements is a Clifford polynomial, then ties a re resolved by sorting by the weight of each element (defined as the s um of the grades of all terms) and then by then number of Clifford bas is monomials in each expression. It returns true or false in each case , and can be used in sorting a list of basis monomials, Clifford monom ials, and Clifford polynomials in the construction sort(L, bygrade).\n \nUse: bygrade(p1,p2) where p1 and p2 are of type 'clibasmon', 'climon ', or 'clipolynom';\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1987 "bygrade: =proc(a1::\{clibasmon,climon,clipolynom\},\n a2::\{clibas mon,climon,clipolynom\}) \nlocal flag1,flag2,flag11,flag22,p1,p2,n1,n2 ,c1,c2,x,w1,w2;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: September 17, 2005`;\n############################################# \nif type(a1,clibasmon) then p1:=a1;\n flag1 :=true:\n flag11:=true:\n \+ n1:=Clifford:-extract(p1): \n elif type(a1,climon) then p1: =op(cliterms(a1));\n flag1:=true:\n \+ flag11:=false:\n n1:=Cliff ord:-extract(p1): \n else p1:=a1;\n flag1:=false:\nend if;\ni f type(a2,clibasmon) then p2:=a2;\n flag2:=t rue:\n flag22:=true:\n \+ n2:=Clifford:-extract(p2): \n elif type(a2,climon) then p2:=op (cliterms(a2));\n flag2:=true:\n \+ flag22:=false:\n n2:=Clifford :-extract(p2): \n else p2:=a2;\n flag2:=false:\nend if;\nx:=' x':\nif flag1 and flag2 then\n if nops(n1)nops(n2) then return false\n else \n if eval b(flag11 and flag22) then return lexorder(p1,p2)\n elif evalb( flag11 and not flag22) then return lexorder(p1,p2)\n elif eval b(not flag11 and flag22) then return not lexorder(p2,p1);\n el se return true\n end if;\n end if; \nelse \n n1:=maxgrade(p 1):\n c1:=cliterms(p1):\n w1:=add(maxgrade(x),x=c1):\n n2:=maxgr ade(p2):\n c2:=cliterms(p2):\n w2:=add(maxgrade(x),x=c2):\n if n 1=n2 then\n if w1=w2 then \n if nops(c1)<=nops(c2) then r eturn true else return false end if;\n else if w1 " 0 "" {MPLTEXT 1 0 2123 "commuting elements:=proc(a1::list(clibasmon)) \nlocal g,groupgens,L,L2,numfact,f ,flag1,flag2,flag3,gen,p,q,i;\nglobal B;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif not type(B,matrix) then \n error \"ma trix must be assigned to B\"\nend if;\nif not type(B,'diagmatrix') the n \n error \"the bilinear form B is not diagonal as expected\" \nend if;\np:=Bsignature(B)[1]:q:=Bsignature(B)[2]:\nnumfact:=q-RHnumber(q- p):\nflag1:=member(Id,a1):\nL:=remove(member,a1,[Id]):\n#return a1 if \+ it was [Id]\nif L=[] then return args end if; \n#return a1 if had one \+ element of square 1 or [] if the square <>1 \nif nops(L)=1 then\n if cmul(L[1],L[1])=Id then return L\n else return [] \nend if;\nend if;\n#First, sort the list\nL:=sort(L,bygrade):\n#Find first element \+ of square 1 mod Id\nflag2:=false:L2:=[]:groupgens:=[]:\nfor g in L whi le not flag2 do \n if evalb(cmul(g,g)=Id) then groupgens:=[g];flag2 :=true\n else L2:=[op(L2),g] fi end do:\nL:=remove(member,L,[op(L2) ,op(groupgens)]);\nif L=[] then \n if flag1 then \n return [Id] else return groupgens \n end if;\nend if; \nif nops(groupgens)=numf act then \n return (sort(groupgens,bygrade)) end if;\n#Find commutin g elements with square 1 mod Id in the specified list of basis monomia ls\nfor g in L while nops(groupgens)0)) \n then grou pgens:=[op(groupgens),g] \n end if;\nend if:\nend do:\nif groupge ns=[] then return args else return sort(groupgens,bygrade) end if;\nen d proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 62. Procedure " } {TEXT 378 16 "factoridempotent" }{TEXT -1 369 " can factor the given i dempotent e into a product of N elements of the type (1/2)*(Id+e[i]), \+ i=1..N, where \{e[i],i=1..N\} is a set of commuting basis monomials w ith square 1 mod Id in the standard (canonical) basis of Cl(Q). It is known that when N = q - RHnumber(q-p) then e is primitive. \n\nTypic al use: factoridempotent(f); #here f is expected to be an idempotent \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1738 "factoridempotent:=proc(a1:: idempotent) \nlocal T,ee,i,L,flag,flag1,flag2,b1b2,b1,b2,ans;\nglobal \+ B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September \+ 17, 2005`;\n#############################################\nif a1=Id th en return Id end if;\nif not type(B,matrix) then \n error \"matrix m ust be assigned to B\"\nend if;\nif not type(B,'diagmatrix') then \n \+ error \"the bilinear form B is not diagonal as expected\" \nend if;\n ee:=eval(a1):\nL:=sort(remove(member,convert(cliterms(ee),list),[Id]), bygrade):\nif nops(L)=1 then \n ans:=(1/2)*(Id+L[1]);\n if display id(a1-ans)=0 then return ans else return a1 end if;\nend if;\nflag1:=t rue:\nwhile flag1 do\nflag2:=true:\nL:=sort(L,bygrade);\nfor b1 in L w hile flag2 do\nfor b2 in remove(member,L,[b1]) while flag2 do\n b1b 2:=cmulQ(b1,b2):\n if member(b1b2,L) then flag2:=false;\n \+ L:=remove(member,L,[b1b2]) end if;\n if member(-b1 b2,L) then flag2:=false;\n L:=remove(member, L,[-b1b2]) end if;\n if flag2 then flag1:=false end if;\nod od end \+ do: \nL:=commutingelements(L);\nif nops(L)=1 then \n ans:=(1/2)*(Id+ L[1]);\n if displayid(a1-ans)=0 then return ans else return a1 end i f;\nend if;\nL:=sort(L,bygrade);\ni:='i':\nans:='cmulQ'(seq((1/2)*(Id+ L[i]),i=1..nops(L)));\nif eval(ans)-a1=0 then return (ans) end if;\n#t ry another sign permutation\nfor i from 1 to nops(L) do\n L||i:=[L[ i],-L[i]]\nend do:\nT:=combinat[cartprod]([seq(L||i,i=1..nops(L))]):\n flag:=false:\nwhile not T[finished] and not flag do \nL:=T[nextvalue]( );\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\nif eval(ans)-a1= 0 then flag:=true:return ans end if;\nend do:\n#return unfactored\nret urn a1;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 63. Proced ure " }{TEXT 379 11 "makealiases" }{TEXT -1 996 " allows the user to a lias basis monomials in a Clifford algebra Cl(V), e.g., to alias e1we2 as e12, or e2we1 as e21. The procedure accepts a positive integer p>1 where p denotes the dimension of the vector space V. A practical lim itation on p is of course the amount of memory Maple will allocate to \+ store these aliases since every basis monomial, not necessarily writte n in the standard order, will be aliased. This procedure is intended \+ to be used when p < 5 although it can be used also when p < 10. Remem ber that to unalias e12 one needs to either restart Maple or simply as sign e12:='e12'.\n\nAs a memory saving feature, option 'ordered' (or \+ \"ordered\") may be entered as a second parameter. If the second param eter is used, aliases are created only for monomials with ordered indi ces, for example, e12 will be an alias for e1we2.\n\nThe procedure ret urns a list of aliases to be defined so they can bee seen by the user. In order to finish the definition process, use 'eval' as shown below .\n" }}{PARA 258 "" 0 "" {TEXT -1 139 "Once basis elements have been a liased, Clifford multiplication can be done using these aliases.\n\nTy pical use: \n\n>makealiases(3);\n>eval(%);\n" }}{PARA 258 "" 0 "" {TEXT -1 41 "or\n\n>makealiases(3,'ordered');\n>eval(%);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 804 "makealiases:=proc(a1::posint,a2::\{symbol, string\}) \nlocal L,i,k,l,K,s;\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\n description `Last revised: September 17, 2005`;\n##################### ########################\nif not a1>1 then \n error \"first paramete r must be a positive integer larger than one\" \nend if;\nif nargs=2 a nd not member(a2,\{'ordered',\"ordered\"\}) then\n error \"second op tional parameter, when used, must be 'ordered'\" \nend if;\nk:='k':l:= 'l':i:='i':\nL:=[seq(op(combinat[choose]([seq(i,i=1..a1)],k)),k=2..a1) ];\nif nargs=1 then \n K:=[seq(op(combinat[permute](l)),l=L)];\n s :=seq(cat(e,op(K[i]))=makeclibasmon(K[i]),i=1..nops(K))\nelse\n s:=s eq(cat(e,op(L[i]))=makeclibasmon(L[i]),i=1..nops(L))\nend if;\nreturn \+ 'alias'(s)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 64. Proc edure " }{TEXT 380 4 "cinv" }{TEXT -1 1285 " calculates a symbolic inv erse of any Clifford polynomial p in the given Clifford algebra Cl(B) \+ or in its subalgebra. The procedure determines a basis for the smalle st subalgebra of Cl(B) in which the inverse might exist. For example, if the polynomial p contains only even grades, then the inverse is so ught in an even subalgebra of Cl(B); otherwise, the inverse is sought \+ in a Clifford algebra over a vector space V whose dimension equals tha maximum index in p. \n\nIf the bilinear form B is not assigned then \+ every Clifford polynomial in Cl(B) has a symbolic inverse. If the bili near form B is assigned then not every element in Cl(B) has the invers e. For example, nilpotent and non-trivial idempotent elements have no inverses. Elements p such that p &c p = a*p for some 'cliscalar' al so have no inverses (these elements are called here 'almost idempotent ').\n\nThus, if B is assigned and the inverse does not exist, the proc edure tries to identify if p is one of the above types and if so, it r eturns an appropriate error message. Otherwise it returns 'NULL'.\n\n This procedure can be used with a second optional argument K of type s ymbol, name, matrix , or array. In that case, it computes the inverse \+ in Cl(K). The seconf argument can also be -K, or any numeric multiple \+ of K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Typical use: cinv(e1 + 2*e2);cinv(e1 + 2*e2,K); cinv(e1 + 2*e2,-K) ; \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4210 "cinv:=proc(a1::\{cliscal ar,clibasmon,climon,clipolynom\}) \nlocal p,pp,pinv,mindex,cinv11,s,aa a,flagB,flagBdiag,S,lname,flagindexed;\nglobal B,_warnings_flag;\nopti ons `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndescription `Last revised: September 17, 2005`;\n#############################################\nif nargs=1 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and type (args[2],\{symbol,name,array,matrix,`&*`(algebraic,name)\}) then\n \+ lname:=args[2];\n flagindexed:=true:\nelse error \"only one or two \+ arguments are expected\"\nend if;\n############################\ncinv1 1:=proc(a1,lname)\nlocal i,d,dbasis,N,u,xm,v,uv,vu,vars,sys,L1,v1,nont rivial;\nglobal evenelement;\n nontrivial:=proc(S::\{set(\{relation, algebraic\}),list(\{relation,algebraic\})\}) \n local is trivial;\n istrivial:=proc(x) \n \+ if type(x,relation) then evalb(x) else evalb(x=0) end if; \n \+ end proc;\n remove(istrivial,S)\n e nd proc: \ni:='i':\nd:=maxindex(a1):\nif type(a1,'evenelement') then d basis:=cbasis(d,'even')\n else dbasis:=cbasis (d) \nend if:\nN:=nops(dbasis):\nu:=clicollect(reorder(a1)):\nxm:=arra y(1..N):\nv:=sum(xm[i]*dbasis[i],'i'=1..N);\nuv:=collect(cmul[lname](u ,v)-Id,dbasis);\nvu:=collect(cmul[lname](v,u)-Id,dbasis);\nvars:=\{coe ffs(v,dbasis)\};\nsys:=\{coeffs(uv,dbasis),coeffs(vu,dbasis)\};\nsys:= nontrivial(sys); #eliminate trivial equations\nL1:=solve(sys,vars);\ni f L1=NULL then return (NULL) else \nv1:=subs(L1,v);\nv1:=reorder(v1): \nv1:=clicollect(v1):\nv1:=map(normal,v1);\nreturn (eval(v1)): \nend i f;\nend proc:\n#####################################\nif type(a1,clisc alar) then\n if a1<>0 then return 1/a1 else error \"0 has no inverse \" end if;\nend if;\nmindex:=maxindex(a1);\nif mindex=0 then return Id /scalarpart(a1) end if;\np:=simplify(reorder(a1)):\np:=displayid(p):\n pinv:=cinv11(p,lname);\nif evalb(pinv<>NULL) then return pinv end if; \+ \n#####################################\nflagB:=type(evalm(lname),matr ix):\nif not flagB then return \"unable to find inverse of %1\",a1 end if;\n#####################################\nif _warnings_flag then\n \+ WARNING(`testing why entered argument has no inverse...`)\nend if;\n #Checking these special cases only when lname is assigned a matrix:\ns :='s':aaa:='aaa':\nflagBdiag:=type(evalm(lname),diagmatrix):\n######## ###############################\n###Checking if element a1 is nilpoten t\n#######################################\nif type([p,lname],nilpoten t) then\n if flagBdiag then \n error \"element %1 is nilpotent \+ in signature %2 and as such it has no inverse\",a1,Bsignature(lname) \+ \n else\n error \"element %1 is nilpotent in current %2 and as \+ such it has no inverse\",a1,lname \n end if;\nend if;\n############# ##########################\n###Checking if element a1 is idempotent\n# ######################################\nif not member(p,\{Id\}) and ty pe([p,lname],idempotent) then\n if flagBdiag then \nerror \"element \+ %1 is an idempotent in signature %2 and as such it has no inverse\",a1 ,Bsignature(lname)\n else \nerror \"element %1 is an idempotent in c urrent %2 and as such it has no inverse\",a1,lname\n end if;\nend if ;\n#######################################\n###Checking if a1 is almos t idempotent\n####################################### \npp:=cmul[lname ](p,p):\nif match(pp=aaa*p,cliterms(p),'s') then \n if flagBdiag the n \n error \"element 'p'=%1 is almost an idempotent since %2 and as \+ such it has no inverse in signature %3\", a1,subs(s,'cmul'('p','p')=aa a*'p'),Bsignature(lname)\n else \n error \"element 'p'=%1 is almos t an idempotent since %2 and as such it has no inverse in current %3\" , a1,subs(s,'cmul'('p','p')=aaa*'p'),lname\n end if;\nend if;\n##### ##################################\nS:=\{solve(pp-s*p,s)\}:\nif not ev alb(S=\{\}) then \n if flagBdiag then \n error \"element 'p'=%1 is almost an idempotent since %2 and as such it has no inverse in signat ure %3\", a1,subs(aaa=op(S),'cmul'('p','p')=aaa*'p'),Bsignature(lname) \n else \n error \"element 'p'=%1 is almost an idempotent since %2 and as such it has no inverse in current\", a1,subs(aaa=op(S),'cmul'( 'p','p')=aaa*'p'),lname\n end if;\nend if;\nreturn NULL\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 65. Procedure " }{TEXT 381 9 "p seudodet" }{TEXT -1 87 " computes pseudodeterminant of a 2 x 2 matrix \+ with entries in a Clifford algebra Cl(B)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typical use: M := linalg[matr ix](2, 2, [Id, e1 + e2, e3, e4we3]); " }}{PARA 258 "" 0 "" {TEXT -1 37 " pseudodet(M);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 534 "pseudodet:=proc(a1::\{clima trix,matrix\}) local M,a,b,c,d;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nM:=map(displayid,evalm(a1)):\nif linalg[rowdim](M) < > 2 or linalg[coldim](M) <> 2 then \n error \"matrix must be 2 x 2\" \nend if;\na:=simplify(M[1,1]): b:=simplify(M[1,2]):\nc:=simplify(M[ 2,1]): d:=simplify(M[2,2]):\nreturn simplify(cmul(a,reversion(d)) - c mul(b,reversion(c)))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 45 "No . 66. Defining quaternionic mutliplication " }{TEXT 382 4 "qmul" } {TEXT -1 687 ". Quaternions are defined as the even elements in Cl(3) (or the para-bivectors in Cl(3)). Thus, a quaternion basis is [Id, e3 we2,e1we3,e2we1] and it is available as the first component of global \+ variable '_quatbasis' defined at the initialization time (type _quatba sis or _quatbasis[1] at the Maple prompt to see it). See P. Lounesto, \"Clifford Algebras and Spinors\", page 49, for more information on q uaternions. Any element that belongs to this vector space is now of t ype 'quaternion'. The infix form of this multiplication is `&q`. Via the procedure 'rmulm', the quaternionic multiplication may also be ap plied to matrices with quaternionic entries and is then denoted by `&q m`." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 121 "NOTE: in order to see answers displayed in terms of the basis \{I d, qi, qj, qk\}, apply 'qdisplay' to the result of 'qmul'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 "Typical us e: qmul(Id + e1we2, e1we3); or (Id + 2*e1we2) &q (e2we3 + e1we2); or \+ (Id + qi) &q (qj + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1300 "qmu l:=proc() local q1,q2,q3,step1,repqmul; \n global \+ B,qi,qj,qk,_default_Clifford_product;\noptions `Copyright (c) 1995-200 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\n####################### ######################\nif member(0,[args]) then return 0 end if;\nif \+ nargs=1 then return qdisplay(args) end if;\n repqmul:=proc() \n \+ if nargs=1 then return args elif\n nargs=2 then return 'qmul'(a rgs) else\n return repqmul(args[1..(nargs-2)],'qmul'(args[nargs -1],args[nargs])) \n end if;\n end proc:\nif nargs>2 then \n q 3:=eval(repqmul(args)):\n return qdisplay(map(combine,q3,trig)) \nen d if;\n_default_Clifford_product:='cmulNUM':\nq1:=eval(args[1]):q2:=ev al(args[2]):\nif type(q1,`^`) or type(q2,`^`) then \n error \"illega l expression found: use 'qinv' for the quaternionic inverse\" \nend if ;\nif type(q1,cliscalar) or type(q2,cliscalar) then \n return qdispl ay(q1*q2) \nend if;\nif q1=Id then return qdisplay(q2) end if;\nif q2= Id then return qdisplay(q1) end if;\nif not type(q1,quaternion) or not type(q2,quaternion) then\n error \"wrong input type: input must be \+ of type 'cliscalar' or 'quaternion'\" \nend if;\nstep1:=reorder(cmul(q 1,q2));\nreturn qdisplay(map(combine,clicollect(step1),trig))\nend pro c:\n" }}{PARA 0 "" 0 "" {TEXT 375 23 "No. 67. Ampersand form " }{TEXT 383 4 "`&q`" }{TEXT 384 4 " of " }{TEXT 385 4 "qmul" }{TEXT 386 39 ". \n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 42 "No. 68. Defining quaternionic conjugation " }{TEXT 387 8 "q_con jug" }{TEXT -1 112 ". Recall that complex conjugation was named 'c_co njug' while the Clifford conjugation was just 'conjugation'. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typic al use: q_conjug(Id + 2*e1we2); or q_conjug(Id + 2*qi + qk); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 559 "q_conjug:=proc(q::algebraic) local q1; global qi,qj,qk;\noptions `Copyright (c) 1995-2005 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: September 17, 2005`;\n####################################### ######\nif type(q,matrix) then return map(procname,q) elif\n type(q, \{cliscalar,quaternion\}) then\nq1:=eval(q):\nif type(q1,cliscalar) th en return q1 \nelse\n return qdisplay(2*scalarpart(q1)-q1)\nend if; \nelse\n error \"wrong input types: input must be of type 'cliscalar ', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 26 "No. 69. Quaternionic norm " }{TEXT 388 5 "qnorm" } {TEXT -1 24 " is defined as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 65 " Typical use: qnorm(Id + 2*e1we2); or qnorm(Id + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 448 "qnorm:=proc(q::\{cliscalar,quatern ion\}) local q1,n,co; global qi,qj,qk;\noptions `Copyright (c) 1995-20 05 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: September 17, 2005`;\n###################### #######################\nq1:=expand(eval(q));\nif type(q1,cliscalar) t hen return abs(q1) \nelse\n n:=0:for co in [coeffs(q1,cliterms(q1))] do n:=n+co^2 end do;\n return combine(sqrt(n),trig) \nend if;\nend \+ proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 38 "No. 70. Quaternionic inverse is named " }{TEXT 389 4 "qinv" }{TEXT -1 141 ". Recall that the inve rse of a Clifford polynomial can be calculated with 'cinv' and that qu aternions form a noncommutative division ring. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "Typical use: qinv(Id + \+ 2*e1we2); or qinv(Id + 2*qi + 3*qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 458 "qinv:=proc(q::\{cliscala r,quaternion\}) local q1,q2; \noptions `Copyright (c) 1995-2005 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: September 17, 2005`;\n############################### ##############\nq1:=eval(q):\nif q1=0 then error \"zero quaternion has no inverse\"\nelif type(q1,cliscalar) and q1<>0 then return 1/q1\nels e q2:=q_conjug(q1)/(qnorm(q1))^2:\n return qdisplay(map(combine,q2 ,trig))\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 71 . Procedure " }{TEXT 390 8 "qdisplay" }{TEXT -1 101 " displays quatern ions or matrices with quaternionic entries in terms of the basis \{Id, qi, qj, qk\}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*Id); map(qdisplay, matri x(2, 2, [Id, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 724 "qdisplay:=proc(a1::\{algebraic,array\}) local q; global qi,qj,qk;\noptions `Copyright (c) 1995-2005 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: September 17, 2005`;\n######################################## #####\nif type(a1,matrix) then\n if not type(a1,climatrix) then \n \+ return evalm(a1) else \n return map(qdisplay,a1) \n end if; \nend if;\nq:=eval(simplify(a1)):\nif type(q,cliscalar) then return q \+ end if;\nif type(q,quaternion) then\nq:=map(combine,clicollect(reorder (q)),trig);\nreturn coeff(q,Id)-coeff(q,e1we2)*'qk'+coeff(q,e1we3)*'qj '-coeff(q,e2we3)*'qi'\nelse \nerror \"wrong input type: input must be \+ of type 'cliscalar', 'quaternion', or 'matrix' \" \nend if;\nend proc: \n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Procedure " }{TEXT 391 5 "rot3d" }{TEXT -1 161 " rotates a vector in 3-dimensional Euclidean sp ace V using the quaternion multiplication. Namely, any vector v is t ransformed according to the following law: " }}{PARA 258 "" 0 "" {TEXT -1 1 " " }}{PARA 258 "" 0 "" {TEXT -1 84 " \+ v -> q &c v &c qinv(q) " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 459 "wher e q is a quaternion given in the basis [Id, e1we2, e1we3, e2we3]. The \+ first entry should be a vector (or any element of the Clifford algebra ) while the second element is a quaternion. Type '_quatbasis' to see \+ how quaternions are defined here. Elements 'qi', 'qj', 'qk' are defin ed at the time of initialization and denote the pure-quaternion basis \+ elements. It is assumed that the user has defined a bilinear form B a s the 3 x 3 identify matrix as in:\n" }}{PARA 258 "" 0 "" {TEXT -1 28 " >B := linalg[diag](1$3); \n" }}{PARA 258 "" 0 "" {TEXT -1 108 "befo re using 'rot3d'. Of course, 'rot3d' will also work if the first argu ment were any element in Cl(3). \n" }}{PARA 258 "" 0 "" {TEXT -1 296 "NOTE: traditionally one uses \{1, i, j, k\} to denote a quaternion ba sis. Here, we are using symbol 'qi' for 'i', 'qj' for 'j', and 'qk' f or 'k'. Symbol 'Id' denotes, as usual, the unit element in all Cliffo rd algebras as well as the unit element in reals, complexes, quaternio ns, and octonions. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 55 "Typical use: rot3d(e1 + e2, Id + 2*qi - 3*qj + 2*qk) ; " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 858 "rot3d:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::quaternion) \nlocal q2,q2inv; global B,qi,qj,qk; \noptions \+ `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n #############################################\nif not assigned(B) or n ot type(B,matrix) then \n error \"bilinear form B has not been assig ned yet. It must be defined as the identity 3 x 3 matrix.\"\nend if:\n if not linalg[equal](B,linalg[diag](1$3)) then \n error \"the identi ty 3 x 3 matrix must be assigned to B\" \nend if;\nif nargs <> 2 then \+ \n error \"two arguments needed of type algebraic and quaternion\" \+ \nend if; \nq2:=clisort(map(combine,eval(a2),trig)); \nq2inv:=clisort( map(combine,eval(qinv(eval(q2))),trig)); \nreturn clicollect(clisort(m ap(combine,cmulQ(q2,a1,q2inv),trig))) \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 73. Procedure " }{TEXT 392 9 "isproduct" }{TEXT -1 238 " can determine whether the given Clifford polynomial, e.g. p \+ := Id + 4*e1we2 + e3we4, is a product of 1-vectors in the given Cliffo rd algebra. It can be used with two options `all`, or `any`, or can be used without any option as follows:" }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 12 "Typical use:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "isproduct(p); \+ answers true or false;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "isproduct(p, 'any'); answers true or false, and gives a list of n vectors [v1, v2, ..., vn] such that the Cliffor d product v1 &c v2 &c ... &c vn = p;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 161 "isproduct(p, 'all'); answers t rue or false, and gives a list of general vectors [v1, v2, ..., vn] su ch that the Clifford product v1 &c v2 &c ... &c vn = p;\n\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4896 "isproduct:=proc(p::\{cliscalar,clibasmo n,climon,clipolynom\},\n s::\{string,symbol\}) \nlocal \+ M,maxg,T,co,vv,x,cf,pnew,p1,L,v,j,S,S2,i,v1v2,expr,t,sys,\nvars,sol,ve ntries,flag,flagB,flagtB,param,flagsol,eq,P1,P2,die,parvalues;\nglobal _MaxSols,B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ September 17, 2005`;\n#############################################\ni f not member(nargs,\{1,2\}) then\n error \"one or two arguments needed of type 'cliscalar', 'clibasmon', 'climon', 'clipolynom', and 'symbol '\"\nend if;\nif nargs=2 and not member(s,\{'all','any'\}) then\n er ror \"second (optional) argument must be 'all' or 'any'\"\nend if;\nif not type(B,diagmatrix) then \n error \"diagonal matrix must be assi gned to B\" end if;\nmaxg:=maxgrade(p);\n############################# ########################\n#An element of grade 0 is always factorable \+ in Cl(B):\n#####################################################\nif m axg=0 then \n if nargs=1 then return true end if;\n flag:=false:\n for i from 1 to linalg[coldim](B) while not flag do\n if B[i, i]<>0 then flag:=true;\n return [true,[(scalarpart(p)/B[i,i]) *e||i,e||i]] \n end if;\n end do;\nerror \"none of the basis 1 -vectors has a square equal to 1 or -1\" \nend if;\n################## ###################################\n#Any 1-vector is already factored :\n#####################################################\nif vectorpar t(p,1)-p=0 then \n if nargs=1 then return true\n else r eturn [true,[p]] \n end if;\nend if;\n############################## #######################\n#Any basis monomial is already factored:\n### ##################################################\nflagB:=type(B,diag matrix):\np1:=factor(reorder(displayid(p))):\nflagtB:=evalb(type(p1,\{ clibasmon,climon\}) and flagB):\nif flagtB then \n S:=op(Clifford :-extract(p1,'integers'));\n if nargs=1 then return true else \n \+ v:=[e||S];\n if not remove(hastype,p1,clibasmon)=NULL\n \+ then v[1]:=remove(hastype,p1,clibasmon)*v[1] \n end if;\n \+ return [true,v] \n end if; \nend if;\n###################### ###################################\n#If p does not belong to any of t he special cases above,\n#find common indices to all monomial terms in p, if any,\n#and then simplify p by factoring out the common factors: \n#########################################################\nT:=cliter ms(p):\nco:=`intersect`(op(map(convert,map(Clifford:-extract,T,'intege rs'),set)));\nx:='x':\nif nops(co)<>0 then\n co:=sort(convert(co,lis t));\n vv:=[seq(cat(e,x),x=co)];\n cf:=cmul(op(vv));\n pnew:=cmu l(p,cf,cf,cf);\n if nargs=1 then M:=procname(pnew) \n elif\n \+ nargs=2 then L:=procname(pnew,s);\n M:=[L[1],[op( L[2]),op(vv)]]; \n end if;\n return M\nend if; \n################ #####################################\n#This is the most general case \+ when no common indices\n#in monomial terms are found:\n############### ######################################\nS2:=map(Clifford:-extract,clit erms(p),'integers');\nS:=\{op(map(op,S2))\}; \nv:=table([]):\nfor j fr om 1 to maxg do\nv[j]:=0:\nfor i in S do v[j]:=v[j]+cat(x,j,i)*cat(e,i ) \nend do;\nend do;\nv1v2:=cmul(seq(v[j],j=1..maxg));\nexpr:=clicolle ct(simplify(reorder(p-v1v2))):\nt:=cliterms(expr);sys:=\{\}:\nfor i fr om 1 to nops(t) do sys:=\{op(sys),coeff(expr,op(i,t))=0\} end do:\nvar s:=sort([op(indets(sys))],lexorder); \n_MaxSols:=1: #setting maximum number of solutions to one\nvars:=convert(vars,set):\nsol:=[solve(sys ,vars)]:\nif nops(sol)=0 then return false end if;\nventries:=[seq(v[j ],j=1..maxg)];\n###################################################### #\n#Finally, we need to return result in appropriate form.\n#By now, i f p were not factorable, 'false' should have\n#been returned:\n####### ################################################\nif nargs=1 then retu rn true end if; \nif nargs=2 and s='all' then return [true,subs(sol[1] ,ventries)] end if; \n################################################ #########\n#If the second parameter is 'any', assign random values\n#t o the parameters showing up in the answer. These random\n#values will \+ change with each execution of the program:\n########################## ###############################\nif nargs=2 and s='any' then \nparam:= proc(a1::\{`=`\}) \n if lhs(a1)=rhs(a1) or rhs(a1)=0 then true else \+ false end if;\nend proc:\nflagsol:=false:\nfor i from 1 to 2 while not flagsol do\nS2:=\{\}:P1:=\{\}:P2:=\{\}:\nS2:=\{op(sol[1])\};\nparvalu es:=[1,-1,1/2,-1/2,1/3,-1/3];\ndie := rand(1..6):\nfor eq in select(pa ram,S2) do \n if rhs(eq)=0 then P1:=P1 union \{eq\}\n e lse P1:=P1 union \{lhs(eq)=parvalues[die()]\};\n end if;\nend do;\nP2 :=remove(param,S2):\nL:=map(op,subs(P2,ventries));\nif not member(0,su bs(P1,map(denom,L))) then flagsol:=true end if;\nend do:\nif flagsol t hen return [true,subs(P1,subs(P2,ventries))]\n else return [ true,subs(sol[1],ventries)]\nend if;\nend if;\nend proc:" }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 74. Procedu re " }{TEXT 393 14 "isVahlenmatrix" }{TEXT -1 258 " determines if the \+ given 2 x 2 matrix is Vahlen matrix as defined in P. Lounesto, \"Clica l and counter-examples\", in eds. R. Ablamowicz, P. Lounesto, and J. \+ Parra, `Clifford algebras with symbolic and numeric computations`, Bir khauser, Boston, 1996, page 19." }}{PARA 258 "" 0 "" {TEXT -1 349 "\nV ahlen matrix V is a 2 x 2 matrix with entries in a Clifford algebra Cl (p, q) such that if \n\n V := matrix(2, 2, [a, b, c, d]); \+ \+ \nand a,b,c, d are elements in Cl(p, q), then the following conditions must be met: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "1 . a, b, c, d are products of vectors;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 74 "2. the pseudodeterminant of V is \+ +1 or -1 (or Id or -Id in the algebra);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 98 "3. a &c reversion(b), reversi on(b) &c d, d &c reversion(c), and reversion(c) &c a are all vectors. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 31 "T ypical use: isVahlenmatrix(V);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 120 "V := matrix(2, 2, [Id - e1we4, -e1 + e 4, e1 + e4, Id + e1we4]) (this example of Vahlen matrix is due to Joh annes Maks)." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1214 "isVahlenmatrix:=proc(cm::\{matrix,climatrix\}) \nlo cal expr1,expr2,a,b,c,d,m; 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 not type(B,matrix) then \n error \"square \+ matrix must be assigned to B\" \nend if;\nif linalg[rowdim](cm)<>2 or \+ linalg[coldim](cm)<>2 then \n error \"to calculate pseudodeterminant matrix must be 2 x 2\" \nend if;\nm:=displayid(cm):\na:=simplify(m[1, 1]):b:=simplify(m[1,2]):\nc:=simplify(m[2,1]):d:=simplify(m[2,2]):\n## ########################################\n### Condition 1:\n########## ################################\nif a<>0 then if not isproduct(a) the n return false fi end if;\nif b<>0 then if not isproduct(b) then retur n false fi end if;\nif c<>0 then if not isproduct(c) then return false fi end if;\nif d<>0 then if not isproduct(d) then return false fi end if;\n##########################################\n### Condition 2:\n## ########################################\nif not member(pseudodet(m), \{1,-1,Id,-Id\}) then return false end if;\n########################## ################\n### Condition 3:\n################################## ########\n" }{TEXT 359 0 "" }{MPLTEXT 1 0 585 "expr1:=simplify(cmul(a, reversion(b)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(s implify(expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmu l(reversion(b),d));\nexpr2:=simplify(vectorpart(expr1,1));\nif not eva lb(simplify(expr1-expr2)=0) then return false end if;\nexpr1:=simplify (cmul(d,reversion(c)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then return false end if;\nexpr1:=simp lify(cmul(reversion(c),a));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then return false end if;\nreturn \+ true\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 75. Procedure " }{TEXT 394 10 "clim inpoly" }{TEXT -1 407 " finds the minimal polynomial of any Clifford p olynomial p. It may be used with an optional second argument 'powers' \+ in which case it returns a list of consecutive powers p^k of p which a re linearly independent, k=1..(n-1) where n = degree of the minimal po lynomial of p. If the second optional argument is 'horner' then polyno mial is returned in 'horner' form. This procedure can accept now optio nal index." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 83 "Typical use: climinpoly(p);climinpoly[K](p);\n \+ climinpoly(p,'s');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1408 "climinpoly:=proc(p::\{cliscalar,clibasm on,climon,clipolynom\})\nlocal dp,L,flag,pp,expr,a,k,eq,sys,vars,sol,p oly,lname;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nif \+ type(op(procname),procedure) then\n lname:=`B`;\n else\n lname: =op(procname);\nend if;\ndp:=displayid(p):\nif maxgrade(dp)=0 then L:= [Id] else L:=[Id,dp] end if;\nflag:=false:k:='k':a:='a':\nwhile not fl ag do\npp:=cmul[lname](L[nops(L)],dp):\nexpr:=expand(add(a[k]*L[k],k=1 ..nops(L)));\neq:=clicollect(pp-expr);\nsys:=\{coeffs(eq,cliterms(eq)) \};\nvars:=\{seq(a[k],k=1..nops(L))\};\nsol:=solve(sys,vars):\nif sol< >NULL then flag:=true else L:=[op(L),pp] end if;\nend do;\npoly:='x'^n ops(L)-add(a[k]*'x'^(k-1),k=1..nops(L));\npoly:=sort(subs(sol,poly)); \+ \nif nargs=1 then return poly\nelif nargs=2 then\n if args[2]='pow ers' then return [poly,L]\n elif args[2]='horner' then return co nvert(poly,horner)\n else error \"second (optional) argument mus t be 'powers' or 'horner' \"\n end if;\nelif nargs=3 then\n if member(args[2],\{'powers','horner'\}) and\n member(args[3],\{' powers','horner'\}) then\n return ([convert(poly,horner), L])\n else error \"wrong arguments\"\n end if;\nelse error \"w rong number of arguments: one, two, or three arguments are needed only \"\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 76. Pro cedure " }{TEXT 395 15 "subs_climinpoly" }{TEXT -1 283 " substitutes a ny Clifford polynomial p into any polynomial pol in one variable. It m ay be used with an optional third argument in which case it returns un evaluated polynomial pol in 'horner' form. For example, one can use th is procedure to verify that the given Clifford polynomial p" }{TEXT 356 1 " " }{TEXT -1 37 "satisfies its own minimal polynomial." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 197 "Typi cal use: subs_climinpoly(p,pol);\n subs_climinpoly( p,pol, 'horner');\n subs_climinpoly(p,pol, \"horner \");\n subs_climinpoly(p,pol, horner);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1334 "subs_clipolynom:=proc(clinumber::\{symb ol,cliscalar,clibasmon,climon,clipolynom\},\n m inpoly::polynom,o::\{symbol,string\}) \nlocal ph,d,k,r,q,h,expr,s,var, varx,dclinumber;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: September 17, 2005`;\n############################################ #\nph:=convert(minpoly,horner);\nvar:=op(remove(type,indets(ph),indexe d));\nif not type(eval(clinumber),\{clibasmon,climon,clipolynom\}) \n \+ then return subs(var=clinumber,ph) \nend if;\nif nops(\{var\})<>1 th en varx:=op(select((member,\{var\},\{x,y,z\}))) else varx:=var end if; \nif nops(\{varx\})<>1 then \n error \"expecting only one of x, y, o r z as a variable in %1 but found %2\",minpoly,varx \nend if:\nd:=degr ee(ph,varx);\nh:=ph:\nfor k from 1 to d do\n r[k]:=rem(h,x,x,'s'); \n q[k]:=convert(s,horner);\nh:=q[k];\nend do:\ndclinumber:=display id(clinumber):\nexpr:=clicollect(r[d]*Id+q[d]*dclinumber);\nfor k from d-1 to 1 by -1 do\n expr:=r[k]*Id+'cmul'(expr,dclinumber);\nend do :\nif nargs=2 then return simplify(eval(expr))\nelif nargs=3 then \n \+ if args[3]='horner' then return expr \n else \n error \"thi rd (optional) argument, when used, must be 'horner', but received %1 i nstead\",args[3]\n end if;\nelse error \"wrong number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Proc edure " }{TEXT 396 4 "sexp" }{TEXT -1 427 " finds a power series expan sion of a Clifford polynomial p up to and including order n modulo the minimal polynomial of p. It is recommended that this procedure be use d when n > d, where d is the degree of the minimal polynomial of p. Ot herwise, use 'cexp' or 'cexpQ' instead. The reason is that 'sexp' is f aster than 'cexp' when n > d, but is is slower when n <= d. This proce dure can use an optional argument such as K or -K." }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 49 "Typical use: sexp(p,4 ); sexp(p,4,K);sexp(p,4,-K);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1527 "sexp:=proc(p::\{numeric,cliscalar,cliba smon,climon,clipolynom\},n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nt e,lname,coB,nameB;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: 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\})) th en\n coB:=op(select(type,\{op(args[3])\},numeric));\n name B:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third argument in sexp. See ?s exp for more help.\" \n end if;\nelse\n error \"two or three argum ents expected in sexp. See ?sexp for more help.\"\nend if;\n########## ###########################\nif n=0 then \n if type(p,\{numeric,'cli scalar'\}) then return 1 else return Id fi\nend if;\nk:='k':\nif type( p,\{numeric,cliscalar\}) then return add(p^k/k!,k=0..n) end if;\nif ev alb(vectorpart(p,0)=p) then pp:=scalarpart(p);\n return (add(pp^k/k! ,k=0..n)*Id) \nend if;\npol:=climinpoly[lname](p,'powers');\npowrs:=po l[2]:\n### readlib(powmod);\nk:='k':te:='te':\npol:=collect(add(powmod ('x',k,pol[1],'x')/k!,k=0..n),'x');\nco:=[coeffs(pol,'x','te')]:\nte:= [te]:\nnte:=nops(te):\nfor k from 1 to nte do \n te[k]:=powrs[degre e(te[k],'x')+1] \nend do;\nreturn clicollect(add(co[k]*te[k],k=1..nte) )\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 358 18 "No. 78. Procedure " } {TEXT 397 8 "all_sigs" }{TEXT 398 383 " gives signatures of all real, \+ real simple, real semi-simple, complex, quaternionic, quaternionic sim ple, and quaternionic semi_simple Clifford algebras up to and includin g the dimension specified as the first parameter. Second parameter, wh en used, must be 'real', 'complex', or 'quat', while the third paramet er must be 'simple' or 'semisimple'.\n\nUse: all_sigs(9,'real','simple ');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2808 "all_sigs:=proc(r) \nloca l s1,s2,mi,ma,P,Q,p,q,pq,r_pq,c_pq,q_pq,x,\nsimple_r_pq,simple_q_pq,se misimple_r_pq,semisimple_q_pq;\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: September 17, 2005`;\n############################## ###############\nif nargs=2 then \n s1:=args[2]:\nelif nargs=3 then \+ \n s1:=args[2]:\n s2:=args[3]:\nend if; \nif not type(r ,range) or \n not type(s1,\{string,symbol\}) or\n not type(s2,\{st ring,symbol\})\nthen\nWARNING(`try first argument as range, e.g., 1..9 , second argument as 'real', 'complex', or 'quat', and third arguments as 'simple' or 'semisimple' instead of:`);\nreturn 'procname(args)'\n end if;\n########################\nmi:=min($r):ma:=max($r):\nP:=\{$0.. 9\}:Q:=\{$0..9\}:\npq:=[]:\nfor p in P do\nfor q in Q do \n if p+q< =ma and p+q>=mi then pq:=[op(pq),[p,q]] end if: \nend do:\nend do:\nr_ pq:=[]:c_pq:=[]:q_pq:=[]:\nfor x in pq do\np:=x[1]:q:=x[2]:\nif member ((p - q) mod 8,\{0,1,2\}) then r_pq:=[op(r_pq),x] end if;\nif member(( p - q) mod 4,\{3\}) then c_pq:=[op(c_pq),x] end if;\nif member((p - q) mod 8,\{4,5,6\}) then q_pq:=[op(q_pq),x] end if;\nend do:\n########## ########################\nif nargs=1 then return pq end if;\n######### #########################\nif nargs=2 then\n if s1='real' then retur n r_pq elif\n s1='complex' then return c_pq elif\n s1='quat' then return q_pq else\n error \"second input string must be 'rea l', 'complex' or 'quat' but received %1\",args[2] \n end if:\nend if : \n##################################\nif s1='real' then\n simp le_r_pq:=[]:semisimple_r_pq:=[]:\n for x in r_pq do \n i f member(x[1]-x[2] mod 8,\{1\}) then \n semisimple_r_pq:=[ op(semisimple_r_pq),x] \n else \n simple_r_pq:=[o p(simple_r_pq),x]\n end if;\n end do:\n if s2='simp le' then return simple_r_pq elif\n s2='semisimple' then return semisimple_r_pq else\n error \"third argument must be 'simple ' or 'semisimple' but received %1\",args[3]\n fi\nend if;\n###### ############################\nif s1='complex' then\n if s2='simple' \+ then return c_pq elif\n s2='semisimple' then return [] \n end i f:\nend if;\n##################################\nif s1='quat' then\n \+ simple_q_pq:=[]:semisimple_q_pq:=[]:\n for x in q_pq do \n \+ if member(x[1]-x[2] mod 8,\{5\}) then \n semisimple _q_pq:=[op(semisimple_q_pq),x] \n else \n simple_ q_pq:=[op(simple_q_pq),x]\n end if;\n end do:\n if \+ s2='simple' then return simple_q_pq elif\n s2='semisimple' the n return semisimple_q_pq else\n error \"third argument must be 'simple' or 'semisimple' but received %1 instead\",args[3]\n end if:\nend if;\nerror \"wrong number of arguments. See ?all_sigs for mo re help.\"\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 357 18 "No. 79. Proce dure " }{TEXT 399 9 "adfmatrix" }{TEXT 400 116 " accomplishes addition of two matrices of type 'dfmatrix', that is, matrices whose entries b elong to a double field\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 371 "adfma trix:=proc(M1::dfmatrix, M2::dfmatrix) local L1, L2;\noptions `Copyrig ht (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: September 17, 2005`;\n######## #####################################\n L1:=ddfmatrix(M1);\n L2: =ddfmatrix(M2);\n return cdfmatrix(evalm(L1[1] + L2[1]), evalm(L1[2 ] + L2[2]))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 361 22 "No. 80/81: Procedures " }{TEXT 403 9 "beta_plus" }{TEXT 404 5 " an d " }{TEXT 401 10 "beta_minus" }{TEXT 402 374 " [originally procedure \+ 'beta' from the package 'double'] are now part of \"CLIFFORD\". They g ive two scalar bilinear forms in the spinor ideal S of Cl(Q).\n\nUsage : beta_plus(psi,phi,f); beta_plus(psi,phi,f),'s'); beta_minus(psi,phi, f); beta_minus(psi,phi,f),'s'); where psi and phi are spinors, f is an idempotent, and 's' is an optional argument that will store 'purescal ar'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2006 "beta_plus:= proc(psi,ph i,f) \nlocal locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i, vars,flagf;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: September 17, 2005`;\n############################ #################\nif not _prolevel then\n if not type(psi,\{cliscalar ,clibasmon,climon,clipolynom\}) then \n error \"first argument must b e of type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\n if not type(phi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n error \"second argument must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-compu ted data and check if idempotents are the same\nlocdata:=clidata(B):\n locf:=eval(locdata[4]);\nKbas:=locdata[6];\nif nops(Kbas)>1 then\n f lagf:=evalb(f=eval(locf) or f=gradeinv(locf) or \n f=-g radeinv(locf) or f=-eval(locf));\n if not flagf then\nerror \"when K = C or K = H, primitive idempotent f = plus/minus clidata(B)[4] or it s grade involution\"\n end if;\nend if;\n###\n y:=cmul(reversion( expand(psi)),expand(phi));\n if y = 0 then return 0 end if;\n m \+ := 'm';i:='i':\n flag := false;\n mons := cbasis(linalg[coldim]( B));\n v := array(1 .. nops(Kbas),[]);\n lambda := add(v[i]*Kbas [i],i=1..nops(Kbas));\n for m in mons while not flag do\n uu := m;\n eq := clicollect(cmul(m,y) - expand(cmul(lambda,f))); \n sys := \{coeffs(eq, cliterms(eq))\};\n vars := \{seq( v[i], i = 1 .. nops(Kbas))\};\n sol := solve(sys, vars);\n \+ flag := not evalb(sol = NULL)\n end do:\n if nargs = 4 then\n if not type(args[4],name) or type(args[4],protected) then \n \+ error \"fourth optional argument, when used, must be of type un protected name\"\n else assign(args[4],uu) \n end if;\n \+ end if;\n lambda:=subs(sol,lambda):\n if vectorpart(lambda,0)=l ambda then return (scalarpart(lambda)) \n else return lambda\n \+ end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2038 "beta_mi nus:= proc(psi,phi,f) \nlocal locf,locdata,y,m,flag,mons,uu,eq,lambda, sys,sol,Kbas,v,i,vars,flagf;\nglobal B,_prolevel;\noptions `Copyright \+ (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: September 17, 2005`;\n########### ##################################\nif not _prolevel then\n if not typ e(psi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n error \"firs t argument must be of type 'cliscalar', 'clibasmon', 'climon', or 'cli polynom'\" \n end if;\n if not type(phi,\{cliscalar,clibasmon,climon,c lipolynom\}) then \n error \"second argument must be of type 'cliscala r', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\nend if;\n###L oad in pre-computed data and check if idempotents are the same\nlocdat a := clidata(B):\nlocf := eval(locdata[4]);\nKbas := locdata[6];\nif n ops(Kbas)>1 then\n flagf:=evalb(f=eval(locf) or f=gradeinv(locf) or \+ \n f=-gradeinv(locf) or f=-eval(locf));\n if not flag f then\n error \"when K = C or K = H, primitive idempotent f = pl us/minus clidata(B)[4] or its grade involution\"\n end if;\nend if; \n###\n y := cmul(conjugation(expand(psi)),expand(phi));\n if y \+ = 0 then return 0 end if;\n m := 'm';i:='i':\n flag := false;\n \+ mons := cbasis(linalg[coldim](B));\n v := array(1 .. nops(Kbas), []);\n lambda := add(v[i]*Kbas[i],i=1..nops(Kbas));\n for m in m ons while not flag do\n uu := m;\n eq := clicollect(cmul (m,y) - expand(cmul(lambda,f)));\n sys := \{coeffs(eq, cliterms (eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n \+ sol := solve(sys, vars);\n flag := not evalb(sol = NULL)\n \+ end do:\n if nargs = 4 then\n if not type(args[4],name) or ty pe(args[4],protected) then \n error \"fourth optional argumen t, when used, must be of type unprotected name\"\n else ass ign(args[4],uu) \n end if;\n end if;\n lambda:=subs(sol,la mbda):\n if vectorpart(lambda,0)=lambda then \n return scalar part(lambda) \n else \n return lambda\n end if;\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT 362 18 "No. 82. Procedure " }{TEXT 405 9 " cdfmatrix" }{TEXT 406 100 " creates a matrix over double field from a \+ list of two matrices or from a serquence of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 923 "cdfmatrix:=proc() local l1,l2,L,i,j,m,n,m1 ,m2,MN;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Septe mber 17, 2005`;\n#############################################\nif nar gs=1 and type(args[1],list(\{matrix,array\})) \n then m1 ,m2:= evalm(args[1][1]),evalm(args[1][2]);\nelif nargs=2 and type(args [1],\{matrix,array\}) and type(args[2],\{matrix,array\}) \n \+ then m1,m2:= evalm(args[1]),evalm(args[2])\nelse error \"wrong num ber or types of arguments. See ?cdfmatrix for help.\" \nend if;\n l 1:=convert(m1,mlist);\n l2:=convert(m2,mlist);\n L:=[];\n for i to nops(l1) do \n L:=[op(L),[l1[i],l2[i]]] \n end do:\n m:=linalg[rowdim](m1);\n n:=linalg[rowdim](m1);\n MN:=linalg [matrix](m,n,[]);\n for i to m do \n for j to n do MN[i,j]:= L[(i-1)*n+j] \n end do:\n end do:\n return evalm(MN)\nend pro c:\n" }}{PARA 0 "" 0 "" {TEXT 363 18 "No. 83. Procedure " }{TEXT 407 9 "ddfmatrix" }{TEXT 408 64 " decomposes a matrix over double field in to a pair of matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 462 "ddfmat rix:=proc(M::dfmatrix) local m,n,i,L1,L2,L;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\n m:=linalg[rowdim](M);\n n:=linalg [coldim](M);\n L:=convert(M,mlist);\n L1:=[seq(L[i][1],i=1..nops (L))];\n L2:=[seq(L[i][2],i=1..nops(L))];\n return [linalg[matri x](m,n,L1),linalg[matrix](m,n,L2)]\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 364 18 "No. 84. Procedure " }{TEXT 409 11 "diagon alize" }{TEXT 410 42 " tries to diagonalize a symmetric matrix.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 786 "diagonalize:=proc(m::symmatrix) lo cal locB,flag,i,j,L,v,S,Bdiag;\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: September 17, 2005`;\n############################## ###############\nif linalg[coldim](m)<>linalg[rowdim](m) then\n erro r \"expected a square matrix as input\" \nend if;\nif type(m,diagmatri x) then \n return evalm(m) \nend if; \nL:=[linalg[eigenvects](m)];\n flag:=true:\nfor i from 1 to nops(L) while flag=true do\n if L[i][2 ]>nops(L[i][3]) then flag:=false end if: \nend do: \nif not flag then \+ \n error \"since matrix entered does not have a complete set of line arly independent eigenvectors, it is not diagonalizable\" \nend if;\nr eturn linalg[diag](seq(seq(L[i][1],j=1..L[i][2]),i=1..nops(L)))\nend p roc:\n" }}{PARA 0 "" 0 "" {TEXT 365 6 "No. 85" }{TEXT -1 1 "." }{TEXT 366 11 " Procedure " }{TEXT 411 9 "mdfmatrix" }{TEXT 412 46 " multipli es two matrices over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 367 "mdfmatrix:=proc(M1::dfmatrix,M2::dfmatrix) local L1, L2;\nopt ions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: September 17, 200 5`;\n#############################################\n L1:=ddfmatrix( M1);\n L2:=ddfmatrix(M2);\n return cdfmatrix((L1[1]) &cm (L2[1]) ,(L1[2]) &cm (L2[2]))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 370 18 "No . 86. Procedure " }{TEXT 413 7 "cocycle" }{TEXT 414 901 " finds an ele ment x in the given Clifford algebra such that cmul(x,a1) = cmul(a2,x) where a1 and a2 are the first two arguments of type 'clibasmon', 'cli mon', or 'clipolynom'. \n\nIf only two arguments are passed to the pro cedure, element x belongs to the Clifford algebra over the lowest dime nsion dim = max(maxindex(a1),maxindex(a2)). \n\nIf three arguments ar e used with the third argument being a list of elements of type 'cliba smon', 'climon', or 'clipolynom', then x belongs to the set generated \+ by a1, a2, and the elements in the third list a3. \n\nIf the fourth ar gument a4 is used, then the third argument is expected to be a list of elements of type 'clibasmon', in which case the procedure searches fo r x from that list.\n\nTypical use:\n\ncocycle(1+2*e1-e1we3,3*e2+e2we4 );\ncocycle(1+2*e1-e1we3,3*e2+e2we4, [e1we2+Id,e1we2we3,e4]);\ncocycle (1+2*e1-e1we3,3*e2+e2we4, [e1we2,e1we2we3,e4],'clibasmon');\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1487 "cocycle:=proc(a1::\{clibasmon,cli mon,clipolynom\},\n a2::\{clibasmon,climon,clipolynom\}, \n a3::list(\{clibasmon,climon,clipolynom\}),\n \+ a4::symbol) \nlocal g,v,n,llist,i,d,S,x,y,xy,sys,vars,sol,llist1,l list2,llist3;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\n #if a1=a2 then return [Id] end if;\nif nargs=4 and member(args[4],\{cl ibasmon,clibasmon\}) then\n llist:=a3:\n S:=[]:\n for i from 1 to n ops(llist) do\n x:=cmul(llist[i],a1): y:=cmul(a2,llist[i]):\n if x-y =0 then\n if x <> 0 and y <> 0 then\n if cmul(llist[i ],llist[i]) <> 0 then\n S:=[op(S),llist[i] ]:\n end if : \n end if: \n end if:\n end do:\nreturn S\nend if;\nif narg s=3 then\n llist1:=`union`(op(map(cliterms,remove(member,\{seq(op(\{c mul(a1,g),cmul(g,a1)\}),g=a3)\},\{0\})))):\n llist2:=`union`(op(map(c literms,remove(member,\{seq(op(\{cmul(a2,g),cmul(g,a2)\}),g=a3)\},\{0 \})))):\n llist3:=map(op@cliterms,convert(a3,set)); \n llist:=conve rt(`union`(llist1,llist2,llist3),list):\n llist:=sort(convert(\{op(ll ist),op(cliterms(op(a3)))\},list),bygrade):\nelse\n llist:=cbasis(max (maxindex(a1),maxindex(a2))):\nend if;\nn:=nops(llist):\ng:=add(_X[i]* llist[i],i=1..n);\nvars:=\{seq(_X[i],i=1..n)\}:\nxy:=clicollect(cmul(g ,a1)-cmul(a2,g)):\nsys:=\{coeffs(xy,llist)\};\nsys:=map(normal,sys);\n sol:=solve(sys,vars);\nreturn subs(sol,g)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 374 18 "No. 87. Procedure " }{TEXT 415 8 "clisolve" }{TEXT 416 103 " for solving equations in a Clifford algebra Cl(B). \n\nTypic al use:\n\nclisolve(eq,pp);\nclisolve(eq,set);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 594 "clisolve:=proc(eq::\{clibasmon,climon,clipolynom\},i ndet::\{list,algebraic\}) \nlocal i,T,vars,sol,sys;\noptions `Copyrigh t (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: September 17, 2005`;\n######### ####################################\nif type(indet,list) then\n vars :=convert(indet,set)\nelse\n vars:=select(type,indets(indet),indexed) \nend if;\nT:=cliterms(eq);\nsys:=\{coeffs(clicollect(simplify(eq)),T) \};\nsol:=[solve(sys,vars)];\nif type(indet,list) then\n return sol\n else\n return [seq(subs(sol[i],indet),i=1..nops(sol))]\nend if;\nend \+ proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 88. This procedure " } {TEXT 372 13 "CLIFFORD_ENV " }{TEXT 417 135 " lists all environnmental variables defined in Clifford, Cliplus, GTP, Octonion, and Bigebra pa ckages, when these packages are loaded.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6580 "CLIFFORD_ENV:=proc() global _warnings_flag:\noption s `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: September 17, 2005`; \n#############################################\nif not assigned(Cliff ord) then \n lprint(`>>> Package Clifford has not been loaded yet. T ype 'with(Clifford)' at the Maple prompt to load it first. <<<`)\nelse \n print('``');###Print blank line\n lprint(`>>> Global variables defi ned in Clifford:-setup are now available and have these values: <<<`); \nlprint(`************* Start *************`); \n##################### ###\nlprint('dim_V'=dim_V);\n #(dimension of the carrier space for Cl(V,B))\nif not member(dim_V,\{1,2,3,4,5,6,7,8,9\}) and _warnings_fl ag then\n lprint(`Warning, value of dim_V is expected to be a positi ve integer between 1 and 9, inclusive.`);\n print('``');###Print bla nk line\nend if;\n########################\nlprint('_default_Clifford_ product'=_default_Clifford_product);\n #(controls whether cmulRS \+ or cmulNUM is used in Clifford product 'cmul')\n#lprint(`Possible valu es are: 'cmulRS','cmulNUM','cmulgen','cmul_user_defined'.`);\nif not m ember(_default_Clifford_product,\{'cmulRS','cmulNUM','cmulgen','cmul_u ser_defined'\}) \n and _warnings_flag then\n lprint(`****** SERIOU S WARNING ******`); \n lprint(`>>> Value of _default_Clifford_produc t was expected to be 'cmulRS', 'cmulNUM', 'cmulgen', or 'cmul_user_def ined'. <<<`);\n lprint(`*****************************`);\nend if;\n# #######################\nlprint('_prolevel'=_prolevel);\n #(contr ols whether or not parsing is done)\nif not member(_prolevel,\{true,fa lse\}) and _warnings_flag then\n lprint(`Warning, value of _prolevel is expected to be true or false.`);\n print('``');###Print blank li ne\nend if;\n########################\nlprint('_shortcut_in_minimalide al'=_shortcut_in_minimalideal);\n #(controls flow in procedure 'm inimalideal')\nif not member(_shortcut_in_minimalideal,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_mi nimalideal is expected to be true or false.`);\n print('``');###Prin t blank line\nend if;\n########################\nlprint('_shortcut_in_ Kfield'=_shortcut_in_Kfield);\n #(controls flow in procedure 'Kfi eld')\nif not member(_shortcut_in_Kfield,\{true,false\}) and _warnings _flag then\n lprint(`Warning, value of _shortcut_in_Kfield is expect ed to be true or false.`);\n print('``');###Print blank line\nend if ;\n########################\nlprint('_shortcut_in_spinorKbasis'=_short cut_in_spinorKbasis);\n #(controls flow in procedure 'spinorKbasi s')\nif not member(_shortcut_in_spinorKbasis,\{true,false\}) and _warn ings_flag then\n lprint(`Warning, value of _shortcut_in_spinorKbasis is expected to be true or false.`);\n print('``');###Print blank li ne\nend if;\n########################\nlprint('_shortcut_in_spinorKrep r'=_shortcut_in_spinorKrepr);\n #(controls flow in procedure 'spi norKrepr')\nif not member(_shortcut_in_spinorKrepr,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_spinor Krepr is expected to be true or false.`);\n print('``');###Print bla nk line\nend if;\n########################\nlprint('_warnings_flag'=_w arnings_flag);\n #(controls whether some procedures, e.g., 'wedge ', give warnings)\nif not member(_warnings_flag,\{true,false\}) then\n lprint(`Warning, value of _warnings_flag is expected to be true or \+ false.`);\n print('``');###Print blank line\nend if;\n############## ##########\nlprint('_scalartypes'=_scalartypes);\n #(defines type s considered to be 'scalars' by 'clibilinear' and 'clilinear')\n###### ##################\nlprint('_quatbasis'=_quatbasis);\n #(defines \+ default quaternionic basis')\nlprint(`************* End *************` );\nprint('``');###Print blank line \nend if;\n####################### #\nif assigned(Cliplus) then\n print('``');###Print blank line\n lprin t(`>>> Global variables defined in Cliplus:-setup are now available an d have these values: <<<`);\n lprint(`************* Start *********** **`);\n lprint('macro(cmul=climul)');\n #('cmul' is now extended \+ by 'climul') \n lprint('macro(cmulQ=climul)');\n #('cmulQ' is now extended by 'climul')\n lprint('macro(`&c`=climul)');\n #('&c' i s now extended by 'climul')\n lprint('macro(`&cQ`=climul)');\n #( '&cQ' is now extended by 'climul')\n lprint('macro(reversion=clirev)') ;\n #('reversion' is now extended by 'clirev')\n lprint('macro(LC =LCbig)');\n #('LC' is now extended by 'LCbig')\n lprint('macro(R C=RCbig)');\n #('RC' is now extended by 'RCbig')\n if _warnings_f lag then \n lprint(`Warning, new definitions for type/climon and t ype/clipolynom now include &C`);\n end if;\n lprint(`************* End *************`);\n print('``');###Print blank line \nend if;\n\n##### ###############################################\n### Executable Bigebr a file for Maple 6 is Bigebra6\n###################################### ##############\nif assigned(Bigebra6) then\n print('``');###Print blan k line\n lprint(`>>> Global variables defined in Bigebra:-init are now available and have these values: <<<`);\n lprint(`************* Star t *************`);\n lprint('_CLIENV[_SILENT]'=_CLIENV[_SILENT]); #co ntrols messaging upon starting 'Bigebra'\n lprint('_CLIENV[_QDEF_PREFA CTOR]'=_CLIENV[_QDEF_PREFACTOR]); #prefactor in 'switch'\n lprint(`** *********** End *************`);\n print('``');###Print blank line\nen d if;\n##########################################\nif assigned(GTP) th en\n print('``');###Print blank line\n lprint(`************* Start *** **********`);\n lprint(`>>> There are no new global variables or macro s in GTP yet. <<<`);\n lprint(`************* End *************`);\n pr int('``');###Print blank line \nend if;\n############################# #############\nif assigned(Octonion) then\n print('``');###Print blank line\n lprint(`>>> Global variables defined in Octonion:-setup are no w available and have these values: <<<`);\n print('``');###Print blan k line\n lprint(`************* Start *************`); \n lprint('_oct basis'=_octbasis); #standard octonion basis as Maple global v ariable\n lprint('_pureoctbasis'=_pureoctbasis); #pure octonion basis as Maple global variable\n lprint('_default_Fano_triples'=_default_Fa no_triples); #default list of Fano triples\n lprint('_default_squares' =_default_squares); #default squares of e1,e2,e3,e4,e5,e6,e7\n lprint( '_default_Clifford_product'=_default_Clifford_product); #selects cmulN UM for numeric B\n lprint(`************* End *************`);\n print( '``');###Print blank line \nend if;\n################################# #########\n\nreturn NULL\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 373 18 "No. 89. Procedure " }{TEXT 418 13 "makeclibasmon" }{TEXT 419 402 " th at takes a list and makes Grassmann basis monomials. It is expected, t hat the list contains positive integers between 1 and 9 inclusive, or \+ symbolic indices consisting of one-character strings. If the list is e mpty, then Id is returned. If any two elements in the list are peated, then 0 is returned. This procedure has a remember table.\n\nTypical u se: makeclibasmon([]); makeclibasmon([1,7,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 475 "makeclibasmon:=proc(x::list) \nlocal result,N,i ;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`,remember;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\n N :=nops(x);\n if N = 0 then return Id end if;\n if N > nops(convert(x ,set)) then return 0 end if;\n result:=cat(e,x[1]);\n for i from 2 to N do\n result:=cat(result,cat(we,x[i]));\n end do:\nretu rn result\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 90. Procedu re " }{TEXT 474 12 "rd_clibasmon" }{TEXT -1 405 " generates a random G rassmann basis monomial. It can be used without any arguments in which case default values are used internally, or with 1 or 2 arguments as \+ follows:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maxim um allowed grade (default 4)\n\nrd_clibasmon(); then NT1 = \+ 9, NT2 = 4 \nrd_clibasmon(a1); then NT1 = a1, NT2 = 4\nrd_cliba smon(a1,a2); then NT1 = a1, NT2 = a2\n\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1405 "rd_clibasmon:=proc() local ind,NT1,NT2,nt1d,nt2d,L; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\n### NT1 = max imum allowed index value (default 9)\n### NT2 = maximum allowed grade \+ (default 4) (must be less than or equal to NT1)\nnt1d,nt2d:=9,4:\n#### #########################################\nif nargs=0 then\n NT1,NT2 :=nt1d,rand(0..nt2d)(): #defaults\n L:=[[]]:\nelif nargs=1 then\n \+ if not type(args[1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0 ) then\n error \"argument must be non negative integer between 0 \+ and 9 giving the maximum monomial index\"\n end if;\n NT1,NT2:=arg s[1],rand(0..args[1])():\n L:=[[]]: \n elif nargs>=2 then\n i f evalb(not type([args],list(nonnegint)) or \n not evalb(args[1]< =9 and args[1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0 )) then\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. Second argument must be non nega tive integer between 0 and first argument giving maximum possible grad e. Other arguments, if present, are ignored.\" \n end if;\n NT1,NT 2:=args[1],min(args[1],args[2]):\n L:=[]:\n end if:\n############# #\nL:=[op(L),op(combinat[choose](NT1,NT2))];\nind:=sort(L[rand(1..nops (L))()]);\nreturn Clifford:-makeclibasmon(ind)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 91. Procedure " }{TEXT 475 9 "rd_climon" } {TEXT -1 560 " generates a random Grassmann monomial. It can be used w ithout any arguments in which case default values are used internally, or with 1, 2, or 3 arguments as follows:\n\nNT1 = maximum allowed ind ex value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = m aximum absolute value of coefficients allowed (default 12)\n\nrd_climo n(); then NT1 = 9, NT2 = 4, NT3 = 12 \nrd_climon(a1); \+ then NT1 = a1, NT2 = 4, NT3 = 12\nrd_climon(a1,a2); \+ then NT1 = a1, NT2 = a2, NT3 = 12\nrd_climon(a1,a2,a3); then NT1 = \+ a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1994 "rd_cl imon:=proc() local rcf,NT1,NT2,NT3,nt1d,nt2d,nt3d;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: September 17, 2005`;\n########## ###################################\n### NT1 = maximum allowed index v alue (default 9)\n### NT2 = maximum allowed grade (default 4)\n### NT3 = maximum absolute value of coefficient allowed (default 12)\nnt1d,nt 2d,nt3d:=9,4,12:\n#############################################\nif na rgs=0 then\n NT1,NT2,NT3:=nt1d,rand(0..nt2d)(),rand(1..nt3d)(): #def aults\nelif nargs=1 then\n if not type(args[1],nonnegint) or not eva lb(args[1]<=9 and args[1]>= 0) then\n error \"argument must be no n negative integer between 0 and 9 giving the maximum monomial index\" \n end if;\n NT1,NT2,NT3:=args[1],rand(0..args[1])(),rand(1..nt3d) (); \nelif nargs=2 then\n if evalb(not type([args],list(nonnegint)) \+ or \n not evalb(args[1]<=9 and args[1]>=0) or\n \+ not evalb(args[2]<=args[1] and args[2]>=0)) then\nerror \"first argume nt must be non negative integer between 0 and 9 giving maximum monomia l index. Second argument must be non negative integer between 0 and fi rst argument giving maximum possible grade.\"\n end if;\n NT1,NT2, NT3:=args[1],min(args[1],args[2]),rand(1..nt3d)():\nelif nargs>=3 then \n if evalb(not type([args],list(nonnegint)) or \n not ev alb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2]<=args [1] and args[2]>=0)) then\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. Second argumen t must be non negative integer between 0 and first argument giving max imum possible grade. Third argument must be a positive integer giving \+ max value of coefficient. Other arguments, if present, are ignored.\" \n end if;\n NT1,NT2,NT3:=args[1],min(args[1],args[2]),args[3]:\ne nd if:\n#############\nrcf:=[rand(-NT3..-1)(),rand(1..NT3)()]:\nrcf:=r cf[rand(1..nops(rcf))()];\nreturn rcf*rd_clibasmon(NT1,NT2)\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 92. Procedure " }{TEXT 476 13 " rd_clipolynom" }{TEXT -1 761 " generates a random Grassmann polynomial . It can be used without any arguments in which case default values ar e used internally, or with 1, 2, 3, or 4 arguments as follows:\n\nNT1 \+ = maximum allowed index value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum absolute value of coefficients allowed (de fault 12)\nNT4 = maximum number of terms allowed (default 4)\n\nrd_cl ipolynom(); then NT1 = 9, NT2 = 4, NT3 = 12, NT4 \+ = 4 \nrd_clipolynom(a1); then NT1 = a1, NT2 = 4, NT3 \+ = 12, NT4 = 4\nrd_clipolynom(a1,a2); then NT1 = a1, NT2 = \+ a2, NT3 = 12, NT4 = 4\nrd_clipolynoma1,a2,a3); then NT1 = a1, N T2 = a2, NT3 = a3, NT4 = 4\nrd_clipolynom(a1,a2,a3,a4); then NT1 = a 1, NT2 = a2, NT3 = a3, NT4 = a4\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3537 "rd_clipolynom:=proc() \nlocal rnt,rcf,NT1,nt1d,NT2,nt2d,NT3,nt3d ,NT4,nt4d,L,newL,i,inde,x,m;\noptions `Copyright (c) 1995-2005 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n################################ #############\n### NT1 = maximum allowed index value (default 9)\n### \+ NT2 = maximum allowed grade (default 4) (must be leq. than NT1)\n### N T3 = maximum absolute value of coefficient allowed (default 12)\n### N T4 = maximum number of terms allowed (default 5)\nnt1d,nt2d,nt3d,nt4d: =9,4,12,5:\n#####################################################\nif \+ nargs=0 then\n NT1,NT2,NT3,NT4:=\n nt1d,rand(0..nt2d)(),rand(1..nt 3d)(),rand(1..nt4d)(): #defaults\nelif nargs=1 then\n if not type(ar gs[1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n \+ error \"argument must be non negative integer between 0 and 9 giving t he maximum monomial index\"\n end if;\n NT1,NT2,NT3,NT4:=args[1],r and(0..args[1])(),\n rand(1..nt3d)(),rand(1..nt4d)( ):\nelif nargs=2 then\nif evalb(not type([args],list(nonnegint)) or \n not evalb(args[1]<=9 and args[1]>=0) or\n not e valb(args[2]<=args[1] and args[2]>=0)) then\nerror \"first argument mu st be non negative integer between 0 and 9 giving maximum monomial ind ex. Second argument must be non negative integer between 0 and first a rgument giving maximum possible grade.\"\n end if;\n NT1,NT2,NT3,N T4:=args[1],rand(0..min(args[1],args[2]))(),\n rand (1..nt3d)(),rand(1..nt4d)(): \nelif nargs=3 then\n if evalb(not typ e([args],list(nonnegint)) or \n not evalb(args[1]<=9 and ar gs[1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) \+ then\nerror \"first argument must be non negative integer between 0 an d 9 giving maximum monomial index. Second argument must be non negativ e integer between 0 and first argument giving maximum possible grade. \+ Third argument must be a positive integer giving max value of coeffici ent.\";\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(args[1],a rgs[2]))(),\n args[3],rand(1..nt4d)():\nelif nargs> =4 then\n if evalb(not type([args],list(nonnegint)) or \n \+ not evalb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2 ]<=args[1] and args[2]>=0)) then\nerror \"first argument NT1 must be n on negative integer between 0 and 9 giving maximum monomial index. Sec ond argument NT2 must be non negative integer between 0 and NT1 (inclu sive) giving maximum possible grade. Third argument NT3 must be a posi tive integer giving max value of coefficient. Fourth argument NT4 must be a positive integer giving maximum number of terms (it is expected \+ to be no larger that number of combinations NT1 choose NT2. Other argu ments, if present, are ignored.\"\n end if:\n NT1,NT2,NT3,NT4:=arg s[1],min(args[1],args[2]),args[3],args[4]:\nend if:\n#############\n## # NT1 = maximum allowed index value (default 9)\n### NT2 = maximum all owed grade (default 5)\n### NT3 = maximum absolute value of coefficien t allowed (default 12)\n### NT4 = maximum number of terms allowed (def ault 4)\n#############\nL:=\{\}:\nfor i from 0 to NT2 do\n L:=\{op( L),op(combinat[choose](NT1,i))\};\nend do:\nm:=min(nops(L),NT4):\nL:=c onvert(L,list):\nnewL:=[[],[[]]]:\nnewL:=newL[rand(1..2)()]:\nfor i fr om 1 to m do\n inde:=rand(1..nops(L))();\n x:=L[inde];\n newL :=[op(newL),x];\n L:=subsop(inde=NULL,L);\nend do;\nL:=map(makeclib asmon,newL);\nrcf:=[rand(-NT3..-1)(),rand(1..NT3)()]:\nreturn add(rcf[ rand(1..nops(rcf))()]*L[i],i=1..nops(L))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. Initialization procedure " }{TEXT 420 5 "set up" }{TEXT -1 26 " for the Clifford package." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 94 "This package is loaded \+ automatically into Maple session when command with(Clifford); is given ." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1634 "setup:=proc() \nlocal x,y,i,j;\nglobal libname,B,\n_quatbasis,qi ,qj,qk,\n_prolevel,\n_shortcut_in_minimalideal,\n_shortcut_in_Kfield, \n_shortcut_in_spinorKbasis,\n_shortcut_in_spinorKrepr,\ndim_V,\n_warn ings_flag,\n_scalartypes,\n_CLIENV,\n_default_Clifford_product,\npause ,\n###################################\n`convert/dfmatrix`,`convert/ml ist`,`convert/str_to_int`,`type/clibasmon`,\n`type/antisymmatrix`,`typ e/climatrix`,`type/climon`,`type/clipolynom`,\n`type/cliprod`,`type/cl iscalar`,`type/dfmatrix`,`type/diagmatrix`, `type/evenelement`,`type/f ieldelement`,`type/gencomplex`,`type/genquatbasis`,\n`type/genquaterni on`,`type/idempotent`,`type/nilpotent`,`type/oddelement`,\n`type/primi tiveidemp`,`type/purequatbasis`,`type/quaternion`,\n`type/symmatrix`,` type/tensorprod`,\n`&c`,`&cQ`,`&cQm`,`&cm`,`&om`,`&q`,`&qm`,`&rm`,`&w` ,`&wm`;\n###################################\noptions `Copyright (c) 1 995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: September 17, 2005`;\n################ #########################################\n_prolevel:=false: \+ #assigning default value\n_shortcut_in_minimalideal:=true: #assi gning default value\n_shortcut_in_Kfield:=true: #assigning defau lt value\n_shortcut_in_spinorKbasis:=true: #assigning default value\n_ shortcut_in_spinorKrepr:=true: #assigning default value\n_warnings_fl ag:=true: #assigning default value\ndim_V:=9: \+ #default value\n_scalartypes:=\{RootOf,mathfunc,function,num eric,rational,constant,indexed,complex,`^`\}:\n_CLIENV[_QDEF_PREFACTOR ]:=-1:\n_default_Clifford_product:=cmulRS: #default Clifford product\n " }}{PARA 0 "" 0 "" {TEXT 371 98 "(1) Global variable _scalartypes con tains all types declared by the user to be of type 'scalar'. \n" }} {PARA 258 "" 0 "" {TEXT -1 303 "(2) Standard quaternion basis as Maple global variable as in P. Lounesto \"Clifford Algebras and Spinors\", \+ page 49. To avoid conflicts with i, j, k, etc. traditionally used in \+ summations, loops, user could define qi, qj, and qk in place of \{i, j , k\} used to denote pure quaternion part of a quaternion.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 "_quatbasis:=[[Id,e3we2,e1we3,e2we1],\{`Ma ple has assigned qi:=-e2we3, qj:=e1we3, qk:=-e1we2`\}];\n" }}{PARA 0 " " 0 "" {TEXT 367 48 "(3) Defining abbreviations for quaternion basis: " }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "unprotect(qi,q j,qk);\nqi:=-e2we3:\nqj:=e1we3:\nqk:=-e1we2:\n" }}{PARA 0 "" 0 "" {TEXT 368 31 "(4) Defining useful functions:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 "pause:=proc(s::nonnegint) local s1:\ns1:=time():\nwhi le time()-s1 < s do od end proc:" }}{PARA 0 "" 0 "" {TEXT 369 37 "\n(5 ) Protecting all procedure names:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "protect(Clifford,e,'qi','qj','qk',Id,w);\n" }}{PARA 258 "" 0 "" {TEXT 473 22 "Types and conversions:" }{TEXT -1 32 "\n\nNo. 1. Definit ion of the type " }{TEXT 436 9 "clibasmon" }{TEXT -1 87 ", i.e., a bas is monomial. \n\nTypical use: type(e2we1,clibasmon); type(e1we2,clibas mon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 915 "`type/clibasmon`:=proc( a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst,N;\noptions `Copyright (c) \+ 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: September 17, 2005`;\n############### ##############################\na1:=simplify(eval(a)):\n if a1 = Id \+ then return true end if:\n if type(a1,\{string,name,symbol\}) then\n str:=convert(a1,string);\n lst:=[seq(str[i],i=1..length(a1))] ;\n N:=(nops(lst)+1)/3;\n if N=1 then \n e_set:=\{lst[1] \};\n w_set:=\{\"w\"\};\n ind_lst:=[lst[2]];\n else\n \+ e_set:=\{seq(lst[3*i-2],i=1..N)\};\n w_set:=\{seq(lst[3*i] ,i=1..N-1)\};\n ind_lst:=[seq(lst[3*i-1],i=1..N)];\n end if: \n# print(e_set,w_set,ind_lst,N,lst);\n if (e_set=\{\"e\"\}) and ( w_set=\{\"w\"\}) and (N=nops(\{op(ind_lst)\})) then\n return tru e\n else\n return false \n end if:\n else\n return false \n end if: \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "N o. 2. Definition of the type " }{TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e., Clifford scalar. A Clifford scalar is essentially any number, function, constant, or an algebraic expression not containing any bas is monomials (this means that 2*Id is not of type 'cliscalar').\n\nTyp ical use: type(e1+e2we3+2*Pi*B[1,2],cliscalar);\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 765 "`type/cliscalar`:=proc(a::anything) local a1,locsc alartypes;\nglobal `&C`,_scalartypes; \noptions `Copyright (c) 1995-20 05 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: September 17, 2005`;\n###################### #######################\na1:=simplify(eval(a)):\nlocscalartypes:=remov e(member,_scalartypes,\{`^`\}):\nif type(a1,\{matrix,list\}) or hastyp e(a1,clibasmon) or \n hastype(a1,tensorprod) or has(a1,`&C`) then re turn false \nend if: \nif type(a1,locscalartypes) or evalb(op(map(typ e,\{op(a1)\},locscalartypes))=true)\n then return true \nend if:\ni f type(a1,`^`) then\n if select(hastype,\{a1\},clibasmon)=\{\} then \n return true else error \"illegal expression in %1\",a1 \n en d if:\nend if:\nreturn cliparse(a1)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 31 "No. 3. Definition of the type " }{TEXT 438 6 "climon" } {TEXT -1 197 ", i.e., Clifford monomial. A Clifford monomial is essent ially any basis monomial (of type 'clibasmon') multiplied by a Cliffor d scalar (of type 'cliscalar').\n\nTypical use: type(e1we2+2*e2,climon );\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 763 "`type/climon`:=proc(x1) lo cal x,S,xx,flag6plus:\noptions `Copyright (c) 1995-2005 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: September 17, 2005`;\n####################################### ######\nx:=simplify(eval(x1)):\nflag6plus:=assigned(Cliplus):\nif hast ype(x,cliprod) and not flag6plus and _warnings_flag then \n WARNING( `argument to 'type/climon' contains type 'cliprod'. Load 'Cliplus' to \+ extend functionality of CLIFFORD. Type ?cliprod for help.`);\nend if: \n##################\nif not flag6plus then S:=\{'clibasmon'\} else S: =\{'clibasmon','cliprod'\} end if:\nxx:=simplify(x):\nif type(xx,clisc alar) then false\nelif evalb(type(xx,`*`) and nops(select(type,\{op(xx )\},S))=1) then\n true \nelse \n false\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 30 "No. 4. Definition of the type " }{TEXT 439 10 "clipolynom" }{TEXT -1 265 ", i.e., Clifford polynomial. A Cli fford polynomial is a multivariate polynomial in the unknowns of type \+ 'climon' or 'cliprod', i.e., Clifford monomial, with coefficients of t he type 'cliscalar', i.e., Clifford scalar.\n\nTypical use: type(e1+2* Pi*e2we3,clipolynom);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 949 "`type/c lipolynom`:=proc(x1) local x,flag6plus:\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\nx:=simplify(eval(x1)):\nif type(eval(x),\{ma trix,list,set,cliscalar\}) or \n (not type(eval(x),algeb raic)) or \n hastype(eval(x),tensorprod) then \nreturn false \nend if:\nflag6plus:=assigned(Cliplus):\nif hastype(x,cliprod ) and not flag6plus and _warnings_flag then \n WARNING(`argument to \+ 'type/clipolynom' contains type 'cliprod'. Load 'Cliplus' to extend f unctionality of CLIFFORD. Type ?cliprod for help.`);\nend if:\nif eval b(not flag6plus and type(expand(x),`+`) and hastype(x,clibasmon) and n ot hastype(x,cliprod)) \n then return true \nend if:\nif evalb(flag 6plus and type(expand(x),`+`) and hastype(x,\{clibasmon,cliprod\})) th en \n return true \nend if: \nreturn false \nend proc:" }}{PARA 0 " " 0 "" {MPLTEXT 0 21 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 432 24 "No. 5. Converts strings " }{TEXT 440 10 "str_to_int" }{TEXT 441 98 " : `1`, `2`, ..., `0` to appropriate digit.\n\nTypical use: ma p(convert,extract(e1we2),str_to_int);\n" }{MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 647 "`convert/str_to_int`:=proc(a1::symbol)\n options `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`,remember;\ndescription `Last revised: Decem ber 2, 2002`;\nreturn parse(a1);\n#################################### #########\nif args[1] = `0` then return 0 elif\n args[1] = `1` then \+ return 1 elif\n args[1] = `2` then return 2 elif\n args[1] = `3` t hen return 3 elif\n args[1] = `4` then return 4 elif\n args[1] = ` 5` then return 5 elif\n args[1] = `6` then return 6 elif\n args[1] = `7` then return 7 elif\n args[1] = `8` then return 8 elif\n arg s[1] = `9` then return 9 else\n return a1\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 26 "No. 6. Definition of type " }{TEXT 442 9 "nilpotent" }{TEXT -1 914 ". The following procedure verifies wheth er or not its non-zero argument is a nilpotent element in the given Cl ifford algebra Cl(B). It is expected that a matrix of the bilinear fo rm B has been specified. If the element happens to be an idempotent, or if some power of that element equals the element itself, or if the element is of type 'cliscalar' then the procedure returns 'false'. \+ Otherwise, the procedure checks if any power of its argument up to and including order of 2^N, where N is the maximum index found in the inp ut, is zero.\n\nThis procedurecan also test for nilpotency w.r.t. to a name/symbol/matrix/array which may be passed on as a second element o f list why the first element in the list is the element to be checked \+ for nilpotency. \n\nTypical use: type((1/2)*(e1 +e1we3),nilpotent); \+ #this is a nilpotent element in Cl(3,0) \ntype(p,nilpotent);\ntype([p, K],nilpotent);\ntype([p,-K],nilpotent);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2105 "`type/nilpotent`:=proc(a11) \nlocal a1,i,x,y,xx,k,f lagB,S,lname,flagindexed;global B;\noptions `Copyright (c) 1995-2005 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: September 17, 2005`;\n########################## ###################\n##########################################\n##Thi s code allows for passing name of the matrix K as a second element in \+ a list:\n##To test element p for nilpotency w.r.t. matrix K enter [p,K ];\n##To test element p for nilpotency w.r.t. B enter p, or, [p,B].\n# #########################################\nif type(a11,\{cliscalar,cli basmon,climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flag indexed:=false:\n if not type(B,matrix) then error \"matrix must \+ be assigned to B\" \n else flagB:=type(B,diagmatrix) \n \+ end if:\nelif type(a11,list) then\n if nops(a11)<>2 then error \"l ist must have exactly two elements\"\n elif not type(a11[1],\{cli scalar,clibasmon,climon,clipolynom\}) or\n not type(a11[2], \{name,symbol,matrix,array,`&*`(numeric,\{name,symbol,matrix,array\}) \})\n then error \"list must contain clipolynom and name\"\n el se\n a1:=a11[1]:\n lname:=a11[2]:\n flagindexed:=true:\n if not type(evalm(lname),matrix) then error \"matrix must be assigned to %1\",lname \n else flagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"unexpected argument type \"\nend if:\n###################################\nx:=displayid(a1):\ni f a1=0 then return true \n elif type(a1,cliscalar) then \n \+ return false \n elif (type(x,clibasmon) and flagB and linalg[de t](evalm(lname))<>0) then \n return false \nend if:\n#### ################################\nxx:=cmul[lname](x,x):\nif evalb(xx=0 ) then return true end if:\nif evalb(simplify(xx-x)=0) or not evalb(so lve(xx=k*x,k)=NULL) then return false end if:\ny:=xx:\nfor i from 1 to 2^maxindex(a1) do\n if y=vectorpart(y,0) or y=x then return fal se end if: \n y:=cmul(x,y);\n if y=0 then return true end if:\n end do:\nerror \"Sorry, but I am unable to determine nilp otency of %1\",a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7 . Definition of type " }{TEXT 443 10 "idempotent" }{TEXT -1 311 ". Th e following procedure verifies whether or not its argument is an idemp otent in the given Clifford algebra Cl(B). It is expected that a matr ix of the bilinear form B has been specified. It can also check elemen t p for being idempotent in Cl(K) if K is entered as a second argument in a list such as [p,K].\n" }}{PARA 0 "" 0 "" {TEXT 431 124 "Typical \+ use: type((1/2)*(1 + e1),idempotent); #this is an idempotent in Cl(3, 0)\ntype(p,idempotent);\ntype([p,K],idempotent);" }}{PARA 0 "" 0 "" {TEXT 435 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1579 "`type/idempotent `:=proc(a11) \nlocal f,ff,lname,a1,flagindexed,flagB; global B;\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\n#############################################\n#################### ######################\n##This code allows for passing name of the mat rix K as a second element in a list:\n##To test element p for being id empotent w.r.t. matrix K enter [p,K];\n##To test element p for being i dempotent w.r.t. B enter p, or, [p,B].\n############################## ############\nif type(a11,\{cliscalar,clibasmon,climon,clipolynom\}) t hen\n a1:=a11:\n lname:=`B`:\n flagindexed:=false:\n if not type(B,matrix) then error \"matrix must be assigned to B\" \n \+ else flagB:=type(B,diagmatrix) \n end if:\nelif type(a11,list ) then\n if nops(a11)<>2 then error \"list must have exactly two ele ments\"\n elif not type(a11[1],\{cliscalar,clibasmon,climon,clipo lynom\}) or\n not type(a11[2],\{name,symbol,matrix,array,`&* `(numeric,\{name,symbol,matrix,array\})\})\n then error \"list mu st contain clipolynom and name\"\n else\n a1:=a11[1]:\n lname:=a 11[2]:\n flagindexed:=true:\n if not type(evalm(lname),matrix) \+ then error \"matrix must be assigned to %1\",lname \n else \+ flagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nels e\n error \"unexpected argument type\"\nend if:\n################### #####################\nf:=displayid(a1):\nff:=cmul[lname](f,f):\nif ev alb(ff=0) then return false end if:\nreturn evalb(simplify(ff-f)=0)\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 8. A new type " } {TEXT 444 9 "climatrix" }{TEXT -1 424 " is a matrix with at least one \+ entry of type 'clipolynom'. Note that anything in Maple that has been \+ defined via the procedure linalg[matrix] is of the standard Maple type 'matrix' including matrices with entries in a Clifford algebra. Since a matrix with numerical entries is not of the type 'climatrix', this \+ procedure allows one to distinguish such matrix from those that do hav e at least one entry in a Clifford algebra." }}{PARA 258 "" 0 "" {TEXT -1 208 "\nMatrices of the type 'matrix' but not 'climatrix' may \+ be multiplied using standard Maple matrix multiplication operator `&*` .\n\nMatrices of the type 'climatrix' must be multiplied using the pro cedure 'rmulm'." }}{PARA 0 "" 0 "" {TEXT 430 104 "\nTypical use: M:=li nalg[matrix](2,2,[e1,e3we4+e3,e4,Id-e1]);\n typ e(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 357 "`type/climatr ix`:=proc(x)\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ September 17, 2005`;\n#############################################\ni f type(x,array) then\n return evalb(select(type,convert(x,set),\{clip olynom,climon,clibasmon\})<>\{\})\nelse \n return false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Useful conversion fun ction to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " needed by 'rmulm'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 370 "`convert/mlist`:=proc(a1::matrix ) local i,longlist;\noptions `Copyright (c) 1995-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: September 17, 2005`;\n######################################### ####\nlonglist:=[]:\nfor i from 1 to linalg[rowdim](a1) do\nlonglist:= [op(longlist),op(convert(linalg[row](a1,i),list))] od\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 428 19 "No. 10. A new type " }{TEXT 447 12 "fiel delement" }{TEXT 448 2 ":\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 549 "`ty pe/fieldelement`:=proc(a1::algebraic) global f; \noptions `Copyright ( c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nif not assigned(f) then \n error \+ \"primitive idempotent f has not been assigned yet\" \nend if:\nif not type(f,primitiveidemp) then \n error \"although f has been assigned , it is not of type/primitiveidemp\"\nend if:\nif member(squaremodf(ar gs[1],f),\{-1,1\}) then return true else return false end if \nend pro c:\n" }}{PARA 0 "" 0 "" {TEXT 427 20 "No. 11. A new type: " }{TEXT 449 9 "symmatrix" }{TEXT 450 25 " - a symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 471 "`type/symmatrix`:=proc(a1::\{name,symbol ,matrix,`&*`(algebraic,matrix)\}) \noptions `Copyright (c) 1995-2005 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: September 17, 2005`;\n########################## ###################\nif evalb(evalm(a1)=a1) then return false end if: \nif linalg[coldim](a1)<>linalg[rowdim](a1) then\n error \"B must be assigned square matrix\" \nend if:\nreturn linalg[equal](a1,linalg[tr anspose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 426 20 "No. 12. A \+ new type: " }{TEXT 451 13 "antisymmatrix" }{TEXT 452 31 " - an anti- symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 476 "`type/antis ymmatrix`:=proc(a1::\{name,symbol,matrix,`&*`(algebraic,matrix)\}) \no ptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: September 17, 2 005`;\n#############################################\nif evalb(evalm(a 1)=a1) then return false end if:\nif linalg[coldim](a1)<>linalg[rowdim ](a1) then\n error \"B must be assigned square matrix\" \nend if:\nr eturn linalg[equal](a1,-linalg[transpose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A new type: " }{TEXT 453 10 "diagmatri x" }{TEXT 454 25 " - a diagonal matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 484 "`type/diagmatrix`:=proc(a1::anything) local N,i,DD; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif not type(a 1,\{matrix,`&*`(algebraic,matrix)\}) then return false end if:\nif not type(a1,symmatrix) then return false end if:\n N:=linalg[coldim](a1) :\n DD:=linalg[diag](seq(a1[i,i],i=1..N)):\n return linalg[iszero](e valm(a1-DD))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Ne w type: " }{TEXT 455 14 "primitiveidemp" }{TEXT -1 1109 " - primitive \+ idempotent. This procedure determines the number of factors in the gi ven idempotent of the type (1/2)*(Id+e[i]), i=1..n, where \{e[i],i=1.. n\} is a set of commuting basis monomials with square equal to 1 mod I d. \nIt returns 'true' if n = q - RHnumber(q-p), where 'RHnumber' is \+ the Radon-Hurwitz function and [p,q] is signature of the current quadr atic form which is assumed to have been defined, i.e., the bilinear fo rm B has been defined as a diagonal matrix, and 'false' if n < q - RHn umber(q-p).\n\nIf the argument is the identity element 'Id' of the alg ebra Cl(Q), the procedure checks if Cl(Q) is simple or semi-simple, an d it returns 'true' or 'false' respectively. It is known that when Cl (Q) is semi-simple, 'Id' can be written as a sum of mutually annihilat ing idempotents (1/2)*(Id+p) and (1/2)*(Id-p), where p is the unit pse udo-scalar element (volume element) in Cl(Q).\n\nThe procedure expects that the bilinear form B has been defined as a diagonal matrix.\n\nTy pical use: type(cmul((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),primitiveide mp);\n type(Id,primitiveidemp);\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 510 "`type/primitiveidemp`:=proc(f::idempotent) \+ local p,q,numfact;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: September 17, 2005`;\n################################# ############\nif not type(B,matrix) then \n error \"B must be assign ed square matrix\" \nelse\n p:=Bsignature(B)[1]:q:=Bsignature(B)[2] \nend if:\nnumfact:=q-RHnumber(q-p):\nif scalarpart(f)=1/2^numfact the n \n return true \nelse \n return false \nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 13 "No. 15. Type " }{TEXT 456 13 "purequatb asis" }{TEXT -1 109 " is a procedure which checks if the given list of three basis monomials can be a basis for pure quaternions.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 922 "`type/purequatbasis`:=proc(l1::lis t(\{clibasmon,climon,clipolynom\})) \nlocal p,q,r;global B;\noptions ` Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n# ############################################\nif nops(l1) <> 3 then \n error \"list must have exactly 3 elements of type 'clibasmon', 'cli mon', or 'clipolynom' but received a list with %1 elements\",nops(l1) \nend if:\nif not type(B,matrix) then \n error \"square matrix must \+ be assigned to B\"\nend if: \np:=l1[1]:q:=l1[2]:r:=l1[3]:\nif cmul(p,p )<>-Id then return false elif\n cmul(q,q)<>-Id then return false eli f\n cmul(r,r)<>-Id then return false elif\n not member(cmul(p,q), \{r,-r\}) then return false elif\n cmul(p,q)+cmul(q,p)<>0 then retur n false elif\n cmul(p,r)+cmul(r,p)<>0 then return false elif\n cmu l(q,r)+cmul(r,q)<>0 then return false else\n return true\nend if:\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 16. A new type: " } {TEXT 457 10 "gencomplex" }{TEXT -1 413 " - a generalized complex elem ent of Cl(B). A Clifford polynomial p in Cl(B) is of this type if it \+ belongs to a subalegbra A of Cl(B) isomorphic to complex numbers C. Kn owing that the given polynomial p is of that type allows for finding t he inverse of p in A < Cl(B) a more efficient way by the procedure 'ci nv'.\n\nNote that elements of grade 0 (eg., 2*Id) are not of this type .\n\nTypical use: type(p,gencomplex);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 888 "`type/gencomplex`:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom\}) local L;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: September 17, 2005`;\n################################# ############\nif not type(B,matrix) then \n error \"can't check type since B is not assigned a matrix\" \nend if:\nif type(a1,cliscalar) t hen return false end if:\nL:=[op(cliterms(reorder(a1)))];\nif nops(L)> 2 then return false end if:\nif nops(L)=1 and L=[Id] then return false end if:\nif nops(L)=2 and not member(Id,L) then return false end if: \nL:=remove(member,L,[Id]);\nif maxindex(L)>linalg[coldim](B) then \n \+ error \"can't check type since the largest index in %1 is greater th an size %2 of current form B\", a1,linalg[coldim](B)\nend if:\nif cmul (L[1],L[1])=-Id then \n return true \nelse \n return false \nend \+ if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 17. A new type: " }{TEXT 458 13 "genquaternion" }{TEXT -1 513 " - a generalized quate rnionic element of Cl(B). A Clifford polynomial p in Cl(B) is of this type if it belongs to a subalegbra A of Cl(B) isomorphic to a divisio n ring H of quaternions. Knowing that the given polynomial p is of th at type allows for finding the inverse of p in A < Cl(B) a more effici ent way by the procedure 'cinv'.\n\nNote that elements of grade 0 (eg. , 2*Id) and elements of type 'gencomplex' - a generalized complex elem ent of Cl(B), are not of this type.\n\nTypical use: type(p,genquaterni on);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 665 "`type/genquaternion`:=pr oc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local L;global B;\no ptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: September 17, 2 005`;\n#############################################\nif not type(B,ma trix) then \n error \"square matrix must be assigned to B\" \nend if :\nif type(a1,cliscalar) then return false end if:\nL:=[op(cliterms(re order(a1)))];\nif nops(L)>4 or type(a1,gencomplex) then return false e nd if:\nL:=remove(member,L,[Id]);\nif nops(L)=1 then return false end \+ if:\nif nops(L)=2 then L:=[op(L),cmul(L[1],L[2])] end if:\nreturn type (L,purequatbasis)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 1 8/19. Two new types: " }{TEXT 460 11 "evenelement" }{TEXT -1 5 " and \+ " }{TEXT 459 10 "oddelement" }{TEXT -1 242 " in Cl(B). These two type -checking procedures determine whether their inputs are even elements, odd elements, or neither in Cl(B).\n\nTypical use: type(p,evenelement );\n type(p,oddelement);\n\nwhere p is a Clifford p olynomial.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 779 "`type/evenelement` :=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\})\noptions `Copyri ght (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n####### ######################################\nif type(eval(a1),cliscalar) th en return true end if:\nreturn evalb(reorder(displayid(eval(a1)-gradei nv(eval(a1))))=0)\nend proc:\n\n`type/oddelement`:=proc(a1::\{cliscala r,clibasmon,climon,clipolynom\})\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: September 17, 2005`;\n############################ #################\nif type(eval(a1),cliscalar) then return false end i f:\nreturn evalb(reorder(displayid(eval(a1)+gradeinv(eval(a1))))=0)\ne nd proc:\n" }}{PARA 0 "" 0 "" {TEXT 424 18 "No. 20. New type: " } {TEXT 461 10 "quaternion" }{TEXT 462 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 898 "`type/quaternion`:=proc(q::algebraic) local aa1,aa2, S;global B,qi,qj,qk;\noptions `Copyright (c) 1995-2005 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: September 17, 2005`;\n######################################## #####\nif not assigned(B) or not type(B,matrix) then \n error \"bili near form B has not been assigned yet. It must be defined as the ident ity 3 x 3 matrix.\"\nend if:\nif not linalg[equal](B,linalg[diag](1$3) ) then \n error \"identity 3 x 3 matrix must be assigned to B\" \nen d if:\nif not type(eval(q),\{'clibasmon','climon','clipolynom'\}) then \n error \"wrong input type: input must be of type 'clibasmon','cli mon', or 'clipolynom'\" \nend if:\naa1:=\{op(cliterms(reorder(expand(e val(q)))))\};\naa2:=\{Id,e1we2,e1we3,e2we3\};#standard basis to be com pared to\nS:=aa1 minus aa2;\nif op(S) = NULL then \n return true els e return false \nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 423 17 "No. 21. New type " }{TEXT 463 10 "tensorprod" }{TEXT 464 183 " is \+ needed to include new types from the package 'GTP' for 'Graded Tensor \+ Product'. This is an experimental package for computations with grade d tensor products of Clifford algebras." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 334 "`type/tensorprod`:=proc(a1::anything)\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\n#############################################\nif type(a1,function) and op(0,a1)=`&t` then return true else return false end if:\nreturn \+ false\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" } }{PARA 0 "" 0 "" {TEXT 422 18 "No. 22. New type: " }{TEXT 465 12 "genq uatbasis" }{TEXT 466 187 ". This procedure checks if the given list or set of four elements is a basis for generalized quaternionic ring.\n \nUse: type([p1,p2,p3,p4], genquatbasis);type(\{p1,p2,p3,p4\}, genquat basis);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1477 "`type/genquatbasis`: =proc(L::\{list(\{cliscalar,clibasmon,climon,clipolynom\}),\n \+ set(\{cliscalar,clibasmon,climon,clipolynom\})\}) \nlocal f,p,q,k,loc,i;global B;\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n####### ######################################\ndescription `Last revised: Sep tember 17, 2005`;\nif nops(L) <> 4 or nops(L)<>nops(convert(L,set)) th en \n error \"list or set must have exactly 4 different elements\" \+ \nend if:\nif not type(B,matrix) then \n error \"square matrix must \+ be assigned to B first\" \nend if: \nf:=op(select(type,L,idempotent)): #select idempotent in L\nif f=NULL then \n error \"one element in t he list must be an idempotent\" \nend if:\nloc:=remove(member,L,\{f\}) ; #assign remaining elements of L to loc \np,q,k:=seq(loc[i],i =1..3): #assign elements of loc to p,q,k\n##################### #############\nif cmul(p,p)<>cmul(-Id,f) then return false elif\n cm ul(q,q)<>cmul(-Id,f) then return false elif\n cmul(k,k)<>cmul(-Id,f) then return false \nend if:\n################################## \ni f (cmul(p,q)=cmul(k,f) and cmul(q,p)=-cmul(k,f) and \n cmul(q,k)=cm ul(p,f) and cmul(k,q)=-cmul(p,f) and \n cmul(k,p)=cmul(q,f) and cmu l(p,k)=-cmul(q,f)) \nor\n (cmul(p,q)=-cmul(k,f) and cmul(q,p)=cmul(k ,f) and \n cmul(q,k)=-cmul(p,f) and cmul(k,q)=cmul(p,f) and \n c mul(k,p)=-cmul(q,f) and cmul(p,k)=cmul(q,f))\nthen return true \nelse \n return false\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 23. New type" }{TEXT 421 2 ": " }{TEXT 467 7 "cliprod" }{TEXT 468 117 "\n\nUse: type(e1we2 &C e3, cliprod); type(`&C`(e1,e2),cliprod ); type(`&C`[K](e1,e2),cliprod); type(&C(e1,e2),cliprod);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 318 "`type/cliprod`:=proc(f::\{function,anyth ing\}) local p;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: September 17, 2005`;\n############################################# \nevalb(member(op(0,f),\{`&C`\}) or member(op(0,op(0,f)),\{`&C`\}))\ne nd proc:\n" }}{PARA 0 "" 0 "" {TEXT 433 18 "No. 24. Procedure " } {TEXT 469 16 "convert/dfmatrix" }{TEXT 470 84 " converts a list of mat rices or a pair of matrices inot a matrix over double field.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 970 "`convert/dfmatrix`:=proc() local l 1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Copyright (c) 1995-2005 by Rafal Ab lamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `La st revised: September 17, 2005`;\n#################################### #########\nif nargs=1 and type(args[1],dfmatrix) \n then return args[1]\nelif nargs=1 and type(args[1],list(\{matrix,array\})) \n then m1,m2:=evalm(args[1][1]),evalm(args[1][2]);\nel if nargs=2 and type(args[1],\{matrix,array\}) and type(args[2],\{matri x,array\}) \n then m1,m2:=evalm(args[1]),evalm(args[2]) \nelse error \"wrong number or types of arguments\" \nend if:\n l1 \+ := convert(m1,mlist);\n l2 := convert(m2,mlist);\n L := [];\n \+ for i to nops(l1) do L := [op(L), [l1[i], l2[i]]] end do:\n m := l inalg[rowdim](m1);\n n := linalg[rowdim](m1);\n MN := linalg[mat rix](m, n, []);\n for i to m do for j to n do MN[i, j] := L[(i - 1) *n + j] od\n end do:\n return evalm(MN)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 434 18 "No. 25. Procedure " }{TEXT 471 13 "type/dfmatrix" }{TEXT 472 73 " checks if a matrix is of type 'dfma trix', that is, over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 498 "`type/dfmatrix`:=proc(m::anything) local mm;\noptions `Copyri ght (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n####### ######################################\nif not type(m,matrix) and not \+ type(m,list(matrix)) then return false end if:\nif type(m,matrix) then \n return type(convert(m,mlist),\n list(list(\{cliscalar,c libasmon,climon,clipolynom,numeric,symbol,algebraic\})))\nelse\n ret urn false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 477 79 "In th is version we define all ampersand operators as global in Clifford:-se tup:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2306 "`&c`:=pr oc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyrig ht (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: September 17, 2005`;\n######## #####################################\n############################### ########\n### Works when &c[''K''] or &c[''-K''] is entered and K is a matrix\n#######################################\nflagdec:=true:\nif t ype(op(procname),procedure) then\n if type([args],listlist) then\n \+ if type(op(args),array) then\n WARNING(\"enclose index in \+ double quotes as in &c[''B''] or &c[''-B''] when B has been assigned a matrix to avoid the following:\");\n return 'procname(args)'; \n end if;\n else coB:=1:\n nameB:=`B`:\n lname:=`B` :\n ARGS:=[args]:\n flagdec:=false:\n end if;\nelse lnam e:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric, name)) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n \+ coB:=1:\n nameB:=lname:\n end if;\n flagdec:=false: \n end if;\n#######################################\ndecindex:=proc() \+ local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if t ype(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)\},numeric));\n \+ nameB:=op(select(type,\{op(nameB)\},name));\n end if;\n \+ elif type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(o p(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 wro ng 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 ar guments and/or index from arguments\"\n end if;\nreturn coB,nameB,[ARG S];\nend proc:\n#####################################\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if;\n NP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if;\nif NP <=1 th en return op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARGS)); \nend \+ proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2382 "`&cQ`:=proc() local NP ,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\n#######################################\n### Works when &cQ[''K''] or &cQ[''-K''] is entered and K is a matrix\n## #####################################\nflagdec:=true:\nif type(op(proc name),procedure) then\n if type([args],listlist) then\n if type (op(args),array) then\n WARNING(\"enclose index in double quot es as in &cQ[''B''] or &cQ[''-B''] when B has been assigned a matrix t o avoid the following:\");\n return 'procname(args)';\n en d if;\n else coB:=1:\n nameB:=`B`:\n lname:=`B`:\n \+ ARGS:=[args]:\n flagdec:=false:\n end if;\nelse lname:=op(proc name);\n ARGS:=[args];\n if type(lname,`&*`(numeric,name)) the n\n coB:=op(select(type,\{op(lname)\},numeric));\n nam eB:=op(select(type,\{op(lname)\},name));\n else\n coB:=1: \n nameB:=lname:\n end if;\n flagdec:=false:\n end if ;\n#######################################\ndecindex:=proc() local ARG S,coB,nameB;global B;\nif type([args],listlist) then\n if type(op(ar gs),function) then\n ARGS:=op(op(args));\n coB:=1:\n na meB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric,name)) th en\n coB:=op(select(type,\{op(nameB)\},numeric));\n na meB:=op(select(type,\{op(nameB)\},name));\n end if;\n elif typ e(op(args),`&*`(numeric,function)) then\n nameB:=\{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,name B);\n else\n error \"unable to determine index from or wrong in dex, use name in double quotes as in &cQ[''B''] or &cQ[''-B'']\"\n e nd if;\nelif\n type([args],list) then\n ARGS:=args;\n coB:=1:\n \+ nameB:=`B`; #default name \nelse\n error \"cannot determine argume nts and/or index from arguments\"\nend if;\nreturn coB,nameB,[ARGS];\n end proc:\n#####################################\nif flagdec then \n \+ coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if;\nNP:=n ops(ARGS);\nif member(0,ARGS) then return 0 end if;\nif NP <=1 then re turn op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARGS));\n#return cm ulQ[eval(lname)](op(ARGS)); ###Causes an error in `&cQ` \nend proc:\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1857 "`&cQm`:=proc() local ARGS,lna me,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ##########\n#######################################\nif type([args],li stlist) then\n if type(op(args),array) then\n WARNING(\"enclose index in double quotes as in &cQm[''B''] or &cQm[''-B''] when B has b een assigned a matrix to avoid the following:\");\n return ('proc name(args)');\n end if;\nend if;\n################################## #####\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([args] ,listlist) then\n if type(op(args),function) then\n ARGS:=op(op (args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n if \+ type(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{op (nameB)\},numeric));\n nameB:=op(select(type,\{op(nameB)\},nam e));\n end if;\n elif type(op(args),`&*`(numeric,function)) th en\n nameB:=\{op(op(args))\}:\n coB:=op(select(type,nameB,nu meric));\n nameB:=op(select(type,nameB,function));\n ARGS:=o p(nameB);\n nameB:=op(0,nameB);\n else\n error \"unable to determine index or wrong index type for &cQm, try enclosing name of t he index in double quotes as in &cQm[''B''] or &cQm[''-B'']\"\n end \+ if;\nelif\n type([args],list) then\n ARGS:=args;\n coB:=1:\n n ameB:=`B`; #default name \nelse\n error \"cannot determine arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n####### ##############################\ncoB,nameB,ARGS:=decindex(args);\nlname :=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 end if;\n if NP <=1 then \n return op(ARGS)\n elif NP = 2 then \n \+ return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmulQ,lname) \n else\n \+ error \"only two arguments and index are allowed\"\n end if;\nend p roc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2449 "`&cm`:=proc() local NP, ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995-20 05 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: September 17, 2005`;\n###################### #######################\n#######################################\n### \+ Works when &cm[''K''] or &cm[''-K''] is entered and K is a matrix\n### ####################################\nflagdec:=true:\nif type(op(procn ame),procedure) then\n if type([args],listlist) then\n if type( op(args),array) then\n WARNING(\"enclose index in double quote s as in &cm[''B''] or &cm[''-B''] when B has been assigned a matrix to avoid the following:\");\n return 'procname(args)';\n en d if;\n else coB:=1:\n nameB:=`B`:\n lname:=`B`:\n \+ ARGS:=[args]:\n flagdec:=false:\n end if;\nelse lname:=op (procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,name) ) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n coB :=1:\n nameB:=lname:\n end if;\n flagdec:=false:\nend if;\n#######################################\ndecindex:=proc() local \+ ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if type(op (args),function) then\n ARGS:=op(op(args));\n coB:=1:\n \+ nameB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{op(nameB)\},numeric));\n \+ nameB:=op(select(type,\{op(nameB)\},name));\n end if;\n elif \+ type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(op(args) )\}:\n coB:=op(select(type,nameB,numeric));\n nameB:=op(sele ct(type,nameB,function));\n ARGS:=op(nameB);\n nameB:=op(0,n ameB);\n else\n error \"unable to determine index or wrong inde x: use name in double quotes as in &cm[''B''] or &cm[''-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 argument s and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n###### ###############################\nif flagdec then \n coB,nameB,ARGS:= decindex(args);\n lname:=coB*nameB;\n end if;\n#return (coB,nameB,ln ame,ARGS);\nNP:=nops(ARGS);\n if member(0,ARGS) then return 0 end if; \n if NP <=1 then \n return op(ARGS)\n elif NP = 2 then \n r eturn rmulm(eval(ARGS[1]),eval(ARGS[2]),cmul,lname) \n else\n err or \"only two arguments and index are allowed\"\n end if;\nend proc: \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 234 "`&q`:=proc()\noptions `Copyr ight (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: September 17, 2005`;\n###### #######################################\nreturn qmul(args) \nend proc: \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 467 "`&qm`:=proc() local NP: \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 NP:=nops([args] );\n if member(0,[args]) then return 0 end if;\n if NP <=1 then \n \+ return args\n elif NP = 2 then \n return rmulm(eval(args[1]),e val(args[2]),qmul) \n else\n error \"only two arguments are allow ed in &qm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 351 "`&om`:=proc()\noptions `Copyright (c) 1995-2005 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: September 17, 2005`;\n########################################## ###\nif not assigned(Octonion) then\n error \"package 'Octonion' mus t be loaded first\"\nend if;\nreturn subs(Id=1,rmulm(args,Octonion:-om ul))\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1849 "`&rm`:=proc( ) local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995 -2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\n#######################################\ni f type([args],listlist) then\n if type(op(args),array) then\n W ARNING(\"enclose index in double quotes as in &rm[''B''] or &rm[''-B'' ] when B has been assigned a matrix to avoid the following:\");\n \+ return 'procname(args)';\n end if;\nend if;\n###################### #################\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if type(op(args),function) then\n \+ ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args))) ;\n if type(nameB,`&*`(numeric,name)) then\n coB:=op(sele ct(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op( nameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,f unction)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(t ype,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 type for &rm, try enclosin g name of the index in double quotes as in &rm[''B''] or &rm[''-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\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc: \n#####################################\ncoB,nameB,ARGS:=decindex(args );\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then ret urn 0 end if;\n if NP <=1 then \n return op(ARGS)\n elif NP = 2 \+ then \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),`&r`,lname) \n e lse\n error \"only two arguments and index are allowed\"\n end if ;\n end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 "`&w`:=proc() ret urn wedge(args) end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 468 "`&w m`:=proc() local NP: \noptions `Copyright (c) 1995-2005 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: September 17, 2005`;\n####################################### ######\n NP:=nops([args]);\n if member(0,[args]) then return 0 end i f;\n if NP <=1 then \n return args\n elif NP = 2 then \n ret urn rmulm(eval(args[1]),eval(args[2]),wedge) \n else\n error \"on ly two arguments are allowed in &wm\"\n end if;\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 117 "################################## ##################\nend proc: ###<< " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 70 "#march('delete',libname[1],C lifford);\n#march('create',libname[1],500);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford'):\n" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 29 "march('listdir',savelibname);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&Q@C:\\Maple9/Cliffordlib\\maple.lib6\"7(\"%.?\"#6\" #BF)\"#:\"#eQ)WRITABLEF&\"\"!" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 76 "For testing purposes, we will save in the directory `C:\\Maple9/Cliffordlib`:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 "savelibname:=\"C:\\\\Maple9/Cliffor dlib\";" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#>%,savelibnameGQ6C:\\Maple9 /Cliffordlib6\"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 "savelibn ame;" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q6C:\\Maple9/Cliffordlib6\"" } }}{EXCHG {PARA 0 "" 0 "" {TEXT -1 24 "We create archive first:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "#march('create',savelibname, 500);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford' ):\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 "march('listdir',sav elibname);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&Q@C:\\Maple9/Cliffor dlib\\maple.lib6\"7(\"%.?\"#6\"#BF)\"#:\"#eQ)WRITABLEF&\"\"!" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 97 "############################ ##################################################################### " }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 59 "Let's add library files to th e main library in libname[1]:\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 449 "march('add',libname[1],`C:\\\\Maple8/Clifforddata/matrealL.m` ,`matrealL.m`);\nmarch('add',libname[1],`C:\\\\Maple8/Clifforddata/mat realR.m`,`matrealR.m`);\nmarch('add',libname[1],`C:\\\\Maple8/Clifford data/matcompL.m`,`matcompL.m`);\nmarch('add',libname[1],`C:\\\\Maple8/ Clifforddata/matcompR.m`,`matcompR.m`);\nmarch('add',libname[1],`C:\\ \\Maple8/Clifforddata/matquatL.m`,`matquatL.m`);\nmarch('add',libname[ 1],`C:\\\\Maple8/Clifforddata/matquatR.m`,`matquatR.m`);" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 48 "and verify that indeed addition has taken place:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealL );" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"\"7#7$\"\"%\"\"$7#7 $\"\"&F*7#7$\"\"!\"\"(7#7$F0\"\"'7#7$F)F)7#7$F*F&7#7$F-F)7#7$F)F%7#7$ \"\"*F07#7$F%F%7#7$F&F17#7$F0\"\")7#7$F*F%7#7$FFF07#7$F*F*7#7$F&FF7#7$ F&F&7#7$F%F0" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(mat realR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"\"7#7$\"\"%\" \"$7#7$\"\"&F*7#7$\"\"!\"\"(7#7$F0\"\"'7#7$F)F)7#7$F*F&7#7$F-F)7#7$F)F %7#7$\"\"*F07#7$F%F%7#7$F&F17#7$F0\"\")7#7$F*F%7#7$FFF07#7$F*F*7#7$F&F F7#7$F&F&7#7$F%F0" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indice s(matcompL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"!\"\"*7#7$\"\" (F%7#7$\"\"\"\"\"'7#7$F-\"\"$7#7$\"\"%F,7#7$\"\"#F)7#7$F0F%7#7$F%\"\"& 7#7$F3F;7#7$F0F37#7$F6F07#7$\"\")F,7#7$F;F67#7$F,F6" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"!\"\"*7#7$\"\"(F%7#7$\"\"\"\"\"'7#7$F-\"\"$7#7$ \"\"%F,7#7$\"\"#F)7#7$F0F%7#7$F%\"\"&7#7$F3F;7#7$F0F37#7$F6F07#7$\"\") F,7#7$F;F67#7$F,F6" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indic es(matquatL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"&7#7$\" \"$F&7#7$\"\"!F%7#7$\"\"(F%7#7$\"\"'F%7#7$F2\"\"\"7#7$F&F57#7$F,\"\"%7 #7$F)F27#7$F/F57#7$F5F)7#7$F:F,7#7$F2F,7#7$F%F:7#7$F5F:7#7$F,F)7#7$F&F ,7#7$F%F27#7$F5F&" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indice s(matquatR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"&7#7$\"\" $F&7#7$\"\"!F%7#7$\"\"(F%7#7$\"\"'F%7#7$F2\"\"\"7#7$F&F57#7$F,\"\"%7#7 $F)F27#7$F/F57#7$F5F)7#7$F:F,7#7$F2F,7#7$F%F:7#7$F5F:7#7$F,F)7#7$F&F,7 #7$F%F27#7$F5F&" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 258 "" 0 "" {TEXT -1 26 "Last revised: Sept-17-2005" }} {PARA 0 "" 0 "" {TEXT -1 952 "NOTES:\n\n1. The table name, e.g., Cliff ord, and the file name, e.g., Clifford.m must be the same.\n2. March c ommands useful in creating and viewing library file (issue in DOS wind ow):\n\nC:\\Maple8>bin.wnt\\march -c Cliffordlib 20 - creates libra ry in a existing empty directory \\Cliffordlib\nC:\\Maple8>bin.wnt\\ma rch -l Cliffordlib - list all entries in the library Cliffordlib\nC: \\Maple8>bin.wnt\\march -l Cliffordlib > list.txt - list all entries \+ in the library Cliffordlib and write them into file list.txt\nC:\\Mapl e8>bin.wnt\\march -d Cliffordlib Clifford.m - delete Clifford.m from \+ the library Cliffordlib\n\n3. Global variable savelibname is empty, bu t savelib() automatically assigns libname[1] to savelibname for the pu rpose of saving package there with the command savelib().\n4. Maple in itialization file maple.ini contains libname augmented by the path and the directory name \\Cliffordlib where the Clifford library with Clif ford.m will be located. " }{MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 198 "########################### ############################\n###end module:\n###march('create',Cliffo rdlib,500);\n###savelib(Clifford,`Clifford.m`):\n##################### ###################################" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}} {MARK "5 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }